diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 5abe1d36..e9cb5793 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -4,35 +4,48 @@ on: [push, pull_request] jobs: Build: - runs-on: ubuntu-latest + runs-on: ubuntu-22.04 strategy: fail-fast: true env: FC: gfortran - GCC_V: 10 + GCC_V: 12 - steps: - - name: Checkout code - uses: actions/checkout@v2 + - name: Install fpm + uses: fortran-lang/setup-fpm@v4 + with: + github-token: ${{ secrets.GITHUB_TOKEN }} + + - name: Get Time + id: time + uses: nanzm/get-time-action@v1.0 + with: + format: 'YYYY-MM' + + - name: Setup cache for opencoarrays + id: cache-opencoarrays + uses: actions/cache@v2 + with: + path: "OpenCoarrays-2.10.0/" + key: ${{ steps.time.outputs.time }} - - name: Install Dependencies + - name: Install GFortran, OpenCoarrays run: | - sudo apt install -y gfortran-${GCC_V} cmake mpich - sudo update-alternatives --install /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} 100 - git clone https://github.com/sourceryinstitute/opencoarrays - mkdir -p opencoarrays/build - cd opencoarrays/build - cmake .. - sudo make -j $(nproc) install - cd - - git clone https://github.com/fortran-lang/fpm - cd fpm - ./install.sh + sudo apt install -y gfortran-${GCC_V} graphviz + sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \ + --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \ + --slave /usr/bingcov gcov /usr/bin/gcov-${GCC_V} + if [ ! -d OpenCoarrays-2.10.0 ] ; then wget -P . https://github.com/sourceryinstitute/OpenCoarrays/releases/download/2.10.0/OpenCoarrays-2.10.0.tar.gz && tar -xf OpenCoarrays-2.10.0.tar.gz && cd OpenCoarrays-2.10.0 && TERM=xterm ./install.sh -y; fi + + steps: + - name: Checkout code + uses: actions/checkout@v3 - name: Build and Test run: | export PATH="${HOME}/.local/bin:$PATH" + source OpenCoarrays-2.10.0/prerequisites/installations/opencoarrays/2.10.0/setup.sh fpm test \ --compiler caf \ --runner "cafrun -n 4" \ diff --git a/src/file_m.f90 b/src/file_m.f90 new file mode 100644 index 00000000..8f0a16d8 --- /dev/null +++ b/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 diff --git a/src/file_s.f90 b/src/file_s.f90 new file mode 100644 index 00000000..9b7659a9 --- /dev/null +++ b/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 diff --git a/src/string_m.f90 b/src/string_m.f90 index 1ae63255..fec2dae7 100644 --- a/src/string_m.f90 +++ b/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 diff --git a/src/string_s.f90 b/src/string_s.f90 index 401a91fd..0ab2992c 100644 --- a/src/string_s.f90 +++ b/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 diff --git a/test/main.f90 b/test/main.f90 index c67690c7..e6d965fb 100644 --- a/test/main.f90 +++ b/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. _________" diff --git a/test/string_test.f90 b/test/string_test.f90 new file mode 100644 index 00000000..9d9c0633 --- /dev/null +++ b/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