Sync with upstream

fpm.toml

@@ -1,5 +1,5 @@
 name = "julienne"
-version = "1.2.0"
+version = "1.3.0"
 license = "license"
 author = "Damian Rouson, Brad Richardson, Patrick Raynaud, Katherine Rasmussen"
 maintainer = "rouson@lbl.gov"

src/julienne/julienne_formats_s.F90

@@ -18,6 +18,8 @@
         select type(mold)
           type is(complex)
             format_string = complex_prefix // separator // suffix
+          type is(double precision)
+            format_string = prefix // separator // suffix
           type is(real)
             format_string = prefix // separator // suffix
           type is(integer)
@@ -42,6 +44,8 @@
     select type(mold)
       type is(complex)
         format_string = complex_prefix // separator // suffix
+      type is(double precision)
+        format_string = prefix // separator // suffix
       type is(real)
         format_string = prefix // separator // suffix
       type is(integer)

src/julienne/julienne_github_ci_m.f90

@@ -0,0 +1,15 @@
+! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
+! Terms of use are as specified in LICENSE.txt
+module julienne_github_ci_m
+  !! Detect whether a program is running in GitHub Continuous Integration (CI)
+  implicit none
+
+  interface
+
+    logical module function GitHub_CI()
+      !! The result is true if the environment variable named "CI" is set to the string "true"
+    end function
+
+  end interface
+
+end module

src/julienne/julienne_github_ci_s.f90

@@ -0,0 +1,25 @@
+! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
+! Terms of use are as specified in LICENSE.txt
+submodule(julienne_github_ci_m) julienne_github_ci_s
+  implicit none
+
+contains
+
+  module procedure GitHub_CI
+
+    integer name_length
+    character(len=:), allocatable :: CI
+
+    call get_environment_variable("CI", length=name_length)
+
+    if (name_length==0) then
+      GitHub_CI = .false.
+    else
+      allocate(character(len=name_length):: CI)
+      call get_environment_variable("CI", value=CI)
+      GitHub_CI = merge(.true., .false., CI=="true")
+    end if
+
+  end procedure
+
+end submodule

src/julienne/julienne_string_m.f90

@@ -30,15 +30,17 @@ module julienne_string_m
                                 ,get_real_array ,get_real_array_with_character_key &
                                 ,get_integer_array, get_integer_array_with_character_key &
                                 ,get_integer, get_integer_with_character_key &
-                                ,get_double_precision, get_double_precision_with_character_key
+                                ,get_double_precision, get_double_precision_with_character_key &
+                                ,get_double_precision_array, get_double_precision_array_with_character_key
     procedure, private :: get_real, get_real_with_character_key
     procedure, private :: get_string
     procedure, private :: get_logical, get_logical_with_character_key
     procedure, private :: get_integer, get_integer_with_character_key
     procedure, private :: get_real_array, get_real_array_with_character_key
     procedure, private :: get_integer_array, get_integer_array_with_character_key
     procedure, private :: get_character, get_character_with_character_key
-    procedure :: get_double_precision, get_double_precision_with_character_key
+    procedure, private :: get_double_precision, get_double_precision_with_character_key
+    procedure, private :: get_double_precision_array, get_double_precision_array_with_character_key
     procedure, private :: string_t_ne_string_t, string_t_ne_character
     procedure, private :: string_t_eq_string_t, string_t_eq_character
     procedure, private :: assign_character_to_string_t
@@ -148,6 +150,21 @@ pure module function get_double_precision_with_character_key(self, key, mold) re
       double precision value_
     end function
 
+    pure module function get_double_precision_array(self, key, mold) result(value_)
+      implicit none
+      class(string_t), intent(in) :: self, key
+      double precision, intent(in) :: mold(:)
+      double precision, allocatable :: value_(:)
+    end function
+
+    pure module function get_double_precision_array_with_character_key(self, key, mold) result(value_)
+      implicit none
+      class(string_t), intent(in) :: self
+      character(len=*), intent(in) :: key
+      double precision, intent(in) :: mold(:)
+      double precision, allocatable :: value_(:)
+    end function
+
     pure module function get_character(self, key, mold) result(value_)
       implicit none
       class(string_t), intent(in) :: self, key

src/julienne/julienne_string_s.f90

@@ -241,6 +241,10 @@
     value_ = self%get_real_array(string_t(key), mold)
   end procedure
 
+  module procedure get_double_precision_array_with_character_key
+    value_ = self%get_double_precision_array(string_t(key), mold)
+  end procedure
+
   module procedure get_real_array
     character(len=:), allocatable :: raw_line
     real, allocatable :: real_array(:)
@@ -265,6 +269,30 @@
 
   end procedure
 
+  module procedure get_double_precision_array
+    character(len=:), allocatable :: raw_line
+    double precision, allocatable :: double_precision_array(:)
+    integer i
+
+    call assert(key==self%get_json_key(), "string_s(get_{double precision,integer}_array): key==self%get_json_key()", key)
+
+    raw_line = self%string()
+    associate(colon => index(raw_line, ":"))
+      associate(opening_bracket => colon + index(raw_line(colon+1:), "["))
+        associate(closing_bracket => opening_bracket + index(raw_line(opening_bracket+1:), "]"))
+          associate(commas => count("," == [(raw_line(i:i), i=opening_bracket+1,closing_bracket-1)]))
+            associate(num_inputs => commas + 1)
+              allocate(double_precision_array(num_inputs))
+              read(raw_line(opening_bracket+1:closing_bracket-1), fmt=*) double_precision_array
+              value_ = double_precision_array
+            end associate
+          end associate
+        end associate
+      end associate
+    end associate
+
+  end procedure
+
   module procedure string_t_eq_string_t
     lhs_eq_rhs = lhs%string() == rhs%string()
   end procedure

src/julienne/julienne_test_description_m.f90

@@ -24,9 +24,10 @@ function test_function_i() result(passes)
     procedure(test_function_i), pointer, nopass :: test_function_ => null()
   contains
     procedure run
-    procedure contains_text
+    generic :: contains_text => contains_string_t, contains_characters
+    procedure, private ::       contains_string_t, contains_characters
     generic :: operator(==) => equals
-    procedure, private :: equals
+    procedure, private ::      equals
   end type
 
   interface test_description_t
@@ -58,14 +59,22 @@ impure elemental module function run(self) result(test_result)
       type(test_result_t) test_result
     end function
 
-    impure elemental module function contains_text(self, substring) result(match)
-      !! The result is .true. if the test description includes the value of substring 
+    impure elemental module function contains_string_t(self, substring) result(match)
+      !! The result is .true. if the test description includes the value of substring
       implicit none
       class(test_description_t), intent(in) :: self
       type(string_t), intent(in) :: substring
       logical match
     end function
 
+    impure elemental module function contains_characters(self, substring) result(match)
+      !! The result is .true. if the test description includes the value of substring
+      implicit none
+      class(test_description_t), intent(in) :: self
+      character(len=*), intent(in) :: substring
+      logical match
+    end function
+
     elemental module function equals(lhs, rhs) result(lhs_eq_rhs)
       !! The result is .true. if the components of the lhs & rhs are equal
       implicit none

src/julienne/julienne_test_description_s.f90

@@ -17,10 +17,14 @@
       test_result = test_result_t(self%description_, self%test_function_())
     end procedure
 
-    module procedure contains_text
+    module procedure contains_string_t
       match = index(self%description_%string(), substring%string()) /= 0
     end procedure
 
+    module procedure contains_characters
+      match = index(self%description_%string(), substring) /= 0
+    end procedure
+
     module procedure equals
       lhs_eq_rhs = (lhs%description_ == rhs%description_) .and. associated(lhs%test_function_, rhs%test_function_)
     end procedure

src/julienne/julienne_test_result_s.F90

@@ -4,6 +4,10 @@
   use julienne_user_defined_collectives_m, only : co_all
   implicit none
 
+#ifdef __flang__
+  #define NO_MULTI_IMAGE_SUPPORT
+#endif
+
 contains
 
     module procedure construct_from_character
@@ -22,7 +26,7 @@
 
     module procedure passed
       test_passed = self%passed_
-#ifndef __flang__
+#ifndef NO_MULTI_IMAGE_SUPPORT
       call co_all(test_passed)
 #endif
     end procedure

src/julienne/julienne_test_s.F90

@@ -5,14 +5,18 @@
   use julienne_command_line_m, only : command_line_t
   implicit none
 
+#if defined(__flang__)
+  #define NO_MULTI_IMAGE_SUPPORT
+#endif
+
 contains
 
   module procedure report
-#ifndef __flang__
-    associate(me => this_image())
-#else
+#ifdef NO_MULTI_IMAGE_SUPPORT
     integer me
     me = 1
+#else
+    associate(me => this_image())
 #endif
 
 
@@ -36,7 +40,7 @@
 
       end if
 
-#ifndef __flang__
+#ifndef NO_MULTI_IMAGE_SUPPORT
       call co_broadcast(test_description_substring, source_image=1)
 #endif
 
@@ -55,7 +59,7 @@
           block 
             logical, allocatable :: passing_tests(:)
             passing_tests = test_results%passed()
-#ifndef __flang__
+#ifndef NO_MULTI_IMAGE_SUPPORT
             call co_all(passing_tests)
 #endif
             associate(num_passes => count(passing_tests))
@@ -64,7 +68,7 @@
             end associate
           end block
         end associate
-#ifndef __flang__
+#ifndef NO_MULTI_IMAGE_SUPPORT
       end associate
 #endif
 

src/julienne/julienne_user_defined_collectives_s.F90

@@ -4,13 +4,16 @@
 !     "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)",
 !     contract # NRC-HQ-60-17-C-0007
 !
+#ifdef __flang__
+  #define NO_MULTI_IMAGE_SUPPORT
+#endif
 submodule(julienne_user_defined_collectives_m) julienne_user_defined_collectives_s
   implicit none
 
 contains
 
   module procedure co_all
-#ifndef __flang__
+#ifndef NO_MULTI_IMAGE_SUPPORT
     call co_reduce(boolean, both)
 #endif
   contains

src/julienne_m.f90

@@ -1,9 +1,11 @@
 ! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
 ! Terms of use are as specified in LICENSE.txt
 module julienne_m
+  !! Global aggregation of all public entities
   use julienne_bin_m, only : bin_t
   use julienne_command_line_m, only : command_line_t
   use julienne_file_m, only : file_t
+  use julienne_github_ci_m, only : github_ci
   use julienne_formats_m, only : separated_values, csv
   use julienne_string_m, only : string_t, operator(.cat.)
   use julienne_test_m, only : test_t, test_description_substring
@@ -18,6 +20,7 @@ module julienne_m
   public :: command_line_t
   public :: operator(.cat.)
   public :: file_t
+  public :: github_ci
   public :: separated_values
   public :: string_t
   public :: test_t

test/formats_test.F90

@@ -32,19 +32,25 @@ function results() result(test_results)
 #ifndef __GFORTRAN__
     test_descriptions = [ & 
       test_description_t(string_t("yielding a comma-separated list of real numbers"), check_csv_reals), &
+      test_description_t(string_t("yielding a comma-separated list of double-precision numbers"), check_csv_double_precision), &
       test_description_t(string_t("yielding a space-separated list of complex numbers"), check_space_separated_complex), &
       test_description_t(string_t("yielding a comma- and space-separated list of character values"), check_csv_character), &
       test_description_t(string_t("yielding a new-line-separated list of integer numbers"), check_new_line_separated_integers) &
     ]   
 #else
     ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument:
-    procedure(test_function_i), pointer :: check_csv_reals_ptr, check_space_ptr, check_csv_char_ptr, check_new_line_ptr
+    procedure(test_function_i), pointer :: &
+      check_csv_reals_ptr, check_space_ptr, check_csv_char_ptr, check_new_line_ptr, check_csv_double_precision_ptr
+
     check_csv_reals_ptr => check_csv_reals
+    check_csv_double_precision_ptr => check_csv_double_precision
     check_space_ptr => check_space_separated_complex
     check_csv_char_ptr => check_csv_character 
     check_new_line_ptr => check_new_line_separated_integers
+
     test_descriptions = [ & 
       test_description_t(string_t("yielding a comma-separated list of real numbers"), check_csv_reals_ptr), &
+      test_description_t(string_t("yielding a comma-separated list of double-precision numbers"), check_csv_double_precision_ptr), &
       test_description_t(string_t("yielding a space-separated list of complex numbers"), check_space_ptr), &
       test_description_t(string_t("yielding a comma- and space-separated list of character values"), check_csv_char_ptr), &
       test_description_t(string_t("yielding a new-line-separated list of integer numbers"), check_new_line_ptr) &
@@ -62,7 +68,7 @@ function check_csv_reals() result(test_passes)
     character(len=100) captured_output 
     real zero, one, two
 
-    write(captured_output, fmt = separated_values(separator=",", mold=[integer::])) [0.,1.,2.]
+    write(captured_output, fmt = separated_values(separator=",", mold=[real::])) [0.,1.,2.]
 
     associate(first_comma => index(captured_output, ','))
       associate(second_comma => first_comma + index(captured_output(first_comma+1:), ','))
@@ -74,6 +80,28 @@ function check_csv_reals() result(test_passes)
     end associate
   end function
 
+  function check_csv_double_precision() result(test_passes)
+    logical test_passes
+    character(len=200) captured_output
+    integer, parameter :: dp = kind(0D0)
+    double precision, parameter :: pi = 3.14159265358979323846_dp
+    double precision, parameter :: e  = 2.71828182845904523536_dp
+    double precision, parameter :: phi = 1.61803398874989484820_dp
+    double precision, parameter :: values_to_write(*) = [double precision:: e, pi, phi]
+    double precision values_read(size(values_to_write))
+
+    write(captured_output, fmt = separated_values(separator=",", mold=[double precision::])) values_to_write
+
+    associate(first_comma => index(captured_output, ','))
+      associate(second_comma => first_comma + index(captured_output(first_comma+1:), ','))
+        read(captured_output(:first_comma-1), *) values_read(1)
+        read(captured_output(first_comma+1:second_comma-1), *) values_read(2)
+        read(captured_output(second_comma+1:), *) values_read(3)
+        test_passes = all(values_to_write == values_read)
+      end associate
+    end associate
+  end function
+
   function check_space_separated_complex() result(test_passes)
     logical test_passes 
     character(len=100) captured_output