Merge pull request #27 from sourceryinstitute/formats

Add module/submodule with useful format strings for reuse

Author: Damian Rouson

README.md

@@ -48,6 +48,7 @@ Contents
 * Array functions
 * String functions
 * User-defined collective subroutines
+* Input/output format strings and format string generators
 
 ### Classes
 * Parallel data partitioning and gathering,

src/formats_m.F90

@@ -0,0 +1,22 @@
+module formats_m
+  !! Useful strings for formatting `print` and `write` statements
+  implicit none
+
+  character(len=*), parameter :: csv = "(*(G0,:,','))" !! comma-separated values
+  character(len=*), parameter :: cscv = "(*('(',G0,',',G0,')',:,',')))" !! comma-separated complex values
+
+  interface
+
+    pure module function separated_values(separator, mold) result(format_string)
+      character(len=*), intent(in) :: separator 
+#ifndef NAGFOR
+      class(*), intent(in) :: mold(..)
+#else
+      class(*), intent(in) :: mold(:)
+#endif
+      character(len=:), allocatable :: format_string
+    end function
+
+  end interface
+
+end module

src/formats_s.F90

@@ -0,0 +1,35 @@
+submodule(formats_m) formats_s
+  !! Construct separated-value formats 
+  implicit none
+
+contains
+
+  module procedure separated_values
+    character(len=*), parameter :: prefix = "(*(G0,:,'"
+    character(len=*), parameter :: suffix =           "'))"
+    character(len=*), parameter :: complex_prefix = "(*('(',G0,',',G0,')',:,'" 
+
+#ifndef NAGFOR
+    select rank(mold)
+      rank(1)
+#endif
+        select type(mold)
+          type is(complex)
+            format_string = complex_prefix // separator // suffix
+          type is(real)
+            format_string = prefix // separator // suffix
+          type is(integer)
+            format_string = prefix // separator // suffix
+          type is(character(len=*))
+            format_string = prefix // separator // suffix
+          class default
+             error stop "format_s separated_values: unsupported type"
+        end select
+#ifndef NAGFOR
+      rank default
+        error stop "formats_s separated_values: unsupported rank"
+    end select
+#endif
+  end procedure
+
+end submodule formats_s

tests/formats_test.f90

@@ -0,0 +1,80 @@
+module formats_test
+
+   !! author: Damian Rouson
+   !!
+   !! summary: verify that format strings provide the desired formatting
+   use vegetables, only: &
+     result_t, test_item_t, &   ! types
+     describe, it, assert_equals ! functions
+   use formats_m, only : separated_values
+   implicit none
+
+   private
+   public :: test_object
+
+contains
+
+  function test_object() result(tests)
+    type(test_item_t) tests
+
+    tests = describe( &
+     "csv format", &
+     [it( &
+       "yields a comma-separated list of real numbers", &
+       check_csv_reals), &
+      it( &
+       "yields a space-separated list of complex numbers", &
+       check_space_separated_complex), &
+      it( &
+       "yields a comma- and space-separated list of character values", &
+       check_cssv_character), &
+      it( &
+       "yields a new-line-separated list of integer numbers", &
+       check_new_line_separated_integers)])
+  end function
+
+  function check_csv_reals() result(result_)
+    type(result_t) result_
+    character(len=*), parameter :: expected_output =  "0.00000000,1.00000000,2.00000000"
+    character(len=len(expected_output)) captured_output 
+
+    write(captured_output, fmt = separated_values(separator=",", mold=[integer::])) [0.,1.,2.]
+
+    result_ = assert_equals(expected_output, captured_output)
+  end function
+
+  function check_space_separated_complex() result(result_)
+    type(result_t) result_
+
+    character(len=*), parameter :: expected_output = "(0.00000000,1.00000000) (1.00000000,0.00000000)"
+    character(len=len(expected_output)) captured_output 
+
+    write(captured_output, fmt = separated_values(separator=" ", mold=[complex::])) [(0.,1.),(1.,0.)]
+
+    result_ = assert_equals(expected_output, captured_output)
+  end function
+
+  function check_new_line_separated_integers() result(result_)
+    type(result_t) result_
+
+    character(len=*), parameter :: expected_output = ( "0" // new_line("") // "1" //new_line("") // "2")
+    character(len=len(expected_output)) captured_output 
+
+    write(captured_output, fmt = separated_values(separator=new_line(""), mold=[integer::])) [0,1,2]
+
+    result_ = assert_equals(captured_output, "0" // new_line("") // "1" //new_line("") // "2")
+  end function
+
+  function check_cssv_character() result(result_)
+    type(result_t) result_
+
+    integer, parameter :: num_spaces=3
+    character(len=*), parameter :: expected_output = "Yodel, Ay, Hee, Hoo!"
+    character(len=len(expected_output)+num_spaces) captured_output 
+
+    write(captured_output, fmt = separated_values(separator=", ", mold=[integer::])) "Yodel", "Ay", "Hee", "Hoo!"
+
+    result_ = assert_equals(expected_output, captured_output)
+  end function
+
+end module formats_test

tests/main.f90

@@ -7,18 +7,21 @@ program main
     subroutine run()
         use data_partition_test, only: &
                 data_partition_data_partition => test_data_partition
+        use formats_test, only: &
+                formats_object => test_object
         use object_interface_test, only: &
                 object_interface_object => test_object
         use user_defined_collectives_test, only: &
                 user_defined_collectives_co_all => test_co_all
         use vegetables, only: test_item_t, test_that, run_tests
 
         type(test_item_t) :: tests
-        type(test_item_t) :: individual_tests(3)
+        type(test_item_t) :: individual_tests(4)
 
         individual_tests(1) = data_partition_data_partition()
-        individual_tests(2) = object_interface_object()
-        individual_tests(3) = user_defined_collectives_co_all()
+        individual_tests(2) = formats_object()
+        individual_tests(3) = object_interface_object()
+        individual_tests(4) = user_defined_collectives_co_all()
         tests = test_that(individual_tests)
 
         call run_tests(tests)