diff options
| -rw-r--r-- | fpm/src/fpm/cmd/new.f90 | 214 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 4 | ||||
| -rw-r--r-- | fpm/src/fpm_filesystem.f90 | 129 | ||||
| -rw-r--r-- | fpm/src/fpm_strings.f90 | 122 |
4 files changed, 240 insertions, 229 deletions
diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index 9b0b362..52a5d42 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -7,7 +7,7 @@ module fpm_cmd_new !> from this type to decide what actions to take. !> !> It is virtually self-contained and so independant of the rest of the -!> application that it could function as a seperate program. +!> application that it could function as a separate program. !> !> The "new" subcommand options currently consist of a SINGLE top !> directory name to create that must have a name that is an @@ -16,7 +16,7 @@ module fpm_cmd_new !> So basically this routine has already had the options vetted and !> just needs to conditionally create a few files. !> -!> As described in the documentation documentation it will selectively +!> As described in the documentation it will selectively !> create the subdirectories app/, test/, src/, and example/ !> and populate them with sample files. !> @@ -56,6 +56,8 @@ 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 : fileopen, fileclose, filewrite, warnwrite +use fpm_strings, only : join use,intrinsic :: iso_fortran_env, only : stderr=>error_unit implicit none private @@ -148,6 +150,9 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' ',& &'## BUILD CONFIGURATION SECTION ',& &'[build] ',& + &'# ',& + &'# Files will be searched for automatically (by default) in src/, app/, test/ ',& + &'# and example/. This can be turned off for app/, test, exampl ',& &'auto-executables = true # Toggle automatic discovery of executables ',& &'auto-examples = true # Toggle automatic discovery of example programs ',& &'auto-tests = true # Toggle automatic discovery of test executables ',& @@ -270,9 +275,6 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) if(settings%with_full)then tomlfile=[character(len=80) :: tomlfile, & &'[dependencies] ', & - &'# ', & - &'#Files will be searched for automatically (by default) in ', & - &'# src/, app/, test/, and example/. ', & &'#For a complete list of keys and their attributes see ', & &'# ', & &'# https://github.com/fortran-lang/fpm/blob/master/manifest-reference.md ', & @@ -311,11 +313,11 @@ character(len=*),intent(in) :: filename ser = toml_serializer() call fileopen(filename,lun) ! fileopen stops on error - call set_value(table, "name", BNAME) - call set_value(table, "version", "0.1.0") - call set_value(table, "license", "license") - call set_value(table, "author", "Jane Doe") - call set_value(table, "maintainer", "jane.doe@example.com") + call set_value(table, "name", BNAME) + call set_value(table, "version", "0.1.0") + call set_value(table, "license", "license") + call set_value(table, "author", "Jane Doe") + call set_value(table, "maintainer", "jane.doe@example.com") call set_value(table, "copyright", 'Copyright '//date(1:4)//', Jane Doe') ! continue building of manifest ! ... @@ -330,95 +332,6 @@ character(len=*),intent(in) :: filename end subroutine create_verified_basic_manifest -subroutine warnwrite(fname,data) -character(len=*),intent(in) :: fname -character(len=*),intent(in) :: data(:) - - if(.not.exists(fname))then - call filewrite(fname,data) - else - write(stderr,'(*(g0,1x))')'<INFO> ',fname,& - & 'already exists. Not overwriting' - endif - -end subroutine warnwrite - -subroutine fileopen(filename,lun) -! procedure to open filedata to file filename -use,intrinsic :: iso_fortran_env, only : & - & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit - -character(len=*),intent(in) :: filename -integer,intent(out) :: lun -integer :: i, ios -character(len=256) :: message - - message=' ' - ios=0 - if(filename.ne.' ')then - open(file=filename, & - & newunit=lun, & - & form='formatted', & ! FORM = FORMATTED | UNFORMATTED - & access='sequential', & ! ACCESS = SEQUENTIAL| DIRECT | STREAM - & action='write', & ! ACTION = READ|WRITE| READWRITE - & position='rewind', & ! POSITION= ASIS | REWIND | APPEND - & status='new', & ! STATUS = NEW| REPLACE| OLD| SCRATCH| UNKNOWN - & iostat=ios, & - & iomsg=message) - else - lun=stdout - ios=0 - endif - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')& - & '<ERROR> *filewrite*:',filename,trim(message) - lun=-1 - stop 1 - endif - -end subroutine fileopen - -subroutine fileclose(lun) -use,intrinsic :: iso_fortran_env, only : & - & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit -integer,intent(in) :: lun -character(len=256) :: message -integer :: ios - if(lun.ne.-1)then - close(unit=lun,iostat=ios,iomsg=message) - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'<ERROR> *filewrite*:',trim(message) - stop 2 - endif - endif -end subroutine fileclose - -subroutine filewrite(filename,filedata) -! procedure to write filedata to file filename -use,intrinsic :: iso_fortran_env, only : & - & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit - -character(len=*),intent(in) :: filename -character(len=*),intent(in) :: filedata(:) -integer :: lun, i, ios -character(len=256) :: message - call fileopen(filename,lun) - if(lun.ne.-1)then ! program currently stops on error on open, but might - ! want it to continue so -1 (unallowed LUN) indicates error - ! write file - do i=1,size(filedata) - write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')& - & '<ERROR> *filewrite*:',filename,trim(message) - stop 4 - endif - enddo - endif - ! close file - call fileclose(lun) - -end subroutine filewrite subroutine validate_toml_data(input) !> verify a string array is a valid fpm.toml file @@ -450,109 +363,6 @@ endif end subroutine validate_toml_data -pure function join(str,sep,trm,left,right) result (string) - -!> M_strings::join(3f): append an array of character variables with specified separator into a single CHARACTER variable -!> -!>##NAME -!> join(3f) - [M_strings:EDITING] append CHARACTER variable array into -!> a single CHARACTER variable with specified separator -!> (LICENSE:PD) -!> -!>##SYNOPSIS -!> -!> pure function join(str,sep,trm,left,right) result (string) -!> -!> character(len=*),intent(in) :: str(:) -!> character(len=*),intent(in),optional :: sep -!> logical,intent(in),optional :: trm -!> character(len=*),intent(in),optional :: right -!> character(len=*),intent(in),optional :: left -!> character(len=:),allocatable :: string -!> -!>##DESCRIPTION -!> JOIN(3f) appends the elements of a CHARACTER array into a single -!> CHARACTER variable, with elements 1 to N joined from left to right. -!> By default each element is trimmed of trailing spaces and the -!> default separator is a null string. -!> -!>##OPTIONS -!> STR(:) array of CHARACTER variables to be joined -!> SEP separator string to place between each variable. defaults -!> to a null string. -!> LEFT string to place at left of each element -!> RIGHT string to place at right of each element -!> TRM option to trim each element of STR of trailing -!> spaces. Defaults to .TRUE. -!> -!>##RESULT -!> STRING CHARACTER variable composed of all of the elements of STR() -!> appended together with the optional separator SEP placed -!> between the elements. -!> -!>##EXAMPLE -!> -!> Sample program: -!> -!> program demo_join -!> use M_strings, only: join -!> implicit none -!> character(len=:),allocatable :: s(:) -!> character(len=:),allocatable :: out -!> integer :: i -!> s=[character(len=10) :: 'United',' we',' stand,', & -!> & ' divided',' we fall.'] -!> out=join(s) -!> write(*,'(a)') out -!> write(*,'(a)') join(s,trm=.false.) -!> write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3) -!> write(*,'(a)') join(s,sep='<>') -!> write(*,'(a)') join(s,sep=';',left='[',right=']') -!> write(*,'(a)') join(s,left='[',right=']') -!> write(*,'(a)') join(s,left='>>') -!> end program demo_join -!> -!> Expected output: -!> -!> United we stand, divided we fall. -!> United we stand, divided we fall. -!> United | we | stand, | divided | we fall. | -!> United | we | stand, | divided | we fall. | -!> United | we | stand, | divided | we fall. | -!> United<> we<> stand,<> divided<> we fall.<> -!> [United];[ we];[ stand,];[ divided];[ we fall.]; -!> [United][ we][ stand,][ divided][ we fall.] -!> >>United>> we>> stand,>> divided>> we fall. -!> -!>##AUTHOR -!> John S. Urban -!> -!>##LICENSE -!> Public Domain - -character(len=*,kind=tfc),intent(in) :: str(:) -character(len=*),intent(in),optional :: sep, right, left -logical,intent(in),optional :: trm -character(len=:,kind=tfc),allocatable :: string -integer :: i -logical :: trm_local -character(len=:),allocatable :: sep_local, left_local, right_local - - if(present(sep))then ; sep_local=sep ; else ; sep_local='' ; endif - if(present(trm))then ; trm_local=trm ; else ; trm_local=.true. ; endif - if(present(left))then ; left_local=left ; else ; left_local='' ; endif - if(present(right))then ; right_local=right ; else ; right_local='' ; endif - - string='' - do i = 1,size(str) - if(trm_local)then - string=string//left_local//trim(str(i))//right_local//sep_local - else - string=string//left_local//str(i)//right_local//sep_local - endif - enddo -end function join - end subroutine cmd_new end module fpm_cmd_new diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 18e4429..2256530 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -93,7 +93,7 @@ end type character(len=:),allocatable :: name character(len=:),allocatable :: os_type -character(len=ibug),allocatable :: names(:) +character(len=ibug),allocatable :: names(:) character(len=:),allocatable :: tnames(:) character(len=:), allocatable :: version_text(:) @@ -434,7 +434,7 @@ contains if(val_compiler.eq.'') then val_compiler='gfortran' endif - + val_build=trim(merge('release','debug ',lget('release'))) end subroutine check_build_vals diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index f221917..7f1cbf5 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -1,4 +1,5 @@ module fpm_filesystem +use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit use fpm_environment, only: get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD @@ -7,6 +8,7 @@ module fpm_filesystem 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 + public :: fileopen, fileclose, filewrite, warnwrite integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -73,7 +75,7 @@ function canon_path(path) result(canon) ! Canonicalize path for comparison ! Handles path string redundancies ! Does not test existence of path - ! + ! ! To be replaced by realpath/_fullname in stdlib_os ! character(*), intent(in) :: path @@ -127,7 +129,7 @@ function canon_path(path) result(canon) end if end if - + temp(j:j) = nixpath(i:i) j = j + 1 @@ -152,23 +154,23 @@ function dirname(path) result (dir) end function dirname -logical function is_dir(dir) - character(*), intent(in) :: dir - integer :: stat +logical function is_dir(dir) + character(*), intent(in) :: dir + integer :: stat - select case (get_os_type()) + select case (get_os_type()) case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) - call execute_command_line("test -d " // dir , exitstat=stat) + call execute_command_line("test -d " // dir , exitstat=stat) - case (OS_WINDOWS) - call execute_command_line('cmd /c "if not exist ' // windows_path(dir) // '\ exit /B 1"', exitstat=stat) + case (OS_WINDOWS) + call execute_command_line('cmd /c "if not exist ' // windows_path(dir) // '\ exit /B 1"', exitstat=stat) - end select + end select - is_dir = (stat == 0) + is_dir = (stat == 0) -end function is_dir +end function is_dir function join_path(a1,a2,a3,a4,a5) result(path) @@ -315,7 +317,7 @@ recursive subroutine list_files(dir, files, recurse) do i=1,size(files) if (is_dir(files(i)%s)) then - call list_files(files(i)%s, dir_files, recurse=.true.) + call list_files(files(i)%s, dir_files, recurse=.true.) sub_dir_files = [sub_dir_files, dir_files] end if @@ -347,7 +349,7 @@ function get_temp_filename() result(tempfile) type(c_ptr) :: c_tempfile_ptr character(len=1), pointer :: c_tempfile(:) - + interface function c_tempnam(dir,pfx) result(tmp) bind(c,name="tempnam") @@ -389,7 +391,7 @@ function windows_path(path) result(winpath) winpath(idx:idx) = '\' idx = index(winpath,'/') end do - + end function windows_path @@ -408,7 +410,7 @@ function unix_path(path) result(nixpath) nixpath(idx:idx) = '/' idx = index(nixpath,'\') end do - + end function unix_path @@ -464,5 +466,100 @@ subroutine delete_file(file) end if end subroutine delete_file +subroutine warnwrite(fname,data) +!> write trimmed character data to a file if it does not exist +character(len=*),intent(in) :: fname +character(len=*),intent(in) :: data(:) + + if(.not.exists(fname))then + call filewrite(fname,data) + else + write(stderr,'(*(g0,1x))')'<INFO> ',fname,& + & 'already exists. Not overwriting' + endif + +end subroutine warnwrite + +subroutine fileopen(filename,lun,ier) +! procedure to open filename as a sequential "text" file + +character(len=*),intent(in) :: filename +integer,intent(out) :: lun +integer,intent(out),optional :: ier +integer :: i, ios +character(len=256) :: message + + message=' ' + ios=0 + if(filename.ne.' ')then + open(file=filename, & + & newunit=lun, & + & form='formatted', & ! FORM = FORMATTED | UNFORMATTED + & access='sequential', & ! ACCESS = SEQUENTIAL| DIRECT | STREAM + & action='write', & ! ACTION = READ|WRITE| READWRITE + & position='rewind', & ! POSITION= ASIS | REWIND | APPEND + & status='new', & ! STATUS = NEW| REPLACE| OLD| SCRATCH| UNKNOWN + & iostat=ios, & + & iomsg=message) + else + lun=stdout + ios=0 + endif + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')& + & '<ERROR> *filewrite*:',filename,trim(message) + lun=-1 + if(present(ier))then + ier=ios + else + stop 1 + endif + endif + +end subroutine fileopen + +subroutine fileclose(lun,ier) +! simple close of a LUN. On error show message and stop (by default) +integer,intent(in) :: lun +integer,intent(out),optional :: ier +character(len=256) :: message +integer :: ios + if(lun.ne.-1)then + close(unit=lun,iostat=ios,iomsg=message) + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'<ERROR> *filewrite*:',trim(message) + if(present(ier))then + ier=ios + else + stop 2 + endif + endif + endif +end subroutine fileclose + +subroutine filewrite(filename,filedata) +! procedure to write filedata to file filename + +character(len=*),intent(in) :: filename +character(len=*),intent(in) :: filedata(:) +integer :: lun, i, ios +character(len=256) :: message + call fileopen(filename,lun) + if(lun.ne.-1)then ! program currently stops on error on open, but might + ! want it to continue so -1 (unallowed LUN) indicates error + ! write file + do i=1,size(filedata) + write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')& + & '<ERROR> *filewrite*:',filename,trim(message) + stop 4 + endif + enddo + endif + ! close file + call fileclose(lun) + +end subroutine filewrite end module fpm_filesystem diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 8e57d5b..649be36 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -6,6 +6,7 @@ private public :: f_string, lower, split, str_ends_with, string_t public :: string_array_contains, string_cat, operator(.in.), fnv_1a public :: resize +public :: join type string_t character(len=:), allocatable :: s @@ -48,7 +49,7 @@ pure logical function str_ends_with_any(s, e) result(r) character(*), intent(in) :: e(:) integer :: i - + r = .true. do i=1,size(e) @@ -76,11 +77,11 @@ function f_string(c_string) do i=1,n f_string(i:i) = c_string(i) end do - + end function f_string -!> Hash a character(*) string of default kind +!> Hash a character(*) string of default kind pure function fnv_1a_char(input, seed) result(hash) character(*), intent(in) :: input integer(int64), intent(in), optional :: seed @@ -103,7 +104,7 @@ pure function fnv_1a_char(input, seed) result(hash) end function fnv_1a_char -!> Hash a string_t array of default kind +!> Hash a string_t array of default kind pure function fnv_1a_string_t(input, seed) result(hash) type(string_t), intent(in) :: input(:) integer(int64), intent(in), optional :: seed @@ -166,7 +167,7 @@ logical function string_array_contains(search_string,array) end function string_array_contains -!> Concatenate an array of type(string_t) into +!> Concatenate an array of type(string_t) into !> a single character function string_cat(strings,delim) result(cat) type(string_t), intent(in) :: strings(:) @@ -191,7 +192,7 @@ function string_cat(strings,delim) result(cat) do i=2,size(strings) cat = cat//delim_str//strings(i)%s - + end do end function string_cat @@ -201,7 +202,7 @@ subroutine split(input_line,array,delimiters,order,nulls) ! Author: John S. Urban ! License: Public Domain - + ! given a line of structure " par1 par2 par3 ... parn " store each par(n) into a separate variable in array. ! o by default adjacent delimiters in the input string do not create an empty string in the output array ! o no quoting of delimiters is supported @@ -210,7 +211,7 @@ subroutine split(input_line,array,delimiters,order,nulls) character(len=*),optional,intent(in) :: order ! order of output array sequential|[reverse|right] character(len=*),optional,intent(in) :: nulls ! return strings composed of delimiters or not ignore|return|ignoreend character(len=:),allocatable,intent(out) :: array(:) ! output array of tokens - + integer :: n ! max number of strings INPUT_LINE could split into if all delimiter integer,allocatable :: ibegin(:) ! positions in input string where tokens start integer,allocatable :: iterm(:) ! positions in input string where tokens end @@ -227,7 +228,7 @@ subroutine split(input_line,array,delimiters,order,nulls) integer :: inotnull ! count strings not composed of delimiters integer :: ireturn ! number of tokens returned integer :: imax ! length of longest token - + ! decide on value for optional DELIMITERS parameter if (present(delimiters)) then ! optional delimiter list was present if(delimiters.ne.'')then ! if DELIMITERS was specified and not null use it @@ -349,4 +350,107 @@ subroutine resize_string(list, n) end subroutine resize_string +pure function join(str,sep,trm,left,right) result (string) + +!> M_strings::join(3f): append an array of character variables with specified separator into a single CHARACTER variable +!> +!>##NAME +!> join(3f) - [M_strings:EDITING] append CHARACTER variable array into +!> a single CHARACTER variable with specified separator +!> (LICENSE:PD) +!> +!>##SYNOPSIS +!> +!> pure function join(str,sep,trm,left,right) result (string) +!> +!> character(len=*),intent(in) :: str(:) +!> character(len=*),intent(in),optional :: sep +!> logical,intent(in),optional :: trm +!> character(len=*),intent(in),optional :: right +!> character(len=*),intent(in),optional :: left +!> character(len=:),allocatable :: string +!> +!>##DESCRIPTION +!> JOIN(3f) appends the elements of a CHARACTER array into a single +!> CHARACTER variable, with elements 1 to N joined from left to right. +!> By default each element is trimmed of trailing spaces and the +!> default separator is a null string. +!> +!>##OPTIONS +!> STR(:) array of CHARACTER variables to be joined +!> SEP separator string to place between each variable. defaults +!> to a null string. +!> LEFT string to place at left of each element +!> RIGHT string to place at right of each element +!> TRM option to trim each element of STR of trailing +!> spaces. Defaults to .TRUE. +!> +!>##RESULT +!> STRING CHARACTER variable composed of all of the elements of STR() +!> appended together with the optional separator SEP placed +!> between the elements and optional left and right elements. +!> +!>##EXAMPLE +!> +!> Sample program: +!> +!> program demo_join +!> use M_strings, only: join +!> implicit none +!> character(len=:),allocatable :: s(:) +!> character(len=:),allocatable :: out +!> integer :: i +!> s=[character(len=10) :: 'United',' we',' stand,', & +!> & ' divided',' we fall.'] +!> out=join(s) +!> write(*,'(a)') out +!> write(*,'(a)') join(s,trm=.false.) +!> write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3) +!> write(*,'(a)') join(s,sep='<>') +!> write(*,'(a)') join(s,sep=';',left='[',right=']') +!> write(*,'(a)') join(s,left='[',right=']') +!> write(*,'(a)') join(s,left='>>') +!> end program demo_join +!> +!> Expected output: +!> +!> United we stand, divided we fall. +!> United we stand, divided we fall. +!> United | we | stand, | divided | we fall. | +!> United | we | stand, | divided | we fall. | +!> United | we | stand, | divided | we fall. | +!> United<> we<> stand,<> divided<> we fall.<> +!> [United];[ we];[ stand,];[ divided];[ we fall.]; +!> [United][ we][ stand,][ divided][ we fall.] +!> >>United>> we>> stand,>> divided>> we fall. +!> +!>##AUTHOR +!> John S. Urban +!> +!>##LICENSE +!> Public Domain + +character(len=*),intent(in) :: str(:) +character(len=*),intent(in),optional :: sep, right, left +logical,intent(in),optional :: trm +character(len=:),allocatable :: string +integer :: i +logical :: trm_local +character(len=:),allocatable :: sep_local, left_local, right_local + + if(present(sep))then ; sep_local=sep ; else ; sep_local='' ; endif + if(present(trm))then ; trm_local=trm ; else ; trm_local=.true. ; endif + if(present(left))then ; left_local=left ; else ; left_local='' ; endif + if(present(right))then ; right_local=right ; else ; right_local='' ; endif + + string='' + do i = 1,size(str) + if(trm_local)then + string=string//left_local//trim(str(i))//right_local//sep_local + else + string=string//left_local//str(i)//right_local//sep_local + endif + enddo +end function join + end module fpm_strings |