feat(string_t): is_allocated type-bound procedure

Author: rouson

src/string_m.f90

@@ -10,6 +10,7 @@ module string_m
     character(len=:), allocatable :: string_
   contains
     procedure :: string
+    procedure :: is_allocated
   end type
 
   interface string_t
@@ -35,7 +36,13 @@ pure module function array_of_strings(delimited_strings, delimiter) result(strin
       character(len=*), intent(in) :: delimited_strings, delimiter
       type(string_t), allocatable :: strings_array(:)
     end function
-   
+
+    elemental module function is_allocated(self) result(string_allocated)
+      implicit none
+      class(string_t), intent(in) :: self
+      logical string_allocated
+    end function
+
   end interface
 
 end module string_m

src/string_s.f90

@@ -3,13 +3,17 @@
 
 contains
 
-    module procedure construct
-      new_string%string_ = string
-    end procedure
+  module procedure construct
+    new_string%string_ = string
+  end procedure
+
+  module procedure string
+    raw_string = self%string_
+  end procedure
 
-    module procedure string
-      raw_string = self%string_
-    end procedure
+  module procedure is_allocated
+    string_allocated = allocated(self%string_)
+  end procedure
 
   module procedure array_of_strings
     character(len=:), allocatable :: remainder, next_string

test/main.f90

@@ -5,6 +5,7 @@ program main
   use formats_test, only : formats_test_t  
   use test_result_test, only : test_result_test_t  
   use command_line_test, only : command_line_test_t
+  use string_test, only : string_test_t
   implicit none
 
   type(collectives_test_t) collectives_test
@@ -13,6 +14,7 @@ program main
   type(object_test_t) object_test
   type(test_result_test_t) test_result_test
   type(command_line_test_t) command_line_test
+  type(string_test_t) string_test
 
   integer :: passes=0, tests=0
 
@@ -22,6 +24,7 @@ program main
   call formats_test%report(passes, tests)
   call test_result_test%report(passes, tests)
   call command_line_test%report(passes, tests)
+  call string_test%report(passes, tests)
 
   print *
   print *,"_________ In total, ",passes," of ",tests, " tests pass. _________"

test/string_test.f90

@@ -0,0 +1,40 @@
+module string_test
+  use test_m, only : test_t, test_result_t
+  use string_m, only : string_t
+  implicit none
+
+  private
+  public :: string_test_t
+
+  type, extends(test_t) :: string_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+contains
+
+  pure function subject() result(specimen)
+    character(len=:), allocatable :: specimen
+    specimen = "The string_t type"
+  end function
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
+
+    test_results = [ &
+      test_result_t("is_allocated() result .true. if & only if the string_t component(s) is/are allocated", check_allocation()) &
+    ]
+  end function
+
+  pure function check_allocation() result(passed)
+    type(string_t) :: scalar_not_allocated, scalar_allocated, array_allocated(2), array_not_allocated(2)
+    logical passed
+
+    scalar_allocated = string_t("")
+    array_allocated = [string_t("yada yada"), string_t("blah blah blah")]
+    passed = (.not. any([scalar_not_allocated%is_allocated(), array_not_allocated%is_allocated()])) .and. &
+             (all([scalar_allocated%is_allocated(), array_allocated%is_allocated()]))
+  end function
+
+end module string_test