Skip to content

Commit 2687745

Browse files
everythingfunctionaleverythingfunctional
authored
Merge branch 'master' into compiler_and_flags
2 parents 5d122c2 + c5b80a3 commit 2687745

File tree

10 files changed

+733
-388
lines changed

10 files changed

+733
-388
lines changed

‎README.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,7 @@ with the following contents and initialized as a git repository.
7777
* `fpm test` – run tests
7878

7979
The command `fpm run` can optionally accept the name of the specific executable
80-
to run, as can `fpm test`; like `fpm run specifc_executable`. Command line
80+
to run, as can `fpm test`; like `fpm run specific_executable`. Command line
8181
arguments can also be passed to the executable(s) or test(s) with the option
8282
`--args "some arguments"`.
8383

‎ci/run_tests.bat‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,10 @@ if errorlevel 1 exit 1
99
fpm run
1010
if errorlevel 1 exit 1
1111

12+
rmdir fpm_scratch_* /s /q
1213
fpm test
1314
if errorlevel 1 exit 1
15+
rmdir fpm_scratch_* /s /q
1416

1517
for /f %%i in ('where /r build fpm.exe') do set fpm_path=%%i
1618

‎ci/run_tests.sh‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,10 +17,11 @@ set -ex
1717
cd fpm
1818
fpm build
1919
fpm run
20+
rm -rf fpm_scratch_*/
2021
fpm test
22+
rm -rf fpm_scratch_*/
2123

2224
f_fpm_path="$(get_abs_filename $(find build -regex 'build/.*/app/fpm'))"
23-
2425
"${f_fpm_path}"
2526

2627
cd ../example_packages/hello_world

‎fpm/.gitignore‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,2 +1 @@
11
build/*
2-
*/FODDER/*

‎fpm/fpm.toml‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,14 @@ name = "cli-test"
1919
source-dir = "test/cli_test"
2020
main = "cli_test.f90"
2121

22+
[[test]]
23+
name = "new-test"
24+
source-dir = "test/new_test"
25+
main = "new_test.f90"
26+
2227
[[test]]
2328
name = "fpm-test"
2429
source-dir = "test/fpm_test"
2530
main = "main.f90"
31+
32+

‎fpm/src/fpm.f90‎

Lines changed: 10 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -320,7 +320,7 @@ subroutine cmd_run(settings)
320320
stop
321321
endif
322322
else
323-
!! expand names, duplicates are a problem??
323+
!*! expand names, duplicates are a problem??
324324
allocate(foundit(size(settings%name)))
325325
foundit=.false.
326326
FINDIT: do i=1,size(package%executable)
@@ -335,18 +335,15 @@ subroutine cmd_run(settings)
335335
do i=1,size(settings%name)
336336
if(.not.foundit(i))then
337337
write(stderr,'(*(g0,1x))')'fpm::run<ERROR>:executable',trim(settings%name(i)),'not located'
338-
!!elseif(settings%debug)then
339-
!! write(stderr,'(*(g0,1x))')'fpm::run<INFO>:executable',trim(settings%name(i)),'located at',newwords(i),&
340-
!! & merge('exists ','does not exist',exists(trim(settings%name(i))))
341338
endif
342339
enddo
343340
if(allocated(foundit))deallocate(foundit)
344341
endif
345342
do i=1,size(newwords)
346-
!! list is a new option for use with xargs, to move files to production area, valgrind, gdb, ls -l, ....
347-
!! maybe add as --mask and could do --mask 'echo %xx' or --mask 'cp %XX /usr/local/bin/' an so on
348-
!! default if blank would be filename uptodate|needs|updated|doesnotexist creation_date, ...
349-
!! or maybe just list filenames so can pipe through xargs, and so on
343+
!*! list is a new option for use with xargs, to move files to production area, valgrind, gdb, ls -l, ....
344+
!*! maybe add as --mask and could do --mask 'echo %xx' or --mask 'cp %XX /usr/local/bin/' an so on
345+
!*! default if blank would be filename uptodate|needs|updated|doesnotexist creation_date, ...
346+
!*! or maybe just list filenames so can pipe through xargs, and so on
350347
if(settings%list)then
351348
write(stderr,'(*(g0,1x))')'fpm::run<INFO>:executable expected at',newwords(i),&
352349
& merge('exists ','does not exist',exists(newwords(i)))
@@ -405,7 +402,7 @@ subroutine cmd_test(settings)
405402
stop
406403
endif
407404
else
408-
!! expand names, duplicates are a problem??
405+
!*! expand names, duplicates are a problem??
409406
allocate(foundit(size(settings%name)))
410407
foundit=.false.
411408
FINDIT: do i=1,size(package%test)
@@ -420,18 +417,15 @@ subroutine cmd_test(settings)
420417
do i=1,size(settings%name)
421418
if(.not.foundit(i))then
422419
write(stderr,'(*(g0,1x))')'fpm::run<ERROR>:test',trim(settings%name(i)),'not located'
423-
!!elseif(settings%debug)then
424-
!! write(stderr,'(*(g0,1x))')'fpm::run<INFO>:test',trim(settings%name(i)),'located at',newwords(i),&
425-
!! & merge('exists ','does not exist',exists(trim(settings%name(i))))
426420
endif
427421
enddo
428422
if(allocated(foundit))deallocate(foundit)
429423
endif
430424
do i=1,size(newwords)
431-
!! list is a new option for use with xargs, to move files to production area, valgrind, gdb, ls -l, ....
432-
!! maybe add as --mask and could do --mask 'echo %xx' or --mask 'cp %XX /usr/local/bin/' an so on
433-
!! default if blank would be filename uptodate|needs|updated|doesnotexist creation_date, ...
434-
!! or maybe just list filenames so can pipe through xargs, and so on
425+
!*! list is a new option for use with xargs, to move files to production area, valgrind, gdb, ls -l, ....
426+
!*! maybe add as --mask and could do --mask 'echo %xx' or --mask 'cp %XX /usr/local/bin/' an so on
427+
!*! default if blank would be filename uptodate|needs|updated|doesnotexist creation_date, ...
428+
!*! or maybe just list filenames so can pipe through xargs, and so on
435429
if(settings%list)then
436430
write(stderr,'(*(g0,1x))')'fpm::run<INFO>:test expected at',newwords(i),&
437431
& merge('exists ','does not exist',exists(newwords(i)))

‎fpm/src/fpm/cmd/new.f90‎

Lines changed: 99 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -2,51 +2,74 @@ module fpm_cmd_new
22

33
use fpm_command_line, only : fpm_new_settings
44
use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS
5-
use fpm_filesystem, only : join_path, exists, basename, mkdir
5+
use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir
66
use,intrinsic :: iso_fortran_env, only : stderr=>error_unit
77
implicit none
88
private
99
public :: cmd_new
1010

1111
contains
1212

13-
subroutine cmd_new(settings) ! --with-executable F --with-test F '
13+
subroutine cmd_new(settings)
1414
type(fpm_new_settings), intent(in) :: settings
1515
character(len=:),allocatable :: bname ! baeename of NAME
1616
character(len=:),allocatable :: message(:)
1717
character(len=:),allocatable :: littlefile(:)
18+
character(len=8) :: date
19+
20+
call date_and_time(DATE=date)
21+
22+
if(exists(settings%name) .and. .not.settings%backfill )then
23+
write(stderr,'(*(g0,1x))')&
24+
& 'ERROR: ',settings%name,'already exists.'
25+
write(stderr,'(*(g0,1x))')&
26+
& ' perhaps you wanted to add --backfill ?'
27+
return
28+
elseif(is_dir(settings%name) .and. settings%backfill )then
29+
write(*,'(*(g0))')'backfilling ',settings%name
30+
elseif(exists(settings%name) )then
31+
write(stderr,'(*(g0,1x))')&
32+
& 'ERROR: ',settings%name,'already exists and is not a directory.'
33+
return
34+
else
35+
! make new directory
36+
call mkdir(settings%name)
37+
endif
1838

19-
call mkdir(settings%name) ! make new directory
20-
call run('cd '//settings%name) ! change to new directory as a test. System dependent potentially
21-
!! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd().
39+
! change to new directory as a test. System dependent potentially
40+
call run('cd '//settings%name)
41+
!*! NOTE: need some system routines to handle filenames like "."
42+
!*! like realpath() or getcwd().
2243
bname=basename(settings%name)
2344

24-
!! weird gfortran bug?? lines truncated to concatenated string length, not 80
25-
!! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable
26-
27-
call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file
45+
! create NAME/.gitignore file
46+
call warnwrite(join_path(settings%name, '.gitignore'), ['build/*'])
2847

2948
littlefile=[character(len=80) :: '# '//bname, 'My cool new project!']
3049

31-
call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md
32-
33-
message=[character(len=80) :: & ! start building NAME/fpm.toml
34-
&'name = "'//bname//'" ', &
35-
&'version = "0.1.0" ', &
36-
&'license = "license" ', &
37-
&'author = "Jane Doe" ', &
38-
&'maintainer = "[email protected]" ', &
39-
&'copyright = "2020 Jane Doe" ', &
40-
&' ', &
50+
! create NAME/README.md
51+
call warnwrite(join_path(settings%name, 'README.md'), littlefile)
52+
53+
! start building NAME/fpm.toml
54+
message=[character(len=80) :: &
55+
&'name = "'//bname//'" ', &
56+
&'version = "0.1.0" ', &
57+
&'license = "license" ', &
58+
&'author = "Jane Doe" ', &
59+
&'maintainer = "[email protected]" ', &
60+
&'copyright = "'//date(1:4)//' Jane Doe" ', &
61+
&' ', &
4162
&'']
4263

4364
if(settings%with_lib)then
4465
call mkdir(join_path(settings%name,'src') )
45-
message=[character(len=80) :: message, & ! create next section of fpm.toml
66+
! create next section of fpm.toml
67+
message=[character(len=80) :: message, &
4668
&'[library] ', &
4769
&'source-dir="src" ', &
4870
&'']
49-
littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90
71+
! create placeholder module src/bname.f90
72+
littlefile=[character(len=80) :: &
5073
&'module '//bname, &
5174
&' implicit none', &
5275
&' private', &
@@ -57,69 +80,87 @@ subroutine cmd_new(settings) ! --with-executable F --with-test F '
5780
&' print *, "Hello, '//bname//'!"', &
5881
&' end subroutine say_hello', &
5982
&'end module '//bname]
60-
! a proposed alternative default
61-
call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90
83+
! create NAME/src/NAME.f90
84+
call warnwrite(join_path(settings%name, 'src', bname//'.f90'),&
85+
& littlefile)
6286
endif
6387

6488
if(settings%with_test)then
65-
call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop
66-
message=[character(len=80) :: message, & ! create next section of fpm.toml
89+
90+
! create NAME/test or stop
91+
call mkdir(join_path(settings%name, 'test'))
92+
! create next section of fpm.toml
93+
message=[character(len=80) :: message, &
6794
&'[[test]] ', &
6895
&'name="runTests" ', &
6996
&'source-dir="test" ', &
7097
&'main="main.f90" ', &
7198
&'']
7299

73-
littlefile=[character(len=80) :: &
100+
littlefile=[character(len=80) :: &
74101
&'program main', &
75102
&'implicit none', &
76103
&'', &
77104
&'print *, "Put some tests in here!"', &
78105
&'end program main']
79-
! a proposed alternative default a little more substantive
80-
call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90
106+
! create NAME/test/main.f90
107+
call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile)
81108
endif
82109

83110
if(settings%with_executable)then
84-
call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop
85-
message=[character(len=80) :: message, & ! create next section of fpm.toml
111+
! create next section of fpm.toml
112+
call mkdir(join_path(settings%name, 'app'))
113+
! create NAME/app or stop
114+
message=[character(len=80) :: message, &
86115
&'[[executable]] ', &
87116
&'name="'//bname//'" ', &
88117
&'source-dir="app" ', &
89118
&'main="main.f90" ', &
90119
&'']
91120

92-
littlefile=[character(len=80) :: &
93-
&'program main', &
94-
&' use '//bname//', only: say_hello', &
95-
&'', &
96-
&' implicit none', &
97-
&'', &
98-
&' call say_hello', &
99-
&'end program main']
121+
if(exists(bname//'/src/'))then
122+
littlefile=[character(len=80) :: &
123+
&'program main', &
124+
&' use '//bname//', only: say_hello', &
125+
&' implicit none', &
126+
&'', &
127+
&' call say_hello()', &
128+
&'end program main']
129+
else
130+
littlefile=[character(len=80) :: &
131+
&'program main', &
132+
&' implicit none', &
133+
&'', &
134+
&' print *, "hello from project '//bname//'"', &
135+
&'end program main']
136+
endif
100137
call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile)
101138
endif
102139

103-
call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml
104-
105-
call run('cd ' // settings%name // '&&git init') ! assumes these commands work on all systems and git(1) is installed
140+
! now that built it write NAME/fpm.toml
141+
call warnwrite(join_path(settings%name, 'fpm.toml'), message)
142+
! assumes git(1) is installed and in path
143+
call run('git init ' // settings%name)
106144
contains
107145

108146
subroutine warnwrite(fname,data)
109147
character(len=*),intent(in) :: fname
110148
character(len=*),intent(in) :: data(:)
111149

112150
if(.not.exists(fname))then
113-
call filewrite(fname,data)
151+
call filewrite(fname,data)
114152
else
115-
write(stderr,'(*(g0,1x))')'fpm::new<WARNING>',fname,'already exists. Not overwriting'
153+
write(stderr,'(*(g0,1x))')'INFO: ',fname,&
154+
& 'already exists. Not overwriting'
116155
endif
117156

118157
end subroutine warnwrite
119158

120159
subroutine filewrite(filename,filedata)
121-
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
122-
! write filedata to file filename
160+
! procedure to write filedata to file filename
161+
use,intrinsic :: iso_fortran_env, only : &
162+
& stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
163+
123164
character(len=*),intent(in) :: filename
124165
character(len=*),intent(in) :: filedata(:)
125166
integer :: lun, i, ios
@@ -130,29 +171,33 @@ subroutine filewrite(filename,filedata)
130171
if(filename.ne.' ')then
131172
open(file=filename, &
132173
& newunit=lun, &
133-
& form='formatted', & ! FORM = FORMATTED | UNFORMATTED
134-
& access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM
135-
& action='write', & ! ACTION = READ|WRITE | READWRITE
136-
& position='rewind', & ! POSITION = ASIS | REWIND | APPEND
137-
& status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN
174+
& form='formatted', & ! FORM = FORMATTED | UNFORMATTED
175+
& access='sequential', & ! ACCESS = SEQUENTIAL| DIRECT | STREAM
176+
& action='write', & ! ACTION = READ|WRITE| READWRITE
177+
& position='rewind', & ! POSITION= ASIS | REWIND | APPEND
178+
& status='new', & ! STATUS = NEW| REPLACE| OLD| SCRATCH| UNKNOWN
138179
& iostat=ios, &
139180
& iomsg=message)
140181
else
141182
lun=stdout
142183
ios=0
143184
endif
144185
if(ios.ne.0)then
145-
write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message)
186+
write(stderr,'(*(a:,1x))')&
187+
& '*filewrite* error:',filename,trim(message)
146188
error stop 1
147189
endif
148-
do i=1,size(filedata) ! write file
190+
! write file
191+
do i=1,size(filedata)
149192
write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i))
150193
if(ios.ne.0)then
151-
write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message)
194+
write(stderr,'(*(a:,1x))')&
195+
& '*filewrite* error:',filename,trim(message)
152196
error stop 4
153197
endif
154198
enddo
155-
close(unit=lun,iostat=ios,iomsg=message) ! close file
199+
! close file
200+
close(unit=lun,iostat=ios,iomsg=message)
156201
if(ios.ne.0)then
157202
write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message)
158203
error stop 2

0 commit comments

Comments
 (0)