Merge pull request #30 from BerkeleyLab/more-string_t-constructors

Feature: construct `string_t` objects from logical & complex arguments

src/julienne/julienne_string_m.f90

@@ -2,6 +2,7 @@
 ! Terms of use are as specified in LICENSE.txt
 module julienne_string_m
   use assert_m, only : characterizable_t
+  use iso_c_binding, only : c_bool
   implicit none
 
   private
@@ -56,7 +57,7 @@ module julienne_string_m
 
   interface string_t
 
-    elemental module function construct(string) result(new_string)
+    elemental module function from_characters(string) result(new_string)
       implicit none
       character(len=*), intent(in) :: string
       type(string_t) new_string
@@ -80,6 +81,30 @@ elemental module function from_double_precision(x) result(string)
       type(string_t) string
     end function
 
+    elemental module function from_default_logical(b) result(string)
+      implicit none
+      logical, intent(in) :: b
+      type(string_t) string
+    end function
+
+    elemental module function from_logical_c_bool(b) result(string)
+      implicit none
+      logical(c_bool), intent(in) :: b
+      type(string_t) string
+    end function
+
+    elemental module function from_default_complex(z) result(string)
+      implicit none
+      complex, intent(in) :: z
+      type(string_t) string
+    end function
+
+    elemental module function from_double_precision_complex(z) result(string)
+      implicit none
+      complex(kind=kind(1D0)), intent(in) :: z
+      type(string_t) string
+    end function
+
   end interface
 
   interface operator(.cat.)

src/julienne/julienne_string_s.f90

@@ -3,13 +3,12 @@
 submodule(julienne_string_m) julienne_string_s
   use assert_m, only : assert, intrinsic_array_t
   implicit none
+
+  integer, parameter :: integer_width_supremum = 11, default_real_width_supremum = 18, double_precision_width_supremum = 25
+  integer, parameter :: logical_width=2, comma_width = 1, parenthesis_width = 1, space=1
 
 contains
 
-  module procedure construct
-    new_string%string_ = string
-  end procedure
-
   module procedure as_character
     raw_string = self%string_
   end procedure
@@ -18,22 +17,50 @@
     string_allocated = allocated(self%string_)
   end procedure
 
+  module procedure from_characters
+    new_string%string_ = string
+  end procedure
+
   module procedure from_default_integer
-    character(len=11) characters
-    write(characters, '(g0)') i
-    string = string_t(trim(characters))
+    allocate(character(len=integer_width_supremum) :: string%string_)
+    write(string%string_, '(g0)') i
+    string%string_ = trim(adjustl(string%string_))
   end procedure
 
   module procedure from_default_real
-    character(len=16) characters
-    write(characters, '(g0)') x
-    string = string_t(trim(characters))
+    allocate(character(len=double_precision_width_supremum) :: string%string_)
+    write(string%string_, '(g0)') x
+    string%string_ = trim(adjustl(string%string_))
   end procedure
 
   module procedure from_double_precision
-    character(len=24) characters
-    write(characters, '(g0)') x
-    string = string_t(trim(characters))
+    allocate(character(len=double_precision_width_supremum) :: string%string_)
+    write(string%string_, '(g0)') x
+    string%string_ = trim(adjustl(string%string_))
+  end procedure
+
+  module procedure from_default_logical
+    allocate(character(len=logical_width) :: string%string_)
+    write(string%string_, '(g0)') b
+    string%string_ = trim(adjustl(string%string_))
+  end procedure
+
+  module procedure from_logical_c_bool
+    allocate(character(len=logical_width) :: string%string_)
+    write(string%string_, '(g0)') b
+    string%string_ = trim(adjustl(string%string_))
+  end procedure
+
+  module procedure from_default_complex
+    allocate(character(len=2*default_real_width_supremum + 2*parenthesis_width + comma_width) :: string%string_)
+    write(string%string_, *) z
+    string%string_ = trim(adjustl(string%string_))
+  end procedure
+
+  module procedure from_double_precision_complex
+    allocate(character(len=space + 2*double_precision_width_supremum + 2*parenthesis_width + comma_width) :: string%string_)
+    write(string%string_, *) z
+    string%string_ = trim(adjustl(string%string_))
   end procedure
 
   module procedure concatenate_elements

test/string_test.F90

@@ -5,6 +5,7 @@
 
 module string_test_m
   use assert_m, only : assert
+  use iso_c_binding, only : c_bool
 
   use julienne_m, only : &
      test_t &
@@ -61,7 +62,15 @@ function results() result(test_results)
       test_description_t &
         (string_t('constructing from a default real value'), constructs_from_default_real), &
       test_description_t &
-        (string_t('constructing from a double precision value'), constructs_from_double_precision), &
+        (string_t('constructing from a double-precision value'), constructs_from_double_precision), &
+      test_description_t &
+        (string_t('constructing from a default-kind logical value'), constructs_from_default_logical), &
+      test_description_t &
+        (string_t('constructing from a logical(c_bool) value'), constructs_from_logical_c_bool), &
+      test_description_t &
+        (string_t('constructing from a default-precision complex value'), constructs_from_default_complex), &
+      test_description_t &
+        (string_t('constructing from a double-precision complex value'), constructs_from_double_precision_complex), &
       test_description_t &
         (string_t('supporting unary operator(.cat.) for array arguments'), concatenates_elements), &
       test_description_t &
@@ -100,6 +109,8 @@ function results() result(test_results)
     procedure(test_function_i), pointer :: &
       check_allocation_ptr, supports_equivalence_ptr, supports_non_equivalence_ptr, supports_concatenation_ptr, &
       assigns_string_ptr, assigns_character_ptr, constructs_from_integer_ptr, constructs_from_default_real_ptr, constructs_from_double_precision_ptr, &
+      constructs_from_default_logical_ptr, constructs_from_logical_c_bool_ptr, constructs_from_default_complex_ptr, &
+      constructs_from_double_precision_complex_ptr, &
       concatenates_ptr, extracts_key_ptr, extracts_real_ptr, extracts_string_ptr, extracts_logical_ptr, extracts_integer_array_ptr, &
       extracts_real_array_ptr, extracts_integer_ptr, extracts_file_base_ptr, extracts_file_name_ptr, &
       ! Remove code that exposes a gfortran compiler bug:
@@ -116,6 +127,10 @@ function results() result(test_results)
     constructs_from_integer_ptr => constructs_from_default_integer
     constructs_from_double_precision_ptr => constructs_from_double_precision
     constructs_from_default_real_ptr => constructs_from_default_real
+    constructs_from_default_logical_ptr => constructs_from_default_logical
+    constructs_from_logical_c_bool_ptr => constructs_from_logical_c_bool
+    constructs_from_default_complex_ptr => constructs_from_default_complex
+    constructs_from_double_precision_complex_ptr => constructs_from_double_precision_complex
     concatenates_ptr => concatenates_elements
     extracts_key_ptr => extracts_key
     extracts_real_ptr => extracts_real_value
@@ -146,7 +161,11 @@ function results() result(test_results)
       test_description_t(string_t('assigning a character variable to a string_t object'), assigns_character_ptr), &
       test_description_t(string_t('constructing from a default integer'), constructs_from_integer_ptr), &
       test_description_t(string_t('constructing from a default real value'), constructs_from_default_real_ptr), &
-      test_description_t(string_t('constructing from a double precision value'), constructs_from_double_precision_ptr), &
+      test_description_t(string_t('constructing from a double-precision value'), constructs_from_double_precision_ptr), &
+      test_description_t(string_t('constructing from a default-kind logical value'), constructs_from_default_logical_ptr), &
+      test_description_t(string_t('constructing from a logical(c_bool) value'), constructs_from_logical_c_bool_ptr), &
+      test_description_t(string_t('constructing from a default-precision complex value'), constructs_from_default_complex_ptr), &
+      test_description_t(string_t('constructing from a double-precision complex value'), constructs_from_double_precision_complex_ptr), &
       test_description_t(string_t('supporting unary operator(.cat.) for array arguments'), concatenates_ptr), &
       test_description_t(string_t("extracting a key string from a colon-separated key/value pair"), extracts_key_ptr), &
       test_description_t(string_t("extracting a real value from a colon-separated key/value pair"), extracts_real_ptr), &
@@ -521,6 +540,86 @@ function constructs_from_double_precision() result(passed)
 #endif
   end function
 
+  function constructs_from_default_complex() result(passed)
+    logical passed
+    complex, parameter :: z = (-1.23456789E-11, -9.87654321E-11)
+    complex read_value
+    character(len=:), allocatable :: character_representation
+
+#ifndef _CRAYFTN
+    associate(string => string_t(z))
+      character_representation = string%string()
+      read(character_representation, *) read_value
+      passed = read_value == z
+    end associate
+#else
+    block
+      type(string_t) string
+      string = string_t(z)
+      character_representation = string%string()
+      read(character_representation, *) read_value
+      passed = read_value == z
+    end block
+#endif
+  end function
+
+  function constructs_from_double_precision_complex() result(passed)
+    logical passed
+    complex(kind(1D0)), parameter :: z = (-1.234567890123456789D-11, -9.87654320123456789D-11)
+    complex(kind(1D0)) read_value
+    character(len=:), allocatable :: character_representation
+
+#ifndef _CRAYFTN
+    associate(string => string_t(z))
+      character_representation = string%string()
+      read(character_representation, *) read_value
+      passed = read_value == z
+    end associate
+#else
+    block
+      type(string_t) string
+      string = string_t(z)
+      character_representation = string%string()
+      read(character_representation, *) read_value
+      passed = read_value == z
+    end block
+#endif
+  end function
+
+  function constructs_from_default_logical() result(passed)
+    logical passed
+
+#ifndef _CRAYFTN
+    associate(true => string_t(.true.), false => string_t(.false.))
+      passed = true%string() == "T" .and. false%string() == "F"
+    end associate
+#else
+    block
+      type(string_t) true, false
+      true = string_t(.true.)
+      false = string_t(.false.)
+      passed = string%string() == "T" .and. false%string() == "F"
+    end block
+#endif
+  end function
+
+  function constructs_from_logical_c_bool() result(passed)
+    logical passed
+
+#ifndef _CRAYFTN
+    associate(true => string_t(.true._c_bool), false => string_t(.false._c_bool))
+      passed = true%string() == "T" .and. false%string() == "F"
+    end associate
+#else
+    block
+      type(string_t) true, false
+      true = string_t(.true._c_bool)
+      false = string_t(.false._c_bool)
+      passed = string%string() == "T" .and. false%string() == "F"
+    end block
+#endif
+  end function
+
   function extracts_file_base_name() result(passed)
     logical passed