Skip to content

Commit f6ee1f0

Browse files
urbanjosturbanjost
committed
refactor fpm.f90 to separate subcommand new into fpm_new_subcommand.f90
1 parent d3a65e3 commit f6ee1f0

File tree

4 files changed

+173
-162
lines changed

4 files changed

+173
-162
lines changed

‎fpm/app/main.f90‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,8 @@ program main
77
fpm_test_settings, &
88
fpm_install_settings, &
99
get_command_line_settings
10-
use fpm, only: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test
10+
use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test
11+
use fpm_new_subcommand, only: cmd_new
1112

1213
implicit none
1314

‎fpm/src/fpm.f90‎

Lines changed: 4 additions & 160 deletions
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,8 @@ module fpm
44
use fpm_backend, only: build_package
55
use fpm_command_line, only: fpm_build_settings, fpm_new_settings, &
66
fpm_run_settings, fpm_install_settings, fpm_test_settings
7-
use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS
8-
use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename, mkdir
7+
use fpm_environment, only: run
8+
use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename
99
use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, &
1010
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, &
1111
FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST
@@ -16,12 +16,10 @@ module fpm
1616
default_library, package_t, default_test
1717
use fpm_error, only : error_t
1818
use fpm_manifest_test, only : test_t
19-
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
20-
& stdout=>output_unit, &
21-
& stderr=>error_unit
19+
use,intrinsic :: iso_fortran_env, only : stderr=>error_unit
2220
implicit none
2321
private
24-
public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test
22+
public :: cmd_build, cmd_install, cmd_run, cmd_test
2523

2624
contains
2725

@@ -168,160 +166,6 @@ subroutine cmd_install(settings)
168166
error stop 8
169167
end subroutine cmd_install
170168

171-
172-
subroutine cmd_new(settings) ! --with-executable F --with-test F '
173-
type(fpm_new_settings), intent(in) :: settings
174-
integer :: ierr
175-
character(len=:),allocatable :: bname ! baeename of NAME
176-
character(len=:),allocatable :: message(:)
177-
character(len=:),allocatable :: littlefile(:)
178-
179-
call mkdir(settings%name) ! make new directory
180-
call run('cd '//settings%name) ! change to new directory as a test. New OS routines to improve this; system dependent potentially
181-
!! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd().
182-
bname=basename(settings%name)
183-
184-
!! weird gfortran bug?? lines truncated to concatenated string length, not 80
185-
!! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable
186-
187-
call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file
188-
189-
littlefile=[character(len=80) :: '# '//bname, 'My cool new project!']
190-
191-
call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md
192-
193-
message=[character(len=80) :: & ! start building NAME/fpm.toml
194-
&'name = "'//bname//'" ', &
195-
&'version = "0.1.0" ', &
196-
&'license = "license" ', &
197-
&'author = "Jane Doe" ', &
198-
&'maintainer = "[email protected]" ', &
199-
&'copyright = "2020 Jane Doe" ', &
200-
&' ', &
201-
&'']
202-
203-
if(settings%with_lib)then
204-
call mkdir(join_path(settings%name,'src') )
205-
message=[character(len=80) :: message, & ! create next section of fpm.toml
206-
&'[library] ', &
207-
&'source-dir="src" ', &
208-
&'']
209-
littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90
210-
&'module '//bname, &
211-
&' implicit none', &
212-
&' private', &
213-
&'', &
214-
&' public :: say_hello', &
215-
&'contains', &
216-
&' subroutine say_hello', &
217-
&' print *, "Hello, '//bname//'!"', &
218-
&' end subroutine say_hello', &
219-
&'end module '//bname]
220-
! a proposed alternative default
221-
call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90
222-
endif
223-
224-
if(settings%with_test)then
225-
call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop
226-
message=[character(len=80) :: message, & ! create next section of fpm.toml
227-
&'[[test]] ', &
228-
&'name="runTests" ', &
229-
&'source-dir="test" ', &
230-
&'main="main.f90" ', &
231-
&'']
232-
233-
littlefile=[character(len=80) :: &
234-
&'program main', &
235-
&'implicit none', &
236-
&'', &
237-
&'print *, "Put some tests in here!"', &
238-
&'end program main']
239-
! a proposed alternative default a little more substantive
240-
call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90
241-
endif
242-
243-
if(settings%with_executable)then
244-
call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop
245-
message=[character(len=80) :: message, & ! create next section of fpm.toml
246-
&'[[executable]] ', &
247-
&'name="'//bname//'" ', &
248-
&'source-dir="app" ', &
249-
&'main="main.f90" ', &
250-
&'']
251-
252-
littlefile=[character(len=80) :: &
253-
&'program main', &
254-
&' use '//bname//', only: say_hello', &
255-
&'', &
256-
&' implicit none', &
257-
&'', &
258-
&' call say_hello', &
259-
&'end program main']
260-
call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile)
261-
endif
262-
263-
call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml
264-
265-
call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed
266-
contains
267-
268-
subroutine warnwrite(fname,data)
269-
character(len=*),intent(in) :: fname
270-
character(len=*),intent(in) :: data(:)
271-
272-
if(.not.exists(fname))then
273-
call filewrite(fname,data)
274-
else
275-
write(stderr,'(*(g0,1x))')'fpm::new<WARNING>',fname,'already exists. Not overwriting'
276-
endif
277-
278-
end subroutine warnwrite
279-
280-
subroutine filewrite(filename,filedata)
281-
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
282-
! write filedata to file filename
283-
character(len=*),intent(in) :: filename
284-
character(len=*),intent(in) :: filedata(:)
285-
integer :: lun, i, ios
286-
character(len=256) :: message
287-
288-
message=' '
289-
ios=0
290-
if(filename.ne.' ')then
291-
open(file=filename, &
292-
& newunit=lun, &
293-
& form='formatted', & ! FORM = FORMATTED | UNFORMATTED
294-
& access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM
295-
& action='write', & ! ACTION = READ|WRITE | READWRITE
296-
& position='rewind', & ! POSITION = ASIS | REWIND | APPEND
297-
& status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN
298-
& iostat=ios, &
299-
& iomsg=message)
300-
else
301-
lun=stdout
302-
ios=0
303-
endif
304-
if(ios.ne.0)then
305-
write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message)
306-
error stop 1
307-
endif
308-
do i=1,size(filedata) ! write file
309-
write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i))
310-
if(ios.ne.0)then
311-
write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message)
312-
error stop 4
313-
endif
314-
enddo
315-
close(unit=lun,iostat=ios,iomsg=message) ! close file
316-
if(ios.ne.0)then
317-
write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message)
318-
error stop 2
319-
endif
320-
end subroutine filewrite
321-
322-
end subroutine cmd_new
323-
324-
325169
subroutine cmd_run(settings)
326170
type(fpm_run_settings), intent(in) :: settings
327171
character(len=:),allocatable :: release_name, cmd, fname

‎fpm/src/fpm_new_subcommand.f90‎

Lines changed: 165 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,165 @@
1+
module fpm_new_subcommand
2+
3+
use fpm_command_line, only : fpm_new_settings
4+
use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS
5+
use fpm_filesystem, only : join_path, exists, basename, mkdir
6+
use,intrinsic :: iso_fortran_env, only : stderr=>error_unit
7+
implicit none
8+
private
9+
public :: cmd_new
10+
11+
contains
12+
13+
subroutine cmd_new(settings) ! --with-executable F --with-test F '
14+
type(fpm_new_settings), intent(in) :: settings
15+
integer :: ierr
16+
character(len=:),allocatable :: bname ! baeename of NAME
17+
character(len=:),allocatable :: message(:)
18+
character(len=:),allocatable :: littlefile(:)
19+
20+
call mkdir(settings%name) ! make new directory
21+
call run('cd '//settings%name) ! change to new directory as a test. System dependent potentially
22+
!! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd().
23+
bname=basename(settings%name)
24+
25+
!! weird gfortran bug?? lines truncated to concatenated string length, not 80
26+
!! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable
27+
28+
call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file
29+
30+
littlefile=[character(len=80) :: '# '//bname, 'My cool new project!']
31+
32+
call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md
33+
34+
message=[character(len=80) :: & ! start building NAME/fpm.toml
35+
&'name = "'//bname//'" ', &
36+
&'version = "0.1.0" ', &
37+
&'license = "license" ', &
38+
&'author = "Jane Doe" ', &
39+
&'maintainer = "[email protected]" ', &
40+
&'copyright = "2020 Jane Doe" ', &
41+
&' ', &
42+
&'']
43+
44+
if(settings%with_lib)then
45+
call mkdir(join_path(settings%name,'src') )
46+
message=[character(len=80) :: message, & ! create next section of fpm.toml
47+
&'[library] ', &
48+
&'source-dir="src" ', &
49+
&'']
50+
littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90
51+
&'module '//bname, &
52+
&' implicit none', &
53+
&' private', &
54+
&'', &
55+
&' public :: say_hello', &
56+
&'contains', &
57+
&' subroutine say_hello', &
58+
&' print *, "Hello, '//bname//'!"', &
59+
&' end subroutine say_hello', &
60+
&'end module '//bname]
61+
! a proposed alternative default
62+
call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90
63+
endif
64+
65+
if(settings%with_test)then
66+
call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop
67+
message=[character(len=80) :: message, & ! create next section of fpm.toml
68+
&'[[test]] ', &
69+
&'name="runTests" ', &
70+
&'source-dir="test" ', &
71+
&'main="main.f90" ', &
72+
&'']
73+
74+
littlefile=[character(len=80) :: &
75+
&'program main', &
76+
&'implicit none', &
77+
&'', &
78+
&'print *, "Put some tests in here!"', &
79+
&'end program main']
80+
! a proposed alternative default a little more substantive
81+
call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90
82+
endif
83+
84+
if(settings%with_executable)then
85+
call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop
86+
message=[character(len=80) :: message, & ! create next section of fpm.toml
87+
&'[[executable]] ', &
88+
&'name="'//bname//'" ', &
89+
&'source-dir="app" ', &
90+
&'main="main.f90" ', &
91+
&'']
92+
93+
littlefile=[character(len=80) :: &
94+
&'program main', &
95+
&' use '//bname//', only: say_hello', &
96+
&'', &
97+
&' implicit none', &
98+
&'', &
99+
&' call say_hello', &
100+
&'end program main']
101+
call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile)
102+
endif
103+
104+
call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml
105+
106+
call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed
107+
contains
108+
109+
subroutine warnwrite(fname,data)
110+
character(len=*),intent(in) :: fname
111+
character(len=*),intent(in) :: data(:)
112+
113+
if(.not.exists(fname))then
114+
call filewrite(fname,data)
115+
else
116+
write(stderr,'(*(g0,1x))')'fpm::new<WARNING>',fname,'already exists. Not overwriting'
117+
endif
118+
119+
end subroutine warnwrite
120+
121+
subroutine filewrite(filename,filedata)
122+
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
123+
! write filedata to file filename
124+
character(len=*),intent(in) :: filename
125+
character(len=*),intent(in) :: filedata(:)
126+
integer :: lun, i, ios
127+
character(len=256) :: message
128+
129+
message=' '
130+
ios=0
131+
if(filename.ne.' ')then
132+
open(file=filename, &
133+
& newunit=lun, &
134+
& form='formatted', & ! FORM = FORMATTED | UNFORMATTED
135+
& access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM
136+
& action='write', & ! ACTION = READ|WRITE | READWRITE
137+
& position='rewind', & ! POSITION = ASIS | REWIND | APPEND
138+
& status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN
139+
& iostat=ios, &
140+
& iomsg=message)
141+
else
142+
lun=stdout
143+
ios=0
144+
endif
145+
if(ios.ne.0)then
146+
write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message)
147+
error stop 1
148+
endif
149+
do i=1,size(filedata) ! write file
150+
write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i))
151+
if(ios.ne.0)then
152+
write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message)
153+
error stop 4
154+
endif
155+
enddo
156+
close(unit=lun,iostat=ios,iomsg=message) ! close file
157+
if(ios.ne.0)then
158+
write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message)
159+
error stop 2
160+
endif
161+
end subroutine filewrite
162+
163+
end subroutine cmd_new
164+
165+
end module fpm_new_subcommand

‎fpm/test/cli_test/cli_test.f90‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -193,7 +193,8 @@ subroutine parse()
193193
fpm_test_settings, &
194194
fpm_install_settings, &
195195
get_command_line_settings
196-
use fpm, only: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test
196+
use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test
197+
use fpm_new_subcommand, only: cmd_new
197198
class(fpm_cmd_settings), allocatable :: cmd_settings
198199
! duplicates the calls as seen in the main program for fpm
199200
call get_command_line_settings(cmd_settings)

0 commit comments

Comments
 (0)