From 3dfa20f1afdcb260a05a07d926fc70200e1726b2 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 16 Jun 2024 20:58:03 -0700 Subject: [PATCH 1/5] fix: compile with LLVM Flang (flang-new) --- src/julienne/julienne_test_s.F90 | 13 ++++++--- .../julienne_vector_test_description_m.f90 | 24 ---------------- .../julienne_vector_test_description_s.f90 | 28 +++++++++++++++++++ test/{main.f90 => main.F90} | 5 +++- test/test_result_test.F90 | 4 +++ 5 files changed, 45 insertions(+), 29 deletions(-) create mode 100644 src/julienne/julienne_vector_test_description_s.f90 rename test/{main.f90 => main.F90} (93%) diff --git a/src/julienne/julienne_test_s.F90 b/src/julienne/julienne_test_s.F90 index fd0d2ba..8b85be7 100644 --- a/src/julienne/julienne_test_s.F90 +++ b/src/julienne/julienne_test_s.F90 @@ -6,11 +6,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 @@ -58,7 +62,10 @@ end associate end block end associate +#ifndef __flang__ end associate +#endif + #else block logical, allocatable :: passing_tests(:) @@ -74,9 +81,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 diff --git a/src/julienne/julienne_vector_test_description_m.f90 b/src/julienne/julienne_vector_test_description_m.f90 index 0ff2d64..4c155cb 100644 --- a/src/julienne/julienne_vector_test_description_m.f90 +++ b/src/julienne/julienne_vector_test_description_m.f90 @@ -62,28 +62,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 diff --git a/src/julienne/julienne_vector_test_description_s.f90 b/src/julienne/julienne_vector_test_description_s.f90 new file mode 100644 index 0000000..608860f --- /dev/null +++ b/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 diff --git a/test/main.f90 b/test/main.F90 similarity index 93% rename from test/main.f90 rename to test/main.F90 index 2b23046..be845e5 100644 --- a/test/main.f90 +++ b/test/main.F90 @@ -36,7 +36,10 @@ program main call vector_test_description_test%report(passes,tests) if (.not. GitHub_CI()) call command_line_test%report(passes, tests) - if (this_image()==1) print *, new_line('a'), "_________ In total, ",passes," of ",tests, " tests pass. _________" +#ifndef __flang__ + if (this_image()==1) & +#endif + print *, new_line('a'), "_________ In total, ",passes," of ",tests, " tests pass. _________" if (passes /= tests) error stop contains diff --git a/test/test_result_test.F90 b/test/test_result_test.F90 index c742648..17d4b61 100644 --- a/test/test_result_test.F90 +++ b/test/test_result_test.F90 @@ -59,11 +59,15 @@ function check_single_image_failure() result(passed) type(test_result_t), allocatable :: test_result logical passed +#ifndef __flang__ if (this_image()==1) then +#endif test_result = test_result_t("image 1 fails", .false.) +#ifndef __flang__ else test_result = test_result_t("all images other than 1 pass", .true.) end if +#endif passed = .not. test_result%passed() end function From 3ac8968803450df2cacbde146c904ce3298e84c5 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 16 Jun 2024 21:40:31 -0700 Subject: [PATCH 2/5] doc(README): link documentation, improve prose --- README.md | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index dcaf338..b895933 100644 --- a/README.md +++ b/README.md @@ -1,12 +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 is achieved through minimalism and isolation. -offering a thin slice of the capabilities of Veggies with no external dependencies. -This is accomplished by incorporating only those parts of Sourcery that the recent versions of most Fortran compilers support. -The latter parts are mostly related to strings. +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-handlikng 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 -------------------- @@ -25,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 From 4c89e065b825eb416fda45d4e63c526fd7dbaf3f Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 16 Jun 2024 22:39:22 -0700 Subject: [PATCH 3/5] feat(file_m):file abstraction for inference-engine --- src/julienne/julienne_file_m.f90 | 48 ++++++++++++++ src/julienne/julienne_file_s.f90 | 107 +++++++++++++++++++++++++++++++ src/julienne_m.f90 | 2 + 3 files changed, 157 insertions(+) create mode 100644 src/julienne/julienne_file_m.f90 create mode 100644 src/julienne/julienne_file_s.f90 diff --git a/src/julienne/julienne_file_m.f90 b/src/julienne/julienne_file_m.f90 new file mode 100644 index 0000000..87ae4cd --- /dev/null +++ b/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 diff --git a/src/julienne/julienne_file_s.f90 b/src/julienne/julienne_file_s.f90 new file mode 100644 index 0000000..872bbe3 --- /dev/null +++ b/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 diff --git a/src/julienne_m.f90 b/src/julienne_m.f90 index f9a4845..057ef17 100644 --- a/src/julienne_m.f90 +++ b/src/julienne_m.f90 @@ -2,6 +2,7 @@ ! Terms of use are as specified in LICENSE.txt module julienne_m use julienne_command_line_m, only : command_line_t + use julienne_file_m, only : file_t use julienne_formats_m, only : separated_values use julienne_string_m, only : string_t, operator(.cat.) use julienne_test_m, only : test_t, test_description_substring @@ -13,6 +14,7 @@ module julienne_m private public :: command_line_t public :: operator(.cat.) + public :: file_t public :: separated_values public :: string_t public :: test_t From 442819a6c11a055c94cc29e1f78d935c9736abb5 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 16 Jun 2024 23:06:00 -0700 Subject: [PATCH 4/5] feat(bin_t): bin abstraction for inference-engine --- src/julienne/julienne_bin_m.f90 | 45 ++++++++++++++++++ src/julienne/julienne_bin_s.f90 | 33 +++++++++++++ src/julienne_m.f90 | 2 + test/bin_test.F90 | 82 +++++++++++++++++++++++++++++++++ test/main.F90 | 5 +- 5 files changed, 166 insertions(+), 1 deletion(-) create mode 100644 src/julienne/julienne_bin_m.f90 create mode 100644 src/julienne/julienne_bin_s.f90 create mode 100644 test/bin_test.F90 diff --git a/src/julienne/julienne_bin_m.f90 b/src/julienne/julienne_bin_m.f90 new file mode 100644 index 0000000..6b247ed --- /dev/null +++ b/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 diff --git a/src/julienne/julienne_bin_s.f90 b/src/julienne/julienne_bin_s.f90 new file mode 100644 index 0000000..1706ab9 --- /dev/null +++ b/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 diff --git a/src/julienne_m.f90 b/src/julienne_m.f90 index 057ef17..ede3d32 100644 --- a/src/julienne_m.f90 +++ b/src/julienne_m.f90 @@ -1,6 +1,7 @@ ! Copyright (c) 2024, Sourcery Institute ! Terms of use are as specified in LICENSE.txt module julienne_m + use julienne_bin_m, only : bin_t use julienne_command_line_m, only : command_line_t use julienne_file_m, only : file_t use julienne_formats_m, only : separated_values @@ -12,6 +13,7 @@ module julienne_m implicit none private + public :: bin_t public :: command_line_t public :: operator(.cat.) public :: file_t diff --git a/test/bin_test.F90 b/test/bin_test.F90 new file mode 100644 index 0000000..d1826f8 --- /dev/null +++ b/test/bin_test.F90 @@ -0,0 +1,82 @@ +module bin_test_m + !! Check data partitioning across bins + use julienne_m, only : bin_t, test_t, test_result_t, test_description_t, test_description_substring, string_t +#ifdef __GFORTRAN__ + use julienne_m, only : test_function_i +#endif + use assert_m, only : assert + implicit none + + private + public :: bin_test_t + + type, extends(test_t) :: bin_test_t + contains + procedure, nopass :: subject + procedure, nopass :: results + end type + +contains + + pure function subject() result(specimen) + character(len=:), allocatable :: specimen + specimen = "An array of bin_t objects (bins)" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(test_description_t), allocatable :: test_descriptions(:) + +#ifndef __GFORTRAN__ + test_descriptions = [ & + test_description_t(string_t("partitioning items nearly evenly across bins"), check_block_partitioning), & + test_description_t(string_t("partitioning all item across all bins without item loss"), check_all_items_partitioned) & + ] +#else + ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument: + procedure(test_function_i), pointer :: check_block_partitioning_ptr, check_all_items_ptr + check_block_partitioning_ptr => check_block_partitioning + check_all_items_ptr => check_all_items_partitioned + test_descriptions = [ & + test_description_t(string_t("partitioning items nearly evenly across bins"), check_block_partitioning_ptr), & + test_description_t(string_t("partitioning all item across all bins without item loss"), check_all_items_ptr) & + ] +#endif + test_descriptions = pack(test_descriptions, & + index(subject(), test_description_substring) /= 0 .or. & + test_descriptions%contains_text(string_t(test_description_substring))) + test_results = test_descriptions%run() + end function + + function check_block_partitioning() result(test_passes) + !! Check that the items are partitioned across bins evenly to within a difference of one item per bin + logical test_passes + + type(bin_t), allocatable :: bins(:) + integer, parameter :: n_items=11, n_bins=7 + integer b + + bins = [( bin_t(num_items=n_items, num_bins=n_bins, bin_number=b), b = 1,n_bins )] + associate(in_bin => [(bins(b)%last() - bins(b)%first() + 1, b = 1, n_bins)]) + associate(remainder => mod(n_items, n_bins), items_per_bin => n_items/n_bins) + test_passes = all([(in_bin(1:remainder) == items_per_bin + 1)]) .and. all([(in_bin(remainder+1:) == items_per_bin)]) + end associate + end associate + + end function + + function check_all_items_partitioned() result(test_passes) + !! Check that the number of items in each bin sums to the total number of items + type(bin_t) partition + logical test_passes + + type(bin_t), allocatable :: bins(:) + integer, parameter :: n_items=11, n_bins=6 + integer b + + bins = [( bin_t(num_items=n_items, num_bins=n_bins, bin_number=b), b = 1,n_bins )] + test_passes = sum([(bins(b)%last() - bins(b)%first() + 1, b = 1, n_bins)]) == n_items + + end function + +end module bin_test_m diff --git a/test/main.F90 b/test/main.F90 index be845e5..0350d95 100644 --- a/test/main.F90 +++ b/test/main.F90 @@ -1,13 +1,15 @@ program main - use julienne_m, only : command_line_t + use bin_test_m, only : bin_test_t use command_line_test_m, only : command_line_test_t use formats_test_m, only : formats_test_t + use julienne_m, only : command_line_t use string_test_m, only : string_test_t use test_result_test_m, only : test_result_test_t use test_description_test_m, only : test_description_test_t use vector_test_description_test_m, only : vector_test_description_test_t implicit none + type(bin_test_t) bin_test type(command_line_test_t) command_line_test type(formats_test_t) formats_test type(string_test_t) string_test @@ -29,6 +31,7 @@ program main if (command_line%argument_present([character(len=len("--help"))::"--help","-h"])) stop usage end block + call bin_test%report(passes, tests) call formats_test%report(passes, tests) call string_test%report(passes, tests) call test_result_test%report(passes, tests) From bd5f4bb9941e6ef1fcc8af24411d547e989891ad Mon Sep 17 00:00:00 2001 From: Katherine Rasmussen Date: Mon, 17 Jun 2024 10:37:33 -0700 Subject: [PATCH 5/5] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index b895933..5c4596e 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ This software repository captures the authors' most frequently used thin slice o 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-handlikng capabilities are included primarily because they support Julienne's unit-testing code. +The string-handling capabilities are included primarily because they support Julienne's unit-testing code. Examples --------