Merge pull request #7 from sourceryinstitute/support-llvm-flang

Support LLVM Flang (`flang-new`)

README.md

@@ -1,11 +1,17 @@
 Julienne
 ========
 
-Spun off from the [Sourcery] proving ground and inspired by [Veggies], Julienne provides unit-testing and string-handling capabilities for modern Fortran. 
-Julienne's originator developed Sourcery, enjoyed using Veggies, and sought to capture a thin slice of the Veggies capabilities while avoiding the compiler limitations that prevented use of Sourcery or Veggies.
-Julienne achieves compiler-portability through minimalism and isolation, offering a thin slice of the capabilities of Veggies with no external dependencies. 
-Julienne contains those parts of Sourcery that the recent versions of most Fortran compilers support.
+Spun off from [Sourcery] and inspired by [Veggies], Julienne is a modern-Fortran unit-testing framework and utility for manipulating strings, including command lines and input/output format strings. 
+This repository's name derives from the term for vegetables sliced into thin strings: julienn vegetables.
+This software repository captures the authors' most frequently used thin slice of the Veggies and Sourcery repositories while avoiding certain compiler limitations.
+Julienne achieves portability across compilers through minimalism and isolation.
+Thus Julienne has no external dependencies and offers limited but widely useful capabilities.
+A need for unit testing support drive the creation of Julienne.
+The string-handling capabilities are included primarily because they support Julienne's unit-testing code.
 
+Examples
+--------
+For examples of how to use Julienne, please see the [examples](./examples) subdirectory.
 
 Building and Testing
 --------------------
@@ -24,16 +30,19 @@ fpm test --compiler nagfor --flag -fpp
 ```
 fpm test --compiler flang-new --flag "-mmlir -allow-assumed-rank"
 ```
-LLVM Flang's capabilities are evolving rapidly so we recommend building a recent version of the main branch of llvm-project.
-A script that could be helpful for doing so is [here].
+where the flags `-mmlir -allow-assumed-rank` turn on LLVM Flang's experimental support for Fortran's assumed-rank dummy arguments.
+Flang's capabilities are evolving rapidly so we recommend building a recent version of the main branch of llvm-project.
+A script that might be helpful for doing so is in the [handy-dandy] repository.
 
 Documentation
 -------------
-Build the documentation with 
+See our online [documentation] or build the documentation locally by installing [FORD] and executing
 ```
 ford ford.md
 ```
-
 [Sourcery]: https://github.com/sourceryinstitute/sourcery
 [Veggies]: https://gitlab.com/everythingfunctional/veggies
 [here]: https://github.com/rouson/handy-dandy/blob/7caaa4dc3d6e5331914a3025f0cb1db5ac1a886f/src/fresh-llvm-build.sh
+[documentation]: https://sourceryinstitute.github.io/assert/
+[FORD]: https://github.com/Fortran-FOSS-Programmers/ford 
+[handy-dandy]: https://github.com/rouson/handy-dandy/blob/7caaa4dc3d6e5331914a3025f0cb1db5ac1a886f/src/fresh-llvm-build.sh

src/julienne/julienne_bin_m.f90

@@ -0,0 +1,45 @@
+module julienne_bin_m
+  !! distribute item numbers across bins such that the number of items differs by at most 1 between any two bins
+  implicit none
+
+  private
+  public :: bin_t
+
+  type bin_t
+    !! encapsulate a range of item numbers associated with a bin 
+    private
+    integer  first_, last_
+  contains
+    procedure first
+    procedure last
+  end type
+
+  interface bin_t
+
+    elemental module function construct(num_items, num_bins, bin_number) result(bin)
+      !! the result is a bin associated with a range of item numbers
+      integer, intent(in) :: num_items, num_bins, bin_number
+      type(bin_t) bin
+    end function
+
+  end interface
+
+  interface
+
+    elemental module function first(self) result(first_item_number)
+      !! the result is the first item number associated with the given bin
+      implicit none
+      class(bin_t), intent(in) :: self
+      integer first_item_number
+    end function
+
+    elemental module function last(self) result(last_item_number)
+      !! the result is the last item number associated with the given bin
+      implicit none
+      class(bin_t), intent(in) :: self
+      integer last_item_number
+    end function
+
+  end interface
+
+end module julienne_bin_m

src/julienne/julienne_bin_s.f90

@@ -0,0 +1,33 @@
+submodule(julienne_bin_m) julienne_bin_s
+  use assert_m, only : assert, intrinsic_array_t
+  implicit none
+
+contains
+
+  module procedure construct
+
+      call assert( num_items>=num_bins, "bin_s(construct): num_items>=num_bins", intrinsic_array_t([num_items,num_bins]))
+
+      associate( remainder => mod(num_items, num_bins), items_per_bin => num_items/num_bins)
+
+        if (bin_number <= remainder) then
+          bin%first_ = 1 + (bin_number-1)*(items_per_bin+1)
+          bin%last_  = bin_number*(items_per_bin+1)
+        else
+          bin%first_ = 1 + (remainder-1)*(items_per_bin+1) + 1 + (bin_number-remainder)*items_per_bin
+          bin%last_ = remainder*(items_per_bin+1) + (bin_number-remainder)*items_per_bin
+        end if
+
+      end associate
+
+  end procedure
+
+  module procedure first
+    first_item_number  = self%first_
+  end procedure
+
+  module procedure last
+    last_item_number = self%last_
+  end procedure
+
+end submodule julienne_bin_s

src/julienne/julienne_file_m.f90

@@ -0,0 +1,48 @@
+module julienne_file_m
+  !! A representation of a file as an object
+  use julienne_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
+
+    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) :: 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 julienne_file_m

src/julienne/julienne_file_s.f90

@@ -0,0 +1,107 @@
+submodule(julienne_file_m) julienne_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 julienne_file_s

src/julienne/julienne_test_s.F90

@@ -8,11 +8,15 @@
 contains
 
   module procedure report
-
+#ifndef __flang__
     associate(me => this_image())
+#else
+    integer me
+    me = 1
+#endif
 
-      if (me==1) then
 
+      if (me==1) then
 
         first_report: &
         if (.not. allocated(test_description_substring)) then
@@ -60,7 +64,10 @@
             end associate
           end block
         end associate
+#ifndef __flang__
       end associate
+#endif
+
 #else
       block
         logical, allocatable :: passing_tests(:)
@@ -76,9 +83,7 @@
             end do
           end if
           passing_tests = test_results%passed()
-#ifndef __flang__
           call co_all(passing_tests)
-#endif
           associate(num_passes => count(passing_tests))
             if (me==1) print '(a,2(i0,a))'," ",num_passes," of ", num_tests," tests pass."
             passes = passes + num_passes

src/julienne/julienne_vector_test_description_m.f90

@@ -64,28 +64,4 @@ module function contains_text(self, substring) result(match_vector)
 
   end interface
 
-contains
-
-  module procedure contains_text
-    integer i
-    associate(num_descriptions => size(self%description_vector_))
-      allocate(match_vector(num_descriptions))
-      do i = 1, num_descriptions
-        match_vector(i) = index(self%description_vector_(i)%string(), substring ) /= 0
-      end do
-    end associate
-  end procedure
-
-  module procedure construct
-    vector_test_description%description_vector_ = description_vector
-    vector_test_description%vector_function_strategy_ = vector_function_strategy
-  end procedure
-
-  module procedure run
-    associate(vector_result => self%vector_function_strategy_%vector_function())
-      call assert(size(self%description_vector_)==size(vector_result), "julienne_vector_test_description_s: size match")
-      test_results = test_result_t(self%description_vector_, vector_result)
-    end associate
-  end procedure
-
 end module julienne_vector_test_description_m

src/julienne/julienne_vector_test_description_s.f90

@@ -0,0 +1,28 @@
+submodule(julienne_vector_test_description_m) julienne_vector_test_description_s
+  implicit none
+
+contains
+
+  module procedure contains_text
+    integer i
+    associate(num_descriptions => size(self%description_vector_))
+      allocate(match_vector(num_descriptions))
+      do i = 1, num_descriptions
+        match_vector(i) = index(self%description_vector_(i)%string(), substring ) /= 0
+      end do
+    end associate
+  end procedure
+
+  module procedure construct
+    vector_test_description%description_vector_ = description_vector
+    vector_test_description%vector_function_strategy_ = vector_function_strategy
+  end procedure
+
+  module procedure run
+    associate(vector_result => self%vector_function_strategy_%vector_function())
+      call assert(size(self%description_vector_)==size(vector_result), "julienne_vector_test_description_s: size match")
+      test_results = test_result_t(self%description_vector_, vector_result)
+    end associate
+  end procedure
+
+end submodule julienne_vector_test_description_s