Skip to content

Commit ea1dc19

Browse files
urbanjosturbanjost
committed
RESTORE
1 parent 260a092 commit ea1dc19

File tree

3 files changed

+215
-37
lines changed

3 files changed

+215
-37
lines changed

‎fpm/src/fpm.f90‎

Lines changed: 211 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ module fpm
55
use fpm_command_line, only: fpm_build_settings, fpm_new_settings, &
66
fpm_run_settings, fpm_install_settings, fpm_test_settings
77
use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS
8-
use fpm_filesystem, only: join_path, number_of_rows, list_files, exists, basename
8+
use fpm_filesystem, only: join_path, number_of_rows, list_files, exists, basename, mkdir
99
use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t
1010
use fpm_sources, only: add_executable_sources, add_sources_from_dir, &
1111
resolve_module_dependencies
@@ -19,9 +19,10 @@ module fpm
1919
private
2020
public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test
2121

22-
2322
contains
24-
23+
!===================================================================================================================================
24+
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
25+
!===================================================================================================================================
2526
subroutine build_model(model, settings, package, error)
2627
! Constructs a valid fpm model from command line settings and toml manifest
2728
!
@@ -89,7 +90,9 @@ subroutine build_model(model, settings, package, error)
8990
call resolve_module_dependencies(model%sources)
9091

9192
end subroutine build_model
92-
93+
!===================================================================================================================================
94+
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
95+
!===================================================================================================================================
9396
subroutine cmd_build(settings)
9497
type(fpm_build_settings), intent(in) :: settings
9598
type(package_t) :: package
@@ -126,21 +129,51 @@ subroutine cmd_build(settings)
126129

127130
call build_package(model)
128131

129-
end subroutine
130-
132+
end subroutine cmd_build
133+
!===================================================================================================================================
134+
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
135+
!===================================================================================================================================
131136
subroutine cmd_install(settings)
132137
type(fpm_install_settings), intent(in) :: settings
133138
print *, "fpm error: 'fpm install' not implemented."
134139
error stop 1
135140
end subroutine cmd_install
136-
141+
!===================================================================================================================================
142+
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
143+
!===================================================================================================================================
137144
subroutine cmd_new(settings) ! --with-executable F --with-test F '
138145
type(fpm_new_settings), intent(in) :: settings
146+
integer :: ierr
147+
character(len=:),allocatable :: bname ! baeename of NAME
139148
character(len=:),allocatable :: message(:)
140-
character(len=:),allocatable :: bname
141-
bname=basename(settings%name) !! new basename(dirname) if full paths are allowed ???
142-
143-
message=[character(len=80) :: & ! create fpm.toml
149+
character(len=:),allocatable :: littlefile(:)
150+
call mkdir(settings%name) ! make new directory
151+
call run('cd '//settings%name) ! change to new directory as a test. New OS routines to improve this; system depenent potentially
152+
call mkdir(join_path(settings%name,'src') )
153+
!! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd().
154+
bname=basename(settings%name)
155+
156+
!! weird gfortran bug?? lines truncated to concatenated string length, not 80
157+
!! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable
158+
littlefile=[character(len=80) :: &
159+
&'module '//bname, &
160+
&' implicit none', &
161+
&' private', &
162+
&'', &
163+
&' public :: say_hello', &
164+
&'contains', &
165+
&' subroutine say_hello', &
166+
&' print *, "Hello, '//bname//'!"', &
167+
&' end subroutine say_hello', &
168+
&'end module '//bname]
169+
call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90
170+
171+
call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file
172+
173+
littlefile=[character(len=80) :: '# '//bname, 'My cool new project!']
174+
call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md
175+
176+
message=[character(len=80) :: & ! build NAME/fpm.toml
144177
&'name = "'//bname//'" ', &
145178
&'version = "0.1.0" ', &
146179
&'license = "license" ', &
@@ -153,46 +186,188 @@ subroutine cmd_new(settings) ! --with-executable F --with-test F '
153186
&'']
154187

155188
if(settings%with_test)then
156-
message=[character(len=80) :: message, & ! create next section of fpm.toml
189+
message=[character(len=80) :: message, & ! create next section of fpm.toml
157190
&'[[test]] ', &
158191
&'name="runTests" ', &
159192
&'source-dir="test" ', &
160193
&'main="main.f90" ', &
161194
&'']
195+
196+
call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop
197+
littlefile=[character(len=80) :: &
198+
&'program main', &
199+
&'implicit none', &
200+
&'', &
201+
&'print *, "Put some tests in here!"', &
202+
&'end program main']
203+
call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90
162204
endif
163205

164206
if(settings%with_executable)then
165-
message=[character(len=80) :: message, & ! create next section of fpm.toml
207+
message=[character(len=80) :: message, & ! create next section of fpm.toml
166208
&'[[executable]] ', &
167209
&'name="'//bname//'" ', &
168210
&'source-dir="app" ', &
169211
&'main="main.f90" ', &
170212
&'']
213+
214+
call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop
215+
littlefile=[character(len=80) :: &
216+
&'program main', &
217+
&' use '//bname//', only: say_hello', &
218+
&'', &
219+
&' implicit none', &
220+
&'', &
221+
&' call say_hello', &
222+
&'end program main']
223+
call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile)
171224
endif
172225

173-
write(*,'(a)')message
174-
print *, "fpm error: 'fpm new' not implemented."
175-
error stop 1
176-
end subroutine cmd_new
226+
call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml
227+
228+
call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed
229+
contains
230+
!===================================================================================================================================
231+
subroutine warnwrite(fname,data)
232+
character(len=*),intent(in) :: fname
233+
character(len=*),intent(in) :: data(:)
234+
if(.not.exists(fname))then
235+
call filewrite(fname,data)
236+
else
237+
write(stderr,'(*(g0,1x))')'fpm::new<WARNING>',fname,'already exists. Not overwriting'
238+
endif
239+
end subroutine warnwrite
240+
!===================================================================================================================================
241+
subroutine filewrite(filename,filedata)
242+
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
243+
! write filedata to file filename
244+
character(len=*),intent(in) :: filename
245+
character(len=*),intent(in) :: filedata(:)
246+
integer :: lun, i, ios
247+
character(len=256) :: message
248+
message=' '
249+
ios=0
250+
if(filename.ne.' ')then
251+
open(file=filename, &
252+
& newunit=lun, &
253+
& form='formatted', & ! FORM = FORMATTED | UNFORMATTED
254+
& access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM
255+
& action='write', & ! ACTION = READ|WRITE | READWRITE
256+
& position='rewind', & ! POSITION = ASIS | REWIND | APPEND
257+
& status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN
258+
& iostat=ios, &
259+
& iomsg=message)
260+
else
261+
lun=stdout
262+
ios=0
263+
endif
264+
if(ios.ne.0)then
265+
write(stderr,'(*(a,1x))')'*filewrite* error:',filename,trim(message)
266+
error stop 1
267+
endif
268+
do i=1,size(filedata) ! write file
269+
write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i))
270+
if(ios.ne.0)then
271+
write(stderr,'(*(a,1x))')'*filewrite* error:',filename,trim(message)
272+
stop 4
273+
endif
274+
enddo
275+
close(unit=lun,iostat=ios,iomsg=message) ! close file
276+
if(ios.ne.0)then
277+
write(stderr,'(*(a,1x))')'*filewrite* error:',trim(message)
278+
error stop 2
279+
endif
280+
end subroutine filewrite
177281

282+
end subroutine cmd_new
283+
!===================================================================================================================================
284+
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
285+
!===================================================================================================================================
178286
subroutine cmd_run(settings)
179-
type(fpm_run_settings), intent(in) :: settings
180-
integer :: i
181-
182-
write(*,*)'RELEASE=',settings%release
183-
if(size(settings%name).eq.0)then
184-
write(*,*)'RUN DEFAULTS with arguments ['//settings%args//']'
185-
else
186-
do i=1,size(settings%name)
187-
write(*,*)'RUN:'//trim(settings%name(i))//' with arguments ['//settings%args//']'
188-
enddo
189-
endif
190-
191-
print *, "fpm error: 'fpm run' not implemented."
192-
error stop 1
193-
287+
type(fpm_run_settings), intent(in) :: settings
288+
character(len=:),allocatable :: release_name, cmd, fname
289+
integer :: i, j
290+
type(package_t) :: package
291+
type(error_t), allocatable :: error
292+
character(len=:),allocatable :: newwords(:)
293+
logical,allocatable :: foundit(:)
294+
logical :: list
295+
call get_package_data(package, "fpm.toml", error)
296+
if (allocated(error)) then
297+
print '(a)', error%message
298+
stop
299+
endif
300+
release_name=trim(merge('gfortran_release','gfortran_debug ',settings%release))
301+
newwords=[character(len=0) ::]
302+
! Populate executable in case we find the default app directory
303+
if (.not.allocated(package%executable) .and. exists("app")) then
304+
allocate(package%executable(1))
305+
call default_executable(package%executable(1), package%name)
306+
endif
307+
if(size(settings%name).eq.0)then
308+
if ( .not.allocated(package%executable) ) then
309+
write(stderr,'(*(g0,1x))')'fpm::run<INFO>:no executables found in fpm.toml and no default app/ directory'
310+
stop
311+
endif
312+
allocate(foundit(size(package%executable)))
313+
do i=1,size(package%executable)
314+
fname=join_path('build',release_name,package%executable(i)%source_dir,package%executable(i)%name)
315+
newwords=[character(len=max(len(newwords),len(fname))) :: newwords,fname]
316+
enddo
317+
if(size(newwords).lt.1)then
318+
write(stderr,'(*(g0,1x))')'fpm::run<INFO>:no executables found in fpm.toml'
319+
stop
320+
endif
321+
else
322+
!! expand names, duplicates are a problem??
323+
allocate(foundit(size(settings%name)))
324+
foundit=.false.
325+
FINDIT: do i=1,size(package%executable)
326+
do j=1,size(settings%name)
327+
if(settings%name(j).eq.package%executable(i)%name)then
328+
fname=join_path('build',release_name,package%executable(i)%source_dir,package%executable(i)%name)
329+
newwords=[character(len=max(len(newwords),len(fname))) :: newwords,fname]
330+
foundit(j)=.true.
331+
endif
332+
enddo
333+
enddo FINDIT
334+
do i=1,size(settings%name)
335+
if(.not.foundit(i))then
336+
write(stderr,'(*(g0,1x))')'fpm::run<ERROR>:executable',trim(settings%name(i)),'not located'
337+
!!elseif(settings%debug)then
338+
!! write(stderr,'(*(g0,1x))')'fpm::run<INFO>:executable',trim(settings%name(i)),'located at',newwords(i),&
339+
!! & merge('exists ','does not exist',exists(trim(settings%name(i))))
340+
endif
341+
enddo
342+
if(allocated(foundit))deallocate(foundit)
343+
endif
344+
do i=1,size(newwords)
345+
!! list is a new option for use with xargs, to move files to production area, valgrind, gdb, ls -l, ....
346+
!! maybe add as --mask and could do --mask 'echo %xx' or --mask 'cp %XX /usr/local/bin/' an so on
347+
!! default if blank would be filename uptodate|needs|updated|doesnotexist creation_date, ...
348+
!! or maybe just list filenames so can pipe through xargs, and so on
349+
if(settings%list)then
350+
write(stderr,'(*(g0,1x))')'fpm::run<INFO>:executable expected at',newwords(i),&
351+
& merge('exists ','does not exist',exists(newwords(i)))
352+
cycle
353+
endif
354+
cmd=newwords(i) // ' ' // settings%args
355+
if(exists(newwords(i)))then
356+
call run(cmd)
357+
else ! try to build
358+
!!call cmd_build()
359+
if(exists(newwords(i)))then
360+
call run(cmd)
361+
else
362+
write(stderr,*)'fpm::run<ERROR>',cmd,' not found'
363+
endif
364+
endif
365+
enddo
366+
deallocate(newwords)
194367
end subroutine cmd_run
195-
368+
!===================================================================================================================================
369+
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
370+
!===================================================================================================================================
196371
subroutine cmd_test(settings)
197372
type(fpm_test_settings), intent(in) :: settings
198373
character(len=:),allocatable :: release_name
@@ -214,5 +389,7 @@ subroutine cmd_test(settings)
214389
print *, "fpm error: 'fpm test' not implemented."
215390
error stop 1
216391
end subroutine cmd_test
217-
392+
!===================================================================================================================================
393+
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
394+
!===================================================================================================================================
218395
end module fpm

‎fpm/src/fpm_command_line.f90‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,8 @@ subroutine get_command_line_settings(cmd_settings)
123123
endif
124124

125125
allocate(fpm_run_settings :: cmd_settings)
126-
cmd_settings=fpm_run_settings( name=names, release=lget('release'), args=remaining )
126+
cmd_settings=fpm_run_settings( name=names, list=lget('list'), &
127+
& release=lget('release'), args=remaining )
127128

128129
case('build')
129130
help_text=[character(len=80) :: &

‎fpm/src/fpm_filesystem.f90‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -135,11 +135,11 @@ subroutine mkdir(dir)
135135
select case (get_os_type())
136136
case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
137137
call execute_command_line('mkdir -p ' // dir, exitstat=stat)
138-
write (*, '(2a)') 'mkdir -p ' // dir
138+
write (*, '(" + ",2a)') 'mkdir -p ' // dir
139139

140140
case (OS_WINDOWS)
141141
call execute_command_line("mkdir " // windows_path(dir), exitstat=stat)
142-
write (*, '(2a)') 'mkdir ' // windows_path(dir)
142+
write (*, '(" + ",2a)') 'mkdir ' // windows_path(dir)
143143
end select
144144

145145
if (stat /= 0) then

0 commit comments

Comments
 (0)