Merge pull request #14 from BerkeleyLab/double-precision-format

Feature: add double-precision separated value format and unit test
sourceryinstitute · Sep 3, 2024 · 6d143f3 · 6d143f3
2 parents 687ad88 + 8d37829
commit 6d143f3
Show file tree

Hide file tree

Showing 3 changed files with 35 additions and 3 deletions.
diff --git a/src/julienne/julienne_formats_s.F90 b/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)

diff --git a/test/formats_test.F90 b/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 

diff --git a/test/string_test.F90 b/test/string_test.F90
@@ -64,7 +64,7 @@ function results() result(test_results)
       test_description_t &
         (string_t("extracting an real array value from a colon-separated key/value pair"), extracts_real_array_value), &
       test_description_t &
-        (string_t("extracting an double-precision array value from a colon-separated key/value pair"), extracts_dp_array_value), &
+        (string_t("extracting a double-precision array value from a colon-separated key/value pair"), extracts_dp_array_value), &
       test_description_t &
         (string_t("extracting an integer value from a colon-separated key/value pair"), extracts_integer_value), &
       test_description_t &