diff --git a/app/fpm-find.F90 b/app/fpm-find.F90 index 317bf2c..d57e244 100644 --- a/app/fpm-find.F90 +++ b/app/fpm-find.F90 @@ -10,21 +10,22 @@ program fpm_find type(command_line_t) command_line if (command_argument_count() < 1 .or. command_line%argument_present([character(len=len("--help")) :: ("--help"), "-h"])) then - stop new_line('') & - // '' // new_line('') & - // 'Usage:' // new_line('') & - // '' // new_line('') & - // ' fpm find [--help|-h]' // new_line('') & - // ' fpm find [--name|-n] [--url|-u] [--case|-c]' // new_line('') & - // '' // new_line('') & - // 'where angular brackets indicate user input values, square brackets' // new_line('') & - // 'surround optional arguments, and pipes separate equivalent alternatives.' // new_line('') & - // 'Please see the README.md file for detailed explanations and examples.' // new_line('') + stop new_line('') & + // '' // new_line('') & + // 'Usage:' // new_line('') & + // '' // new_line('') & + // ' fpm find [--help|-h]' // new_line('') & + // ' fpm find [--name|-n] [--url|-u] [--case|-c] [--build-systems|-b]' // new_line('') & + // '' // new_line('') & + // 'where angular brackets indicate user input values, square brackets' // new_line('') & + // 'surround optional arguments, and pipes separate equivalent alternatives.' // new_line('') & + // 'Please see the README.md file for detailed explanations and examples.' // new_line('') end if block character(len=*), parameter :: url_base = "https://raw.githubusercontent.com/fortran-lang/webpage/refs/heads/main/data" character(len=*), parameter :: infix = ".local/share/fpm-find", file_name = "package_index.yml" + character(len=*), parameter :: downloaded_file_name = file_name // "-download" character(len=:), allocatable :: search_string, default_prefix integer exit_status, search_string_length, prefix_length @@ -41,29 +42,40 @@ program fpm_find ,exitstat = exit_status & ) call execute_command_line( & - command = "curl --silent -L " // url_base // "/" // file_name // " > " // file_path // "/" // file_name & + command = "curl --silent -L " // url_base // "/" // file_name // " > " // file_path // "/" // downloaded_file_name & ,wait = .true. & ,exitstat = exit_status & ) if (exit_status /= 0) then call execute_command_line( & - command = "wget --quiet " // url_base // "/" // file_name // " -O " // file_path // "/" // file_name & + command = "wget --quiet " // url_base // "/" // file_name // " -O " // file_path // "/" // downloaded_file_name & ,wait = .true. & ,exitstat = exit_status & ) end if + associate(downloaded_file => file_t(file_path // "/" // downloaded_file_name)) + if (size(downloaded_file%lines()) /= 0) then + call execute_command_line( & + command = "mv " // file_path // "/" // downloaded_file_name // " " // file_path // "/" // file_name & + ,wait = .true. & + ,exitstat = exit_status & + ) + end if + end associate + call get_command_argument(number=1, length=search_string_length) allocate(character(len=search_string_length) :: search_string) call get_command_argument(number=1, value=search_string) associate( & - name_search => command_line%argument_present([string_t("--name"), string_t("-n")]) & - ,url_search => command_line%argument_present([string_t("--url" ), string_t("-u")]) & - ,case_sensitive => command_line%argument_present([string_t("--case"), string_t("-c")]) & + name_search => command_line%argument_present([string_t("--name" ), string_t("-n")]) & + ,url_search => command_line%argument_present([string_t("--url" ), string_t("-u")]) & + ,case_sensitive => command_line%argument_present([string_t("--case" ), string_t("-c")]) & + ,build_systems => command_line%argument_present([string_t("--build-systems"), string_t("-b")]) & ) associate(package_index => package_index_t(file_t(file_path // "/" // file_name))) - associate(matching_packages => package_index%find(search_string, name_search, url_search, case_sensitive)) + associate(matching_packages => package_index%find(search_string, name_search, url_search, build_systems, case_sensitive)) print * if (size(matching_packages) == 0) print '(a)', "No packages found." block diff --git a/fpm.toml b/fpm.toml index feeae93..c66c1e3 100644 --- a/fpm.toml +++ b/fpm.toml @@ -2,4 +2,4 @@ name = "fpm-find" version = "0.1.0" [dependencies] -julienne = {git = "https://github.com/berkeleylab/julienne.git", tag = "4.1.1"} +julienne = {git = "https://github.com/berkeleylab/julienne.git", tag = "4.1.2"} diff --git a/src/fpm_find/indexed_package_m.F90 b/src/fpm_find/indexed_package_m.F90 index e84d51e..fb84457 100644 --- a/src/fpm_find/indexed_package_m.F90 +++ b/src/fpm_find/indexed_package_m.F90 @@ -3,7 +3,7 @@ module indexed_package_m !! Define an abstraction for the fortran-lang package-index packages - use julienne_m, only : string_t + use julienne_m, only : string_t, operator(.separatedBy.) implicit none private @@ -15,21 +15,24 @@ module indexed_package_m character(len=:), allocatable :: name_, description_, categories_, tags_ character(len=:), allocatable :: github_, gitlab_, url_ ! optional (zero length if not present) character(len=:), allocatable :: license_, version_ ! optional (zero length if not present) + type(string_t) , allocatable :: build_systems_(:) ! optional (zero-length array if not present) contains procedure url procedure as_text procedure contains + procedure build_systems end type interface indexed_package_t pure module function construct_from_components( & - name, description, categories, tags, license, version, github, gitlab, url) result(indexed_package) + name, description, categories, tags, license, version, github, gitlab, url, build_systems) result(indexed_package) !! Construct new indexed_package_t object from components implicit none character(len=*), intent(in) :: name, description, categories, tags character(len=*), intent(in), optional :: github, gitlab, url character(len=*), intent(in), optional :: license, version + type(string_t) , intent(in), optional :: build_systems(:) type(indexed_package_t) indexed_package end function @@ -65,17 +68,24 @@ pure module function as_text(self) result(text) character(len=:), allocatable :: text end function - pure module function contains(self, search_string, search_name, search_url, case_sensitive) result(match) + pure module function contains(self, search_string, search_name, search_url, search_build_systems, case_sensitive) result(match) !! Result is true if any of the package's entries contain search_string as a substring; false otherwise. !! search_name and search_url restrict the search to the package name or URL of the union of the two. !! case_sensitive toggles case sensitivity implicit none class(indexed_package_t), intent(in) :: self character(len=*), intent(in) :: search_string - logical, intent(in) :: search_name, search_url, case_sensitive + logical, intent(in) :: search_name, search_url, search_build_systems, case_sensitive logical match end function + pure module function build_systems(self) result(build_systems_list) + !! Result is a space-separated list of self's build systems + implicit none + class(indexed_package_t), intent(in) :: self + character(len=:), allocatable :: build_systems_list + end function + end interface end module indexed_package_m \ No newline at end of file diff --git a/src/fpm_find/indexed_package_s.F90 b/src/fpm_find/indexed_package_s.F90 index 769e3ed..07e1f33 100644 --- a/src/fpm_find/indexed_package_s.F90 +++ b/src/fpm_find/indexed_package_s.F90 @@ -10,6 +10,16 @@ contains + module procedure build_systems + if (size(self%build_systems_)==0) then + build_systems_list = "" + else + associate(build_systems_string => self%build_systems_ .separatedBy. " ") + build_systems_list = build_systems_string%string() + end associate + end if + end procedure + module procedure construct_from_components indexed_package%name_ = name indexed_package%description_ = description @@ -47,8 +57,34 @@ else allocate(character(len=0) :: indexed_package%version_) end if + + if (present(build_systems)) then + indexed_package%build_systems_ = build_systems + else + indexed_package%build_systems_ = [string_t::] + end if end procedure + pure function skip(line) result(comment_or_blank) + character(len=*), intent(in) :: line + logical comment_or_blank + + if (len(trim(line)) == 0) then + comment_or_blank = .true. + else + block + character(len=:), allocatable :: hash_etc + hash_etc = adjustl(line) + if (hash_etc(1:1) == "#") then + comment_or_blank = .true. + else + comment_or_blank = .false. + return + end if + end block + end if + end function + pure function get_key_value(key, lines) result(key_value) character(len=*), intent(in) :: key type(string_t), intent(in) :: lines(:) @@ -72,28 +108,6 @@ pure function get_key_value(key, lines) result(key_value) key_value = "" - contains - - pure function skip(line) result(comment_or_blank) - character(len=*), intent(in) :: line - logical comment_or_blank - - if (len(trim(line)) == 0) then - comment_or_blank = .true. - else - block - character(len=:), allocatable :: hash_etc - hash_etc = adjustl(line) - if (hash_etc(1:1) == "#") then - comment_or_blank = .true. - else - comment_or_blank = .false. - return - end if - end block - end if - end function - end function module procedure construct_from_strings @@ -107,7 +121,64 @@ pure function skip(line) result(comment_or_blank) ,url = get_key_value( "url", lines) & ,license = get_key_value( "license", lines) & ,version = get_key_value( "version", lines) & + ,build_systems= get_key_value_array("build-systems", lines) & ) + contains + + pure function extract_from_space_separated_strings(text) result(string_array) + character(len=*), intent(in) :: text + type(string_t), allocatable :: string_array(:) + integer c, s + +#ifdef __GFORTRAN__ + block + character(len=:), allocatable :: trimmed + trimmed = trim(adjustl(text)) +#else + associate(trimmed => trim(adjustl(text))) +#endif + associate( & + leading_edges => [1, [(merge(c, 0, trimmed(c:c)/=" " .and. trimmed(c-1:c-1)==" "), c = 2, len(trimmed) )] ] & + ,trailing_edges => [ [(merge(c, 0, trimmed(c:c)/=" " .and. trimmed(c+1:c+1)==" "), c = 1, len(trimmed)-1)], len(trimmed) ] & + ) + associate( & + leads => pack( leading_edges, leading_edges /= 0) & + ,trails => pack(trailing_edges, trailing_edges /= 0) & + ) + string_array = [( string_t(trimmed(leads(s):trails(s))), s = 1, size(trails) )] + end associate + end associate +#ifndef __GFORTRAN__ + end associate +#else + end block +#endif + end function + + pure function get_key_value_array(key, lines) result(key_value_array) + character(len=*), intent(in) :: key + type(string_t) , intent(in) :: lines(:) + type(string_t) , allocatable :: key_value_array(:) + integer l + + do l = 1, size(lines) + block + character(len=:), allocatable :: characters, key_values + characters = lines(l)%string() + if (skip(characters)) cycle + associate(colon => index(characters, ":")) + if (colon == 0) error stop "missing key/value separator ':'" + if (index(characters(1:colon-1), key)/=0)then + key_value_array = extract_from_space_separated_strings(characters(colon+1:)) + return + end if + end associate + end block + end do + + key_value_array = [string_t::] + end function + end procedure module procedure construct_from_characters @@ -176,7 +247,8 @@ pure function new_line_locations(characters) result(locations) "- name : " // self%name_ // new_line('') & // "description : " // self%description_ // new_line('') & // "categories : " // self%categories_ // new_line('') & - // "tags : " // self%tags_ + // "tags : " // self%tags_ // new_line('') & + // "build-systems : " // self%build_systems() if (len(self%github_ )/=0) then text = text // new_line('') // "url : " // self%url() @@ -197,14 +269,18 @@ pure function new_line_locations(characters) result(locations) character(len=:), allocatable :: search_subject - allocate(character(len=0) :: search_subject) - - if (search_name .or. (.not. search_url )) search_subject = search_subject // self%name_ - if (search_url .or. (.not. search_name)) search_subject = search_subject // self%url() + associate(search_all => .not. any([search_name, search_url, search_build_systems])) - if (.not. any([search_name, search_url])) & - search_subject = search_subject & - // self%description_ // self%categories_ // self%tags_ // self%github_ // self%gitlab_ // self%license_ // self%version_ + if (search_all) then + search_subject = self%description_ // self%categories_ // self%tags_ // self%github_ // self%gitlab_ // self%license_ & + // self%version_ // self%build_systems() + else + allocate(character(len=0) :: search_subject) + if (search_name ) search_subject = search_subject // self%name_ + if (search_url ) search_subject = search_subject // self%url() + if (search_build_systems) search_subject = search_subject // self%build_systems() + end if + end associate if (case_sensitive) then match = index(search_subject, search_string) /= 0 diff --git a/src/fpm_find/package_index_m.F90 b/src/fpm_find/package_index_m.F90 index 963b7d4..1784016 100644 --- a/src/fpm_find/package_index_m.F90 +++ b/src/fpm_find/package_index_m.F90 @@ -31,12 +31,13 @@ pure module function new_index_from_file_object(yaml_file) result(package_index) interface - pure module function find(self, search_string, search_name, search_url, case_sensitive) result(package_list) + pure module function find(self, search_string, search_name, search_url, search_build_systems, case_sensitive) & + result(package_list) !! Result is a listing of the packages that have entries containing the provided search_string implicit none class(package_index_t), intent(in) :: self character(len=*), intent(in) :: search_string - logical, intent(in) :: search_name, search_url, case_sensitive + logical, intent(in) :: search_name, search_url, search_build_systems, case_sensitive type(indexed_package_t), allocatable :: package_list(:) end function diff --git a/src/fpm_find/package_index_s.F90 b/src/fpm_find/package_index_s.F90 index 1570bea..1b27e82 100644 --- a/src/fpm_find/package_index_s.F90 +++ b/src/fpm_find/package_index_s.F90 @@ -91,7 +91,7 @@ pure function dash_name_colon(line) result(match) allocate(package_list(0)) do p = 1, size(self%packages_) - if (self%packages_(p)%contains(search_string, search_name, search_url, case_sensitive)) & + if (self%packages_(p)%contains(search_string, search_name, search_url, search_build_systems, case_sensitive)) & package_list = [package_list, self%packages_(p)] end do diff --git a/test/test-fpm-find.F90 b/test/test-fpm-find.F90 index b5353f8..f646bb2 100644 --- a/test/test-fpm-find.F90 +++ b/test/test-fpm-find.F90 @@ -35,6 +35,7 @@ subroutine test_fpm_find(tests, passes) ,string_t(" categories: testing") & ,string_t(" tags: unit-testing assertions pure-procedure-diagnostic-output") & ,string_t(" version: 3.4.1") & + ,string_t("build-systems: fpm") & ] & ,assert_entry => [ & string_t("- name: assert") & @@ -50,6 +51,7 @@ subroutine test_fpm_find(tests, passes) ,string_t("categories : numerical") & ,string_t("tags : machine-learning deep-learning high-performance-computing") & ,string_t("url : https://github.com/BerkeleyLab/fiats") & + ,string_t("build-systems: fpm") & ] & ,caffeine_entry => [ & string_t("- name: caffeine") & @@ -90,11 +92,11 @@ subroutine test_fpm_find(tests, passes) ) find_package_entries: & associate( & - formal => packages%find("formal" , search_name=.false., search_url=.false., case_sensitive=.false.) & - ,fiats => packages%find("BerkeleyLab", search_name=.false., search_url=.true. , case_sensitive=.true. ) & - ,caffeine => packages%find("caffeine" , search_name=.true. , search_url=.false., case_sensitive=.false.) & - ,nothing => packages%find("nonexistent", search_name=.true. , search_url=.false., case_sensitive=.false.) & - ,julienne_assert => packages%find("assert" , search_name=.false., search_url=.false., case_sensitive=.false.) & + formal => packages%find("formal" , search_name=.false., search_url=.false., search_build_systems=.false., case_sensitive=.false.) & + ,fiats => packages%find("BerkeleyLab", search_name=.false., search_url=.true. , search_build_systems=.false., case_sensitive=.true. ) & + ,caffeine => packages%find("caffeine" , search_name=.true. , search_url=.false., search_build_systems=.false., case_sensitive=.false.) & + ,nothing => packages%find("nonexistent", search_name=.true. , search_url=.false., search_build_systems=.false., case_sensitive=.false.) & + ,fpm => packages%find("fpm" , search_name=.false., search_url=.false., search_build_systems=.true. , case_sensitive=.false.) & ) block integer :: tests_subtotal = 0, passes_subtotal = 0 @@ -107,10 +109,8 @@ subroutine test_fpm_find(tests, passes) " searching on package-name text via the option `--name`" , tests_subtotal, passes_subtotal) call test(size( nothing)==0 , & " finding nothing for an unlisted package", tests_subtotal, passes_subtotal) - call test(size(julienne_assert) == 2 & - .and. julienne_assert(1)%as_text() == julienne_pkg%as_text() & - .and. julienne_assert(2)%as_text() == assert_pkg%as_text(), & - " finding two matching packages", tests_subtotal, passes_subtotal) + call test(size( fpm)==2 .and. (fpm(1)%as_text() == julienne_pkg%as_text()) .and. (fpm(2)%as_text() == fiats_pkg%as_text()), & + " searching on build-systems text via the command-line argumunt `fpm --build-systems`", tests_subtotal, passes_subtotal) print fmt(tests), "______ ", passes_subtotal, " of ", tests_subtotal, " tests passed. ______" diff --git a/test/test-utilities.F90 b/test/test-utilities.F90 index f8a3a16..578f4fb 100644 --- a/test/test-utilities.F90 +++ b/test/test-utilities.F90 @@ -2,7 +2,7 @@ ! Terms of use are as specified in LICENSE.txt module test_utilities_m - !! Define procedures for us in fpm-find unit tests + !! Define procedures for use in fpm-find unit tests implicit none private