diff --git a/src/julienne/julienne_formats_s.F90 b/src/julienne/julienne_formats_s.F90 index 84e9d0f..293feb1 100644 --- 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 index 5f307ef..ca719d1 100644 --- 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 index 5540312..018d111 100644 --- 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 &