Stop and print

.github/workflows/build.yml

@@ -293,6 +293,25 @@ jobs:
           test ${PIPESTATUS[0]} > 0 && grep -q "expected 2; actual value is 1" output
         )
 
+    - name: Run Stop-and-Print Example (Assertions ON)
+      if: ${{ matrix.compiler == 'gfortran' || 
+             (matrix.compiler == 'flang' && (matrix.version >= 20 || matrix.version == 'latest') ) }}
+      env:
+        FPM_FLAGS: ${{ env.FPM_FLAGS }} --flag -DASSERTIONS
+      run: |
+        ( set +e
+          fpm run --example pure-stop-and-print ${FPM_FLAGS} --flag "$FFLAGS" -- --array 2>&1 | tee output
+          test ${PIPESTATUS[0]} > 0 && grep -q "212,222" output
+        )
+        ( set +e
+          fpm run --example pure-stop-and-print ${FPM_FLAGS} --flag "$FFLAGS" -- --derived-type 2>&1 | tee output
+          test ${PIPESTATUS[0]} > 0 && grep -q "answer = 42" output
+        )
+        ( set +e
+          fpm run --example pure-stop-and-print ${FPM_FLAGS} --flag "$FFLAGS" -- --file fpm.toml 2>&1 | tee output
+          test ${PIPESTATUS[0]} > 0 && grep -q "[install]" output
+        )
+
     - name: Test w/ Parallel Callbacks
       env:
         FPM_FLAGS: ${{ env.FPM_FLAGS }} --flag -DJULIENNE_PARALLEL_CALLBACKS --flag -DTEST_PARALLEL_CALLBACKS

README.md

@@ -4,13 +4,34 @@
 
 Julienne: Idiomatic Correctness Checking for Fortran 2023
 =========================================================
-The Julienne framework offers a unified approach to writing unit tests and
-assertions.  Julienne defines idioms for specifying correctness conditions in a
-common in tests that wrap the tested procedures or assertions that conditionally
-execute inside procedures.  Julienne idioms center around expressions built from
+The Julienne framework offers unified approaches to unit testing, assertion
+enforcement, and formatted error-output inside `pure` procedures.  Julienne
+defines idioms for specifying correctness conditions in a common way in tests
+that wrap the tested procedures or assertions that conditionally execute inside
+procedures.  Julienne idioms center around expressions built from
 defined operations: a uniquely flexible Fortran capability allowing developers
 to define _new_ operators or to overloading Fortran's intrinsic operators.
 
+Output in pure procedures
+-------------------------
+Julienne's `stop_and_print` generic interface facilitates automatic or user-defined
+formatting of various data types and ranks inside `pure` procedures via either of two
+specific subroutines:
+
+1. One with a Julienne `string_t` dummy argument and
+2. Another with `character` and unlimited-polymorphic/assumed-rank dummy arguments.
+
+The first subroutine accepts Julienne `string_t` expressions that, for example, convert
+numeric arrays to comma-separated text with `.csv. string_t([1,2,3])`.  The second
+subroutine prints its `character` argument as a header followed by user-formatted or
+automatically-formatted representrations of its polymorphic argument.  Julienne
+automatically formats and prints numeric scalars or arrays up to rank 3.  Users can
+format information for printing by encapsulating the text in a Julienne `file_t` object
+or passing an object, or object wrapper, that extends Julienne's `writable_t` abstract
+type and defines the so-inherited `write(formatted)` generic binding.
+
+Expressive idioms
+-----------------
 Example expressions                                  | Supported operand types
 -----------------------------------------------------|--------------------------------------
 `x .approximates. y .within. tolerance`              | `real`, `double precision` for `x`, `y`, `tolerance`
@@ -38,8 +59,6 @@ where
 * `.equalsExpected.` generates asymmetric diagnostic output for failures, denoting the left- and right-hand sides as the actual value and expected values, respectively; and
 * `//` appends the subsequent string to diagnostics strings, if any.
 
-Expressive idioms
------------------
 ### Assertions
 Any of the above expressions can be the actual argument in an invocation of
 Julienne's `call_julienne_assert` function-line preprocessor macro:

example/README.md

@@ -4,5 +4,6 @@ Please see the following directories for examples of the listed Julienne uses:
 
 * [Assertions](./assertions): runtime assertion checking using idioms that evaluate to `test_diagnosis_t` result objects,
 * [Command-line parsing](./command-line-parsing): checking a command-line flag's presence and getting an associated value using the `command_line_t` type,
+* [Printing in procedures](./pure-printing): producing automatically-formatted or user-formatted text in `pure` procedures via the `stop_and_print` subroutine,
 * [String operations](./strings): operating on strings using the `string_t` type and defined operations, and
 * [Testing](../demo): a demonstration unit test suite using the `test_t` type.

example/pure-printing/README.md

@@ -0,0 +1,58 @@
+Pure Printing
+=============
+
+This directory contains a program and a supporting module/submodule
+pair that collectively demonstrate the use of Julienne's
+`stop_and_print` subroutine designed for use inside `pure` procedures.
+Specifically, the program shows how to print the following entities:
+
+- a text file,
+- a two-dimensional (2D) integer array, or
+- an object of derived type.
+
+```
+Usage:
+  fpm run \
+     --example pure-stop-and-print \
+     --compiler flang --profile release \
+     -- [-h|--help] | [--file <name>] | [--array] | [--derived-type]
+```
+
+where pipes (|) separate alternatives, square brackets ([]) delimit
+optional arguments, and angular brackets (<>) delimit user input.
+
+Getting help
+------------
+The following command prints the above usage text:
+
+```
+  fpm run --example pure-stop-and-print --compiler flang -- --help
+```
+
+Examples
+--------
+### Printing a 2D integer array
+The following command prints a 2D integer array defined in the example program:
+
+```
+  fpm run --example pure-stop-and-print --compiler flang -- --array
+```
+
+### Printing a derived type
+The following command prints the derived type defined in this directory's
+[write_stuff_m](./write_stuff_m.F90)) module:
+
+```
+  fpm run --example pure-stop-and-print --compiler flang -- --derived-type
+```
+
+using the derived-type output procedure in the [write_stuff_s](./write_stuff_s.F90))
+submodule.
+
+### Printing a text file
+
+The following command prints this repository's `fpm` manifest: `fpm.toml`.
+
+```
+  fpm run --example pure-stop-and-print --compiler flang -- --file fpm.toml
+```

example/pure-printing/pure-stop-and-print.F90

@@ -0,0 +1,55 @@
+! Copyright (c) 2024-2026, The Regents of the University of California and Sourcery Institute
+! Terms of use are as specified in LICENSE.txt
+
+#include "language-support.F90"
+
+program pure_stop_and_print
+#if HAVE_STOP_AND_PRINT_SUPPORT
+  !! Demonstrate Julienne's support for printing during error termination inside pure procedures
+  use julienne_m, only : &
+     command_line_t &
+    ,file_t &
+    ,stop_and_print &
+    ,string_t
+  use write_stuff_m, only : write_stuff_t
+  implicit none
+
+  type(command_line_t) command_line
+  character(len=:), allocatable :: stop_code, file_name
+
+  stop_code = usage_info()
+  if (      command_line%string_argument_present( [string_t("--help"), string_t("-h")                                 ] ))       stop stop_code
+  if (.not. command_line%string_argument_present( [string_t("--file"), string_t("--array"), string_t("--derived-type")] )) error stop stop_code
+
+  file_name = command_line%flag_value("--file")
+  if (len(file_name) > 0) then
+    call pure_subroutine(.false., .false., file_t(file_name))
+  end if
+  call pure_subroutine(command_line%argument_present(["--array"]), command_line%argument_present(["--derived-type"]))
+
+contains
+
+  pure subroutine pure_subroutine(print_array, print_derived_type, file)
+    logical, intent(in) :: print_array, print_derived_type
+    type(file_t), intent(in), optional :: file
+    if (present(file))      call stop_and_print(header = "______________", data = file, footer = "______________")
+    if (print_array)        call stop_and_print(reshape([111,211,121,221, 112,212,122,222], [2,2,2]))
+    if (print_derived_type) call stop_and_print(write_stuff_t())
+  end subroutine
+
+  pure function usage_info() result(message)
+    character(len=:), allocatable :: message
+    message = new_line('') // new_line('') &
+      // 'Usage:' // new_line('') // new_line('') &
+      // '  fpm run \'  // new_line('') &
+      // '     --example pure-stop-and-print \'  // new_line('') &
+      // '     --compiler flang --profile release \' // new_line('') &
+      // '     -- [-h|--help] | [--file <name>] | [--array] | [--derived-type]' // new_line('') // new_line('') &
+      // 'where pipes (|) separate alternatives, square brackets ([]) delimit' // new_line('') &
+      // 'optional arguments, and angular brackets (<>) delimit user input.' // new_line('')
+   end function
+
+#else
+  error stop "Julienne's stop_and_print feature is not supported on this compiler"
+#endif
+end program pure_stop_and_print

example/pure-printing/write_stuff_m.F90

@@ -0,0 +1,32 @@
+! Copyright (c) 2024-2026, The Regents of the University of California and Sourcery Institute
+! Terms of use are as specified in LICENSE.txt
+
+#include "language-support.F90"
+
+#if HAVE_STOP_AND_PRINT_SUPPORT
+module write_stuff_m
+  !! Demonstrate a derived type that is writable to a stop  via Julienne's stop_and_print utility
+  use julienne_m, only : writable_t
+  implicit none
+
+  type, extends(writable_t) :: write_stuff_t
+    integer :: answer_ = 42
+  contains
+    procedure :: write_formatted
+  end type
+
+  interface
+
+    module subroutine write_formatted(self, unit, edit_descriptor, v_list, iostat, iomsg)
+      class(write_stuff_t), intent(in) :: self
+      integer, intent(in) :: unit
+      character(len=*), intent(in) :: edit_descriptor
+      integer, intent(in) :: v_list(:)
+      integer, intent(out) :: iostat
+      character(len=*), intent(inout) :: iomsg
+    end subroutine
+
+  end interface
+
+end module
+#endif

example/pure-printing/write_stuff_s.F90

@@ -0,0 +1,21 @@
+! Copyright (c) 2024-2026, The Regents of the University of California and Sourcery Institute
+! Terms of use are as specified in LICENSE.txt
+
+#include "language-support.F90"
+
+#if HAVE_STOP_AND_PRINT_SUPPORT
+submodule(write_stuff_m) write_stuff_s
+  implicit none
+
+contains
+
+  module procedure  write_formatted
+    write(unit,'(a)'     ) new_line('')
+    write(unit,'(a)'     ) "write_stuff_t {" // new_line('')
+    write(unit,'(a,i2,a)') "  answer = ", self%answer_, new_line('')
+    write(unit,'(a)'     ) "}" // new_line('')
+    iostat = 0
+  end procedure
+
+end submodule
+#endif

include/language-support.F90

@@ -14,6 +14,12 @@
 #define GCC_GE_MINIMUM
 #endif
 
+#if defined(__GFORTRAN__) || __flang_major__ >= 20
+#  define HAVE_STOP_AND_PRINT_SUPPORT 1
+#else
+#  define HAVE_STOP_AND_PRINT_SUPPORT 0
+#endif
+
 ! If not already determined, make a compiler-dependent determination of whether Julienne may use
 ! multi-image features such as `this_image()` and `sync all`.
 #ifndef HAVE_MULTI_IMAGE_SUPPORT

src/julienne/julienne_command_line_m.f90

@@ -3,15 +3,18 @@
 
 module julienne_command_line_m
   !! return command line argument information
+  use julienne_string_m, only : string_t
   implicit none
 
   private
   public :: command_line_t
 
   type command_line_t
   contains
-    procedure, nopass :: argument_present
-    procedure, nopass :: flag_value
+    generic :: generic_argument_present => argument_present, string_argument_present
+    procedure, nopass :: argument_present, string_argument_present
+    generic :: generic_flag_value => flag_value, string_flag_value
+    procedure, nopass :: flag_value, string_flag_value
   end type
 
   interface
@@ -26,12 +29,26 @@ module function argument_present(acceptable_argument) result(found)
       logical found
     end function
 
-    module function flag_value(flag)
+    module function string_argument_present(acceptable_argument) result(found)
+      implicit none
+      !! same as `character_argument_present` but allowing ragged-edged array of character values
+      type(string_t), intent(in) :: acceptable_argument(:)
+      logical found
+    end function
+
+    module function flag_value(flag) result(value)
       !! result = { the value passed immediately after a command-line flag if the flag is present or
       !!          { an empty string otherwise.
       implicit none
       character(len=*), intent(in) :: flag
-      character(len=:), allocatable :: flag_value
+      character(len=:), allocatable :: value
+    end function
+
+    module function string_flag_value(flag) result(value)
+      !! same as `character_flag_value` but accepting a string_t dummy argument
+      implicit none
+      type(string_t), intent(in) :: flag
+      character(len=:), allocatable :: value
     end function
 
   end interface

src/julienne/julienne_command_line_s.f90 → src/julienne/julienne_command_line_s.F90

@@ -1,12 +1,40 @@
-! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute
+! Copyright (c) 2024-2026, The Regents of the University of California and Sourcery Institute
 ! Terms of use are as specified in LICENSE.txt
 
+#include "language-support.F90"
+
 submodule(julienne_command_line_m) julienne_command_line_s
   implicit none
 
 contains
 
-  module procedure argument_present
+  module procedure string_argument_present
+     integer a, sz, maxlen
+
+     sz = size(acceptable_argument)
+     maxlen = maxval([(len(acceptable_argument(a)%string()), a = 1,sz)])
+     block
+       character(maxlen) :: strings(size(acceptable_argument))
+       do a=1,sz
+         strings(a) = acceptable_argument(a)%string()
+       end do
+       found = argument_present(strings)
+     end block
+# ifdef __INTEL_COMPILER
+  ! workaround ifx bug where it thinks argument to len must be a constant expression
+  contains
+    pure function len(char) result(l)
+      character(len=*), intent(in) :: char
+      integer :: l
+      block
+        intrinsic :: len
+        l = len(char)
+      end block
+    end function
+# endif
+  end procedure
+
+  module procedure argument_present ! specific procedure for character argument
       !! list of acceptable arguments
       !! sample list: [character(len=len(longest_argument)):: "--benchmark", "-b", "/benchmark", "/b"]
       !! where dashes support Linux/macOS and slashes support Windows
@@ -38,23 +66,27 @@
 
   end procedure
 
-  module procedure flag_value
-    integer argnum, arglen, flag_value_length
+  module procedure string_flag_value
+    value = flag_value(flag%string())
+  end procedure
+
+  module procedure flag_value ! specific procedure for character argument
+    integer argnum, arglen, value_length
     character(len=:), allocatable :: arg
 
     do argnum = 1,command_argument_count()-1
       call get_command_argument(argnum, length=arglen)
       allocate(character(len=arglen) :: arg)
       call get_command_argument(argnum, arg)
       if (arg==flag) then
-        call get_command_argument(argnum+1, length=flag_value_length)
-        allocate(character(len=flag_value_length) :: flag_value)
-        call get_command_argument(argnum+1, flag_value)
+        call get_command_argument(argnum+1, length=value_length)
+        allocate(character(len=value_length) :: value)
+        call get_command_argument(argnum+1, value)
         return
       end if
       deallocate(arg)
     end do
-    flag_value=""
+    value=""
   end procedure
 
 end submodule