aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn S. Urban <urbanjost@comcast.net>2021-01-31 15:51:29 -0500
committerJohn S. Urban <urbanjost@comcast.net>2021-01-31 15:51:29 -0500
commitbc9fa943c5f954bbdbbdda9280fc558948ce9bbd (patch)
treee9d9e75c380c9fe1ddb9c6671cc934077ed2cf5d
parentb3e3d83b79833da7941ef8d690d799838a607da4 (diff)
downloadfpm-bc9fa943c5f954bbdbbdda9280fc558948ce9bbd.tar.gz
fpm-bc9fa943c5f954bbdbbdda9280fc558948ce9bbd.zip
rebased
-rw-r--r--CONTRIBUTING.md2
-rw-r--r--fpm/src/fpm/cmd/new.f9010
-rw-r--r--fpm/src/fpm_command_line.f9011
-rw-r--r--fpm/src/fpm_filesystem.f9018
-rw-r--r--fpm/src/fpm_source_parsing.f904
-rw-r--r--fpm/src/fpm_strings.f9036
-rw-r--r--fpm/test/fpm_test/main.f9026
-rw-r--r--fpm/test/new_test/new_test.f9014
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)