diff options
| -rw-r--r-- | CONTRIBUTING.md | 2 | ||||
| -rw-r--r-- | fpm/src/fpm/cmd/new.f90 | 10 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 11 | ||||
| -rw-r--r-- | fpm/src/fpm_filesystem.f90 | 18 | ||||
| -rw-r--r-- | fpm/src/fpm_source_parsing.f90 | 4 | ||||
| -rw-r--r-- | fpm/src/fpm_strings.f90 | 36 | ||||
| -rw-r--r-- | fpm/test/fpm_test/main.f90 | 26 | ||||
| -rw-r--r-- | fpm/test/new_test/new_test.f90 | 14 |
8 files changed, 78 insertions, 43 deletions
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index b74aeda..2cc1ffa 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -115,7 +115,7 @@ open an issue and we’ll discuss it. If you have never created a pull request before, welcome :tada:. You can learn how from -[this great tutorial](https://egghead.io/series/how-to-contribute-to-an-open-source-project-on-github). +[this great tutorial](https://app.egghead.io/courses/how-to-contribute-to-an-open-source-project-on-github). Don’t know where to start? You can start by looking through the list of diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index a1e25da..d0cf60c 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -55,7 +55,7 @@ module fpm_cmd_new use fpm_command_line, only : fpm_new_settings use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir +use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir, to_fortran_name use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite use fpm_strings, only : join use,intrinsic :: iso_fortran_env, only : stderr=>error_unit @@ -71,7 +71,7 @@ integer,parameter :: tfc = selected_char_kind('DEFAULT') character(len=:,kind=tfc),allocatable :: bname ! baeename of NAME character(len=:,kind=tfc),allocatable :: tomlfile(:) character(len=:,kind=tfc),allocatable :: littlefile(:) - + !> TOP DIRECTORY NAME PROCESSING !> see if requested new directory already exists and process appropriately if(exists(settings%name) .and. .not.settings%backfill )then @@ -310,7 +310,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) endif ! create placeholder module src/bname.f90 littlefile=[character(len=80) :: & - &'module '//bname, & + &'module '//to_fortran_name(bname), & &' implicit none', & &' private', & &'', & @@ -319,7 +319,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' subroutine say_hello', & &' print *, "Hello, '//bname//'!"', & &' end subroutine say_hello', & - &'end module '//bname] + &'end module '//to_fortran_name(bname)] ! create NAME/src/NAME.f90 call warnwrite(join_path(settings%name, 'src', bname//'.f90'),& & littlefile) @@ -460,7 +460,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) if(exists(bname//'/src/'))then littlefile=[character(len=80) :: & &'program main', & - &' use '//bname//', only: say_hello', & + &' use '//to_fortran_name(bname)//', only: say_hello', & &' implicit none', & &'', & &' call say_hello()', & diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index c3cd94d..cfa6cb9 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -28,7 +28,7 @@ use fpm_environment, only : get_os_type, get_env, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use fpm_strings, only : lower, split -use fpm_filesystem, only : basename, canon_path +use fpm_filesystem, only : basename, canon_path, to_fortran_name use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit @@ -231,13 +231,10 @@ contains end select !*! canon_path is not converting ".", etc. name=canon_path(name) - if( .not.is_fortran_name(basename(name)) )then + if( .not.is_fortran_name(to_fortran_name(basename(name))) )then write(stderr,'(g0)') [ character(len=72) :: & - & '<ERROR>the new directory basename must be an allowed ', & - & ' Fortran name. It must be composed of 1 to 63 ASCII', & - & ' characters and start with a letter and be composed', & - & ' entirely of alphanumeric characters [a-zA-Z0-9]', & - & ' and underscores.'] + & '<ERROR> the fpm project name must be made of up to 63 ASCII letters,', & + & ' numbers, underscores, or hyphens, and start with a letter.'] stop 4 endif diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 7f1cbf5..5811cd4 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -3,11 +3,11 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, use fpm_environment, only: get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD - use fpm_strings, only: f_string, string_t, split + use fpm_strings, only: f_string, replace, string_t, split implicit none private public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, & - mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file + mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, to_fortran_name public :: fileopen, fileclose, filewrite, warnwrite integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -147,8 +147,6 @@ function dirname(path) result (dir) character(*), intent(in) :: path character(:), allocatable :: dir - character(:), allocatable :: file_parts(:) - dir = path(1:scan(path,'/\',back=.true.)) end function dirname @@ -486,7 +484,7 @@ subroutine fileopen(filename,lun,ier) character(len=*),intent(in) :: filename integer,intent(out) :: lun integer,intent(out),optional :: ier -integer :: i, ios +integer :: ios character(len=256) :: message message=' ' @@ -562,4 +560,14 @@ character(len=256) :: message end subroutine filewrite +pure function to_fortran_name(string) result(res) + ! Returns string with special characters replaced with an underscore. + ! For now, only a hyphen is treated as a special character, but this can be + ! expanded to other characters if needed. + character(*), intent(in) :: string + character(len(string)) :: res + character, parameter :: SPECIAL_CHARACTERS(*) = ['-'] + res = replace(string, SPECIAL_CHARACTERS, '_') +end function to_fortran_name + end module fpm_filesystem diff --git a/fpm/src/fpm_source_parsing.f90 b/fpm/src/fpm_source_parsing.f90 index f81555d..33b8400 100644 --- a/fpm/src/fpm_source_parsing.f90 +++ b/fpm/src/fpm_source_parsing.f90 @@ -16,7 +16,7 @@ !> module fpm_source_parsing use fpm_error, only: error_t, file_parse_error, fatal_error -use fpm_strings, only: string_t, string_cat, split, lower, str_ends_with, fnv_1a +use fpm_strings, only: string_t, string_cat, len_trim, split, lower, str_ends_with, fnv_1a use fpm_model, only: srcfile_t, & FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & @@ -476,4 +476,4 @@ function split_n(string,delims,n,stat) result(substring) end function split_n -end module fpm_source_parsing
\ No newline at end of file +end module fpm_source_parsing diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 2430237..2b036d1 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -4,13 +4,17 @@ implicit none private public :: f_string, lower, split, str_ends_with, string_t -public :: string_array_contains, string_cat, operator(.in.), fnv_1a -public :: resize, str, join +public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a +public :: replace, resize, str, join type string_t character(len=:), allocatable :: s end type +interface len_trim + module procedure :: string_len_trim +end interface len_trim + interface resize module procedure :: resize_string end interface @@ -177,7 +181,7 @@ function string_cat(strings,delim) result(cat) character(*), intent(in), optional :: delim character(:), allocatable :: cat - integer :: i,n + integer :: i character(:), allocatable :: delim_str if (size(strings) < 1) then @@ -200,6 +204,18 @@ function string_cat(strings,delim) result(cat) end function string_cat +!> Determine total trimmed length of `string_t` array +pure function string_len_trim(strings) result(n) + type(string_t), intent(in) :: strings(:) + integer :: i, n + + n = 0 + do i=1,size(strings) + n = n + len_trim(strings(i)%s) + end do + +end function string_len_trim + subroutine split(input_line,array,delimiters,order,nulls) ! parse string on delimiter characters and store tokens into an allocatable array" ! Author: John S. Urban @@ -318,6 +334,20 @@ subroutine split(input_line,array,delimiters,order,nulls) enddo end subroutine split +pure function replace(string, charset, target_char) result(res) + ! Returns string with characters in charset replaced with target_char. + character(*), intent(in) :: string + character, intent(in) :: charset(:), target_char + character(len(string)) :: res + integer :: n + res = string + do n = 1, len(string) + if (any(string(n:n) == charset)) then + res(n:n) = target_char + end if + end do +end function replace + subroutine resize_string(list, n) !> Instance of the array to be resized type(string_t), allocatable, intent(inout) :: list(:) diff --git a/fpm/test/fpm_test/main.f90 b/fpm/test/fpm_test/main.f90 index a7f4979..e1b9d1e 100644 --- a/fpm/test/fpm_test/main.f90 +++ b/fpm/test/fpm_test/main.f90 @@ -14,12 +14,12 @@ program fpm_testing implicit none integer :: stat, is character(len=:), allocatable :: suite_name, test_name - type(testsuite_t), allocatable :: testsuite(:) + type(testsuite_t), allocatable :: suite(:) character(len=*), parameter :: fmt = '("#", *(1x, a))' stat = 0 - testsuite = [ & + suite = [ & & new_testsuite("fpm_toml", collect_toml), & & new_testsuite("fpm_manifest", collect_manifest), & & new_testsuite("fpm_source_parsing", collect_source_parsing), & @@ -34,29 +34,29 @@ program fpm_testing call get_argument(2, test_name) if (allocated(suite_name)) then - is = select_suite(testsuite, suite_name) - if (is > 0 .and. is <= size(testsuite)) then + is = select_suite(suite, suite_name) + if (is > 0 .and. is <= size(suite)) then if (allocated(test_name)) then - write(error_unit, fmt) "Suite:", testsuite(is)%name - call run_selected(testsuite(is)%collect, test_name, error_unit, stat) + write(error_unit, fmt) "Suite:", suite(is)%name + call run_selected(suite(is)%collect, test_name, error_unit, stat) if (stat < 0) then error stop 1 end if else - write(error_unit, fmt) "Testing:", testsuite(is)%name - call run_testsuite(testsuite(is)%collect, error_unit, stat) + write(error_unit, fmt) "Testing:", suite(is)%name + call run_testsuite(suite(is)%collect, error_unit, stat) end if else write(error_unit, fmt) "Available testsuites" - do is = 1, size(testsuite) - write(error_unit, fmt) "-", testsuite(is)%name + do is = 1, size(suite) + write(error_unit, fmt) "-", suite(is)%name end do error stop 1 end if else - do is = 1, size(testsuite) - write(error_unit, fmt) "Testing:", testsuite(is)%name - call run_testsuite(testsuite(is)%collect, error_unit, stat) + do is = 1, size(suite) + write(error_unit, fmt) "Testing:", suite(is)%name + call run_testsuite(suite(is)%collect, error_unit, stat) end do end if diff --git a/fpm/test/new_test/new_test.f90 b/fpm/test/new_test/new_test.f90 index 22cf113..c284002 100644 --- a/fpm/test/new_test/new_test.f90 +++ b/fpm/test/new_test/new_test.f90 @@ -13,7 +13,7 @@ character(len=*),parameter :: scr = 'fpm_scratch_' character(len=*),parameter :: cmds(*) = [character(len=80) :: & ! run a variety of "fpm new" variations and verify expected files are generated ' new', & -' new no-no', & +' new name-with-hyphens', & ' new '//scr//'A', & ' new '//scr//'B --lib', & ' new '//scr//'C --app', & @@ -64,7 +64,7 @@ logical :: IS_OS_WINDOWS if( is_dir(trim(directories(i))) ) then write(*,*)'ERROR:',trim( directories(i) ),' already exists' write(*,*)' you must remove scratch directories before performing this test' - write(*,'(*(g0:,1x))')'directories:',(trim(directories(j)),j=1,size(directories)),'no-no' + write(*,'(*(g0:,1x))')'directories:',(trim(directories(j)),j=1,size(directories)),'name-with-hyphens' stop endif enddo @@ -76,12 +76,12 @@ logical :: IS_OS_WINDOWS write(*,'(*(g0))')'CMD=',trim(cmds(i)),' EXITSTAT=',estat,' CMDSTAT=',cstat,' MESSAGE=',trim(message) enddo - if( is_dir('no-no') ) then - tally=[tally,.false.] - write(*,*)'ERROR: directory no-no/ exists' - else + if( is_dir('name-with-hyphens') ) then tally=[tally,.true.] - endif + else + write(*,*)'ERROR: directory name-with-hyphens/ exists' + tally=[tally,.false.] + endif ! assuming hidden files in .git and .gitignore are ignored for now TESTS: do i=1,size(directories) |