Merge pull request #39 from sourceryinstitute/add-file-abstraction

Feature: add `file_t` file abstraction

Author: rouson

src/file_m.f90

@@ -0,0 +1,48 @@
+module file_m
+  !! A representation of a file as an object
+  use string_m, only : string_t
+
+  private
+  public :: file_t
+
+  type file_t
+    private
+    type(string_t), allocatable :: lines_(:)
+  contains
+    procedure :: lines
+    procedure :: write_lines
+  end type
+
+  interface file_t
+
+    impure elemental module function read_lines(file_name) result(file_object)
+      implicit none
+      type(string_t), intent(in) :: file_name
+      type(file_t) file_object
+    end function
+
+    pure module function construct(lines) result(file_object)
+      implicit none
+      type(string_t), intent(in), allocatable :: lines(:)
+      type(file_t) file_object
+    end function
+
+  end interface
+
+  interface
+
+    pure module function lines(self)  result(my_lines)
+      implicit none
+      class(file_t), intent(in) :: self
+      type(string_t), allocatable :: my_lines(:)
+    end function
+
+    impure elemental module subroutine write_lines(self, file_name)
+      implicit none
+      class(file_t), intent(in) :: self
+      type(string_t), intent(in), optional :: file_name
+    end subroutine
+
+  end interface
+
+end module file_m

src/file_s.f90

@@ -0,0 +1,107 @@
+submodule(file_m) file_s
+  use iso_fortran_env, only : iostat_end, iostat_eor, output_unit
+  use assert_m, only : assert
+  implicit none
+
+contains
+
+  module procedure construct
+    file_object%lines_ = lines
+  end procedure
+
+  module procedure write_lines
+
+    integer file_unit, io_status, l
+
+    call assert(allocated(self%lines_), "file_t%write_lines: allocated(self%lines_)")
+
+    if (present(file_name)) then
+      open(newunit=file_unit, file=file_name%string(), form='formatted', status='unknown', iostat=io_status, action='write')
+      call assert(io_status==0,"write_lines: io_status==0 after 'open' statement", file_name%string())
+    else
+      file_unit = output_unit
+    end if
+
+    do l = 1, size(self%lines_)
+      write(file_unit, *) self%lines_(l)%string()
+    end do
+
+    if (present(file_name)) close(file_unit)
+  end procedure
+  
+  module procedure read_lines
+
+    integer io_status, file_unit, line_num
+    character(len=:), allocatable :: line
+    integer, parameter :: max_message_length=128
+    character(len=max_message_length) error_message
+    integer, allocatable :: lengths(:)
+
+    open(newunit=file_unit, file=file_name%string(), form='formatted', status='old', iostat=io_status, action='read')
+    call assert(io_status==0,"read_lines: io_status==0 after 'open' statement", file_name%string())
+
+    lengths = line_lengths(file_unit)
+
+    associate(num_lines => size(lengths))
+
+      allocate(file_object%lines_(num_lines))
+  
+      do line_num = 1, num_lines
+        allocate(character(len=lengths(line_num)) :: line)
+        read(file_unit, '(a)', iostat=io_status, iomsg=error_message) line
+        call assert(io_status==0,"read_lines: io_status==0 after line read", error_message)
+        file_object%lines_(line_num) = string_t(line)
+        deallocate(line)
+      end do
+
+    end associate
+
+    close(file_unit)
+
+  contains
+   
+    function line_count(file_unit) result(num_lines)
+      integer, intent(in) :: file_unit
+      integer num_lines
+    
+      rewind(file_unit)
+      num_lines = 0 
+      do  
+        read(file_unit, *, iostat=io_status)
+        if (io_status==iostat_end) exit
+        num_lines = num_lines + 1 
+      end do
+      rewind(file_unit)
+    end function
+
+    function line_lengths(file_unit) result(lengths)
+      integer, intent(in) :: file_unit
+      integer, allocatable ::  lengths(:)
+      integer io_status
+      character(len=1) c
+
+      associate(num_lines => line_count(file_unit))
+
+        allocate(lengths(num_lines), source = 0)
+        rewind(file_unit)
+
+        do line_num = 1, num_lines
+          do
+            read(file_unit, '(a)', advance='no', iostat=io_status, iomsg=error_message) c
+            if (io_status==iostat_eor .or. io_status==iostat_end) exit
+            lengths(line_num) = lengths(line_num) + 1
+          end do
+        end do
+
+        rewind(file_unit)
+  
+      end associate
+    end function
+
+  end procedure
+
+  module procedure lines
+    my_lines = self%lines_
+  end procedure
+
+end submodule file_s

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