From bf864695588829490508991f3b041dd8535c69bc Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 26 Aug 2020 09:47:34 +0100 Subject: Restructure: move some routines out of fpm module. Create separate modules for filesystem and string routines. These can be substituted eventually for stdlib. --- fpm/src/FPM_Filesystem.f90 | 76 +++++++++++++++++++++++++++++++++++++++++++ fpm/src/FPM_Strings.f90 | 23 +++++++++++++ fpm/src/environment.f90 | 14 +++++++- fpm/src/fpm.f90 | 81 ++-------------------------------------------- 4 files changed, 115 insertions(+), 79 deletions(-) create mode 100644 fpm/src/FPM_Filesystem.f90 create mode 100644 fpm/src/FPM_Strings.f90 diff --git a/fpm/src/FPM_Filesystem.f90 b/fpm/src/FPM_Filesystem.f90 new file mode 100644 index 0000000..fe35066 --- /dev/null +++ b/fpm/src/FPM_Filesystem.f90 @@ -0,0 +1,76 @@ +module FPM_Filesystem +use FPM_Strings +use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +implicit none + +private +public :: number_of_rows, list_files, exists + +integer, parameter :: LINE_BUFFER_LEN = 1000 + +contains + + +integer function number_of_rows(s) result(nrows) + ! determine number or rows + integer,intent(in)::s + integer :: ios + character(len=100) :: r + rewind(s) + nrows = 0 + do + read(s, *, iostat=ios) r + if (ios /= 0) exit + nrows = nrows + 1 + end do + rewind(s) +end function + +function read_lines(filename) result(lines) + character(*), intent(in) :: filename + type(string_t), allocatable :: lines(:) + + integer :: fh, i + character(LINE_BUFFER_LEN) :: line_buffer + + open(newunit=fh, file=filename, status="old") + allocate(lines(number_of_rows(fh))) + do i = 1, size(lines) + read(fh, *) line_buffer + lines(i)%s = trim(line_buffer) + end do + close(fh) + +end function read_lines + + +subroutine list_files(dir, files) + character(len=*), intent(in) :: dir + type(string_t), allocatable, intent(out) :: files(:) + integer :: stat + ! Using `inquire` / exists on directories works with gfortran, but not ifort + if (.not. exists(dir)) then + allocate(files(0)) + return + end if + select case (get_os_type()) + case (OS_LINUX) + call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) + case (OS_MACOS) + call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) + case (OS_WINDOWS) + call execute_command_line("dir /b " // dir // " > fpm_ls.out", exitstat=stat) + end select + if (stat /= 0) then + print *, "execute_command_line() failed" + error stop + end if + files = read_lines("fpm_ls.out") +end subroutine + +logical function exists(filename) result(r) + character(len=*), intent(in) :: filename + inquire(file=filename, exist=r) +end function + +end module FPM_Filesystem \ No newline at end of file diff --git a/fpm/src/FPM_Strings.f90 b/fpm/src/FPM_Strings.f90 new file mode 100644 index 0000000..33ae0c4 --- /dev/null +++ b/fpm/src/FPM_Strings.f90 @@ -0,0 +1,23 @@ +module FPM_Strings +implicit none + +type string_t + character(len=:), allocatable :: s +end type + +contains + +logical function str_ends_with(s, e) result(r) + character(*), intent(in) :: s, e + integer :: n1, n2 + n1 = len(s)-len(e)+1 + n2 = len(s) + if (n1 < 1) then + r = .false. + else + r = (s(n1:n2) == e) + end if +end function + + +end module FPM_Strings \ No newline at end of file diff --git a/fpm/src/environment.f90 b/fpm/src/environment.f90 index 9190eb6..23cd8aa 100644 --- a/fpm/src/environment.f90 +++ b/fpm/src/environment.f90 @@ -6,7 +6,7 @@ module environment integer, parameter, public :: OS_MACOS = 2 integer, parameter, public :: OS_WINDOWS = 3 - public :: get_os_type + public :: get_os_type, run contains integer function get_os_type() result(r) ! Determine the OS type @@ -51,4 +51,16 @@ contains r = OS_LINUX end if end function + + subroutine run(cmd) + character(len=*), intent(in) :: cmd + integer :: stat + print *, "+ ", cmd + call execute_command_line(cmd, exitstat=stat) + if (stat /= 0) then + print *, "Command failed" + error stop + end if + end subroutine + end module diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index ed80313..26a4631 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,89 +1,14 @@ module fpm -use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +use FPM_Strings +use environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +use FPM_Filesystem, only: number_of_rows, list_files, exists implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test -type string_t - character(len=:), allocatable :: s -end type contains -integer function number_of_rows(s) result(nrows) -! determine number or rows -integer,intent(in)::s -integer :: ios -character(len=100) :: r -rewind(s) -nrows = 0 -do - read(s, *, iostat=ios) r - if (ios /= 0) exit - nrows = nrows + 1 -end do -rewind(s) -end function - - -subroutine list_files(dir, files) -character(len=*), intent(in) :: dir -type(string_t), allocatable, intent(out) :: files(:) -character(len=100) :: filename -integer :: stat, u, i -! Using `inquire` / exists on directories works with gfortran, but not ifort -if (.not. exists(dir)) then - allocate(files(0)) - return -end if -select case (get_os_type()) - case (OS_LINUX) - call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) - case (OS_MACOS) - call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) - case (OS_WINDOWS) - call execute_command_line("dir /b " // dir // " > fpm_ls.out", exitstat=stat) -end select -if (stat /= 0) then - print *, "execute_command_line() failed" - error stop -end if -open(newunit=u, file="fpm_ls.out", status="old") -allocate(files(number_of_rows(u))) -do i = 1, size(files) - read(u, *) filename - files(i)%s = trim(filename) -end do -close(u) -end subroutine - -subroutine run(cmd) -character(len=*), intent(in) :: cmd -integer :: stat -print *, "+ ", cmd -call execute_command_line(cmd, exitstat=stat) -if (stat /= 0) then - print *, "Command failed" - error stop -end if -end subroutine - -logical function exists(filename) result(r) -character(len=*), intent(in) :: filename -inquire(file=filename, exist=r) -end function - -logical function str_ends_with(s, e) result(r) -character(*), intent(in) :: s, e -integer :: n1, n2 -n1 = len(s)-len(e)+1 -n2 = len(s) -if (n1 < 1) then - r = .false. -else - r = (s(n1:n2) == e) -end if -end function subroutine package_name(name) character(:), allocatable, intent(out) :: name -- cgit v1.2.3 From cdedb0add8366dc6a378d69998456ff8d0b10222 Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 26 Aug 2020 10:03:21 +0100 Subject: Use temporary file for directory listing output. --- fpm/src/FPM_Filesystem.f90 | 73 ++++++++++++++++++++++++++++++++++++++-------- fpm/src/FPM_Strings.f90 | 20 +++++++++++++ 2 files changed, 81 insertions(+), 12 deletions(-) diff --git a/fpm/src/FPM_Filesystem.f90 b/fpm/src/FPM_Filesystem.f90 index fe35066..6729632 100644 --- a/fpm/src/FPM_Filesystem.f90 +++ b/fpm/src/FPM_Filesystem.f90 @@ -4,13 +4,12 @@ use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS implicit none private -public :: number_of_rows, list_files, exists +public :: number_of_rows, read_lines, list_files, exists, get_temp_filename integer, parameter :: LINE_BUFFER_LEN = 1000 contains - integer function number_of_rows(s) result(nrows) ! determine number or rows integer,intent(in)::s @@ -26,20 +25,19 @@ integer function number_of_rows(s) result(nrows) rewind(s) end function -function read_lines(filename) result(lines) - character(*), intent(in) :: filename + +function read_lines(fh) result(lines) + integer, intent(in) :: fh type(string_t), allocatable :: lines(:) - integer :: fh, i + integer :: i character(LINE_BUFFER_LEN) :: line_buffer - open(newunit=fh, file=filename, status="old") allocate(lines(number_of_rows(fh))) do i = 1, size(lines) read(fh, *) line_buffer lines(i)%s = trim(line_buffer) end do - close(fh) end function read_lines @@ -47,30 +45,81 @@ end function read_lines subroutine list_files(dir, files) character(len=*), intent(in) :: dir type(string_t), allocatable, intent(out) :: files(:) - integer :: stat + + integer :: stat, fh + character(:), allocatable :: temp_file + ! Using `inquire` / exists on directories works with gfortran, but not ifort if (.not. exists(dir)) then allocate(files(0)) return end if + + allocate(temp_file, source = get_temp_filename() ) + select case (get_os_type()) case (OS_LINUX) - call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) + call execute_command_line("ls " // dir // " > "//temp_file, exitstat=stat) case (OS_MACOS) - call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) + call execute_command_line("ls " // dir // " > "//temp_file, exitstat=stat) case (OS_WINDOWS) - call execute_command_line("dir /b " // dir // " > fpm_ls.out", exitstat=stat) + call execute_command_line("dir /b " // dir // " > "//temp_file, exitstat=stat) end select if (stat /= 0) then print *, "execute_command_line() failed" error stop end if - files = read_lines("fpm_ls.out") + + open(newunit=fh, file=temp_file, status="old") + files = read_lines(fh) + close(fh,status="delete") + end subroutine + logical function exists(filename) result(r) character(len=*), intent(in) :: filename inquire(file=filename, exist=r) end function + +function get_temp_filename() result(tempfile) + ! Get a unused temporary filename + ! Calls posix 'tempnam' - not recommended, but + ! we have no security concerns for this application + ! and use here is temporary. + ! Works with MinGW + ! + use iso_c_binding, only: c_ptr, C_NULL_PTR, c_f_pointer + character(:), allocatable :: 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") + import + type(c_ptr), intent(in), value :: dir + type(c_ptr), intent(in), value :: pfx + type(c_ptr) :: tmp + end function c_tempnam + + subroutine c_free(ptr) BIND(C,name="free") + import + type(c_ptr), value :: ptr + end subroutine c_free + + end interface + + c_tempfile_ptr = c_tempnam(C_NULL_PTR, C_NULL_PTR) + call c_f_pointer(c_tempfile_ptr,c_tempfile,[LINE_BUFFER_LEN]) + + tempfile = f_string(c_tempfile) + + call c_free(c_tempfile_ptr) + +end function get_temp_filename + + end module FPM_Filesystem \ No newline at end of file diff --git a/fpm/src/FPM_Strings.f90 b/fpm/src/FPM_Strings.f90 index 33ae0c4..9a8869d 100644 --- a/fpm/src/FPM_Strings.f90 +++ b/fpm/src/FPM_Strings.f90 @@ -19,5 +19,25 @@ logical function str_ends_with(s, e) result(r) end if end function +function f_string(c_string) + use iso_c_binding + character(len=1), intent(in) :: c_string(:) + character(:), allocatable :: f_string + + integer :: i, n + + i = 0 + do while(c_string(i+1) /= C_NULL_CHAR) + i = i + 1 + end do + n = i + + allocate(character(n) :: f_string) + do i=1,n + f_string(i:i) = c_string(i) + end do + + end function f_string + end module FPM_Strings \ No newline at end of file -- cgit v1.2.3 From 1746dd064ca98391227742d49938c185037c5c8f Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 26 Aug 2020 12:26:15 +0100 Subject: Minor fix: to read_lines subroutine. --- fpm/src/FPM_Filesystem.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/FPM_Filesystem.f90 b/fpm/src/FPM_Filesystem.f90 index 6729632..a20c7ab 100644 --- a/fpm/src/FPM_Filesystem.f90 +++ b/fpm/src/FPM_Filesystem.f90 @@ -35,7 +35,7 @@ function read_lines(fh) result(lines) allocate(lines(number_of_rows(fh))) do i = 1, size(lines) - read(fh, *) line_buffer + read(fh, '(A)') line_buffer lines(i)%s = trim(line_buffer) end do -- cgit v1.2.3 From fbe3370e7faeff78e33133989e6ec301de7f6d04 Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 26 Aug 2020 12:26:44 +0100 Subject: Add: Sourcefiles module for processing sources. Currently extract use/include dependencies and resolves these to specific source files. Also included lower and split string routines as needed. --- fpm/src/FPM_Sourcefiles.f90 | 271 ++++++++++++++++++++++++++++++++++++++++++++ fpm/src/FPM_Strings.f90 | 154 ++++++++++++++++++++++++- 2 files changed, 424 insertions(+), 1 deletion(-) create mode 100644 fpm/src/FPM_Sourcefiles.f90 diff --git a/fpm/src/FPM_Sourcefiles.f90 b/fpm/src/FPM_Sourcefiles.f90 new file mode 100644 index 0000000..63067c9 --- /dev/null +++ b/fpm/src/FPM_Sourcefiles.f90 @@ -0,0 +1,271 @@ +module FPM_Sourcefiles +use FPM_Strings +use FPM_Filesystem, only: read_lines +implicit none + +private +public srcfile_ptr, srcfile_t +public scan_f_sources + +integer, parameter, public :: FPM_UNIT_UNKNOWN = -1 +integer, parameter, public :: FPM_UNIT_PROGRAM = 1 +integer, parameter, public :: FPM_UNIT_MODULE = 2 +integer, parameter, public :: FPM_UNIT_SUBMODULE = 3 +integer, parameter, public :: FPM_UNIT_SUBPROGRAM = 4 +integer, parameter, public :: FPM_UNIT_CSOURCE = 5 +integer, parameter, public :: FPM_UNIT_CHEADER = 6 + +character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & + ['iso_c_binding ', & + 'iso_fortran_env'] + +type srcfile_ptr + ! For constructing arrays of src_file pointers + type(srcfile_t), pointer :: ptr => NULL() +end type srcfile_ptr + +type srcfile_t + ! Type for encapsulating a source file + ! and it's metadata + character(:), allocatable :: file_name + ! File path relative to cwd + character(:), allocatable :: unit_name + ! Module/program name + integer :: unit_type = FPM_UNIT_UNKNOWN + ! Type of program unit + type(string_t), allocatable :: module_dependencies(:) + ! Modules USEd by this source file (lowerstring) + type(string_t), allocatable :: include_dependencies(:) + ! Files INCLUDEd by this source file + type(srcfile_ptr), allocatable :: file_dependencies(:) + ! Resolved source file dependencies + + logical :: built = .false. + logical :: touched = .false. +end type srcfile_t + + +contains + +subroutine scan_f_sources(file_names,f_sources) + ! Enumerate Fortran sources and resolve file + ! dependencies + ! + type(string_t), intent(in) :: file_names(:) + type(srcfile_t), allocatable, intent(out), target :: f_sources(:) + + integer :: i, j + logical :: is_f_source(size(file_names)) + type(string_t), allocatable :: f_file_names(:) + + is_f_source = [(str_ends_with(lower(file_names(i)%s), ".f90"),i=1,size(file_names))] + f_file_names = pack(file_names,is_f_source) + + allocate(f_sources(size(f_file_names))) + + do i = 1, size(f_file_names) + + f_sources(i) = parse_f_source(f_file_names(i)%s) + + end do + + do i=1,size(f_sources) + write(*,*) 'Filename: "',f_sources(i)%file_name,'"' + write(*,*) ' Module name: "',f_sources(i)%unit_name,'"' + do j=1,size(f_sources(i)%module_dependencies) + write(*,*) ' Uses: "',f_sources(i)%module_dependencies(j)%s,'"' + end do + do j=1,size(f_sources(i)%include_dependencies) + write(*,*) ' Includes: "',f_sources(i)%include_dependencies(j)%s,'"' + end do + end do + + call resolve_f_dependencies(f_sources) + +end subroutine scan_f_sources + + +function parse_f_source(f_filename) result(f_source) + ! Rudimentary scan of Fortran source file and + ! extract program unit name and use/include dependencies + ! + character(*), intent(in) :: f_filename + type(srcfile_t) :: f_source + + integer :: fh, n_use, n_include, i, j, pass + type(string_t), allocatable :: file_lines(:) + character(:), allocatable :: line_parts(:) + character(:), allocatable :: temp_string, use_module_name + + f_source%file_name = f_filename + + open(newunit=fh,file=f_filename,status='old') + file_lines = read_lines(fh) + close(fh) + + do pass = 1,2 + n_use = 0 + n_include = 0 + file_loop: do i=1,size(file_lines) + + ! Process 'USE' statements + if (index(adjustl(lower(file_lines(i)%s)),'use') == 1) then + + if (index(file_lines(i)%s,'::') > 0) then + + call split(file_lines(i)%s,line_parts,delimiters=':') + temp_string = line_parts(2) + call split(temp_string,line_parts,delimiters=' ,') + use_module_name = trim(lower(line_parts(1))) + + else + + call split(file_lines(i)%s,line_parts,delimiters=' ,') + use_module_name = trim(lower(line_parts(2))) + + end if + + if (any([(index(use_module_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & + j=1,size(INTRINSIC_MODULE_NAMES))])) then + cycle + end if + + n_use = n_use + 1 + + if (pass == 2) then + + f_source%module_dependencies(n_use)%s = use_module_name + + end if + + end if + + ! Process 'INCLUDE' statements + if (index(adjustl(lower(file_lines(i)%s)),'include') == 1) then + + n_include = n_include + 1 + + if (pass == 2) then + call split(file_lines(i)%s,line_parts,delimiters="'") + f_source%include_dependencies(n_include)%s = line_parts(2) + end if + + end if + + ! Extract name of module if is module + if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & + index(adjustl(lower(file_lines(i)%s)),'module') == 1) then + + call split(file_lines(i)%s,line_parts,delimiters=' ') + + f_source%unit_name = adjustl(trim(lower(line_parts(2)))) + f_source%unit_type = FPM_UNIT_MODULE + + end if + + ! Extract name of submodule if is submodule + if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then + + call split(file_lines(i)%s,line_parts,delimiters=' ()') + + f_source%unit_name = adjustl(trim(lower(line_parts(3)))) + f_source%unit_type = FPM_UNIT_SUBMODULE + + n_use = n_use + 1 + + if (pass == 2) then + + f_source%module_dependencies(n_use)%s = adjustl(trim(lower(line_parts(2)))) + + end if + + end if + + ! Extract name of program if is program + if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & + index(adjustl(lower(file_lines(i)%s)),'program') == 1) then + + call split(file_lines(i)%s,line_parts,delimiters=' ') + + f_source%unit_name = adjustl(trim(lower(line_parts(2)))) + f_source%unit_type = FPM_UNIT_PROGRAM + + end if + + end do file_loop + + ! Default to subprogram unit type + if (f_source%unit_type == FPM_UNIT_UNKNOWN) then + f_source%unit_type = FPM_UNIT_SUBPROGRAM + end if + + if (pass == 1) then + allocate(f_source%module_dependencies(n_use)) + allocate(f_source%include_dependencies(n_include)) + end if + + end do + +end function parse_f_source + + +subroutine resolve_f_dependencies(f_sources) + ! After enumerating all source files: resolve file dependencies + ! by searching on module names & include files + ! + type(srcfile_t), intent(inout), target :: f_sources(:) + + integer :: n_use, n_include, n_depend + integer :: i, j, k + + do i=1,size(f_sources) + + n_use = size(f_sources(i)%module_dependencies) + n_include = size(f_sources(i)%include_dependencies) + n_depend = n_use + n_include + + allocate(f_sources(i)%file_dependencies(n_depend)) + + do j=1,n_use + + do k=1,size(f_sources) + + if (f_sources(i)%module_dependencies(j)%s == f_sources(k)%unit_name) then + f_sources(i)%file_dependencies(j)%ptr => f_sources(k) + exit + end if + + end do + + if (.not.associated(f_sources(i)%file_dependencies(j)%ptr)) then + write(*,*) '(!) Unable to find source for module dependency: ',f_sources(i)%module_dependencies(j)%s + stop + end if + + end do + + do j=1,n_include + + do k=1,size(f_sources) + + if (index(f_sources(k)%file_name,f_sources(i)%include_dependencies(j)%s) > 0) then + f_sources(i)%file_dependencies(n_use+j)%ptr => f_sources(k) + exit + end if + + end do + + if (.not.associated(f_sources(i)%file_dependencies(n_use+j)%ptr)) then + write(*,*) '(!) Unable to find source for include dependency: ',f_sources(i)%include_dependencies(j)%s + stop + end if + + end do + + end do + +end subroutine resolve_f_dependencies + + + +end module FPM_Sourcefiles \ No newline at end of file diff --git a/fpm/src/FPM_Strings.f90 b/fpm/src/FPM_Strings.f90 index 9a8869d..7ca88e2 100644 --- a/fpm/src/FPM_Strings.f90 +++ b/fpm/src/FPM_Strings.f90 @@ -37,7 +37,159 @@ function f_string(c_string) f_string(i:i) = c_string(i) end do - end function f_string +end function f_string + + +elemental pure function lower(str,begin,end) result (string) + ! Changes a string to lowercase over specified range + ! Author: John S. Urban + ! License: Public Domain + + character(*), intent(In) :: str + character(len(str)) :: string + integer,intent(in),optional :: begin, end + integer :: i + integer :: ibegin, iend + string = str + + ibegin = 1 + if (present(begin))then + ibegin = max(ibegin,begin) + endif + + iend = len_trim(str) + if (present(end))then + iend= min(iend,end) + endif + + do i = ibegin, iend ! step thru each letter in the string in specified range + select case (str(i:i)) + case ('A':'Z') + string(i:i) = char(iachar(str(i:i))+32) ! change letter to miniscule + case default + end select + end do + +end function lower + + +subroutine split(input_line,array,delimiters,order,nulls) + ! parse string on delimiter characters and store tokens into an allocatable array" + ! 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 + character(len=*),intent(in) :: input_line ! input string to tokenize + character(len=*),optional,intent(in) :: delimiters ! list of delimiter characters + 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 + character(len=:),allocatable :: dlim ! string containing delimiter characters + character(len=:),allocatable :: ordr ! string containing order keyword + character(len=:),allocatable :: nlls ! string containing nulls keyword + integer :: ii,iiii ! loop parameters used to control print order + integer :: icount ! number of tokens found + integer :: ilen ! length of input string with trailing spaces trimmed + integer :: i10,i20,i30 ! loop counters + integer :: icol ! pointer into input string as it is being parsed + integer :: idlim ! number of delimiter characters + integer :: ifound ! where next delimiter character is found in remaining input string data + 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 + dlim=delimiters + else ! DELIMITERS was specified on call as empty string + dlim=' '//char(9)//char(10)//char(11)//char(12)//char(13)//char(0) ! use default delimiter when not specified + endif + else ! no delimiter value was specified + dlim=' '//char(9)//char(10)//char(11)//char(12)//char(13)//char(0) ! use default delimiter when not specified + endif + idlim=len(dlim) ! dlim a lot of blanks on some machines if dlim is a big string + + if(present(order))then; ordr=lower(adjustl(order)); else; ordr='sequential'; endif ! decide on value for optional ORDER parameter + if(present(nulls))then; nlls=lower(adjustl(nulls)); else; nlls='ignore' ; endif ! optional parameter + + n=len(input_line)+1 ! max number of strings INPUT_LINE could split into if all delimiter + allocate(ibegin(n)) ! allocate enough space to hold starting location of tokens if string all tokens + allocate(iterm(n)) ! allocate enough space to hold ending location of tokens if string all tokens + ibegin(:)=1 + iterm(:)=1 + + ilen=len(input_line) ! ILEN is the column position of the last non-blank character + icount=0 ! how many tokens found + inotnull=0 ! how many tokens found not composed of delimiters + imax=0 ! length of longest token found + + select case (ilen) + + case (:0) ! command was totally blank + + case default ! there is at least one non-delimiter in INPUT_LINE if get here + icol=1 ! initialize pointer into input line + INFINITE: do i30=1,ilen,1 ! store into each array element + ibegin(i30)=icol ! assume start new token on the character + if(index(dlim(1:idlim),input_line(icol:icol)).eq.0)then ! if current character is not a delimiter + iterm(i30)=ilen ! initially assume no more tokens + do i10=1,idlim ! search for next delimiter + ifound=index(input_line(ibegin(i30):ilen),dlim(i10:i10)) + IF(ifound.gt.0)then + iterm(i30)=min(iterm(i30),ifound+ibegin(i30)-2) + endif + enddo + icol=iterm(i30)+2 ! next place to look as found end of this token + inotnull=inotnull+1 ! increment count of number of tokens not composed of delimiters + else ! character is a delimiter for a null string + iterm(i30)=icol-1 ! record assumed end of string. Will be less than beginning + icol=icol+1 ! advance pointer into input string + endif + imax=max(imax,iterm(i30)-ibegin(i30)+1) + icount=i30 ! increment count of number of tokens found + if(icol.gt.ilen)then ! no text left + exit INFINITE + endif + enddo INFINITE + + end select + + select case (trim(adjustl(nlls))) + case ('ignore','','ignoreend') + ireturn=inotnull + case default + ireturn=icount + end select + allocate(character(len=imax) :: array(ireturn)) ! allocate the array to return + !allocate(array(ireturn)) ! allocate the array to turn + + select case (trim(adjustl(ordr))) ! decide which order to store tokens + case ('reverse','right') ; ii=ireturn ; iiii=-1 ! last to first + case default ; ii=1 ; iiii=1 ! first to last + end select + + do i20=1,icount ! fill the array with the tokens that were found + if(iterm(i20).lt.ibegin(i20))then + select case (trim(adjustl(nlls))) + case ('ignore','','ignoreend') + case default + array(ii)=' ' + ii=ii+iiii + end select + else + array(ii)=input_line(ibegin(i20):iterm(i20)) + ii=ii+iiii + endif + enddo +end subroutine split end module FPM_Strings \ No newline at end of file -- cgit v1.2.3 From a06b6445de964adeed160b85cf66e5dcf9f7506f Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 26 Aug 2020 14:36:00 +0100 Subject: Minor fix: to count_rows in filesystem mod. --- fpm/src/FPM_Filesystem.f90 | 2 +- fpm/src/FPM_Sourcefiles.f90 | 141 +++++++++++++++++++++++++++----------------- 2 files changed, 87 insertions(+), 56 deletions(-) diff --git a/fpm/src/FPM_Filesystem.f90 b/fpm/src/FPM_Filesystem.f90 index a20c7ab..cc0487d 100644 --- a/fpm/src/FPM_Filesystem.f90 +++ b/fpm/src/FPM_Filesystem.f90 @@ -18,7 +18,7 @@ integer function number_of_rows(s) result(nrows) rewind(s) nrows = 0 do - read(s, *, iostat=ios) r + read(s, '(A)', iostat=ios) r if (ios /= 0) exit nrows = nrows + 1 end do diff --git a/fpm/src/FPM_Sourcefiles.f90 b/fpm/src/FPM_Sourcefiles.f90 index 63067c9..78230d4 100644 --- a/fpm/src/FPM_Sourcefiles.f90 +++ b/fpm/src/FPM_Sourcefiles.f90 @@ -5,7 +5,7 @@ implicit none private public srcfile_ptr, srcfile_t -public scan_f_sources +public scan_sources integer, parameter, public :: FPM_UNIT_UNKNOWN = -1 integer, parameter, public :: FPM_UNIT_PROGRAM = 1 @@ -47,42 +47,44 @@ end type srcfile_t contains -subroutine scan_f_sources(file_names,f_sources) +subroutine scan_sources(file_names,sources) ! Enumerate Fortran sources and resolve file ! dependencies ! type(string_t), intent(in) :: file_names(:) - type(srcfile_t), allocatable, intent(out), target :: f_sources(:) + type(srcfile_t), allocatable, intent(out), target :: sources(:) integer :: i, j - logical :: is_f_source(size(file_names)) - type(string_t), allocatable :: f_file_names(:) + logical :: is_source(size(file_names)) + type(string_t), allocatable :: src_file_names(:) - is_f_source = [(str_ends_with(lower(file_names(i)%s), ".f90"),i=1,size(file_names))] - f_file_names = pack(file_names,is_f_source) + is_source = [(str_ends_with(lower(file_names(i)%s), ".f90"),i=1,size(file_names))] + src_file_names = pack(file_names,is_source) - allocate(f_sources(size(f_file_names))) + allocate(sources(size(src_file_names))) - do i = 1, size(f_file_names) + do i = 1, size(src_file_names) - f_sources(i) = parse_f_source(f_file_names(i)%s) + if (str_ends_with(lower(file_names(i)%s), ".f90")) then + sources(i) = parse_f_source(src_file_names(i)%s) + end if end do - do i=1,size(f_sources) - write(*,*) 'Filename: "',f_sources(i)%file_name,'"' - write(*,*) ' Module name: "',f_sources(i)%unit_name,'"' - do j=1,size(f_sources(i)%module_dependencies) - write(*,*) ' Uses: "',f_sources(i)%module_dependencies(j)%s,'"' + do i=1,size(sources) + write(*,*) 'Filename: "',sources(i)%file_name,'"' + write(*,*) ' Module name: "',sources(i)%unit_name,'"' + do j=1,size(sources(i)%module_dependencies) + write(*,*) ' Uses: "',sources(i)%module_dependencies(j)%s,'"' end do - do j=1,size(f_sources(i)%include_dependencies) - write(*,*) ' Includes: "',f_sources(i)%include_dependencies(j)%s,'"' + do j=1,size(sources(i)%include_dependencies) + write(*,*) ' Includes: "',sources(i)%include_dependencies(j)%s,'"' end do end do - call resolve_f_dependencies(f_sources) + call resolve_dependencies(sources) -end subroutine scan_f_sources +end subroutine scan_sources function parse_f_source(f_filename) result(f_source) @@ -92,7 +94,7 @@ function parse_f_source(f_filename) result(f_source) character(*), intent(in) :: f_filename type(srcfile_t) :: f_source - integer :: fh, n_use, n_include, i, j, pass + integer :: fh, n_use, n_include, i, j, ic, pass type(string_t), allocatable :: file_lines(:) character(:), allocatable :: line_parts(:) character(:), allocatable :: temp_string, use_module_name @@ -108,8 +110,21 @@ function parse_f_source(f_filename) result(f_source) n_include = 0 file_loop: do i=1,size(file_lines) + ! Skip lines that are continued: not statements + if (i > 1) then + ic = index(file_lines(i-1)%s,'!') + if (ic < 1) then + ic = len(file_lines(i-1)%s) + end if + temp_string = trim(file_lines(i-1)%s(1:ic)) + if (len(temp_string) > 0 .and. index(temp_string,'&') == len(temp_string)) then + cycle + end if + end if + ! Process 'USE' statements - if (index(adjustl(lower(file_lines(i)%s)),'use') == 1) then + if (index(adjustl(lower(file_lines(i)%s)),'use ') == 1 .or. & + index(adjustl(lower(file_lines(i)%s)),'use::') == 1) then if (index(file_lines(i)%s,'::') > 0) then @@ -125,6 +140,10 @@ function parse_f_source(f_filename) result(f_source) end if + if (.not.validate_name(use_module_name)) then + cycle + end if + if (any([(index(use_module_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & j=1,size(INTRINSIC_MODULE_NAMES))])) then cycle @@ -206,57 +225,69 @@ function parse_f_source(f_filename) result(f_source) end do -end function parse_f_source + contains + function validate_name(name) result(valid) + character(*), intent(in) :: name + logical :: valid -subroutine resolve_f_dependencies(f_sources) - ! After enumerating all source files: resolve file dependencies - ! by searching on module names & include files - ! - type(srcfile_t), intent(inout), target :: f_sources(:) + integer :: i - integer :: n_use, n_include, n_depend - integer :: i, j, k + if (lower(name(1:1)) < 'a' .or. & + lower(name(1:1)) > 'z') then - do i=1,size(f_sources) - - n_use = size(f_sources(i)%module_dependencies) - n_include = size(f_sources(i)%include_dependencies) - n_depend = n_use + n_include + valid = .false. + return + end if - allocate(f_sources(i)%file_dependencies(n_depend)) + do i=1,len(name) - do j=1,n_use + if (.not.( & + (name(i:i) >= '0' .and. name(i:i) <= '9').or. & + (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & + name(i:i) == '_') ) then + + valid = .false. + return + end if - do k=1,size(f_sources) + end do - if (f_sources(i)%module_dependencies(j)%s == f_sources(k)%unit_name) then - f_sources(i)%file_dependencies(j)%ptr => f_sources(k) - exit - end if - - end do + valid = .true. + return - if (.not.associated(f_sources(i)%file_dependencies(j)%ptr)) then - write(*,*) '(!) Unable to find source for module dependency: ',f_sources(i)%module_dependencies(j)%s - stop - end if + end function validate_name - end do +end function parse_f_source + + +subroutine resolve_dependencies(sources) + ! After enumerating all source files: resolve file dependencies + ! by searching on module names + ! + type(srcfile_t), intent(inout), target :: sources(:) + + integer :: n_depend, i, j, k + + do i=1,size(sources) + + n_depend = size(sources(i)%module_dependencies) + + allocate(sources(i)%file_dependencies(n_depend)) - do j=1,n_include + do j=1,n_depend - do k=1,size(f_sources) + do k=1,size(sources) - if (index(f_sources(k)%file_name,f_sources(i)%include_dependencies(j)%s) > 0) then - f_sources(i)%file_dependencies(n_use+j)%ptr => f_sources(k) + if (sources(i)%module_dependencies(j)%s == sources(k)%unit_name) then + sources(i)%file_dependencies(j)%ptr => sources(k) exit end if end do - if (.not.associated(f_sources(i)%file_dependencies(n_use+j)%ptr)) then - write(*,*) '(!) Unable to find source for include dependency: ',f_sources(i)%include_dependencies(j)%s + if (.not.associated(sources(i)%file_dependencies(j)%ptr)) then + write(*,*) '(!) Unable to find source for module dependency: ',sources(i)%module_dependencies(j)%s stop end if @@ -264,7 +295,7 @@ subroutine resolve_f_dependencies(f_sources) end do -end subroutine resolve_f_dependencies +end subroutine resolve_dependencies -- cgit v1.2.3 From 6d6c3363f2c990930b3aac5c871fe12d0592e124 Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 26 Aug 2020 14:37:30 +0100 Subject: Add: initial fpm build backend. --- fpm/src/FPM_Backend.f90 | 47 +++++++++++++++++++++++++++++++++++ fpm/src/fpm.f90 | 66 +++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 103 insertions(+), 10 deletions(-) create mode 100644 fpm/src/FPM_Backend.f90 diff --git a/fpm/src/FPM_Backend.f90 b/fpm/src/FPM_Backend.f90 new file mode 100644 index 0000000..f52efb3 --- /dev/null +++ b/fpm/src/FPM_Backend.f90 @@ -0,0 +1,47 @@ +module FPM_Backend +use FPM_Strings +use FPM_Model +use environment +implicit none + + +contains + +recursive subroutine build_source(source_file,linking) + ! Compile Fortran source, called recursively on it dependents + ! + type(srcfile_t), intent(inout) :: source_file + character(:), allocatable, intent(inout) :: linking + + integer :: n, i + character(:), allocatable :: file_parts(:) + character(:), allocatable :: basename + + if (source_file%built) then + return + end if + + if (source_file%touched) then + write(*,*) '(!) Circular dependency found with: ',source_file%unit_name + stop + else + source_file%touched = .true. + end if + + do i=1,size(source_file%file_dependencies) + + call build_source(source_file%file_dependencies(i)%ptr,linking) + + end do + + call split(source_file%file_name,file_parts,delimiters='\/.') + basename = file_parts(size(file_parts)-1) + + call run("gfortran -c " // source_file%file_name // " -o " // basename // ".o") + linking = linking // " " // basename // ".o" + + source_file%built = .true. + +end subroutine build_source + +end module FPM_Backend \ No newline at end of file diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 26a4631..e9771a7 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -2,6 +2,8 @@ module fpm use FPM_Strings use environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS use FPM_Filesystem, only: number_of_rows, list_files, exists +use FPM_Sourcefiles +use FPM_Backend implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test @@ -21,23 +23,67 @@ end if end subroutine subroutine cmd_build() +type(string_t), allocatable :: lib_files(:) +type(string_t), allocatable :: app_files(:) type(string_t), allocatable :: files(:) character(:), allocatable :: basename, pkg_name, linking integer :: i, n + +type(srcfile_t), allocatable :: sources(:) +character(:), allocatable :: file_parts(:) + print *, "# Building project" -call list_files("src", files) + + +call list_files("src", lib_files) +lib_files = [(string_t("src/"//lib_files(i)%s),i=1,size(lib_files))] + +call list_files("app", app_files) +app_files = [(string_t("app/"//app_files(i)%s),i=1,size(app_files))] + +files = [lib_files, app_files] + +call scan_sources(files,sources) + linking = "" -do i = 1, size(files) - if (str_ends_with(files(i)%s, ".f90")) then - n = len(files(i)%s) - basename = files(i)%s(1:n-4) - call run("gfortran -c src/" // basename // ".f90 -o " // basename // ".o") - linking = linking // " " // basename // ".o" +do i=1,size(sources) + + if (sources(i)%unit_type == FPM_UNIT_MODULE .or. & + sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. & + sources(i)%unit_type == FPM_UNIT_SUBPROGRAM) then + + call build_source(sources(i),linking) + end if + end do -call run("gfortran -c app/main.f90 -o main.o") -call package_name(pkg_name) -call run("gfortran main.o " // linking // " -o " // pkg_name) + +do i=1,size(sources) + + if (sources(i)%unit_type == FPM_UNIT_PROGRAM) then + + call split(sources(i)%file_name,file_parts,delimiters='\/.') + basename = file_parts(size(file_parts)-1) + + call run("gfortran " // sources(i)%file_name // linking // " -o " // basename) + + end if + +end do + +! linking = "" +! do i = 1, size(files) +! if (str_ends_with(files(i)%s, ".f90")) then +! n = len(files(i)%s) +! basename = files(i)%s(1:n-4) +! call run("gfortran -c src/" // basename // ".f90 -o " // basename // ".o") +! linking = linking // " " // basename // ".o" +! end if +! end do + +! call run("gfortran -c app/main.f90 -o main.o") +! call package_name(pkg_name) +! call run("gfortran main.o " // linking // " -o " // pkg_name) end subroutine subroutine cmd_install() -- cgit v1.2.3 From d44bb2e4e3312f7d533b9f9123893f330cefdc45 Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 26 Aug 2020 15:24:38 +0100 Subject: Add: initial support for c sources. C programs (int main) not yet allowed. --- fpm/src/FPM_Sourcefiles.f90 | 81 ++++++++++++++++++++++++++++++++++++++++++--- fpm/src/fpm.f90 | 17 ++-------- 2 files changed, 78 insertions(+), 20 deletions(-) diff --git a/fpm/src/FPM_Sourcefiles.f90 b/fpm/src/FPM_Sourcefiles.f90 index 78230d4..33c0de2 100644 --- a/fpm/src/FPM_Sourcefiles.f90 +++ b/fpm/src/FPM_Sourcefiles.f90 @@ -58,22 +58,29 @@ subroutine scan_sources(file_names,sources) logical :: is_source(size(file_names)) type(string_t), allocatable :: src_file_names(:) - is_source = [(str_ends_with(lower(file_names(i)%s), ".f90"),i=1,size(file_names))] + is_source = [(str_ends_with(lower(file_names(i)%s), ".f90") .or. & + str_ends_with(lower(file_names(i)%s), ".c") .or. & + str_ends_with(lower(file_names(i)%s), ".h"),i=1,size(file_names))] src_file_names = pack(file_names,is_source) allocate(sources(size(src_file_names))) do i = 1, size(src_file_names) - if (str_ends_with(lower(file_names(i)%s), ".f90")) then + if (str_ends_with(lower(src_file_names(i)%s), ".f90")) then sources(i) = parse_f_source(src_file_names(i)%s) end if + if (str_ends_with(lower(src_file_names(i)%s), ".c") .or. & + str_ends_with(lower(src_file_names(i)%s), ".h")) then + sources(i) = parse_c_source(src_file_names(i)%s) + end if + end do do i=1,size(sources) write(*,*) 'Filename: "',sources(i)%file_name,'"' - write(*,*) ' Module name: "',sources(i)%unit_name,'"' + write(*,*) ' Unit name: "',sources(i)%unit_name,'"' do j=1,size(sources(i)%module_dependencies) write(*,*) ' Uses: "',sources(i)%module_dependencies(j)%s,'"' end do @@ -165,7 +172,7 @@ function parse_f_source(f_filename) result(f_source) n_include = n_include + 1 if (pass == 2) then - call split(file_lines(i)%s,line_parts,delimiters="'") + call split(file_lines(i)%s,line_parts,delimiters="'"//'"') f_source%include_dependencies(n_include)%s = line_parts(2) end if @@ -218,6 +225,10 @@ function parse_f_source(f_filename) result(f_source) f_source%unit_type = FPM_UNIT_SUBPROGRAM end if + if (.not.allocated(f_source%unit_name)) then + f_source%unit_name = f_filename + end if + if (pass == 1) then allocate(f_source%module_dependencies(n_use)) allocate(f_source%include_dependencies(n_include)) @@ -261,6 +272,66 @@ function parse_f_source(f_filename) result(f_source) end function parse_f_source +function parse_c_source(c_filename) result(c_source) + ! Rudimentary scan of c source file and + ! extract include dependencies + ! + character(*), intent(in) :: c_filename + type(srcfile_t) :: c_source + + integer :: fh, n_include, i, pass + type(string_t), allocatable :: file_lines(:) + character(:), allocatable :: line_parts(:) + character(:), allocatable :: temp_string, use_module_name + + c_source%file_name = c_filename + + if (str_ends_with(lower(c_filename), ".c")) then + + c_source%unit_type = FPM_UNIT_CSOURCE + + elseif (str_ends_with(lower(c_filename), ".h")) then + + c_source%unit_type = FPM_UNIT_CHEADER + + end if + + c_source%unit_name = c_filename + + allocate(c_source%module_dependencies(0)) + + open(newunit=fh,file=c_filename,status='old') + file_lines = read_lines(fh) + close(fh) + + do pass = 1,2 + n_include = 0 + file_loop: do i=1,size(file_lines) + + ! Process 'INCLUDE' statements + if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & + index(file_lines(i)%s,'"') > 0) then + + n_include = n_include + 1 + + if (pass == 2) then + call split(file_lines(i)%s,line_parts,delimiters='"') + c_source%include_dependencies(n_include)%s = line_parts(2) + end if + + end if + + end do file_loop + + if (pass == 1) then + allocate(c_source%include_dependencies(n_include)) + end if + + end do + +end function parse_c_source + + subroutine resolve_dependencies(sources) ! After enumerating all source files: resolve file dependencies ! by searching on module names @@ -288,7 +359,7 @@ subroutine resolve_dependencies(sources) if (.not.associated(sources(i)%file_dependencies(j)%ptr)) then write(*,*) '(!) Unable to find source for module dependency: ',sources(i)%module_dependencies(j)%s - stop + ! stop end if end do diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index e9771a7..0d1e851 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -34,7 +34,6 @@ character(:), allocatable :: file_parts(:) print *, "# Building project" - call list_files("src", lib_files) lib_files = [(string_t("src/"//lib_files(i)%s),i=1,size(lib_files))] @@ -50,7 +49,8 @@ do i=1,size(sources) if (sources(i)%unit_type == FPM_UNIT_MODULE .or. & sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. & - sources(i)%unit_type == FPM_UNIT_SUBPROGRAM) then + sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. & + sources(i)%unit_type == FPM_UNIT_CSOURCE) then call build_source(sources(i),linking) @@ -71,19 +71,6 @@ do i=1,size(sources) end do -! linking = "" -! do i = 1, size(files) -! if (str_ends_with(files(i)%s, ".f90")) then -! n = len(files(i)%s) -! basename = files(i)%s(1:n-4) -! call run("gfortran -c src/" // basename // ".f90 -o " // basename // ".o") -! linking = linking // " " // basename // ".o" -! end if -! end do - -! call run("gfortran -c app/main.f90 -o main.o") -! call package_name(pkg_name) -! call run("gfortran main.o " // linking // " -o " // pkg_name) end subroutine subroutine cmd_install() -- cgit v1.2.3 From 434033f6e873912993c2bf6b7bb6878b5e8f4a23 Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 26 Aug 2020 15:50:11 +0100 Subject: Minor fix: add dependency pointer guard. --- fpm/src/FPM_Backend.f90 | 4 +++- fpm/src/FPM_Sourcefiles.f90 | 2 ++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/fpm/src/FPM_Backend.f90 b/fpm/src/FPM_Backend.f90 index f52efb3..d0aaa19 100644 --- a/fpm/src/FPM_Backend.f90 +++ b/fpm/src/FPM_Backend.f90 @@ -30,7 +30,9 @@ recursive subroutine build_source(source_file,linking) do i=1,size(source_file%file_dependencies) - call build_source(source_file%file_dependencies(i)%ptr,linking) + if (associated(source_file%file_dependencies(i)%ptr)) then + call build_source(source_file%file_dependencies(i)%ptr,linking) + end if end do diff --git a/fpm/src/FPM_Sourcefiles.f90 b/fpm/src/FPM_Sourcefiles.f90 index 33c0de2..b613423 100644 --- a/fpm/src/FPM_Sourcefiles.f90 +++ b/fpm/src/FPM_Sourcefiles.f90 @@ -348,6 +348,8 @@ subroutine resolve_dependencies(sources) do j=1,n_depend + sources(i)%file_dependencies(j)%ptr => NULL() + do k=1,size(sources) if (sources(i)%module_dependencies(j)%s == sources(k)%unit_name) then -- cgit v1.2.3 From a6df3bba006fcc34d36b6dd8ed36143efdc5fa38 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Fri, 28 Aug 2020 12:51:13 +0100 Subject: Add: fpm_ prefix to all module names. --- fpm/app/main.f90 | 2 +- fpm/src/FPM_Backend.f90 | 49 ------ fpm/src/FPM_Filesystem.f90 | 125 --------------- fpm/src/FPM_Sourcefiles.f90 | 375 ------------------------------------------- fpm/src/FPM_Strings.f90 | 195 ---------------------- fpm/src/command_line.f90 | 78 --------- fpm/src/environment.f90 | 66 -------- fpm/src/fpm.f90 | 10 +- fpm/src/fpm_backend.f90 | 49 ++++++ fpm/src/fpm_command_line.f90 | 78 +++++++++ fpm/src/fpm_environment.f90 | 66 ++++++++ fpm/src/fpm_filesystem.f90 | 125 +++++++++++++++ fpm/src/fpm_sources.f90 | 375 +++++++++++++++++++++++++++++++++++++++++++ fpm/src/fpm_strings.f90 | 195 ++++++++++++++++++++++ 14 files changed, 894 insertions(+), 894 deletions(-) delete mode 100644 fpm/src/FPM_Backend.f90 delete mode 100644 fpm/src/FPM_Filesystem.f90 delete mode 100644 fpm/src/FPM_Sourcefiles.f90 delete mode 100644 fpm/src/FPM_Strings.f90 delete mode 100644 fpm/src/command_line.f90 delete mode 100644 fpm/src/environment.f90 create mode 100644 fpm/src/fpm_backend.f90 create mode 100644 fpm/src/fpm_command_line.f90 create mode 100644 fpm/src/fpm_environment.f90 create mode 100644 fpm/src/fpm_filesystem.f90 create mode 100644 fpm/src/fpm_sources.f90 create mode 100644 fpm/src/fpm_strings.f90 diff --git a/fpm/app/main.f90 b/fpm/app/main.f90 index 30abf5b..7f0f425 100644 --- a/fpm/app/main.f90 +++ b/fpm/app/main.f90 @@ -1,5 +1,5 @@ program main -use command_line, only: & +use fpm_command_line, only: & fpm_cmd_settings, & fpm_new_settings, & fpm_build_settings, & diff --git a/fpm/src/FPM_Backend.f90 b/fpm/src/FPM_Backend.f90 deleted file mode 100644 index d0aaa19..0000000 --- a/fpm/src/FPM_Backend.f90 +++ /dev/null @@ -1,49 +0,0 @@ -module FPM_Backend -use FPM_Strings -use FPM_Model -use environment -implicit none - - -contains - -recursive subroutine build_source(source_file,linking) - ! Compile Fortran source, called recursively on it dependents - ! - type(srcfile_t), intent(inout) :: source_file - character(:), allocatable, intent(inout) :: linking - - integer :: n, i - character(:), allocatable :: file_parts(:) - character(:), allocatable :: basename - - if (source_file%built) then - return - end if - - if (source_file%touched) then - write(*,*) '(!) Circular dependency found with: ',source_file%unit_name - stop - else - source_file%touched = .true. - end if - - do i=1,size(source_file%file_dependencies) - - if (associated(source_file%file_dependencies(i)%ptr)) then - call build_source(source_file%file_dependencies(i)%ptr,linking) - end if - - end do - - call split(source_file%file_name,file_parts,delimiters='\/.') - basename = file_parts(size(file_parts)-1) - - call run("gfortran -c " // source_file%file_name // " -o " // basename // ".o") - linking = linking // " " // basename // ".o" - - source_file%built = .true. - -end subroutine build_source - -end module FPM_Backend \ No newline at end of file diff --git a/fpm/src/FPM_Filesystem.f90 b/fpm/src/FPM_Filesystem.f90 deleted file mode 100644 index cc0487d..0000000 --- a/fpm/src/FPM_Filesystem.f90 +++ /dev/null @@ -1,125 +0,0 @@ -module FPM_Filesystem -use FPM_Strings -use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -implicit none - -private -public :: number_of_rows, read_lines, list_files, exists, get_temp_filename - -integer, parameter :: LINE_BUFFER_LEN = 1000 - -contains - -integer function number_of_rows(s) result(nrows) - ! determine number or rows - integer,intent(in)::s - integer :: ios - character(len=100) :: r - rewind(s) - nrows = 0 - do - read(s, '(A)', iostat=ios) r - if (ios /= 0) exit - nrows = nrows + 1 - end do - rewind(s) -end function - - -function read_lines(fh) result(lines) - integer, intent(in) :: fh - type(string_t), allocatable :: lines(:) - - integer :: i - character(LINE_BUFFER_LEN) :: line_buffer - - allocate(lines(number_of_rows(fh))) - do i = 1, size(lines) - read(fh, '(A)') line_buffer - lines(i)%s = trim(line_buffer) - end do - -end function read_lines - - -subroutine list_files(dir, files) - character(len=*), intent(in) :: dir - type(string_t), allocatable, intent(out) :: files(:) - - integer :: stat, fh - character(:), allocatable :: temp_file - - ! Using `inquire` / exists on directories works with gfortran, but not ifort - if (.not. exists(dir)) then - allocate(files(0)) - return - end if - - allocate(temp_file, source = get_temp_filename() ) - - select case (get_os_type()) - case (OS_LINUX) - call execute_command_line("ls " // dir // " > "//temp_file, exitstat=stat) - case (OS_MACOS) - call execute_command_line("ls " // dir // " > "//temp_file, exitstat=stat) - case (OS_WINDOWS) - call execute_command_line("dir /b " // dir // " > "//temp_file, exitstat=stat) - end select - if (stat /= 0) then - print *, "execute_command_line() failed" - error stop - end if - - open(newunit=fh, file=temp_file, status="old") - files = read_lines(fh) - close(fh,status="delete") - -end subroutine - - -logical function exists(filename) result(r) - character(len=*), intent(in) :: filename - inquire(file=filename, exist=r) -end function - - -function get_temp_filename() result(tempfile) - ! Get a unused temporary filename - ! Calls posix 'tempnam' - not recommended, but - ! we have no security concerns for this application - ! and use here is temporary. - ! Works with MinGW - ! - use iso_c_binding, only: c_ptr, C_NULL_PTR, c_f_pointer - character(:), allocatable :: 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") - import - type(c_ptr), intent(in), value :: dir - type(c_ptr), intent(in), value :: pfx - type(c_ptr) :: tmp - end function c_tempnam - - subroutine c_free(ptr) BIND(C,name="free") - import - type(c_ptr), value :: ptr - end subroutine c_free - - end interface - - c_tempfile_ptr = c_tempnam(C_NULL_PTR, C_NULL_PTR) - call c_f_pointer(c_tempfile_ptr,c_tempfile,[LINE_BUFFER_LEN]) - - tempfile = f_string(c_tempfile) - - call c_free(c_tempfile_ptr) - -end function get_temp_filename - - -end module FPM_Filesystem \ No newline at end of file diff --git a/fpm/src/FPM_Sourcefiles.f90 b/fpm/src/FPM_Sourcefiles.f90 deleted file mode 100644 index b613423..0000000 --- a/fpm/src/FPM_Sourcefiles.f90 +++ /dev/null @@ -1,375 +0,0 @@ -module FPM_Sourcefiles -use FPM_Strings -use FPM_Filesystem, only: read_lines -implicit none - -private -public srcfile_ptr, srcfile_t -public scan_sources - -integer, parameter, public :: FPM_UNIT_UNKNOWN = -1 -integer, parameter, public :: FPM_UNIT_PROGRAM = 1 -integer, parameter, public :: FPM_UNIT_MODULE = 2 -integer, parameter, public :: FPM_UNIT_SUBMODULE = 3 -integer, parameter, public :: FPM_UNIT_SUBPROGRAM = 4 -integer, parameter, public :: FPM_UNIT_CSOURCE = 5 -integer, parameter, public :: FPM_UNIT_CHEADER = 6 - -character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & - ['iso_c_binding ', & - 'iso_fortran_env'] - -type srcfile_ptr - ! For constructing arrays of src_file pointers - type(srcfile_t), pointer :: ptr => NULL() -end type srcfile_ptr - -type srcfile_t - ! Type for encapsulating a source file - ! and it's metadata - character(:), allocatable :: file_name - ! File path relative to cwd - character(:), allocatable :: unit_name - ! Module/program name - integer :: unit_type = FPM_UNIT_UNKNOWN - ! Type of program unit - type(string_t), allocatable :: module_dependencies(:) - ! Modules USEd by this source file (lowerstring) - type(string_t), allocatable :: include_dependencies(:) - ! Files INCLUDEd by this source file - type(srcfile_ptr), allocatable :: file_dependencies(:) - ! Resolved source file dependencies - - logical :: built = .false. - logical :: touched = .false. -end type srcfile_t - - -contains - -subroutine scan_sources(file_names,sources) - ! Enumerate Fortran sources and resolve file - ! dependencies - ! - type(string_t), intent(in) :: file_names(:) - type(srcfile_t), allocatable, intent(out), target :: sources(:) - - integer :: i, j - logical :: is_source(size(file_names)) - type(string_t), allocatable :: src_file_names(:) - - is_source = [(str_ends_with(lower(file_names(i)%s), ".f90") .or. & - str_ends_with(lower(file_names(i)%s), ".c") .or. & - str_ends_with(lower(file_names(i)%s), ".h"),i=1,size(file_names))] - src_file_names = pack(file_names,is_source) - - allocate(sources(size(src_file_names))) - - do i = 1, size(src_file_names) - - if (str_ends_with(lower(src_file_names(i)%s), ".f90")) then - sources(i) = parse_f_source(src_file_names(i)%s) - end if - - if (str_ends_with(lower(src_file_names(i)%s), ".c") .or. & - str_ends_with(lower(src_file_names(i)%s), ".h")) then - sources(i) = parse_c_source(src_file_names(i)%s) - end if - - end do - - do i=1,size(sources) - write(*,*) 'Filename: "',sources(i)%file_name,'"' - write(*,*) ' Unit name: "',sources(i)%unit_name,'"' - do j=1,size(sources(i)%module_dependencies) - write(*,*) ' Uses: "',sources(i)%module_dependencies(j)%s,'"' - end do - do j=1,size(sources(i)%include_dependencies) - write(*,*) ' Includes: "',sources(i)%include_dependencies(j)%s,'"' - end do - end do - - call resolve_dependencies(sources) - -end subroutine scan_sources - - -function parse_f_source(f_filename) result(f_source) - ! Rudimentary scan of Fortran source file and - ! extract program unit name and use/include dependencies - ! - character(*), intent(in) :: f_filename - type(srcfile_t) :: f_source - - integer :: fh, n_use, n_include, i, j, ic, pass - type(string_t), allocatable :: file_lines(:) - character(:), allocatable :: line_parts(:) - character(:), allocatable :: temp_string, use_module_name - - f_source%file_name = f_filename - - open(newunit=fh,file=f_filename,status='old') - file_lines = read_lines(fh) - close(fh) - - do pass = 1,2 - n_use = 0 - n_include = 0 - file_loop: do i=1,size(file_lines) - - ! Skip lines that are continued: not statements - if (i > 1) then - ic = index(file_lines(i-1)%s,'!') - if (ic < 1) then - ic = len(file_lines(i-1)%s) - end if - temp_string = trim(file_lines(i-1)%s(1:ic)) - if (len(temp_string) > 0 .and. index(temp_string,'&') == len(temp_string)) then - cycle - end if - end if - - ! Process 'USE' statements - if (index(adjustl(lower(file_lines(i)%s)),'use ') == 1 .or. & - index(adjustl(lower(file_lines(i)%s)),'use::') == 1) then - - if (index(file_lines(i)%s,'::') > 0) then - - call split(file_lines(i)%s,line_parts,delimiters=':') - temp_string = line_parts(2) - call split(temp_string,line_parts,delimiters=' ,') - use_module_name = trim(lower(line_parts(1))) - - else - - call split(file_lines(i)%s,line_parts,delimiters=' ,') - use_module_name = trim(lower(line_parts(2))) - - end if - - if (.not.validate_name(use_module_name)) then - cycle - end if - - if (any([(index(use_module_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & - j=1,size(INTRINSIC_MODULE_NAMES))])) then - cycle - end if - - n_use = n_use + 1 - - if (pass == 2) then - - f_source%module_dependencies(n_use)%s = use_module_name - - end if - - end if - - ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'include') == 1) then - - n_include = n_include + 1 - - if (pass == 2) then - call split(file_lines(i)%s,line_parts,delimiters="'"//'"') - f_source%include_dependencies(n_include)%s = line_parts(2) - end if - - end if - - ! Extract name of module if is module - if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & - index(adjustl(lower(file_lines(i)%s)),'module') == 1) then - - call split(file_lines(i)%s,line_parts,delimiters=' ') - - f_source%unit_name = adjustl(trim(lower(line_parts(2)))) - f_source%unit_type = FPM_UNIT_MODULE - - end if - - ! Extract name of submodule if is submodule - if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then - - call split(file_lines(i)%s,line_parts,delimiters=' ()') - - f_source%unit_name = adjustl(trim(lower(line_parts(3)))) - f_source%unit_type = FPM_UNIT_SUBMODULE - - n_use = n_use + 1 - - if (pass == 2) then - - f_source%module_dependencies(n_use)%s = adjustl(trim(lower(line_parts(2)))) - - end if - - end if - - ! Extract name of program if is program - if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & - index(adjustl(lower(file_lines(i)%s)),'program') == 1) then - - call split(file_lines(i)%s,line_parts,delimiters=' ') - - f_source%unit_name = adjustl(trim(lower(line_parts(2)))) - f_source%unit_type = FPM_UNIT_PROGRAM - - end if - - end do file_loop - - ! Default to subprogram unit type - if (f_source%unit_type == FPM_UNIT_UNKNOWN) then - f_source%unit_type = FPM_UNIT_SUBPROGRAM - end if - - if (.not.allocated(f_source%unit_name)) then - f_source%unit_name = f_filename - end if - - if (pass == 1) then - allocate(f_source%module_dependencies(n_use)) - allocate(f_source%include_dependencies(n_include)) - end if - - end do - - contains - - function validate_name(name) result(valid) - character(*), intent(in) :: name - logical :: valid - - integer :: i - - if (lower(name(1:1)) < 'a' .or. & - lower(name(1:1)) > 'z') then - - valid = .false. - return - end if - - do i=1,len(name) - - if (.not.( & - (name(i:i) >= '0' .and. name(i:i) <= '9').or. & - (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & - name(i:i) == '_') ) then - - valid = .false. - return - end if - - end do - - valid = .true. - return - - end function validate_name - -end function parse_f_source - - -function parse_c_source(c_filename) result(c_source) - ! Rudimentary scan of c source file and - ! extract include dependencies - ! - character(*), intent(in) :: c_filename - type(srcfile_t) :: c_source - - integer :: fh, n_include, i, pass - type(string_t), allocatable :: file_lines(:) - character(:), allocatable :: line_parts(:) - character(:), allocatable :: temp_string, use_module_name - - c_source%file_name = c_filename - - if (str_ends_with(lower(c_filename), ".c")) then - - c_source%unit_type = FPM_UNIT_CSOURCE - - elseif (str_ends_with(lower(c_filename), ".h")) then - - c_source%unit_type = FPM_UNIT_CHEADER - - end if - - c_source%unit_name = c_filename - - allocate(c_source%module_dependencies(0)) - - open(newunit=fh,file=c_filename,status='old') - file_lines = read_lines(fh) - close(fh) - - do pass = 1,2 - n_include = 0 - file_loop: do i=1,size(file_lines) - - ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & - index(file_lines(i)%s,'"') > 0) then - - n_include = n_include + 1 - - if (pass == 2) then - call split(file_lines(i)%s,line_parts,delimiters='"') - c_source%include_dependencies(n_include)%s = line_parts(2) - end if - - end if - - end do file_loop - - if (pass == 1) then - allocate(c_source%include_dependencies(n_include)) - end if - - end do - -end function parse_c_source - - -subroutine resolve_dependencies(sources) - ! After enumerating all source files: resolve file dependencies - ! by searching on module names - ! - type(srcfile_t), intent(inout), target :: sources(:) - - integer :: n_depend, i, j, k - - do i=1,size(sources) - - n_depend = size(sources(i)%module_dependencies) - - allocate(sources(i)%file_dependencies(n_depend)) - - do j=1,n_depend - - sources(i)%file_dependencies(j)%ptr => NULL() - - do k=1,size(sources) - - if (sources(i)%module_dependencies(j)%s == sources(k)%unit_name) then - sources(i)%file_dependencies(j)%ptr => sources(k) - exit - end if - - end do - - if (.not.associated(sources(i)%file_dependencies(j)%ptr)) then - write(*,*) '(!) Unable to find source for module dependency: ',sources(i)%module_dependencies(j)%s - ! stop - end if - - end do - - end do - -end subroutine resolve_dependencies - - - -end module FPM_Sourcefiles \ No newline at end of file diff --git a/fpm/src/FPM_Strings.f90 b/fpm/src/FPM_Strings.f90 deleted file mode 100644 index 7ca88e2..0000000 --- a/fpm/src/FPM_Strings.f90 +++ /dev/null @@ -1,195 +0,0 @@ -module FPM_Strings -implicit none - -type string_t - character(len=:), allocatable :: s -end type - -contains - -logical function str_ends_with(s, e) result(r) - character(*), intent(in) :: s, e - integer :: n1, n2 - n1 = len(s)-len(e)+1 - n2 = len(s) - if (n1 < 1) then - r = .false. - else - r = (s(n1:n2) == e) - end if -end function - -function f_string(c_string) - use iso_c_binding - character(len=1), intent(in) :: c_string(:) - character(:), allocatable :: f_string - - integer :: i, n - - i = 0 - do while(c_string(i+1) /= C_NULL_CHAR) - i = i + 1 - end do - n = i - - allocate(character(n) :: f_string) - do i=1,n - f_string(i:i) = c_string(i) - end do - -end function f_string - - -elemental pure function lower(str,begin,end) result (string) - ! Changes a string to lowercase over specified range - ! Author: John S. Urban - ! License: Public Domain - - character(*), intent(In) :: str - character(len(str)) :: string - integer,intent(in),optional :: begin, end - integer :: i - integer :: ibegin, iend - string = str - - ibegin = 1 - if (present(begin))then - ibegin = max(ibegin,begin) - endif - - iend = len_trim(str) - if (present(end))then - iend= min(iend,end) - endif - - do i = ibegin, iend ! step thru each letter in the string in specified range - select case (str(i:i)) - case ('A':'Z') - string(i:i) = char(iachar(str(i:i))+32) ! change letter to miniscule - case default - end select - end do - -end function lower - - -subroutine split(input_line,array,delimiters,order,nulls) - ! parse string on delimiter characters and store tokens into an allocatable array" - ! 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 - character(len=*),intent(in) :: input_line ! input string to tokenize - character(len=*),optional,intent(in) :: delimiters ! list of delimiter characters - 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 - character(len=:),allocatable :: dlim ! string containing delimiter characters - character(len=:),allocatable :: ordr ! string containing order keyword - character(len=:),allocatable :: nlls ! string containing nulls keyword - integer :: ii,iiii ! loop parameters used to control print order - integer :: icount ! number of tokens found - integer :: ilen ! length of input string with trailing spaces trimmed - integer :: i10,i20,i30 ! loop counters - integer :: icol ! pointer into input string as it is being parsed - integer :: idlim ! number of delimiter characters - integer :: ifound ! where next delimiter character is found in remaining input string data - 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 - dlim=delimiters - else ! DELIMITERS was specified on call as empty string - dlim=' '//char(9)//char(10)//char(11)//char(12)//char(13)//char(0) ! use default delimiter when not specified - endif - else ! no delimiter value was specified - dlim=' '//char(9)//char(10)//char(11)//char(12)//char(13)//char(0) ! use default delimiter when not specified - endif - idlim=len(dlim) ! dlim a lot of blanks on some machines if dlim is a big string - - if(present(order))then; ordr=lower(adjustl(order)); else; ordr='sequential'; endif ! decide on value for optional ORDER parameter - if(present(nulls))then; nlls=lower(adjustl(nulls)); else; nlls='ignore' ; endif ! optional parameter - - n=len(input_line)+1 ! max number of strings INPUT_LINE could split into if all delimiter - allocate(ibegin(n)) ! allocate enough space to hold starting location of tokens if string all tokens - allocate(iterm(n)) ! allocate enough space to hold ending location of tokens if string all tokens - ibegin(:)=1 - iterm(:)=1 - - ilen=len(input_line) ! ILEN is the column position of the last non-blank character - icount=0 ! how many tokens found - inotnull=0 ! how many tokens found not composed of delimiters - imax=0 ! length of longest token found - - select case (ilen) - - case (:0) ! command was totally blank - - case default ! there is at least one non-delimiter in INPUT_LINE if get here - icol=1 ! initialize pointer into input line - INFINITE: do i30=1,ilen,1 ! store into each array element - ibegin(i30)=icol ! assume start new token on the character - if(index(dlim(1:idlim),input_line(icol:icol)).eq.0)then ! if current character is not a delimiter - iterm(i30)=ilen ! initially assume no more tokens - do i10=1,idlim ! search for next delimiter - ifound=index(input_line(ibegin(i30):ilen),dlim(i10:i10)) - IF(ifound.gt.0)then - iterm(i30)=min(iterm(i30),ifound+ibegin(i30)-2) - endif - enddo - icol=iterm(i30)+2 ! next place to look as found end of this token - inotnull=inotnull+1 ! increment count of number of tokens not composed of delimiters - else ! character is a delimiter for a null string - iterm(i30)=icol-1 ! record assumed end of string. Will be less than beginning - icol=icol+1 ! advance pointer into input string - endif - imax=max(imax,iterm(i30)-ibegin(i30)+1) - icount=i30 ! increment count of number of tokens found - if(icol.gt.ilen)then ! no text left - exit INFINITE - endif - enddo INFINITE - - end select - - select case (trim(adjustl(nlls))) - case ('ignore','','ignoreend') - ireturn=inotnull - case default - ireturn=icount - end select - allocate(character(len=imax) :: array(ireturn)) ! allocate the array to return - !allocate(array(ireturn)) ! allocate the array to turn - - select case (trim(adjustl(ordr))) ! decide which order to store tokens - case ('reverse','right') ; ii=ireturn ; iiii=-1 ! last to first - case default ; ii=1 ; iiii=1 ! first to last - end select - - do i20=1,icount ! fill the array with the tokens that were found - if(iterm(i20).lt.ibegin(i20))then - select case (trim(adjustl(nlls))) - case ('ignore','','ignoreend') - case default - array(ii)=' ' - ii=ii+iiii - end select - else - array(ii)=input_line(ibegin(i20):iterm(i20)) - ii=ii+iiii - endif - enddo -end subroutine split - - -end module FPM_Strings \ No newline at end of file diff --git a/fpm/src/command_line.f90 b/fpm/src/command_line.f90 deleted file mode 100644 index cd78904..0000000 --- a/fpm/src/command_line.f90 +++ /dev/null @@ -1,78 +0,0 @@ -module command_line - use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS - - implicit none - private - - type, public, abstract :: fpm_cmd_settings - end type - - type, public, extends(fpm_cmd_settings) :: fpm_new_settings - end type - - type, public, extends(fpm_cmd_settings) :: fpm_build_settings - end type - - type, public, extends(fpm_cmd_settings) :: fpm_run_settings - end type - - type, public, extends(fpm_cmd_settings) :: fpm_test_settings - end type - - type, public, extends(fpm_cmd_settings) :: fpm_install_settings - end type - - public :: get_command_line_settings -contains - subroutine get_command_line_settings(cmd_settings) - class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings - - character(len=100) :: cmdarg - - if (command_argument_count() == 0) then - call print_help() - else if (command_argument_count() == 1) then - call get_command_argument(1, cmdarg) - select case(trim(cmdarg)) - case("new") - allocate(fpm_new_settings :: cmd_settings) - case("build") - allocate(fpm_build_settings :: cmd_settings) - case("run") - allocate(fpm_run_settings :: cmd_settings) - case("test") - allocate(fpm_test_settings :: cmd_settings) - case("install") - allocate(fpm_install_settings :: cmd_settings) - case default - print *, "fpm error: No such command " // trim(cmdarg) - error stop 1 - end select - else - print *, "Too many arguments" - error stop 1 - end if - end subroutine - - subroutine print_help() - print *, "fpm - A Fortran package manager and build system" - select case (get_os_type()) - case (OS_LINUX) - print *, "OS Type: Linux" - case (OS_MACOS) - print *, "OS Type: macOS" - case (OS_WINDOWS) - print *, "OS Type: Windows" - end select - print * - print *, "Usage:" - print *, " fpm [COMMAND]" - print * - print *, "Valid fpm commands are:" - print *, " build Compile the current package" - print *, " install Install a Fortran binary or library (not implemented)" - print *, " new Create a new Fortran package (not implemented)" - print *, " run Run a binary of the local package (not implemented)" - print *, " test Run the tests (not implemented)" - end subroutine -end module command_line diff --git a/fpm/src/environment.f90 b/fpm/src/environment.f90 deleted file mode 100644 index 23cd8aa..0000000 --- a/fpm/src/environment.f90 +++ /dev/null @@ -1,66 +0,0 @@ -module environment - implicit none - private - - integer, parameter, public :: OS_LINUX = 1 - integer, parameter, public :: OS_MACOS = 2 - integer, parameter, public :: OS_WINDOWS = 3 - - public :: get_os_type, run -contains - integer function get_os_type() result(r) - ! Determine the OS type - ! - ! Returns one of OS_LINUX, OS_MACOS, OS_WINDOWS. - ! - ! Currently we use the $HOME and $HOMEPATH environment variables to determine - ! the OS type. That is not 100% accurate in all cases, but it seems to be good - ! enough for now. See the following issue for a more robust solution: - ! - ! https://github.com/fortran-lang/fpm/issues/144 - ! - character(len=100) :: val - integer stat - ! Only Windows define $HOMEPATH by default and we test its value to improve the - ! chances of it working even if a user defines $HOMEPATH on Linux or macOS. - call get_environment_variable("HOMEPATH", val, status=stat) - if (stat == 0 .and. val(1:7) == "\Users\") then - r = OS_WINDOWS - return - end if - - ! We assume that $HOME=/home/... is Linux, $HOME=/Users/... is macOS, otherwise - ! we assume Linux. This is only a heuristic and can easily fail. - call get_environment_variable("HOME", val, status=stat) - if (stat == 1) then - print *, "$HOME does not exist" - error stop - end if - if (stat /= 0) then - print *, "get_environment_variable() failed" - error stop - end if - if (val(1:6) == "/home/") then - r = OS_LINUX - else if (val(1:7) == "/Users/") then - r = OS_MACOS - else - ! This will happen on HPC systems that typically do not use either /home nor - ! /Users for $HOME. Those systems are typically Linux, so for now we simply - ! set Linux here. - r = OS_LINUX - end if - end function - - subroutine run(cmd) - character(len=*), intent(in) :: cmd - integer :: stat - print *, "+ ", cmd - call execute_command_line(cmd, exitstat=stat) - if (stat /= 0) then - print *, "Command failed" - error stop - end if - end subroutine - -end module diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 0d1e851..cd30db2 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,9 +1,9 @@ module fpm -use FPM_Strings -use environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use FPM_Filesystem, only: number_of_rows, list_files, exists -use FPM_Sourcefiles -use FPM_Backend +use fpm_strings +use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +use fpm_filesystem, only: number_of_rows, list_files, exists +use fpm_sources +use fpm_backend implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 new file mode 100644 index 0000000..7394be9 --- /dev/null +++ b/fpm/src/fpm_backend.f90 @@ -0,0 +1,49 @@ +module fpm_backend +use fpm_strings +use fpm_environment +use fpm_sources +implicit none + + +contains + +recursive subroutine build_source(source_file,linking) + ! Compile Fortran source, called recursively on it dependents + ! + type(srcfile_t), intent(inout) :: source_file + character(:), allocatable, intent(inout) :: linking + + integer :: n, i + character(:), allocatable :: file_parts(:) + character(:), allocatable :: basename + + if (source_file%built) then + return + end if + + if (source_file%touched) then + write(*,*) '(!) Circular dependency found with: ',source_file%unit_name + stop + else + source_file%touched = .true. + end if + + do i=1,size(source_file%file_dependencies) + + if (associated(source_file%file_dependencies(i)%ptr)) then + call build_source(source_file%file_dependencies(i)%ptr,linking) + end if + + end do + + call split(source_file%file_name,file_parts,delimiters='\/.') + basename = file_parts(size(file_parts)-1) + + call run("gfortran -c " // source_file%file_name // " -o " // basename // ".o") + linking = linking // " " // basename // ".o" + + source_file%built = .true. + +end subroutine build_source + +end module fpm_backend \ No newline at end of file diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 new file mode 100644 index 0000000..9902110 --- /dev/null +++ b/fpm/src/fpm_command_line.f90 @@ -0,0 +1,78 @@ +module fpm_command_line + use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS + + implicit none + private + + type, public, abstract :: fpm_cmd_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_new_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_build_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_run_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_test_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_install_settings + end type + + public :: get_command_line_settings +contains + subroutine get_command_line_settings(cmd_settings) + class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings + + character(len=100) :: cmdarg + + if (command_argument_count() == 0) then + call print_help() + else if (command_argument_count() == 1) then + call get_command_argument(1, cmdarg) + select case(trim(cmdarg)) + case("new") + allocate(fpm_new_settings :: cmd_settings) + case("build") + allocate(fpm_build_settings :: cmd_settings) + case("run") + allocate(fpm_run_settings :: cmd_settings) + case("test") + allocate(fpm_test_settings :: cmd_settings) + case("install") + allocate(fpm_install_settings :: cmd_settings) + case default + print *, "fpm error: No such command " // trim(cmdarg) + error stop 1 + end select + else + print *, "Too many arguments" + error stop 1 + end if + end subroutine + + subroutine print_help() + print *, "fpm - A Fortran package manager and build system" + select case (get_os_type()) + case (OS_LINUX) + print *, "OS Type: Linux" + case (OS_MACOS) + print *, "OS Type: macOS" + case (OS_WINDOWS) + print *, "OS Type: Windows" + end select + print * + print *, "Usage:" + print *, " fpm [COMMAND]" + print * + print *, "Valid fpm commands are:" + print *, " build Compile the current package" + print *, " install Install a Fortran binary or library (not implemented)" + print *, " new Create a new Fortran package (not implemented)" + print *, " run Run a binary of the local package (not implemented)" + print *, " test Run the tests (not implemented)" + end subroutine +end module fpm_command_line diff --git a/fpm/src/fpm_environment.f90 b/fpm/src/fpm_environment.f90 new file mode 100644 index 0000000..5ef7e18 --- /dev/null +++ b/fpm/src/fpm_environment.f90 @@ -0,0 +1,66 @@ +module fpm_environment + implicit none + private + + integer, parameter, public :: OS_LINUX = 1 + integer, parameter, public :: OS_MACOS = 2 + integer, parameter, public :: OS_WINDOWS = 3 + + public :: get_os_type, run +contains + integer function get_os_type() result(r) + ! Determine the OS type + ! + ! Returns one of OS_LINUX, OS_MACOS, OS_WINDOWS. + ! + ! Currently we use the $HOME and $HOMEPATH environment variables to determine + ! the OS type. That is not 100% accurate in all cases, but it seems to be good + ! enough for now. See the following issue for a more robust solution: + ! + ! https://github.com/fortran-lang/fpm/issues/144 + ! + character(len=100) :: val + integer stat + ! Only Windows define $HOMEPATH by default and we test its value to improve the + ! chances of it working even if a user defines $HOMEPATH on Linux or macOS. + call get_environment_variable("HOMEPATH", val, status=stat) + if (stat == 0 .and. val(1:7) == "\Users\") then + r = OS_WINDOWS + return + end if + + ! We assume that $HOME=/home/... is Linux, $HOME=/Users/... is macOS, otherwise + ! we assume Linux. This is only a heuristic and can easily fail. + call get_environment_variable("HOME", val, status=stat) + if (stat == 1) then + print *, "$HOME does not exist" + error stop + end if + if (stat /= 0) then + print *, "get_environment_variable() failed" + error stop + end if + if (val(1:6) == "/home/") then + r = OS_LINUX + else if (val(1:7) == "/Users/") then + r = OS_MACOS + else + ! This will happen on HPC systems that typically do not use either /home nor + ! /Users for $HOME. Those systems are typically Linux, so for now we simply + ! set Linux here. + r = OS_LINUX + end if + end function + + subroutine run(cmd) + character(len=*), intent(in) :: cmd + integer :: stat + print *, "+ ", cmd + call execute_command_line(cmd, exitstat=stat) + if (stat /= 0) then + print *, "Command failed" + error stop + end if + end subroutine run + +end module fpm_environment diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 new file mode 100644 index 0000000..2b2793a --- /dev/null +++ b/fpm/src/fpm_filesystem.f90 @@ -0,0 +1,125 @@ +module fpm_filesystem +use fpm_strings +use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +implicit none + +private +public :: number_of_rows, read_lines, list_files, exists, get_temp_filename + +integer, parameter :: LINE_BUFFER_LEN = 1000 + +contains + +integer function number_of_rows(s) result(nrows) + ! determine number or rows + integer,intent(in)::s + integer :: ios + character(len=100) :: r + rewind(s) + nrows = 0 + do + read(s, '(A)', iostat=ios) r + if (ios /= 0) exit + nrows = nrows + 1 + end do + rewind(s) +end function number_of_rows + + +function read_lines(fh) result(lines) + integer, intent(in) :: fh + type(string_t), allocatable :: lines(:) + + integer :: i + character(LINE_BUFFER_LEN) :: line_buffer + + allocate(lines(number_of_rows(fh))) + do i = 1, size(lines) + read(fh, '(A)') line_buffer + lines(i)%s = trim(line_buffer) + end do + +end function read_lines + + +subroutine list_files(dir, files) + character(len=*), intent(in) :: dir + type(string_t), allocatable, intent(out) :: files(:) + + integer :: stat, fh + character(:), allocatable :: temp_file + + ! Using `inquire` / exists on directories works with gfortran, but not ifort + if (.not. exists(dir)) then + allocate(files(0)) + return + end if + + allocate(temp_file, source = get_temp_filename() ) + + select case (get_os_type()) + case (OS_LINUX) + call execute_command_line("ls " // dir // " > "//temp_file, exitstat=stat) + case (OS_MACOS) + call execute_command_line("ls " // dir // " > "//temp_file, exitstat=stat) + case (OS_WINDOWS) + call execute_command_line("dir /b " // dir // " > "//temp_file, exitstat=stat) + end select + if (stat /= 0) then + print *, "execute_command_line() failed" + error stop + end if + + open(newunit=fh, file=temp_file, status="old") + files = read_lines(fh) + close(fh,status="delete") + +end subroutine list_files + + +logical function exists(filename) result(r) + character(len=*), intent(in) :: filename + inquire(file=filename, exist=r) +end function + + +function get_temp_filename() result(tempfile) + ! Get a unused temporary filename + ! Calls posix 'tempnam' - not recommended, but + ! we have no security concerns for this application + ! and use here is temporary. + ! Works with MinGW + ! + use iso_c_binding, only: c_ptr, C_NULL_PTR, c_f_pointer + character(:), allocatable :: 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") + import + type(c_ptr), intent(in), value :: dir + type(c_ptr), intent(in), value :: pfx + type(c_ptr) :: tmp + end function c_tempnam + + subroutine c_free(ptr) BIND(C,name="free") + import + type(c_ptr), value :: ptr + end subroutine c_free + + end interface + + c_tempfile_ptr = c_tempnam(C_NULL_PTR, C_NULL_PTR) + call c_f_pointer(c_tempfile_ptr,c_tempfile,[LINE_BUFFER_LEN]) + + tempfile = f_string(c_tempfile) + + call c_free(c_tempfile_ptr) + +end function get_temp_filename + + +end module fpm_filesystem \ No newline at end of file diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 new file mode 100644 index 0000000..64dfcdc --- /dev/null +++ b/fpm/src/fpm_sources.f90 @@ -0,0 +1,375 @@ +module fpm_sources +use fpm_strings +use fpm_filesystem, only: read_lines +implicit none + +private +public srcfile_ptr, srcfile_t +public scan_sources + +integer, parameter, public :: FPM_UNIT_UNKNOWN = -1 +integer, parameter, public :: FPM_UNIT_PROGRAM = 1 +integer, parameter, public :: FPM_UNIT_MODULE = 2 +integer, parameter, public :: FPM_UNIT_SUBMODULE = 3 +integer, parameter, public :: FPM_UNIT_SUBPROGRAM = 4 +integer, parameter, public :: FPM_UNIT_CSOURCE = 5 +integer, parameter, public :: FPM_UNIT_CHEADER = 6 + +character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & + ['iso_c_binding ', & + 'iso_fortran_env'] + +type srcfile_ptr + ! For constructing arrays of src_file pointers + type(srcfile_t), pointer :: ptr => NULL() +end type srcfile_ptr + +type srcfile_t + ! Type for encapsulating a source file + ! and it's metadata + character(:), allocatable :: file_name + ! File path relative to cwd + character(:), allocatable :: unit_name + ! Module/program name + integer :: unit_type = FPM_UNIT_UNKNOWN + ! Type of program unit + type(string_t), allocatable :: module_dependencies(:) + ! Modules USEd by this source file (lowerstring) + type(string_t), allocatable :: include_dependencies(:) + ! Files INCLUDEd by this source file + type(srcfile_ptr), allocatable :: file_dependencies(:) + ! Resolved source file dependencies + + logical :: built = .false. + logical :: touched = .false. +end type srcfile_t + + +contains + +subroutine scan_sources(file_names,sources) + ! Enumerate Fortran sources and resolve file + ! dependencies + ! + type(string_t), intent(in) :: file_names(:) + type(srcfile_t), allocatable, intent(out), target :: sources(:) + + integer :: i, j + logical :: is_source(size(file_names)) + type(string_t), allocatable :: src_file_names(:) + + is_source = [(str_ends_with(lower(file_names(i)%s), ".f90") .or. & + str_ends_with(lower(file_names(i)%s), ".c") .or. & + str_ends_with(lower(file_names(i)%s), ".h"),i=1,size(file_names))] + src_file_names = pack(file_names,is_source) + + allocate(sources(size(src_file_names))) + + do i = 1, size(src_file_names) + + if (str_ends_with(lower(src_file_names(i)%s), ".f90")) then + sources(i) = parse_f_source(src_file_names(i)%s) + end if + + if (str_ends_with(lower(src_file_names(i)%s), ".c") .or. & + str_ends_with(lower(src_file_names(i)%s), ".h")) then + sources(i) = parse_c_source(src_file_names(i)%s) + end if + + end do + + do i=1,size(sources) + write(*,*) 'Filename: "',sources(i)%file_name,'"' + write(*,*) ' Unit name: "',sources(i)%unit_name,'"' + do j=1,size(sources(i)%module_dependencies) + write(*,*) ' Uses: "',sources(i)%module_dependencies(j)%s,'"' + end do + do j=1,size(sources(i)%include_dependencies) + write(*,*) ' Includes: "',sources(i)%include_dependencies(j)%s,'"' + end do + end do + + call resolve_dependencies(sources) + +end subroutine scan_sources + + +function parse_f_source(f_filename) result(f_source) + ! Rudimentary scan of Fortran source file and + ! extract program unit name and use/include dependencies + ! + character(*), intent(in) :: f_filename + type(srcfile_t) :: f_source + + integer :: fh, n_use, n_include, i, j, ic, pass + type(string_t), allocatable :: file_lines(:) + character(:), allocatable :: line_parts(:) + character(:), allocatable :: temp_string, use_module_name + + f_source%file_name = f_filename + + open(newunit=fh,file=f_filename,status='old') + file_lines = read_lines(fh) + close(fh) + + do pass = 1,2 + n_use = 0 + n_include = 0 + file_loop: do i=1,size(file_lines) + + ! Skip lines that are continued: not statements + if (i > 1) then + ic = index(file_lines(i-1)%s,'!') + if (ic < 1) then + ic = len(file_lines(i-1)%s) + end if + temp_string = trim(file_lines(i-1)%s(1:ic)) + if (len(temp_string) > 0 .and. index(temp_string,'&') == len(temp_string)) then + cycle + end if + end if + + ! Process 'USE' statements + if (index(adjustl(lower(file_lines(i)%s)),'use ') == 1 .or. & + index(adjustl(lower(file_lines(i)%s)),'use::') == 1) then + + if (index(file_lines(i)%s,'::') > 0) then + + call split(file_lines(i)%s,line_parts,delimiters=':') + temp_string = line_parts(2) + call split(temp_string,line_parts,delimiters=' ,') + use_module_name = trim(lower(line_parts(1))) + + else + + call split(file_lines(i)%s,line_parts,delimiters=' ,') + use_module_name = trim(lower(line_parts(2))) + + end if + + if (.not.validate_name(use_module_name)) then + cycle + end if + + if (any([(index(use_module_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & + j=1,size(INTRINSIC_MODULE_NAMES))])) then + cycle + end if + + n_use = n_use + 1 + + if (pass == 2) then + + f_source%module_dependencies(n_use)%s = use_module_name + + end if + + end if + + ! Process 'INCLUDE' statements + if (index(adjustl(lower(file_lines(i)%s)),'include') == 1) then + + n_include = n_include + 1 + + if (pass == 2) then + call split(file_lines(i)%s,line_parts,delimiters="'"//'"') + f_source%include_dependencies(n_include)%s = line_parts(2) + end if + + end if + + ! Extract name of module if is module + if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & + index(adjustl(lower(file_lines(i)%s)),'module') == 1) then + + call split(file_lines(i)%s,line_parts,delimiters=' ') + + f_source%unit_name = adjustl(trim(lower(line_parts(2)))) + f_source%unit_type = FPM_UNIT_MODULE + + end if + + ! Extract name of submodule if is submodule + if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then + + call split(file_lines(i)%s,line_parts,delimiters=' ()') + + f_source%unit_name = adjustl(trim(lower(line_parts(3)))) + f_source%unit_type = FPM_UNIT_SUBMODULE + + n_use = n_use + 1 + + if (pass == 2) then + + f_source%module_dependencies(n_use)%s = adjustl(trim(lower(line_parts(2)))) + + end if + + end if + + ! Extract name of program if is program + if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & + index(adjustl(lower(file_lines(i)%s)),'program') == 1) then + + call split(file_lines(i)%s,line_parts,delimiters=' ') + + f_source%unit_name = adjustl(trim(lower(line_parts(2)))) + f_source%unit_type = FPM_UNIT_PROGRAM + + end if + + end do file_loop + + ! Default to subprogram unit type + if (f_source%unit_type == FPM_UNIT_UNKNOWN) then + f_source%unit_type = FPM_UNIT_SUBPROGRAM + end if + + if (.not.allocated(f_source%unit_name)) then + f_source%unit_name = f_filename + end if + + if (pass == 1) then + allocate(f_source%module_dependencies(n_use)) + allocate(f_source%include_dependencies(n_include)) + end if + + end do + + contains + + function validate_name(name) result(valid) + character(*), intent(in) :: name + logical :: valid + + integer :: i + + if (lower(name(1:1)) < 'a' .or. & + lower(name(1:1)) > 'z') then + + valid = .false. + return + end if + + do i=1,len(name) + + if (.not.( & + (name(i:i) >= '0' .and. name(i:i) <= '9').or. & + (lower(name(i:i)) >= 'a' .and. lower(name(i:i)) <= 'z').or. & + name(i:i) == '_') ) then + + valid = .false. + return + end if + + end do + + valid = .true. + return + + end function validate_name + +end function parse_f_source + + +function parse_c_source(c_filename) result(c_source) + ! Rudimentary scan of c source file and + ! extract include dependencies + ! + character(*), intent(in) :: c_filename + type(srcfile_t) :: c_source + + integer :: fh, n_include, i, pass + type(string_t), allocatable :: file_lines(:) + character(:), allocatable :: line_parts(:) + character(:), allocatable :: temp_string, use_module_name + + c_source%file_name = c_filename + + if (str_ends_with(lower(c_filename), ".c")) then + + c_source%unit_type = FPM_UNIT_CSOURCE + + elseif (str_ends_with(lower(c_filename), ".h")) then + + c_source%unit_type = FPM_UNIT_CHEADER + + end if + + c_source%unit_name = c_filename + + allocate(c_source%module_dependencies(0)) + + open(newunit=fh,file=c_filename,status='old') + file_lines = read_lines(fh) + close(fh) + + do pass = 1,2 + n_include = 0 + file_loop: do i=1,size(file_lines) + + ! Process 'INCLUDE' statements + if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & + index(file_lines(i)%s,'"') > 0) then + + n_include = n_include + 1 + + if (pass == 2) then + call split(file_lines(i)%s,line_parts,delimiters='"') + c_source%include_dependencies(n_include)%s = line_parts(2) + end if + + end if + + end do file_loop + + if (pass == 1) then + allocate(c_source%include_dependencies(n_include)) + end if + + end do + +end function parse_c_source + + +subroutine resolve_dependencies(sources) + ! After enumerating all source files: resolve file dependencies + ! by searching on module names + ! + type(srcfile_t), intent(inout), target :: sources(:) + + integer :: n_depend, i, j, k + + do i=1,size(sources) + + n_depend = size(sources(i)%module_dependencies) + + allocate(sources(i)%file_dependencies(n_depend)) + + do j=1,n_depend + + sources(i)%file_dependencies(j)%ptr => NULL() + + do k=1,size(sources) + + if (sources(i)%module_dependencies(j)%s == sources(k)%unit_name) then + sources(i)%file_dependencies(j)%ptr => sources(k) + exit + end if + + end do + + if (.not.associated(sources(i)%file_dependencies(j)%ptr)) then + write(*,*) '(!) Unable to find source for module dependency: ',sources(i)%module_dependencies(j)%s + ! stop + end if + + end do + + end do + +end subroutine resolve_dependencies + + + +end module fpm_sources \ No newline at end of file diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 new file mode 100644 index 0000000..09fa3c0 --- /dev/null +++ b/fpm/src/fpm_strings.f90 @@ -0,0 +1,195 @@ +module fpm_strings +implicit none + +type string_t + character(len=:), allocatable :: s +end type + +contains + +logical function str_ends_with(s, e) result(r) + character(*), intent(in) :: s, e + integer :: n1, n2 + n1 = len(s)-len(e)+1 + n2 = len(s) + if (n1 < 1) then + r = .false. + else + r = (s(n1:n2) == e) + end if +end function str_ends_with + +function f_string(c_string) + use iso_c_binding + character(len=1), intent(in) :: c_string(:) + character(:), allocatable :: f_string + + integer :: i, n + + i = 0 + do while(c_string(i+1) /= C_NULL_CHAR) + i = i + 1 + end do + n = i + + allocate(character(n) :: f_string) + do i=1,n + f_string(i:i) = c_string(i) + end do + +end function f_string + + +elemental pure function lower(str,begin,end) result (string) + ! Changes a string to lowercase over specified range + ! Author: John S. Urban + ! License: Public Domain + + character(*), intent(In) :: str + character(len(str)) :: string + integer,intent(in),optional :: begin, end + integer :: i + integer :: ibegin, iend + string = str + + ibegin = 1 + if (present(begin))then + ibegin = max(ibegin,begin) + endif + + iend = len_trim(str) + if (present(end))then + iend= min(iend,end) + endif + + do i = ibegin, iend ! step thru each letter in the string in specified range + select case (str(i:i)) + case ('A':'Z') + string(i:i) = char(iachar(str(i:i))+32) ! change letter to miniscule + case default + end select + end do + +end function lower + + +subroutine split(input_line,array,delimiters,order,nulls) + ! parse string on delimiter characters and store tokens into an allocatable array" + ! 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 + character(len=*),intent(in) :: input_line ! input string to tokenize + character(len=*),optional,intent(in) :: delimiters ! list of delimiter characters + 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 + character(len=:),allocatable :: dlim ! string containing delimiter characters + character(len=:),allocatable :: ordr ! string containing order keyword + character(len=:),allocatable :: nlls ! string containing nulls keyword + integer :: ii,iiii ! loop parameters used to control print order + integer :: icount ! number of tokens found + integer :: ilen ! length of input string with trailing spaces trimmed + integer :: i10,i20,i30 ! loop counters + integer :: icol ! pointer into input string as it is being parsed + integer :: idlim ! number of delimiter characters + integer :: ifound ! where next delimiter character is found in remaining input string data + 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 + dlim=delimiters + else ! DELIMITERS was specified on call as empty string + dlim=' '//char(9)//char(10)//char(11)//char(12)//char(13)//char(0) ! use default delimiter when not specified + endif + else ! no delimiter value was specified + dlim=' '//char(9)//char(10)//char(11)//char(12)//char(13)//char(0) ! use default delimiter when not specified + endif + idlim=len(dlim) ! dlim a lot of blanks on some machines if dlim is a big string + + if(present(order))then; ordr=lower(adjustl(order)); else; ordr='sequential'; endif ! decide on value for optional ORDER parameter + if(present(nulls))then; nlls=lower(adjustl(nulls)); else; nlls='ignore' ; endif ! optional parameter + + n=len(input_line)+1 ! max number of strings INPUT_LINE could split into if all delimiter + allocate(ibegin(n)) ! allocate enough space to hold starting location of tokens if string all tokens + allocate(iterm(n)) ! allocate enough space to hold ending location of tokens if string all tokens + ibegin(:)=1 + iterm(:)=1 + + ilen=len(input_line) ! ILEN is the column position of the last non-blank character + icount=0 ! how many tokens found + inotnull=0 ! how many tokens found not composed of delimiters + imax=0 ! length of longest token found + + select case (ilen) + + case (:0) ! command was totally blank + + case default ! there is at least one non-delimiter in INPUT_LINE if get here + icol=1 ! initialize pointer into input line + INFINITE: do i30=1,ilen,1 ! store into each array element + ibegin(i30)=icol ! assume start new token on the character + if(index(dlim(1:idlim),input_line(icol:icol)).eq.0)then ! if current character is not a delimiter + iterm(i30)=ilen ! initially assume no more tokens + do i10=1,idlim ! search for next delimiter + ifound=index(input_line(ibegin(i30):ilen),dlim(i10:i10)) + IF(ifound.gt.0)then + iterm(i30)=min(iterm(i30),ifound+ibegin(i30)-2) + endif + enddo + icol=iterm(i30)+2 ! next place to look as found end of this token + inotnull=inotnull+1 ! increment count of number of tokens not composed of delimiters + else ! character is a delimiter for a null string + iterm(i30)=icol-1 ! record assumed end of string. Will be less than beginning + icol=icol+1 ! advance pointer into input string + endif + imax=max(imax,iterm(i30)-ibegin(i30)+1) + icount=i30 ! increment count of number of tokens found + if(icol.gt.ilen)then ! no text left + exit INFINITE + endif + enddo INFINITE + + end select + + select case (trim(adjustl(nlls))) + case ('ignore','','ignoreend') + ireturn=inotnull + case default + ireturn=icount + end select + allocate(character(len=imax) :: array(ireturn)) ! allocate the array to return + !allocate(array(ireturn)) ! allocate the array to turn + + select case (trim(adjustl(ordr))) ! decide which order to store tokens + case ('reverse','right') ; ii=ireturn ; iiii=-1 ! last to first + case default ; ii=1 ; iiii=1 ! first to last + end select + + do i20=1,icount ! fill the array with the tokens that were found + if(iterm(i20).lt.ibegin(i20))then + select case (trim(adjustl(nlls))) + case ('ignore','','ignoreend') + case default + array(ii)=' ' + ii=ii+iiii + end select + else + array(ii)=input_line(ibegin(i20):iterm(i20)) + ii=ii+iiii + endif + enddo +end subroutine split + + +end module fpm_strings \ No newline at end of file -- cgit v1.2.3 From 43dd6e1e8dadfec74a61e50e22dc1ceb97b9fe34 Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 1 Sep 2020 09:36:05 +0100 Subject: Update: for extracting modules --- fpm/src/fpm.f90 | 2 + fpm/src/fpm_backend.f90 | 2 +- fpm/src/fpm_sources.f90 | 128 +++++++++++++++++++++++++++++------------------- 3 files changed, 80 insertions(+), 52 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index cd30db2..ac412c6 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -44,6 +44,8 @@ files = [lib_files, app_files] call scan_sources(files,sources) +call resolve_dependencies(sources) + linking = "" do i=1,size(sources) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 7394be9..da2cc85 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -22,7 +22,7 @@ recursive subroutine build_source(source_file,linking) end if if (source_file%touched) then - write(*,*) '(!) Circular dependency found with: ',source_file%unit_name + write(*,*) '(!) Circular dependency found with: ',source_file%file_name stop else source_file%touched = .true. diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 64dfcdc..b07366d 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -5,7 +5,7 @@ implicit none private public srcfile_ptr, srcfile_t -public scan_sources +public scan_sources, resolve_dependencies integer, parameter, public :: FPM_UNIT_UNKNOWN = -1 integer, parameter, public :: FPM_UNIT_PROGRAM = 1 @@ -29,11 +29,11 @@ type srcfile_t ! and it's metadata character(:), allocatable :: file_name ! File path relative to cwd - character(:), allocatable :: unit_name - ! Module/program name + type(string_t), allocatable :: modules_provided(:) + ! Modules provided by this source file (lowerstring) integer :: unit_type = FPM_UNIT_UNKNOWN ! Type of program unit - type(string_t), allocatable :: module_dependencies(:) + type(string_t), allocatable :: modules_used(:) ! Modules USEd by this source file (lowerstring) type(string_t), allocatable :: include_dependencies(:) ! Files INCLUDEd by this source file @@ -80,17 +80,17 @@ subroutine scan_sources(file_names,sources) do i=1,size(sources) write(*,*) 'Filename: "',sources(i)%file_name,'"' - write(*,*) ' Unit name: "',sources(i)%unit_name,'"' - do j=1,size(sources(i)%module_dependencies) - write(*,*) ' Uses: "',sources(i)%module_dependencies(j)%s,'"' + do j=1,size(sources(i)%modules_provided) + write(*,*) ' Provides: "',sources(i)%modules_provided(j)%s,'"' + end do + do j=1,size(sources(i)%modules_used) + write(*,*) ' Uses: "',sources(i)%modules_used(j)%s,'"' end do do j=1,size(sources(i)%include_dependencies) write(*,*) ' Includes: "',sources(i)%include_dependencies(j)%s,'"' end do end do - call resolve_dependencies(sources) - end subroutine scan_sources @@ -101,10 +101,10 @@ function parse_f_source(f_filename) result(f_source) character(*), intent(in) :: f_filename type(srcfile_t) :: f_source - integer :: fh, n_use, n_include, i, j, ic, pass + integer :: fh, n_use, n_include, n_mod, i, j, ic, pass type(string_t), allocatable :: file_lines(:) character(:), allocatable :: line_parts(:) - character(:), allocatable :: temp_string, use_module_name + character(:), allocatable :: temp_string, mod_name f_source%file_name = f_filename @@ -115,6 +115,7 @@ function parse_f_source(f_filename) result(f_source) do pass = 1,2 n_use = 0 n_include = 0 + n_mod = 0 file_loop: do i=1,size(file_lines) ! Skip lines that are continued: not statements @@ -138,21 +139,21 @@ function parse_f_source(f_filename) result(f_source) call split(file_lines(i)%s,line_parts,delimiters=':') temp_string = line_parts(2) call split(temp_string,line_parts,delimiters=' ,') - use_module_name = trim(lower(line_parts(1))) + mod_name = trim(lower(line_parts(1))) else call split(file_lines(i)%s,line_parts,delimiters=' ,') - use_module_name = trim(lower(line_parts(2))) - + mod_name = trim(lower(line_parts(2))) + end if - if (.not.validate_name(use_module_name)) then + if (.not.validate_name(mod_name)) then cycle end if - if (any([(index(use_module_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & - j=1,size(INTRINSIC_MODULE_NAMES))])) then + if (any([(index(mod_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & + j=1,size(INTRINSIC_MODULE_NAMES))])) then cycle end if @@ -160,7 +161,7 @@ function parse_f_source(f_filename) result(f_source) if (pass == 2) then - f_source%module_dependencies(n_use)%s = use_module_name + f_source%modules_used(n_use)%s = mod_name end if @@ -168,7 +169,7 @@ function parse_f_source(f_filename) result(f_source) ! Process 'INCLUDE' statements if (index(adjustl(lower(file_lines(i)%s)),'include') == 1) then - + n_include = n_include + 1 if (pass == 2) then @@ -179,29 +180,38 @@ function parse_f_source(f_filename) result(f_source) end if ! Extract name of module if is module - if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & - index(adjustl(lower(file_lines(i)%s)),'module') == 1) then - + if (index(adjustl(lower(file_lines(i)%s)),'module ') == 1) then + call split(file_lines(i)%s,line_parts,delimiters=' ') - f_source%unit_name = adjustl(trim(lower(line_parts(2)))) + mod_name = adjustl(trim(lower(line_parts(2)))) + + if (.not.validate_name(mod_name)) then + cycle + end if + + n_mod = n_mod + 1 + + if (pass == 2) then + f_source%modules_provided(n_mod) = string_t(mod_name) + end if + f_source%unit_type = FPM_UNIT_MODULE end if ! Extract name of submodule if is submodule if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then - + call split(file_lines(i)%s,line_parts,delimiters=' ()') - f_source%unit_name = adjustl(trim(lower(line_parts(3)))) f_source%unit_type = FPM_UNIT_SUBMODULE n_use = n_use + 1 if (pass == 2) then - f_source%module_dependencies(n_use)%s = adjustl(trim(lower(line_parts(2)))) + f_source%modules_used(n_use)%s = adjustl(trim(lower(line_parts(2)))) end if @@ -210,10 +220,9 @@ function parse_f_source(f_filename) result(f_source) ! Extract name of program if is program if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & index(adjustl(lower(file_lines(i)%s)),'program') == 1) then - + call split(file_lines(i)%s,line_parts,delimiters=' ') - f_source%unit_name = adjustl(trim(lower(line_parts(2)))) f_source%unit_type = FPM_UNIT_PROGRAM end if @@ -225,13 +234,10 @@ function parse_f_source(f_filename) result(f_source) f_source%unit_type = FPM_UNIT_SUBPROGRAM end if - if (.not.allocated(f_source%unit_name)) then - f_source%unit_name = f_filename - end if - if (pass == 1) then - allocate(f_source%module_dependencies(n_use)) + allocate(f_source%modules_used(n_use)) allocate(f_source%include_dependencies(n_include)) + allocate(f_source%modules_provided(n_mod)) end if end do @@ -244,6 +250,14 @@ function parse_f_source(f_filename) result(f_source) integer :: i + if (trim(lower(name)) == 'procedure' .or. & + trim(lower(name)) == 'subroutine' .or. & + trim(lower(name)) == 'function') then + + valid = .false. + return + end if + if (lower(name(1:1)) < 'a' .or. & lower(name(1:1)) > 'z') then @@ -282,7 +296,6 @@ function parse_c_source(c_filename) result(c_source) integer :: fh, n_include, i, pass type(string_t), allocatable :: file_lines(:) character(:), allocatable :: line_parts(:) - character(:), allocatable :: temp_string, use_module_name c_source%file_name = c_filename @@ -296,9 +309,8 @@ function parse_c_source(c_filename) result(c_source) end if - c_source%unit_name = c_filename - - allocate(c_source%module_dependencies(0)) + allocate(c_source%modules_used(0)) + allocate(c_source%modules_provided(0)) open(newunit=fh,file=c_filename,status='old') file_lines = read_lines(fh) @@ -338,38 +350,52 @@ subroutine resolve_dependencies(sources) ! type(srcfile_t), intent(inout), target :: sources(:) - integer :: n_depend, i, j, k + integer :: n_depend, i, j do i=1,size(sources) - n_depend = size(sources(i)%module_dependencies) + n_depend = size(sources(i)%modules_used) allocate(sources(i)%file_dependencies(n_depend)) do j=1,n_depend - sources(i)%file_dependencies(j)%ptr => NULL() - - do k=1,size(sources) - - if (sources(i)%module_dependencies(j)%s == sources(k)%unit_name) then - sources(i)%file_dependencies(j)%ptr => sources(k) - exit - end if - - end do + sources(i)%file_dependencies(j)%ptr => & + find_module_dependency(sources,sources(i)%modules_used(j)%s) if (.not.associated(sources(i)%file_dependencies(j)%ptr)) then - write(*,*) '(!) Unable to find source for module dependency: ',sources(i)%module_dependencies(j)%s + write(*,*) '(!) Unable to find source for module dependency: ',sources(i)%modules_used(j)%s ! stop end if end do - end do + end do end subroutine resolve_dependencies +function find_module_dependency(sources,module_name) result(src_ptr) + type(srcfile_t), intent(in), target :: sources(:) + character(*), intent(in) :: module_name + type(srcfile_t), pointer :: src_ptr + + integer :: k, l + + src_ptr => NULL() + + do k=1,size(sources) + + do l=1,size(sources(k)%modules_provided) + + if (module_name == sources(k)%modules_provided(l)%s) then + src_ptr => sources(k) + exit + end if + + end do + + end do +end function find_module_dependency end module fpm_sources \ No newline at end of file -- cgit v1.2.3 From b6000d89933610bd8f481b5f0f2c8ceeac7f18ff Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 1 Sep 2020 10:37:33 +0100 Subject: Add: stubs for model and manifest structures Backend now only accepts the fpm model structure. This structure currently only contains the array of sources. --- fpm/app/main.f90 | 4 ++-- fpm/src/fpm.f90 | 53 +++++++----------------------------------------- fpm/src/fpm_backend.f90 | 40 ++++++++++++++++++++++++++++++++++++ fpm/src/fpm_manifest.f90 | 10 +++++++++ fpm/src/fpm_model.f90 | 29 ++++++++++++++++++++++++++ fpm/src/fpm_sources.f90 | 19 +++++++++++++---- 6 files changed, 103 insertions(+), 52 deletions(-) create mode 100644 fpm/src/fpm_manifest.f90 create mode 100644 fpm/src/fpm_model.f90 diff --git a/fpm/app/main.f90 b/fpm/app/main.f90 index 7f0f425..c7f9786 100644 --- a/fpm/app/main.f90 +++ b/fpm/app/main.f90 @@ -15,11 +15,11 @@ class(fpm_cmd_settings), allocatable :: cmd_settings call get_command_line_settings(cmd_settings) -select type(cmd_settings) +select type(settings=>cmd_settings) type is (fpm_new_settings) call cmd_new() type is (fpm_build_settings) - call cmd_build() + call cmd_build(settings) type is (fpm_run_settings) call cmd_run() type is (fpm_test_settings) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index ac412c6..a4d830b 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -22,56 +22,17 @@ else end if end subroutine -subroutine cmd_build() -type(string_t), allocatable :: lib_files(:) -type(string_t), allocatable :: app_files(:) -type(string_t), allocatable :: files(:) -character(:), allocatable :: basename, pkg_name, linking -integer :: i, n +subroutine cmd_build(settings) + type(fpm_build_settings), intent(in) :: settings -type(srcfile_t), allocatable :: sources(:) -character(:), allocatable :: file_parts(:) + type(fpm_manifest_t) :: manifest + type(fpm_model_t) :: model -print *, "# Building project" + print *, "# Building project" -call list_files("src", lib_files) -lib_files = [(string_t("src/"//lib_files(i)%s),i=1,size(lib_files))] + call build_model(model, settings, manifest) -call list_files("app", app_files) -app_files = [(string_t("app/"//app_files(i)%s),i=1,size(app_files))] - -files = [lib_files, app_files] - -call scan_sources(files,sources) - -call resolve_dependencies(sources) - -linking = "" -do i=1,size(sources) - - if (sources(i)%unit_type == FPM_UNIT_MODULE .or. & - sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. & - sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. & - sources(i)%unit_type == FPM_UNIT_CSOURCE) then - - call build_source(sources(i),linking) - - end if - -end do - -do i=1,size(sources) - - if (sources(i)%unit_type == FPM_UNIT_PROGRAM) then - - call split(sources(i)%file_name,file_parts,delimiters='\/.') - basename = file_parts(size(file_parts)-1) - - call run("gfortran " // sources(i)%file_name // linking // " -o " // basename) - - end if - -end do + call build_package(model) end subroutine diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index da2cc85..37afe65 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -2,11 +2,51 @@ module fpm_backend use fpm_strings use fpm_environment use fpm_sources +use fpm_model implicit none contains + +subroutine build_package(model) + type(fpm_model_t), intent(inout) :: model + + integer :: i + character(:), allocatable :: basename, linking + character(:), allocatable :: file_parts(:) + + linking = "" + do i=1,size(model%sources) + + if (model%sources(i)%unit_type == FPM_UNIT_MODULE .or. & + model%sources(i)%unit_type == FPM_UNIT_SUBMODULE .or. & + model%sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. & + model%sources(i)%unit_type == FPM_UNIT_CSOURCE) then + + call build_source(model%sources(i),linking) + + end if + + end do + + do i=1,size(model%sources) + + if (model%sources(i)%unit_type == FPM_UNIT_PROGRAM) then + + call split(model%sources(i)%file_name,file_parts,delimiters='\/.') + basename = file_parts(size(file_parts)-1) + + call run("gfortran " // model%sources(i)%file_name // linking // " -o " // basename) + + end if + + end do + +end subroutine build_package + + + recursive subroutine build_source(source_file,linking) ! Compile Fortran source, called recursively on it dependents ! diff --git a/fpm/src/fpm_manifest.f90 b/fpm/src/fpm_manifest.f90 new file mode 100644 index 0000000..4a88844 --- /dev/null +++ b/fpm/src/fpm_manifest.f90 @@ -0,0 +1,10 @@ +module fpm_manifest +! Parsing, validation and representation of 'fpm.toml' manifest file +implicit none + +type fpm_manifest_t + ! Encapsulates settings parsed from 'fpm.toml' + +end type fpm_manifest_t + +end module fpm_manifest \ No newline at end of file diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 new file mode 100644 index 0000000..501ea29 --- /dev/null +++ b/fpm/src/fpm_model.f90 @@ -0,0 +1,29 @@ +module fpm_model +! Definition and validation of the backend model +! +use fpm_strings +use fpm_sources +use fpm_command_line +use fpm_manifest +implicit none + +type fpm_model_t + type(srcfile_t), allocatable :: sources(:) + ! Array of sources with module-dependencies resolved + +end type fpm_model_t + +contains + +subroutine build_model(model, settings, manifest) + type(fpm_model_t), intent(out) :: model + type(fpm_build_settings), intent(in) :: settings + type(fpm_manifest_t), intent(in) :: manifest + + call scan_sources(model%sources,[string_t('app'),string_t('src')]) + + call resolve_dependencies(model%sources) + +end subroutine build_model + +end module fpm_model \ No newline at end of file diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index b07366d..88a9ffa 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,6 +1,6 @@ module fpm_sources use fpm_strings -use fpm_filesystem, only: read_lines +use fpm_filesystem, only: read_lines, list_files implicit none private @@ -47,17 +47,28 @@ end type srcfile_t contains -subroutine scan_sources(file_names,sources) +subroutine scan_sources(sources,directories) ! Enumerate Fortran sources and resolve file ! dependencies ! - type(string_t), intent(in) :: file_names(:) type(srcfile_t), allocatable, intent(out), target :: sources(:) + type(string_t), intent(in) :: directories(:) integer :: i, j - logical :: is_source(size(file_names)) + logical, allocatable :: is_source(:) + type(string_t), allocatable :: dir_files(:) + type(string_t), allocatable :: file_names(:) type(string_t), allocatable :: src_file_names(:) + ! Scan directories for sources + allocate(file_names(0)) + do i=1,size(directories) + + call list_files(directories(i)%s, dir_files) + file_names = [file_names,(string_t(directories(i)%s//'/'//dir_files(j)%s),j=1,size(dir_files))] + + end do + is_source = [(str_ends_with(lower(file_names(i)%s), ".f90") .or. & str_ends_with(lower(file_names(i)%s), ".c") .or. & str_ends_with(lower(file_names(i)%s), ".h"),i=1,size(file_names))] -- cgit v1.2.3 From 54a5c6de29c3d7aa70797ff2d14aa962e9e169d8 Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 2 Sep 2020 09:55:40 +0100 Subject: Fix: for multilevel submodules Ignores ancestor name in submodule declaration statement. --- fpm/src/fpm_sources.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 88a9ffa..d65b9f3 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -222,6 +222,12 @@ function parse_f_source(f_filename) result(f_source) if (pass == 2) then + if (index(line_parts(2),':') > 0) then + + line_parts(2) = line_parts(2)(index(line_parts(2),':')+1:) + + end if + f_source%modules_used(n_use)%s = adjustl(trim(lower(line_parts(2)))) end if -- cgit v1.2.3 From f466572a8bc255cce1bb05ac50a96e47995c782b Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 2 Sep 2020 10:41:18 +0100 Subject: Add basic fields to model structure. Adds output directory, compiler and compiler flags to model structure - currently hard-coded values. Adds mkdir subroutine in filesystem, implemented via command line shell. --- fpm/src/fpm.f90 | 3 +++ fpm/src/fpm_backend.f90 | 30 +++++++++++++++++++++++------- fpm/src/fpm_filesystem.f90 | 22 +++++++++++++++++++++- fpm/src/fpm_model.f90 | 28 +++++++++++++++++++++++++++- fpm/src/fpm_sources.f90 | 24 ++++++++++++------------ 5 files changed, 86 insertions(+), 21 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index a4d830b..4fb6bd4 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,5 +1,8 @@ module fpm use fpm_strings +use fpm_command_line +use fpm_manifest +use fpm_model use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS use fpm_filesystem, only: number_of_rows, list_files, exists use fpm_sources diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 37afe65..475dcdd 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -1,10 +1,15 @@ module fpm_backend +! Implements the native fpm build backend +! use fpm_strings use fpm_environment use fpm_sources use fpm_model +use fpm_filesystem implicit none +private +public :: build_package contains @@ -16,6 +21,10 @@ subroutine build_package(model) character(:), allocatable :: basename, linking character(:), allocatable :: file_parts(:) + if(.not.exists(model%output_directory)) then + call mkdir(model%output_directory) + end if + linking = "" do i=1,size(model%sources) @@ -24,7 +33,7 @@ subroutine build_package(model) model%sources(i)%unit_type == FPM_UNIT_SUBPROGRAM .or. & model%sources(i)%unit_type == FPM_UNIT_CSOURCE) then - call build_source(model%sources(i),linking) + call build_source(model,model%sources(i),linking) end if @@ -37,7 +46,12 @@ subroutine build_package(model) call split(model%sources(i)%file_name,file_parts,delimiters='\/.') basename = file_parts(size(file_parts)-1) - call run("gfortran " // model%sources(i)%file_name // linking // " -o " // basename) + call run("gfortran -c " // model%sources(i)%file_name // ' '//model%fortran_compile_flags & + // " -o " // model%output_directory // '/' // basename // ".o") + + call run("gfortran " // model%output_directory // '/' // basename // ".o "// & + linking //" " //model%link_flags // " -o " // model%output_directory & + // '/' // model%package_name) end if @@ -47,13 +61,14 @@ end subroutine build_package -recursive subroutine build_source(source_file,linking) +recursive subroutine build_source(model,source_file,linking) ! Compile Fortran source, called recursively on it dependents ! + type(fpm_model_t), intent(in) :: model type(srcfile_t), intent(inout) :: source_file character(:), allocatable, intent(inout) :: linking - integer :: n, i + integer :: i character(:), allocatable :: file_parts(:) character(:), allocatable :: basename @@ -71,7 +86,7 @@ recursive subroutine build_source(source_file,linking) do i=1,size(source_file%file_dependencies) if (associated(source_file%file_dependencies(i)%ptr)) then - call build_source(source_file%file_dependencies(i)%ptr,linking) + call build_source(model,source_file%file_dependencies(i)%ptr,linking) end if end do @@ -79,8 +94,9 @@ recursive subroutine build_source(source_file,linking) call split(source_file%file_name,file_parts,delimiters='\/.') basename = file_parts(size(file_parts)-1) - call run("gfortran -c " // source_file%file_name // " -o " // basename // ".o") - linking = linking // " " // basename // ".o" + call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags & + // " -o " // model%output_directory//'/'//basename // ".o") + linking = linking // " " // model%output_directory//'/'// basename // ".o" source_file%built = .true. diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 2b2793a..c531e84 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -4,7 +4,7 @@ use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS implicit none private -public :: number_of_rows, read_lines, list_files, exists, get_temp_filename +public :: number_of_rows, read_lines, list_files, mkdir, exists, get_temp_filename integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -41,6 +41,26 @@ function read_lines(fh) result(lines) end function read_lines +subroutine mkdir(dir) + character(*), intent(in) :: dir + + integer :: stat + + select case (get_os_type()) + case (OS_LINUX,OS_MACOS) + call execute_command_line("mkdir -p " // dir , exitstat=stat) + write(*,*) "mkdir -p " // dir + case (OS_WINDOWS) + call execute_command_line("mkdir " // dir, exitstat=stat) + write(*,*) "mkdir " // dir + end select + if (stat /= 0) then + print *, "execute_command_line() failed" + error stop + end if + +end subroutine mkdir + subroutine list_files(dir, files) character(len=*), intent(in) :: dir diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 501ea29..a0bbdb5 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -4,22 +4,48 @@ module fpm_model use fpm_strings use fpm_sources use fpm_command_line +use fpm_filesystem use fpm_manifest implicit none type fpm_model_t + character(:), allocatable :: package_name + ! Name of package type(srcfile_t), allocatable :: sources(:) ! Array of sources with module-dependencies resolved - + character(:), allocatable :: fortran_compiler + ! Command line name to invoke fortran compiler + character(:), allocatable :: fortran_compile_flags + ! Command line flags passed to fortran for compilation + character(:), allocatable :: link_flags + ! Command line flags pass for linking + character(:), allocatable :: output_directory + ! Base directory for build end type fpm_model_t contains subroutine build_model(model, settings, manifest) + ! Constructs a valid fpm model from command line settings and toml manifest + ! type(fpm_model_t), intent(out) :: model type(fpm_build_settings), intent(in) :: settings type(fpm_manifest_t), intent(in) :: manifest + if (exists("src/fpm.f90")) then + model%package_name = "fpm" + else + model%package_name = "hello_world" + end if + + ! #TODO: Choose flags and output directory based on cli settings & manifest inputs + model%fortran_compiler = 'gfortran' + model%output_directory = 'build/gfortran_debug' + model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & + '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & + '-J'//model%output_directory + model%link_flags = '' + call scan_sources(model%sources,[string_t('app'),string_t('src')]) call resolve_dependencies(model%sources) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index d65b9f3..2960339 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -89,18 +89,18 @@ subroutine scan_sources(sources,directories) end do - do i=1,size(sources) - write(*,*) 'Filename: "',sources(i)%file_name,'"' - do j=1,size(sources(i)%modules_provided) - write(*,*) ' Provides: "',sources(i)%modules_provided(j)%s,'"' - end do - do j=1,size(sources(i)%modules_used) - write(*,*) ' Uses: "',sources(i)%modules_used(j)%s,'"' - end do - do j=1,size(sources(i)%include_dependencies) - write(*,*) ' Includes: "',sources(i)%include_dependencies(j)%s,'"' - end do - end do + ! do i=1,size(sources) + ! write(*,*) 'Filename: "',sources(i)%file_name,'"' + ! do j=1,size(sources(i)%modules_provided) + ! write(*,*) ' Provides: "',sources(i)%modules_provided(j)%s,'"' + ! end do + ! do j=1,size(sources(i)%modules_used) + ! write(*,*) ' Uses: "',sources(i)%modules_used(j)%s,'"' + ! end do + ! do j=1,size(sources(i)%include_dependencies) + ! write(*,*) ' Includes: "',sources(i)%include_dependencies(j)%s,'"' + ! end do + ! end do end subroutine scan_sources -- cgit v1.2.3 From d8afa4d3b5dc633b49ea4e84fdd5d11fee2fa760 Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 2 Sep 2020 12:06:29 +0100 Subject: Fix: EOL to unix LF manifest and model sources files were incorrectly using Windows EOL. --- fpm/src/fpm_manifest.f90 | 18 ++++---- fpm/src/fpm_model.f90 | 108 +++++++++++++++++++++++------------------------ 2 files changed, 63 insertions(+), 63 deletions(-) diff --git a/fpm/src/fpm_manifest.f90 b/fpm/src/fpm_manifest.f90 index 4a88844..8b0add0 100644 --- a/fpm/src/fpm_manifest.f90 +++ b/fpm/src/fpm_manifest.f90 @@ -1,10 +1,10 @@ -module fpm_manifest -! Parsing, validation and representation of 'fpm.toml' manifest file -implicit none - -type fpm_manifest_t - ! Encapsulates settings parsed from 'fpm.toml' - -end type fpm_manifest_t - +module fpm_manifest +! Parsing, validation and representation of 'fpm.toml' manifest file +implicit none + +type fpm_manifest_t + ! Encapsulates settings parsed from 'fpm.toml' + +end type fpm_manifest_t + end module fpm_manifest \ No newline at end of file diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index a0bbdb5..c1489cf 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -1,55 +1,55 @@ -module fpm_model -! Definition and validation of the backend model -! -use fpm_strings -use fpm_sources -use fpm_command_line -use fpm_filesystem -use fpm_manifest -implicit none - -type fpm_model_t - character(:), allocatable :: package_name - ! Name of package - type(srcfile_t), allocatable :: sources(:) - ! Array of sources with module-dependencies resolved - character(:), allocatable :: fortran_compiler - ! Command line name to invoke fortran compiler - character(:), allocatable :: fortran_compile_flags - ! Command line flags passed to fortran for compilation - character(:), allocatable :: link_flags - ! Command line flags pass for linking - character(:), allocatable :: output_directory - ! Base directory for build -end type fpm_model_t - -contains - -subroutine build_model(model, settings, manifest) - ! Constructs a valid fpm model from command line settings and toml manifest - ! - type(fpm_model_t), intent(out) :: model - type(fpm_build_settings), intent(in) :: settings - type(fpm_manifest_t), intent(in) :: manifest - - if (exists("src/fpm.f90")) then - model%package_name = "fpm" - else - model%package_name = "hello_world" - end if - - ! #TODO: Choose flags and output directory based on cli settings & manifest inputs - model%fortran_compiler = 'gfortran' - model%output_directory = 'build/gfortran_debug' - model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & - '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & - '-J'//model%output_directory - model%link_flags = '' - - call scan_sources(model%sources,[string_t('app'),string_t('src')]) - - call resolve_dependencies(model%sources) - -end subroutine build_model - +module fpm_model +! Definition and validation of the backend model +! +use fpm_strings +use fpm_sources +use fpm_command_line +use fpm_filesystem +use fpm_manifest +implicit none + +type fpm_model_t + character(:), allocatable :: package_name + ! Name of package + type(srcfile_t), allocatable :: sources(:) + ! Array of sources with module-dependencies resolved + character(:), allocatable :: fortran_compiler + ! Command line name to invoke fortran compiler + character(:), allocatable :: fortran_compile_flags + ! Command line flags passed to fortran for compilation + character(:), allocatable :: link_flags + ! Command line flags pass for linking + character(:), allocatable :: output_directory + ! Base directory for build +end type fpm_model_t + +contains + +subroutine build_model(model, settings, manifest) + ! Constructs a valid fpm model from command line settings and toml manifest + ! + type(fpm_model_t), intent(out) :: model + type(fpm_build_settings), intent(in) :: settings + type(fpm_manifest_t), intent(in) :: manifest + + if (exists("src/fpm.f90")) then + model%package_name = "fpm" + else + model%package_name = "hello_world" + end if + + ! #TODO: Choose flags and output directory based on cli settings & manifest inputs + model%fortran_compiler = 'gfortran' + model%output_directory = 'build/gfortran_debug' + model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & + '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & + '-J'//model%output_directory + model%link_flags = '' + + call scan_sources(model%sources,[string_t('app'),string_t('src')]) + + call resolve_dependencies(model%sources) + +end subroutine build_model + end module fpm_model \ No newline at end of file -- cgit v1.2.3 From f85f291ba5ebd66bbb258e2dc859f4dcc95017c5 Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 2 Sep 2020 12:17:47 +0100 Subject: Update: fortran fpm test script. --- ci/run_tests.bat | 2 +- ci/run_tests.sh | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 99d0296..482cf79 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -18,5 +18,5 @@ if errorlevel 1 exit 1 ..\..\..\fpm\build\gfortran_debug\app\fpm build if errorlevel 1 exit 1 -.\hello_world +.\build\gfortran_debug\hello_world if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 59724d5..e046910 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -8,4 +8,4 @@ fpm run build/gfortran_debug/app/fpm cd ../test/example_packages/hello_world ../../../fpm/build/gfortran_debug/app/fpm build -./hello_world +./build/gfortran_debug/hello_world -- cgit v1.2.3 From 61780313dfc873f06973dd6e7a51e3004f4a7bd6 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Tue, 1 Sep 2020 22:48:32 +0200 Subject: Implement interface to TOML-Fortran and reading of fpm.toml --- fpm/fpm.toml | 3 + fpm/src/fpm.f90 | 70 ++++++---- fpm/src/fpm/config.f90 | 79 +++++++++++ fpm/src/fpm/config/dependency.f90 | 241 ++++++++++++++++++++++++++++++++++ fpm/src/fpm/config/executable.f90 | 173 ++++++++++++++++++++++++ fpm/src/fpm/config/library.f90 | 126 ++++++++++++++++++ fpm/src/fpm/config/package.f90 | 270 ++++++++++++++++++++++++++++++++++++++ fpm/src/fpm/config/test.f90 | 166 +++++++++++++++++++++++ fpm/src/fpm/error.f90 | 61 +++++++++ fpm/src/fpm/git.f90 | 170 ++++++++++++++++++++++++ fpm/src/fpm/toml.f90 | 65 +++++++++ 11 files changed, 1401 insertions(+), 23 deletions(-) create mode 100644 fpm/src/fpm/config.f90 create mode 100644 fpm/src/fpm/config/dependency.f90 create mode 100644 fpm/src/fpm/config/executable.f90 create mode 100644 fpm/src/fpm/config/library.f90 create mode 100644 fpm/src/fpm/config/package.f90 create mode 100644 fpm/src/fpm/config/test.f90 create mode 100644 fpm/src/fpm/error.f90 create mode 100644 fpm/src/fpm/git.f90 create mode 100644 fpm/src/fpm/toml.f90 diff --git a/fpm/fpm.toml b/fpm/fpm.toml index c07eeba..f07987d 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -4,3 +4,6 @@ license = "MIT" author = "fpm maintainers" maintainer = "" copyright = "2020 fpm contributors" + +[dependencies] +toml-f = { git = "https://github.com/toml-f/toml-f" } diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index ed80313..5123436 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,5 +1,8 @@ module fpm use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +use fpm_config, only : get_package_data, default_executable, default_library, & + & package_t +use fpm_error, only : error_t implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test @@ -85,34 +88,55 @@ else end if end function -subroutine package_name(name) -character(:), allocatable, intent(out) :: name -! Currrently a heuristic. We should update this to read the name from fpm.toml -if (exists("src/fpm.f90")) then - name = "fpm" -else - name = "hello_world" -end if -end subroutine - subroutine cmd_build() +type(package_t) :: package +type(error_t), allocatable :: error type(string_t), allocatable :: files(:) -character(:), allocatable :: basename, pkg_name, linking +character(:), allocatable :: basename, linking integer :: i, n -print *, "# Building project" -call list_files("src", files) +call get_package_data(package, "fpm.toml", error) +if (allocated(error)) then + print '(a)', error%message + error stop 1 +end if + +! Populate library in case we find the default src directory +if (.not.allocated(package%library) .and. exists("src")) then + call default_library(package%library) +end if + +! Populate executable in case we find the default app directory +if (.not.allocated(package%executable) .and. exists("app")) then + allocate(package%executable(1)) + call default_executable(package%executable(1), package%name) +end if + +if (.not.(allocated(package%library) .or. allocated(package%executable))) then + print '(a)', "Neither library nor executable found, there is nothing to do" + error stop 1 +end if + linking = "" -do i = 1, size(files) - if (str_ends_with(files(i)%s, ".f90")) then - n = len(files(i)%s) - basename = files(i)%s(1:n-4) - call run("gfortran -c src/" // basename // ".f90 -o " // basename // ".o") - linking = linking // " " // basename // ".o" - end if +if (allocated(package%library)) then + call list_files(package%library%source_dir, files) + do i = 1, size(files) + if (str_ends_with(files(i)%s, ".f90")) then + n = len(files(i)%s) + basename = files(i)%s + call run("gfortran -c " // package%library%source_dir // "/" // & + & basename // " -o " // basename // ".o") + linking = linking // " " // basename // ".o" + end if + end do +end if + +do i = 1, size(package%executable) + basename = package%executable(i)%main + call run("gfortran -c " // package%executable(i)%source_dir // "/" // & + & basename // " -o " // basename // ".o") + call run("gfortran " // basename // ".o " // linking // " -o " // & + & package%executable(i)%name) end do -call run("gfortran -c app/main.f90 -o main.o") -call package_name(pkg_name) -call run("gfortran main.o " // linking // " -o " // pkg_name) end subroutine subroutine cmd_install() diff --git a/fpm/src/fpm/config.f90 b/fpm/src/fpm/config.f90 new file mode 100644 index 0000000..03ad768 --- /dev/null +++ b/fpm/src/fpm/config.f90 @@ -0,0 +1,79 @@ +!> Package configuration data. +! +! This module provides the necessary procedure to translate a TOML document +! to the corresponding Fortran type, while verifying it with respect to +! its schema. +! +! Additionally, the required data types for users of this module are reexported +! to hide the actual implementation details. +module fpm_config + use fpm_config_executable, only : executable_t + use fpm_config_library, only : library_t + use fpm_config_package, only : package_t, new_package + use fpm_error, only : error_t, fatal_error, file_not_found_error + use fpm_toml, only : toml_table, read_package_file + implicit none + private + + public :: get_package_data, default_executable, default_library + public :: package_t + + +contains + + + !> Populate library in case we find the default src directory + subroutine default_library(self) + + !> Instance of the library meta data + type(library_t), intent(out) :: self + + self%source_dir = "src" + + end subroutine default_library + + + !> Populate executable in case we find the default app directory + subroutine default_executable(self, name) + + !> Instance of the executable meta data + type(executable_t), intent(out) :: self + + !> Name of the package + character(len=*), intent(in) :: name + + self%name = name + self%source_dir = "app" + self%main = "main.f90" + + end subroutine default_executable + + + !> Obtain package meta data from a configuation file + subroutine get_package_data(package, file, error) + + !> Parsed package meta data + type(package_t), intent(out) :: package + + !> Name of the package configuration file + character(len=*), intent(in) :: file + + !> Error status of the operation + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + + call read_package_file(table, file, error) + if (allocated(error)) return + + if (.not.allocated(table)) then + call fatal_error(error, "Unclassified error while reading: '"//file//"'") + return + end if + + call new_package(package, table, error) + + end subroutine get_package_data + + +end module fpm_config diff --git a/fpm/src/fpm/config/dependency.f90 b/fpm/src/fpm/config/dependency.f90 new file mode 100644 index 0000000..d98951f --- /dev/null +++ b/fpm/src/fpm/config/dependency.f90 @@ -0,0 +1,241 @@ +!> Implementation of the meta data for dependencies. +! +! A dependency table can currently have the following fields +! +! ```toml +! [dependencies] +! "dep1" = { git = "url" } +! "dep2" = { git = "url", branch = "name" } +! "dep3" = { git = "url", tag = "name" } +! "dep4" = { git = "url", rev = "sha1" } +! "dep0" = { path = "path" } +! ``` +! +! To reduce the amount of boilerplate code this module provides two constructors +! for dependency types, one basic for an actual dependency (inline) table +! and another to collect all dependency objects from a dependencies table, +! which is handling the allocation of the objects and is forwarding the +! individual dependency tables to their respective constructors. +! The usual entry point should be the constructor for the super table. +! +! This objects contains a target to retrieve required `fpm` projects to +! build the target declaring the dependency. +! Resolving a dependency will result in obtaining a new package configuration +! data for the respective project. +module fpm_config_dependency + use fpm_error, only : error_t, syntax_error + use fpm_git, only : git_target_t, git_target_tag, git_target_branch, & + & git_target_revision, git_target_default + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: dependency_t, new_dependency, new_dependencies + + + !> Configuration meta data for a dependency + type :: dependency_t + + !> Name of the dependency + character(len=:), allocatable :: name + + !> Local target + character(len=:), allocatable :: path + + !> Git descriptor + type(git_target_t), allocatable :: git + + contains + + !> Print information on this instance + procedure :: info + + end type dependency_t + + +contains + + + !> Construct a new dependency configuration from a TOML data structure + subroutine new_dependency(self, table, error) + + !> Instance of the dependency configuration + type(dependency_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: url, obj + + call check(table, error) + if (allocated(error)) return + + call table%get_key(self%name) + + call get_value(table, "path", url) + if (allocated(url)) then + call move_alloc(url, self%path) + else + call get_value(table, "git", url) + + call get_value(table, "tag", obj) + if (allocated(obj)) then + self%git = git_target_tag(url, obj) + end if + + if (.not.allocated(self%git)) then + call get_value(table, "branch", obj) + if (allocated(obj)) then + self%git = git_target_branch(url, obj) + end if + end if + + if (.not.allocated(self%git)) then + call get_value(table, "revision", obj) + if (allocated(obj)) then + self%git = git_target_revision(url, obj) + end if + end if + + if (.not.allocated(self%git)) then + self%git = git_target_default(url) + end if + + end if + + end subroutine new_dependency + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: name + type(toml_key), allocatable :: list(:) + logical :: url_present, git_target_present + integer :: ikey + + url_present = .false. + git_target_present = .false. + + call table%get_key(name) + call table%get_keys(list) + + if (.not.allocated(list)) then + call syntax_error(error, "Dependency "//name//" does not provide sufficient entries") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in dependency "//name) + exit + + case("git", "path") + if (url_present) then + call syntax_error(error, "Dependency "//name//" cannot have both git and path entries") + exit + end if + url_present = .true. + + case("branch", "rev", "tag") + if (git_target_present) then + call syntax_error(error, "Dependency "//name//" can only have one of branch, rev or tag present") + exit + end if + git_target_present = .true. + + end select + end do + if (allocated(error)) return + + if (.not.url_present .and. git_target_present) then + call syntax_error(error, "Dependency "//name//" uses a local path, therefore no git identifiers are allowed") + end if + + end subroutine check + + + !> Construct new dependency array from a TOML data structure + subroutine new_dependencies(deps, table, error) + + !> Instance of the dependency configuration + type(dependency_t), allocatable, intent(out) :: deps(:) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: node + type(toml_key), allocatable :: list(:) + integer :: idep, stat + + call table%get_keys(list) + ! An empty table is okay + if (.not.allocated(list)) return + + allocate(deps(size(list))) + do idep = 1, size(list) + call get_value(table, list(idep)%key, node, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Dependency "//list(idep)%key//" must be a table entry") + exit + end if + call new_dependency(deps(idep), node, error) + if (allocated(error)) exit + end do + + end subroutine new_dependencies + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the dependency configuration + class(dependency_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + write(unit, fmt) "Dependency" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + + if (allocated(self%git)) then + write(unit, fmt) "- kind", "git" + call self%git%info(unit, pr - 1) + end if + + if (allocated(self%path)) then + write(unit, fmt) "- kind", "local" + write(unit, fmt) "- path", self%path + end if + + end subroutine info + + +end module fpm_config_dependency diff --git a/fpm/src/fpm/config/executable.f90 b/fpm/src/fpm/config/executable.f90 new file mode 100644 index 0000000..f5078eb --- /dev/null +++ b/fpm/src/fpm/config/executable.f90 @@ -0,0 +1,173 @@ +!> Implementation of the meta data for an executables. +! +! An executable table can currently have the following fields +! +! ```toml +! [[executable]] +! name = "string" +! source-dir = "path" +! main = "file" +! [executable.dependencies] +! ``` +module fpm_config_executable + use fpm_config_dependency, only : dependency_t, new_dependencies + use fpm_error, only : error_t, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: executable_t, new_executable + + + !> Configuation meta data for an executable + type :: executable_t + + !> Name of the resulting executable + character(len=:), allocatable :: name + + !> Source directory for collecting the executable + character(len=:), allocatable :: source_dir + + !> Name of the source file declaring the main program + character(len=:), allocatable :: main + + !> Dependency meta data for this executable + type(dependency_t), allocatable :: dependency(:) + + contains + + !> Print information on this instance + procedure :: info + + end type executable_t + + +contains + + + !> Construct a new executable configuration from a TOML data structure + subroutine new_executable(self, table, error) + + !> Instance of the executable configuration + type(executable_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: child + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "name", self%name) + call get_value(table, "source-dir", self%source_dir, "app") + call get_value(table, "main", self%main, "main.f90") + + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, error) + if (allocated(error)) return + end if + + end subroutine new_executable + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_keys(list) + + if (.not.allocated(list)) then + call syntax_error(error, "Executable section does not provide sufficient entries") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed executable entry") + exit + + case("name") + name_present = .true. + + case("source-dir", "main", "dependencies") + continue + + end select + end do + + if (.not.name_present) then + call syntax_error(error, "Executable name is not provided, please add a name entry") + end if + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the executable configuration + class(executable_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Executable target" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + if (allocated(self%source_dir)) then + if (self%source_dir /= "app" .or. pr > 2) then + write(unit, fmt) "- source directory", self%source_dir + end if + end if + if (allocated(self%main)) then + if (self%main /= "main.f90" .or. pr > 2) then + write(unit, fmt) "- program source", self%main + end if + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + +end module fpm_config_executable diff --git a/fpm/src/fpm/config/library.f90 b/fpm/src/fpm/config/library.f90 new file mode 100644 index 0000000..0650051 --- /dev/null +++ b/fpm/src/fpm/config/library.f90 @@ -0,0 +1,126 @@ +!> Implementation of the meta data for libraries. +! +! A library table can currently have the following fields +! +! ```toml +! [library] +! source-dir = "path" +! build-script = "file" +! ``` +module fpm_config_library + use fpm_error, only : error_t, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: library_t, new_library + + + !> Configuration meta data for a library + type :: library_t + + !> Source path prefix + character(len=:), allocatable :: source_dir + + !> Alternative build script to be invoked + character(len=:), allocatable :: build_script + + contains + + !> Print information on this instance + procedure :: info + + end type library_t + + +contains + + + !> Construct a new library configuration from a TOML data structure + subroutine new_library(self, table, error) + + !> Instance of the library configuration + type(library_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "source-dir", self%source_dir, "src") + call get_value(table, "build-script", self%build_script) + + end subroutine new_library + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + integer :: ikey + + call table%get_keys(list) + + ! table can be empty + if (.not.allocated(list)) return + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file") + exit + + case("source-dir", "build-script") + continue + + end select + end do + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the library configuration + class(library_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Library target" + if (allocated(self%source_dir)) then + write(unit, fmt) "- source directory", self%source_dir + end if + if (allocated(self%build_script)) then + write(unit, fmt) "- custom build", self%build_script + end if + + end subroutine info + + +end module fpm_config_library diff --git a/fpm/src/fpm/config/package.f90 b/fpm/src/fpm/config/package.f90 new file mode 100644 index 0000000..66f275d --- /dev/null +++ b/fpm/src/fpm/config/package.f90 @@ -0,0 +1,270 @@ +!> Define the package data containing the meta data from the configuration file. +! +! The package data defines a Fortran type corresponding to the respective +! TOML document, after creating it from a package file no more interaction +! with the TOML document is required. +! +! Every configuration type provides it custom constructor (prefixed with `new_`) +! and knows how to deserialize itself from a TOML document. +! To ensure we find no untracked content in the package file all keywords are +! checked and possible entries have to be explicitly allowed in the `check` +! function. +! If entries are mutally exclusive or interdependent inside the current table +! the `check` function is required to enforce this schema on the data structure. +! +! The package file root allows the following keywords +! +! ```toml +! name = "string" +! version = "string" +! license = "string" +! author = "string" +! maintainer = "string" +! copyright = "string +! [library] +! [dependencies] +! [dev-dependencies] +! [[executable]] +! [[test]] +! ``` +module fpm_config_package + use fpm_config_dependency, only : dependency_t, new_dependencies + use fpm_config_executable, only : executable_t, new_executable + use fpm_config_library, only : library_t, new_library + use fpm_config_test, only : test_t, new_test + use fpm_error, only : error_t, fatal_error, syntax_error + use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, & + & len + implicit none + private + + public :: package_t, new_package + + + !> Package meta data + type :: package_t + + !> Name of the package + character(len=:), allocatable :: name + + !> Library meta data + type(library_t), allocatable :: library + + !> Executable meta data + type(executable_t), allocatable :: executable(:) + + !> Dependency meta data + type(dependency_t), allocatable :: dependency(:) + + !> Development dependency meta data + type(dependency_t), allocatable :: dev_dependency(:) + + !> Test meta data + type(test_t), allocatable :: test(:) + + contains + + !> Print information on this instance + procedure :: info + + end type package_t + + +contains + + + !> Construct a new package configuration from a TOML data structure + subroutine new_package(self, table, error) + + !> Instance of the package configuration + type(package_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: child, node + class(toml_array), pointer :: children + integer :: ii, nn, stat + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "name", self%name) + + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, error) + if (allocated(error)) return + end if + + call get_value(table, "dev-dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dev_dependency, child, error) + if (allocated(error)) return + end if + + call get_value(table, "library", child, requested=.false.) + if (associated(child)) then + allocate(self%library) + call new_library(self%library, child, error) + end if + + call get_value(table, "executable", children, requested=.false.) + if (associated(children)) then + nn = len(children) + allocate(self%executable(nn)) + do ii = 1, nn + call get_value(children, ii, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve executable from array entry") + exit + end if + call new_executable(self%executable(ii), node, error) + if (allocated(error)) exit + end do + end if + + call get_value(table, "test", children, requested=.false.) + if (associated(children)) then + nn = len(children) + allocate(self%test(nn)) + do ii = 1, nn + call get_value(children, ii, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve test from array entry") + exit + end if + call new_test(self%test(ii), node, error) + if (allocated(error)) exit + end do + end if + + end subroutine new_package + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: name + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_key(name) + call table%get_keys(list) + + if (.not.allocated(list)) then + call syntax_error(error, "Package file is empty") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file") + exit + + case("name") + name_present = .true. + + case("version", "license", "author", "maintainer", "copyright", & + & "dependencies", "dev-dependencies", "test", "executable", & + & "library") + continue + + end select + end do + if (allocated(error)) return + + if (.not.name_present) then + call syntax_error(error, "Package name is not provided, please add a name entry") + end if + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the package configuration + class(package_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Package" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + + if (allocated(self%library)) then + write(unit, fmt) "- target", "archive" + call self%library%info(unit, pr - 1) + end if + + if (allocated(self%executable)) then + if (size(self%executable) > 1 .or. pr > 2) then + write(unit, fmti) "- executables", size(self%executable) + end if + do ii = 1, size(self%executable) + call self%executable(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%test)) then + if (size(self%test) > 1 .or. pr > 2) then + write(unit, fmti) "- tests", size(self%test) + end if + do ii = 1, size(self%test) + call self%test(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%dev_dependency)) then + if (size(self%dev_dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- development deps.", size(self%dev_dependency) + end if + do ii = 1, size(self%dev_dependency) + call self%dev_dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + +end module fpm_config_package diff --git a/fpm/src/fpm/config/test.f90 b/fpm/src/fpm/config/test.f90 new file mode 100644 index 0000000..5c6c9f3 --- /dev/null +++ b/fpm/src/fpm/config/test.f90 @@ -0,0 +1,166 @@ +!> Implementation of the meta data for a test. +! +! The test data structure is effectively a decorated version of an executable +! and shares most of its properties, except for the defaults and can be +! handled under most circumstances just like any other executable. +! +! A test table can currently have the following fields +! +! ```toml +! [[test]] +! name = "string" +! source-dir = "path" +! main = "file" +! [test.dependencies] +! ``` +module fpm_config_test + use fpm_config_dependency, only : dependency_t, new_dependencies + use fpm_config_executable, only : executable_t + use fpm_error, only : error_t, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: test_t, new_test + + + !> Configuation meta data for an test + type, extends(executable_t) :: test_t + + contains + + !> Print information on this instance + procedure :: info + + end type test_t + + +contains + + + !> Construct a new test configuration from a TOML data structure + subroutine new_test(self, table, error) + + !> Instance of the test configuration + type(test_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: child + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "name", self%name) + call get_value(table, "source-dir", self%source_dir, "test") + call get_value(table, "main", self%main, "main.f90") + + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, error) + if (allocated(error)) return + end if + + end subroutine new_test + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_keys(list) + + if (.not.allocated(list)) then + call syntax_error(error, "Executable section does not provide sufficient entries") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in test entry") + exit + + case("name") + name_present = .true. + + case("source-dir", "main", "dependencies") + continue + + end select + end do + + if (.not.name_present) then + call syntax_error(error, "Executable name is not provided, please add a name entry") + end if + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the test configuration + class(test_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Test target" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + if (allocated(self%source_dir)) then + if (self%source_dir /= "test" .or. pr > 2) then + write(unit, fmt) "- source directory", self%source_dir + end if + end if + if (allocated(self%main)) then + if (self%main /= "main.f90" .or. pr > 2) then + write(unit, fmt) "- test source", self%main + end if + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + +end module fpm_config_test diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 new file mode 100644 index 0000000..957d3bf --- /dev/null +++ b/fpm/src/fpm/error.f90 @@ -0,0 +1,61 @@ +!> Implementation of basic error handling. +module fpm_error + implicit none + private + + public :: error_t + public :: fatal_error, syntax_error, file_not_found_error + + + !> Data type defining an error + type :: error_t + + !> Error message + character(len=:), allocatable :: message + + end type error_t + + + !> Alias syntax errors to fatal errors for now + interface syntax_error + module procedure :: fatal_error + end interface syntax_error + + +contains + + + !> Generic fatal runtime error + subroutine fatal_error(error, message) + + !> Instance of the error data + type(error_t), allocatable, intent(out) :: error + + !> Error message + character(len=*), intent(in) :: message + + allocate(error) + error%message = message + + end subroutine fatal_error + + + !> Error created when a file is missing or not found + subroutine file_not_found_error(error, file_name) + + !> Instance of the error data + type(error_t), allocatable, intent(out) :: error + + !> Name of the missing file + character(len=*), intent(in) :: file_name + + character(len=:), allocatable :: message + + message = "'"//file_name//"' could not be found, check if the file exists" + + call move_alloc(message, error%message) + + end subroutine file_not_found_error + + +end module fpm_error diff --git a/fpm/src/fpm/git.f90 b/fpm/src/fpm/git.f90 new file mode 100644 index 0000000..28ae867 --- /dev/null +++ b/fpm/src/fpm/git.f90 @@ -0,0 +1,170 @@ +!> Implementation for interacting with git repositories. +module fpm_git + implicit none + + public :: git_target_t + public :: git_target_default, git_target_branch, git_target_tag, & + & git_target_revision + + + !> Possible git target + type :: enum_descriptor + + !> Default target + integer :: default = 200 + + !> Branch in git repository + integer :: branch = 201 + + !> Tag in git repository + integer :: tag = 202 + + !> Commit hash + integer :: revision = 203 + + end type enum_descriptor + + !> Actual enumerator for descriptors + type(enum_descriptor), parameter :: git_descriptor = enum_descriptor() + + + !> Description of an git target + type :: git_target_t + private + + !> Kind of the git target + integer :: descriptor = git_descriptor%default + + !> Target URL of the git repository + character(len=:), allocatable :: url + + !> Additional descriptor of the git object + character(len=:), allocatable :: object + + contains + + !> Show information on instance + procedure :: info + + end type git_target_t + + +contains + + + !> Default target + function git_target_default(url) result(self) + + !> Target URL of the git repository + character(len=*), intent(in) :: url + + !> New git target + type(git_target_t) :: self + + self%descriptor = git_descriptor%default + self%url = url + + end function git_target_default + + + !> Target a branch in the git repository + function git_target_branch(url, branch) result(self) + + !> Target URL of the git repository + character(len=*), intent(in) :: url + + !> Name of the branch of interest + character(len=*), intent(in) :: branch + + !> New git target + type(git_target_t) :: self + + self%descriptor = git_descriptor%branch + self%url = url + self%object = branch + + end function git_target_branch + + + !> Target a specific git revision + function git_target_revision(url, sha1) result(self) + + !> Target URL of the git repository + character(len=*), intent(in) :: url + + !> Commit hash of interest + character(len=*), intent(in) :: sha1 + + !> New git target + type(git_target_t) :: self + + self%descriptor = git_descriptor%revision + self%url = url + self%object = sha1 + + end function git_target_revision + + + !> Target a git tag + function git_target_tag(url, tag) result(self) + + !> Target URL of the git repository + character(len=*), intent(in) :: url + + !> Tag name of interest + character(len=*), intent(in) :: tag + + !> New git target + type(git_target_t) :: self + + self%descriptor = git_descriptor%tag + self%url = url + self%object = tag + + end function git_target_tag + + + !> Show information on git target + subroutine info(self, unit, verbosity) + + !> Instance of the git target + class(git_target_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Git target" + if (allocated(self%url)) then + write(unit, fmt) "- URL", self%url + end if + if (allocated(self%object)) then + select case(self%descriptor) + case default + write(unit, fmt) "- object", self%object + case(git_descriptor%tag) + write(unit, fmt) "- tag", self%object + case(git_descriptor%branch) + write(unit, fmt) "- branch", self%object + case(git_descriptor%revision) + write(unit, fmt) "- sha1", self%object + end select + end if + + end subroutine info + + +end module fpm_git diff --git a/fpm/src/fpm/toml.f90 b/fpm/src/fpm/toml.f90 new file mode 100644 index 0000000..d847c69 --- /dev/null +++ b/fpm/src/fpm/toml.f90 @@ -0,0 +1,65 @@ +!> Interface to TOML processing library. +! +! This module acts as a proxy to the `toml-f` public Fortran API and allows +! to selectively expose components from the library to `fpm`. +! The interaction with `toml-f` data types outside of this module should be +! limited to tables, arrays and key-lists, most of the necessary interactions +! are implemented in the building interface with the `get_value` and `set_value` +! procedures. +! +! This module allows to implement features necessary for `fpm`, which are +! not yet available in upstream `toml-f`. +! +! For more details on the library used see: https://github.com/toml-f/toml-f +module fpm_toml + use fpm_error, only : error_t, fatal_error, file_not_found_error + use tomlf, only : toml_table, toml_array, toml_key, toml_stat, get_value, & + & toml_parse, toml_error + use tomlf_type, only : len + implicit none + private + + public :: read_package_file + public :: toml_table, toml_array, toml_key, toml_stat, get_value, len + + +contains + + + !> Process the configuration file to a TOML data structure + subroutine read_package_file(table, config, error) + + !> TOML data structure + type(toml_table), allocatable, intent(out) :: table + + !> Name of the package configuration file + character(len=*), intent(in) :: config + + !> Error status of the operation + type(error_t), allocatable, intent(out) :: error + + type(toml_error), allocatable :: parse_error + integer :: unit + logical :: exist + + inquire(file=config, exist=exist) + + if (.not.exist) then + call file_not_found_error(error, config) + return + end if + + open(file=config, newunit=unit) + call toml_parse(table, unit, parse_error) + close(unit) + + if (allocated(parse_error)) then + allocate(error) + call move_alloc(parse_error%message, error%message) + return + end if + + end subroutine read_package_file + + +end module fpm_toml -- cgit v1.2.3 From 58ef8896388385d0e79aedb49996367aeacdbb0c Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Wed, 2 Sep 2020 21:45:25 +0200 Subject: Add unit tests for fpm-fortran --- ci/run_tests.bat | 3 + ci/run_tests.sh | 1 + fpm/fpm.toml | 5 ++ fpm/test/main.f90 | 27 +++++++ fpm/test/test_config.f90 | 188 +++++++++++++++++++++++++++++++++++++++++++++++ fpm/test/test_toml.f90 | 95 ++++++++++++++++++++++++ fpm/test/testsuite.f90 | 122 ++++++++++++++++++++++++++++++ 7 files changed, 441 insertions(+) create mode 100644 fpm/test/main.f90 create mode 100644 fpm/test/test_config.f90 create mode 100644 fpm/test/test_toml.f90 create mode 100644 fpm/test/testsuite.f90 diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 99d0296..33d7071 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -9,6 +9,9 @@ if errorlevel 1 exit 1 fpm run if errorlevel 1 exit 1 +fpm test +if errorlevel 1 exit 1 + build\gfortran_debug\app\fpm if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 59724d5..c740cd8 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -5,6 +5,7 @@ set -ex cd fpm fpm build fpm run +fpm test build/gfortran_debug/app/fpm cd ../test/example_packages/hello_world ../../../fpm/build/gfortran_debug/app/fpm build diff --git a/fpm/fpm.toml b/fpm/fpm.toml index f07987d..9a0009f 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -7,3 +7,8 @@ copyright = "2020 fpm contributors" [dependencies] toml-f = { git = "https://github.com/toml-f/toml-f" } + +[[test]] +name = "fpm-test" +source-dir = "test" +main = "main.f90" diff --git a/fpm/test/main.f90 b/fpm/test/main.f90 new file mode 100644 index 0000000..c4bfee5 --- /dev/null +++ b/fpm/test/main.f90 @@ -0,0 +1,27 @@ +!> Driver for unit testing +program fpm_testing + use, intrinsic :: iso_fortran_env, only : error_unit + use testsuite, only : run_testsuite + use test_toml, only : collect_toml + use test_config, only : collect_config + implicit none + integer :: stat + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + write(error_unit, fmt) "Testing:", "fpm_toml" + call run_testsuite(collect_toml, error_unit, stat) + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "tests failed!" + error stop 1 + end if + + write(error_unit, fmt) "Testing:", "fpm_config" + call run_testsuite(collect_config, error_unit, stat) + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "tests failed!" + error stop 1 + end if + +end program fpm_testing diff --git a/fpm/test/test_config.f90 b/fpm/test/test_config.f90 new file mode 100644 index 0000000..ecdf0a5 --- /dev/null +++ b/fpm/test/test_config.f90 @@ -0,0 +1,188 @@ +!> Define tests for the `fpm_config` modules +module test_config + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_config + implicit none + private + + public :: collect_config + + +contains + + + !> Collect all exported unit tests + subroutine collect_config(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("valid-config", test_valid_config), & + & new_unittest("invalid-config", test_invalid_config, should_fail=.true.), & + & new_unittest("default-library", test_default_library), & + & new_unittest("default-executable", test_default_executable)] + + end subroutine collect_config + + + !> Try to read some unnecessary obscure and convoluted but not invalid package file + subroutine test_valid_config(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: config = 'fpm-valid-config.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=config, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[dependencies.fpm]', & + & 'git = "https://github.com/fortran-lang/fpm"', & + & '[[executable]]', & + & 'name = "example-#1" # comment', & + & 'source-dir = "prog"', & + & '[dependencies]', & + & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & + & '"toml..f" = { path = ".." }', & + & '[["executable"]]', & + & 'name = "example-#2"', & + & 'source-dir = "prog"', & + & '[executable.dependencies]', & + & '[''library'']', & + & 'source-dir = """', & + & 'lib""" # comment' + close(unit) + + call get_package_data(package, config, error) + + open(file=config, newunit=unit) + close(unit, status='delete') + + if (allocated(error)) return + + if (package%name /= "example") then + call test_failed(error, "Package name is "//package%name//" but should be example") + return + end if + + if (.not.allocated(package%library)) then + call test_failed(error, "library is not present in package data") + return + end if + + if (.not.allocated(package%executable)) then + call test_failed(error, "executable is not present in package data") + return + end if + + if (size(package%executable) /= 2) then + call test_failed(error, "Number of executables in package is not two") + return + end if + + if (.not.allocated(package%dependency)) then + call test_failed(error, "dependency is not present in package data") + return + end if + + if (size(package%dependency) /= 3) then + call test_failed(error, "Number of dependencies in package is not three") + return + end if + + if (allocated(package%test)) then + call test_failed(error, "test is present in package but not in package file") + return + end if + + end subroutine test_valid_config + + + !> Try to read a valid TOML document which represent an invalid package file + subroutine test_invalid_config(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: config = 'fpm-invalid-config.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=config, newunit=unit) + write(unit, '(a)') & + & '[package]', & + & 'name = "example"', & + & 'version = "0.1.0"' + close(unit) + + call get_package_data(package, config, error) + + open(file=config, newunit=unit) + close(unit, status='delete') + + end subroutine test_invalid_config + + + !> Create a default library + subroutine test_default_library(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + + allocate(package%library) + call default_library(package%library) + + if (.not.allocated(package%library%source_dir)) then + call test_failed(error, "Default library source-dir is not set") + return + end if + + if (package%library%source_dir /= "src") then + call test_failed(error, "Default library source-dir is "// & + & package%library%source_dir//" but should be src") + return + end if + + end subroutine test_default_library + + + !> Create a default executable + subroutine test_default_executable(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: name = "default" + + allocate(package%executable(1)) + call default_executable(package%executable(1), name) + + if (.not.allocated(package%executable(1)%source_dir)) then + call test_failed(error, "Default executable source-dir is not set") + return + end if + + if (package%executable(1)%source_dir /= "app") then + call test_failed(error, "Default executable source-dir is "// & + & package%executable(1)%source_dir//" but should be app") + return + end if + + if (package%executable(1)%name /= name) then + call test_failed(error, "Default executable name is "// & + & package%executable(1)%name//" but should be "//name) + return + end if + + end subroutine test_default_executable + + +end module test_config diff --git a/fpm/test/test_toml.f90 b/fpm/test/test_toml.f90 new file mode 100644 index 0000000..8d57150 --- /dev/null +++ b/fpm/test/test_toml.f90 @@ -0,0 +1,95 @@ +!> Define tests for the `fpm_toml` modules +module test_toml + use testsuite, only : new_unittest, unittest_t, error_t + use fpm_toml + implicit none + private + + public :: collect_toml + + +contains + + + !> Collect all exported unit tests + subroutine collect_toml(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("valid-toml", test_valid_toml), & + & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.)] + + end subroutine collect_toml + + + !> Try to read some unnecessary obscure and convoluted but not invalid package file + subroutine test_valid_toml(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + character(len=*), parameter :: config = 'fpm-valid-toml.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=config, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[dependencies.fpm]', & + & 'git = "https://github.com/fortran-lang/fpm"', & + & '[[executable]]', & + & 'name = "example-#1" # comment', & + & 'source-dir = "prog"', & + & '[dependencies]', & + & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & + & '"toml..f" = { path = ".." }', & + & '[["executable"]]', & + & 'name = "example-#2"', & + & 'source-dir = "prog"', & + & '[executable.dependencies]', & + & '[''library'']', & + & 'source-dir = """', & + & 'lib""" # comment' + close(unit) + + call read_package_file(table, config, error) + + open(file=config, newunit=unit) + close(unit, status='delete') + + end subroutine test_valid_toml + + + !> Try to read an invalid TOML document + subroutine test_invalid_toml(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + character(len=*), parameter :: config = 'fpm-invalid-toml.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=config, newunit=unit) + write(unit, '(a)') & + & '# INVALID TOML DOC', & + & 'name = "example"', & + & 'dependencies.fpm.git = "https://github.com/fortran-lang/fpm"', & + & '[dependencies]', & + & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & + & '"toml..f" = { path = ".." }' + close(unit) + + call read_package_file(table, config, error) + + open(file=config, newunit=unit) + close(unit, status='delete') + + end subroutine test_invalid_toml + + +end module test_toml diff --git a/fpm/test/testsuite.f90 b/fpm/test/testsuite.f90 new file mode 100644 index 0000000..bd0d415 --- /dev/null +++ b/fpm/test/testsuite.f90 @@ -0,0 +1,122 @@ +!> Define some procedures to automate collecting and launching of tests +module testsuite + use fpm_error, only : error_t, test_failed => fatal_error + implicit none + private + + public :: run_testsuite, new_unittest, test_failed + public :: unittest_t, error_t + + + abstract interface + !> Entry point for tests + subroutine test_interface(error) + import :: error_t + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + end subroutine test_interface + end interface + + + !> Declaration of a unit test + type :: unittest_t + + !> Name of the test + character(len=:), allocatable :: name + + !> Entry point of the test + procedure(test_interface), pointer, nopass :: test => null() + + !> Whether test is supposed to fail + logical :: should_fail = .false. + + end type unittest_t + + + abstract interface + !> Collect all tests + subroutine collect_interface(testsuite) + import :: unittest_t + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + end subroutine collect_interface + end interface + + +contains + + + !> Driver for testsuite + subroutine run_testsuite(collect, unit, stat) + + !> Collect tests + procedure(collect_interface) :: collect + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + integer, intent(out) :: stat + + type(unittest_t), allocatable :: testsuite(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + character(len=*), parameter :: indent = repeat(" ", 5) // repeat(".", 3) + type(error_t), allocatable :: error + integer :: ii + + stat = 0 + + call collect(testsuite) + + do ii = 1, size(testsuite) + write(unit, '("#", *(1x, a))') "Starting", testsuite(ii)%name, "..." + call testsuite(ii)%test(error) + if (allocated(error) .neqv. testsuite(ii)%should_fail) then + if (testsuite(ii)%should_fail) then + write(unit, fmt) indent, testsuite(ii)%name, "[UNEXPECTED PASS]" + else + write(unit, fmt) indent, testsuite(ii)%name, "[FAILED]" + end if + stat = stat + 1 + else + if (testsuite(ii)%should_fail) then + write(unit, fmt) indent, testsuite(ii)%name, "[EXPECTED FAIL]" + else + write(unit, fmt) indent, testsuite(ii)%name, "[PASSED]" + end if + end if + if (allocated(error)) then + write(unit, '(a)') error%message + end if + end do + + end subroutine run_testsuite + + + !> Register a new unit test + function new_unittest(name, test, should_fail) result(self) + + !> Name of the test + character(len=*), intent(in) :: name + + !> Entry point for the test + procedure(test_interface) :: test + + !> Whether test is supposed to error or not + logical, intent(in), optional :: should_fail + + !> Newly registered test + type(unittest_t) :: self + + self%name = name + self%test => test + if (present(should_fail)) self%should_fail = should_fail + + end function new_unittest + + +end module testsuite -- cgit v1.2.3 From fd77e6ba357390ec9a21506315b5578aaff513ce Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 3 Sep 2020 11:13:29 +0200 Subject: Rename config to manifest --- fpm/src/fpm.f90 | 2 +- fpm/src/fpm/config.f90 | 79 ----------- fpm/src/fpm/config/dependency.f90 | 241 -------------------------------- fpm/src/fpm/config/executable.f90 | 173 ----------------------- fpm/src/fpm/config/library.f90 | 126 ----------------- fpm/src/fpm/config/package.f90 | 270 ------------------------------------ fpm/src/fpm/config/test.f90 | 166 ---------------------- fpm/src/fpm/manifest.f90 | 79 +++++++++++ fpm/src/fpm/manifest/dependency.f90 | 241 ++++++++++++++++++++++++++++++++ fpm/src/fpm/manifest/executable.f90 | 173 +++++++++++++++++++++++ fpm/src/fpm/manifest/library.f90 | 126 +++++++++++++++++ fpm/src/fpm/manifest/package.f90 | 270 ++++++++++++++++++++++++++++++++++++ fpm/src/fpm/manifest/test.f90 | 166 ++++++++++++++++++++++ fpm/src/fpm/toml.f90 | 10 +- fpm/test/main.f90 | 6 +- fpm/test/test_config.f90 | 188 ------------------------- fpm/test/test_manifest.f90 | 188 +++++++++++++++++++++++++ fpm/test/test_toml.f90 | 16 +-- 18 files changed, 1260 insertions(+), 1260 deletions(-) delete mode 100644 fpm/src/fpm/config.f90 delete mode 100644 fpm/src/fpm/config/dependency.f90 delete mode 100644 fpm/src/fpm/config/executable.f90 delete mode 100644 fpm/src/fpm/config/library.f90 delete mode 100644 fpm/src/fpm/config/package.f90 delete mode 100644 fpm/src/fpm/config/test.f90 create mode 100644 fpm/src/fpm/manifest.f90 create mode 100644 fpm/src/fpm/manifest/dependency.f90 create mode 100644 fpm/src/fpm/manifest/executable.f90 create mode 100644 fpm/src/fpm/manifest/library.f90 create mode 100644 fpm/src/fpm/manifest/package.f90 create mode 100644 fpm/src/fpm/manifest/test.f90 delete mode 100644 fpm/test/test_config.f90 create mode 100644 fpm/test/test_manifest.f90 diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 5123436..9c8918b 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,6 +1,6 @@ module fpm use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_config, only : get_package_data, default_executable, default_library, & +use fpm_manifest, only : get_package_data, default_executable, default_library, & & package_t use fpm_error, only : error_t implicit none diff --git a/fpm/src/fpm/config.f90 b/fpm/src/fpm/config.f90 deleted file mode 100644 index 03ad768..0000000 --- a/fpm/src/fpm/config.f90 +++ /dev/null @@ -1,79 +0,0 @@ -!> Package configuration data. -! -! This module provides the necessary procedure to translate a TOML document -! to the corresponding Fortran type, while verifying it with respect to -! its schema. -! -! Additionally, the required data types for users of this module are reexported -! to hide the actual implementation details. -module fpm_config - use fpm_config_executable, only : executable_t - use fpm_config_library, only : library_t - use fpm_config_package, only : package_t, new_package - use fpm_error, only : error_t, fatal_error, file_not_found_error - use fpm_toml, only : toml_table, read_package_file - implicit none - private - - public :: get_package_data, default_executable, default_library - public :: package_t - - -contains - - - !> Populate library in case we find the default src directory - subroutine default_library(self) - - !> Instance of the library meta data - type(library_t), intent(out) :: self - - self%source_dir = "src" - - end subroutine default_library - - - !> Populate executable in case we find the default app directory - subroutine default_executable(self, name) - - !> Instance of the executable meta data - type(executable_t), intent(out) :: self - - !> Name of the package - character(len=*), intent(in) :: name - - self%name = name - self%source_dir = "app" - self%main = "main.f90" - - end subroutine default_executable - - - !> Obtain package meta data from a configuation file - subroutine get_package_data(package, file, error) - - !> Parsed package meta data - type(package_t), intent(out) :: package - - !> Name of the package configuration file - character(len=*), intent(in) :: file - - !> Error status of the operation - type(error_t), allocatable, intent(out) :: error - - type(toml_table), allocatable :: table - - call read_package_file(table, file, error) - if (allocated(error)) return - - if (.not.allocated(table)) then - call fatal_error(error, "Unclassified error while reading: '"//file//"'") - return - end if - - call new_package(package, table, error) - - end subroutine get_package_data - - -end module fpm_config diff --git a/fpm/src/fpm/config/dependency.f90 b/fpm/src/fpm/config/dependency.f90 deleted file mode 100644 index d98951f..0000000 --- a/fpm/src/fpm/config/dependency.f90 +++ /dev/null @@ -1,241 +0,0 @@ -!> Implementation of the meta data for dependencies. -! -! A dependency table can currently have the following fields -! -! ```toml -! [dependencies] -! "dep1" = { git = "url" } -! "dep2" = { git = "url", branch = "name" } -! "dep3" = { git = "url", tag = "name" } -! "dep4" = { git = "url", rev = "sha1" } -! "dep0" = { path = "path" } -! ``` -! -! To reduce the amount of boilerplate code this module provides two constructors -! for dependency types, one basic for an actual dependency (inline) table -! and another to collect all dependency objects from a dependencies table, -! which is handling the allocation of the objects and is forwarding the -! individual dependency tables to their respective constructors. -! The usual entry point should be the constructor for the super table. -! -! This objects contains a target to retrieve required `fpm` projects to -! build the target declaring the dependency. -! Resolving a dependency will result in obtaining a new package configuration -! data for the respective project. -module fpm_config_dependency - use fpm_error, only : error_t, syntax_error - use fpm_git, only : git_target_t, git_target_tag, git_target_branch, & - & git_target_revision, git_target_default - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value - implicit none - private - - public :: dependency_t, new_dependency, new_dependencies - - - !> Configuration meta data for a dependency - type :: dependency_t - - !> Name of the dependency - character(len=:), allocatable :: name - - !> Local target - character(len=:), allocatable :: path - - !> Git descriptor - type(git_target_t), allocatable :: git - - contains - - !> Print information on this instance - procedure :: info - - end type dependency_t - - -contains - - - !> Construct a new dependency configuration from a TOML data structure - subroutine new_dependency(self, table, error) - - !> Instance of the dependency configuration - type(dependency_t), intent(out) :: self - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - character(len=:), allocatable :: url, obj - - call check(table, error) - if (allocated(error)) return - - call table%get_key(self%name) - - call get_value(table, "path", url) - if (allocated(url)) then - call move_alloc(url, self%path) - else - call get_value(table, "git", url) - - call get_value(table, "tag", obj) - if (allocated(obj)) then - self%git = git_target_tag(url, obj) - end if - - if (.not.allocated(self%git)) then - call get_value(table, "branch", obj) - if (allocated(obj)) then - self%git = git_target_branch(url, obj) - end if - end if - - if (.not.allocated(self%git)) then - call get_value(table, "revision", obj) - if (allocated(obj)) then - self%git = git_target_revision(url, obj) - end if - end if - - if (.not.allocated(self%git)) then - self%git = git_target_default(url) - end if - - end if - - end subroutine new_dependency - - - !> Check local schema for allowed entries - subroutine check(table, error) - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - character(len=:), allocatable :: name - type(toml_key), allocatable :: list(:) - logical :: url_present, git_target_present - integer :: ikey - - url_present = .false. - git_target_present = .false. - - call table%get_key(name) - call table%get_keys(list) - - if (.not.allocated(list)) then - call syntax_error(error, "Dependency "//name//" does not provide sufficient entries") - return - end if - - do ikey = 1, size(list) - select case(list(ikey)%key) - case default - call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in dependency "//name) - exit - - case("git", "path") - if (url_present) then - call syntax_error(error, "Dependency "//name//" cannot have both git and path entries") - exit - end if - url_present = .true. - - case("branch", "rev", "tag") - if (git_target_present) then - call syntax_error(error, "Dependency "//name//" can only have one of branch, rev or tag present") - exit - end if - git_target_present = .true. - - end select - end do - if (allocated(error)) return - - if (.not.url_present .and. git_target_present) then - call syntax_error(error, "Dependency "//name//" uses a local path, therefore no git identifiers are allowed") - end if - - end subroutine check - - - !> Construct new dependency array from a TOML data structure - subroutine new_dependencies(deps, table, error) - - !> Instance of the dependency configuration - type(dependency_t), allocatable, intent(out) :: deps(:) - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - class(toml_table), pointer :: node - type(toml_key), allocatable :: list(:) - integer :: idep, stat - - call table%get_keys(list) - ! An empty table is okay - if (.not.allocated(list)) return - - allocate(deps(size(list))) - do idep = 1, size(list) - call get_value(table, list(idep)%key, node, stat=stat) - if (stat /= toml_stat%success) then - call syntax_error(error, "Dependency "//list(idep)%key//" must be a table entry") - exit - end if - call new_dependency(deps(idep), node, error) - if (allocated(error)) exit - end do - - end subroutine new_dependencies - - - !> Write information on instance - subroutine info(self, unit, verbosity) - - !> Instance of the dependency configuration - class(dependency_t), intent(in) :: self - - !> Unit for IO - integer, intent(in) :: unit - - !> Verbosity of the printout - integer, intent(in), optional :: verbosity - - integer :: pr - character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' - - if (present(verbosity)) then - pr = verbosity - else - pr = 1 - end if - - write(unit, fmt) "Dependency" - if (allocated(self%name)) then - write(unit, fmt) "- name", self%name - end if - - if (allocated(self%git)) then - write(unit, fmt) "- kind", "git" - call self%git%info(unit, pr - 1) - end if - - if (allocated(self%path)) then - write(unit, fmt) "- kind", "local" - write(unit, fmt) "- path", self%path - end if - - end subroutine info - - -end module fpm_config_dependency diff --git a/fpm/src/fpm/config/executable.f90 b/fpm/src/fpm/config/executable.f90 deleted file mode 100644 index f5078eb..0000000 --- a/fpm/src/fpm/config/executable.f90 +++ /dev/null @@ -1,173 +0,0 @@ -!> Implementation of the meta data for an executables. -! -! An executable table can currently have the following fields -! -! ```toml -! [[executable]] -! name = "string" -! source-dir = "path" -! main = "file" -! [executable.dependencies] -! ``` -module fpm_config_executable - use fpm_config_dependency, only : dependency_t, new_dependencies - use fpm_error, only : error_t, syntax_error - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value - implicit none - private - - public :: executable_t, new_executable - - - !> Configuation meta data for an executable - type :: executable_t - - !> Name of the resulting executable - character(len=:), allocatable :: name - - !> Source directory for collecting the executable - character(len=:), allocatable :: source_dir - - !> Name of the source file declaring the main program - character(len=:), allocatable :: main - - !> Dependency meta data for this executable - type(dependency_t), allocatable :: dependency(:) - - contains - - !> Print information on this instance - procedure :: info - - end type executable_t - - -contains - - - !> Construct a new executable configuration from a TOML data structure - subroutine new_executable(self, table, error) - - !> Instance of the executable configuration - type(executable_t), intent(out) :: self - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - class(toml_table), pointer :: child - - call check(table, error) - if (allocated(error)) return - - call get_value(table, "name", self%name) - call get_value(table, "source-dir", self%source_dir, "app") - call get_value(table, "main", self%main, "main.f90") - - call get_value(table, "dependencies", child, requested=.false.) - if (associated(child)) then - call new_dependencies(self%dependency, child, error) - if (allocated(error)) return - end if - - end subroutine new_executable - - - !> Check local schema for allowed entries - subroutine check(table, error) - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_key), allocatable :: list(:) - logical :: name_present - integer :: ikey - - name_present = .false. - - call table%get_keys(list) - - if (.not.allocated(list)) then - call syntax_error(error, "Executable section does not provide sufficient entries") - return - end if - - do ikey = 1, size(list) - select case(list(ikey)%key) - case default - call syntax_error(error, "Key "//list(ikey)%key//" is not allowed executable entry") - exit - - case("name") - name_present = .true. - - case("source-dir", "main", "dependencies") - continue - - end select - end do - - if (.not.name_present) then - call syntax_error(error, "Executable name is not provided, please add a name entry") - end if - - end subroutine check - - - !> Write information on instance - subroutine info(self, unit, verbosity) - - !> Instance of the executable configuration - class(executable_t), intent(in) :: self - - !> Unit for IO - integer, intent(in) :: unit - - !> Verbosity of the printout - integer, intent(in), optional :: verbosity - - integer :: pr, ii - character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & - & fmti = '("#", 1x, a, t30, i0)' - - if (present(verbosity)) then - pr = verbosity - else - pr = 1 - end if - - if (pr < 1) return - - write(unit, fmt) "Executable target" - if (allocated(self%name)) then - write(unit, fmt) "- name", self%name - end if - if (allocated(self%source_dir)) then - if (self%source_dir /= "app" .or. pr > 2) then - write(unit, fmt) "- source directory", self%source_dir - end if - end if - if (allocated(self%main)) then - if (self%main /= "main.f90" .or. pr > 2) then - write(unit, fmt) "- program source", self%main - end if - end if - - if (allocated(self%dependency)) then - if (size(self%dependency) > 1 .or. pr > 2) then - write(unit, fmti) "- dependencies", size(self%dependency) - end if - do ii = 1, size(self%dependency) - call self%dependency(ii)%info(unit, pr - 1) - end do - end if - - end subroutine info - - -end module fpm_config_executable diff --git a/fpm/src/fpm/config/library.f90 b/fpm/src/fpm/config/library.f90 deleted file mode 100644 index 0650051..0000000 --- a/fpm/src/fpm/config/library.f90 +++ /dev/null @@ -1,126 +0,0 @@ -!> Implementation of the meta data for libraries. -! -! A library table can currently have the following fields -! -! ```toml -! [library] -! source-dir = "path" -! build-script = "file" -! ``` -module fpm_config_library - use fpm_error, only : error_t, syntax_error - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value - implicit none - private - - public :: library_t, new_library - - - !> Configuration meta data for a library - type :: library_t - - !> Source path prefix - character(len=:), allocatable :: source_dir - - !> Alternative build script to be invoked - character(len=:), allocatable :: build_script - - contains - - !> Print information on this instance - procedure :: info - - end type library_t - - -contains - - - !> Construct a new library configuration from a TOML data structure - subroutine new_library(self, table, error) - - !> Instance of the library configuration - type(library_t), intent(out) :: self - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - call check(table, error) - if (allocated(error)) return - - call get_value(table, "source-dir", self%source_dir, "src") - call get_value(table, "build-script", self%build_script) - - end subroutine new_library - - - !> Check local schema for allowed entries - subroutine check(table, error) - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_key), allocatable :: list(:) - integer :: ikey - - call table%get_keys(list) - - ! table can be empty - if (.not.allocated(list)) return - - do ikey = 1, size(list) - select case(list(ikey)%key) - case default - call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file") - exit - - case("source-dir", "build-script") - continue - - end select - end do - - end subroutine check - - - !> Write information on instance - subroutine info(self, unit, verbosity) - - !> Instance of the library configuration - class(library_t), intent(in) :: self - - !> Unit for IO - integer, intent(in) :: unit - - !> Verbosity of the printout - integer, intent(in), optional :: verbosity - - integer :: pr - character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' - - if (present(verbosity)) then - pr = verbosity - else - pr = 1 - end if - - if (pr < 1) return - - write(unit, fmt) "Library target" - if (allocated(self%source_dir)) then - write(unit, fmt) "- source directory", self%source_dir - end if - if (allocated(self%build_script)) then - write(unit, fmt) "- custom build", self%build_script - end if - - end subroutine info - - -end module fpm_config_library diff --git a/fpm/src/fpm/config/package.f90 b/fpm/src/fpm/config/package.f90 deleted file mode 100644 index 66f275d..0000000 --- a/fpm/src/fpm/config/package.f90 +++ /dev/null @@ -1,270 +0,0 @@ -!> Define the package data containing the meta data from the configuration file. -! -! The package data defines a Fortran type corresponding to the respective -! TOML document, after creating it from a package file no more interaction -! with the TOML document is required. -! -! Every configuration type provides it custom constructor (prefixed with `new_`) -! and knows how to deserialize itself from a TOML document. -! To ensure we find no untracked content in the package file all keywords are -! checked and possible entries have to be explicitly allowed in the `check` -! function. -! If entries are mutally exclusive or interdependent inside the current table -! the `check` function is required to enforce this schema on the data structure. -! -! The package file root allows the following keywords -! -! ```toml -! name = "string" -! version = "string" -! license = "string" -! author = "string" -! maintainer = "string" -! copyright = "string -! [library] -! [dependencies] -! [dev-dependencies] -! [[executable]] -! [[test]] -! ``` -module fpm_config_package - use fpm_config_dependency, only : dependency_t, new_dependencies - use fpm_config_executable, only : executable_t, new_executable - use fpm_config_library, only : library_t, new_library - use fpm_config_test, only : test_t, new_test - use fpm_error, only : error_t, fatal_error, syntax_error - use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, & - & len - implicit none - private - - public :: package_t, new_package - - - !> Package meta data - type :: package_t - - !> Name of the package - character(len=:), allocatable :: name - - !> Library meta data - type(library_t), allocatable :: library - - !> Executable meta data - type(executable_t), allocatable :: executable(:) - - !> Dependency meta data - type(dependency_t), allocatable :: dependency(:) - - !> Development dependency meta data - type(dependency_t), allocatable :: dev_dependency(:) - - !> Test meta data - type(test_t), allocatable :: test(:) - - contains - - !> Print information on this instance - procedure :: info - - end type package_t - - -contains - - - !> Construct a new package configuration from a TOML data structure - subroutine new_package(self, table, error) - - !> Instance of the package configuration - type(package_t), intent(out) :: self - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - class(toml_table), pointer :: child, node - class(toml_array), pointer :: children - integer :: ii, nn, stat - - call check(table, error) - if (allocated(error)) return - - call get_value(table, "name", self%name) - - call get_value(table, "dependencies", child, requested=.false.) - if (associated(child)) then - call new_dependencies(self%dependency, child, error) - if (allocated(error)) return - end if - - call get_value(table, "dev-dependencies", child, requested=.false.) - if (associated(child)) then - call new_dependencies(self%dev_dependency, child, error) - if (allocated(error)) return - end if - - call get_value(table, "library", child, requested=.false.) - if (associated(child)) then - allocate(self%library) - call new_library(self%library, child, error) - end if - - call get_value(table, "executable", children, requested=.false.) - if (associated(children)) then - nn = len(children) - allocate(self%executable(nn)) - do ii = 1, nn - call get_value(children, ii, node, stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Could not retrieve executable from array entry") - exit - end if - call new_executable(self%executable(ii), node, error) - if (allocated(error)) exit - end do - end if - - call get_value(table, "test", children, requested=.false.) - if (associated(children)) then - nn = len(children) - allocate(self%test(nn)) - do ii = 1, nn - call get_value(children, ii, node, stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Could not retrieve test from array entry") - exit - end if - call new_test(self%test(ii), node, error) - if (allocated(error)) exit - end do - end if - - end subroutine new_package - - - !> Check local schema for allowed entries - subroutine check(table, error) - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - character(len=:), allocatable :: name - type(toml_key), allocatable :: list(:) - logical :: name_present - integer :: ikey - - name_present = .false. - - call table%get_key(name) - call table%get_keys(list) - - if (.not.allocated(list)) then - call syntax_error(error, "Package file is empty") - return - end if - - do ikey = 1, size(list) - select case(list(ikey)%key) - case default - call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file") - exit - - case("name") - name_present = .true. - - case("version", "license", "author", "maintainer", "copyright", & - & "dependencies", "dev-dependencies", "test", "executable", & - & "library") - continue - - end select - end do - if (allocated(error)) return - - if (.not.name_present) then - call syntax_error(error, "Package name is not provided, please add a name entry") - end if - - end subroutine check - - - !> Write information on instance - subroutine info(self, unit, verbosity) - - !> Instance of the package configuration - class(package_t), intent(in) :: self - - !> Unit for IO - integer, intent(in) :: unit - - !> Verbosity of the printout - integer, intent(in), optional :: verbosity - - integer :: pr, ii - character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & - & fmti = '("#", 1x, a, t30, i0)' - - if (present(verbosity)) then - pr = verbosity - else - pr = 1 - end if - - if (pr < 1) return - - write(unit, fmt) "Package" - if (allocated(self%name)) then - write(unit, fmt) "- name", self%name - end if - - if (allocated(self%library)) then - write(unit, fmt) "- target", "archive" - call self%library%info(unit, pr - 1) - end if - - if (allocated(self%executable)) then - if (size(self%executable) > 1 .or. pr > 2) then - write(unit, fmti) "- executables", size(self%executable) - end if - do ii = 1, size(self%executable) - call self%executable(ii)%info(unit, pr - 1) - end do - end if - - if (allocated(self%dependency)) then - if (size(self%dependency) > 1 .or. pr > 2) then - write(unit, fmti) "- dependencies", size(self%dependency) - end if - do ii = 1, size(self%dependency) - call self%dependency(ii)%info(unit, pr - 1) - end do - end if - - if (allocated(self%test)) then - if (size(self%test) > 1 .or. pr > 2) then - write(unit, fmti) "- tests", size(self%test) - end if - do ii = 1, size(self%test) - call self%test(ii)%info(unit, pr - 1) - end do - end if - - if (allocated(self%dev_dependency)) then - if (size(self%dev_dependency) > 1 .or. pr > 2) then - write(unit, fmti) "- development deps.", size(self%dev_dependency) - end if - do ii = 1, size(self%dev_dependency) - call self%dev_dependency(ii)%info(unit, pr - 1) - end do - end if - - end subroutine info - - -end module fpm_config_package diff --git a/fpm/src/fpm/config/test.f90 b/fpm/src/fpm/config/test.f90 deleted file mode 100644 index 5c6c9f3..0000000 --- a/fpm/src/fpm/config/test.f90 +++ /dev/null @@ -1,166 +0,0 @@ -!> Implementation of the meta data for a test. -! -! The test data structure is effectively a decorated version of an executable -! and shares most of its properties, except for the defaults and can be -! handled under most circumstances just like any other executable. -! -! A test table can currently have the following fields -! -! ```toml -! [[test]] -! name = "string" -! source-dir = "path" -! main = "file" -! [test.dependencies] -! ``` -module fpm_config_test - use fpm_config_dependency, only : dependency_t, new_dependencies - use fpm_config_executable, only : executable_t - use fpm_error, only : error_t, syntax_error - use fpm_toml, only : toml_table, toml_key, toml_stat, get_value - implicit none - private - - public :: test_t, new_test - - - !> Configuation meta data for an test - type, extends(executable_t) :: test_t - - contains - - !> Print information on this instance - procedure :: info - - end type test_t - - -contains - - - !> Construct a new test configuration from a TOML data structure - subroutine new_test(self, table, error) - - !> Instance of the test configuration - type(test_t), intent(out) :: self - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - class(toml_table), pointer :: child - - call check(table, error) - if (allocated(error)) return - - call get_value(table, "name", self%name) - call get_value(table, "source-dir", self%source_dir, "test") - call get_value(table, "main", self%main, "main.f90") - - call get_value(table, "dependencies", child, requested=.false.) - if (associated(child)) then - call new_dependencies(self%dependency, child, error) - if (allocated(error)) return - end if - - end subroutine new_test - - - !> Check local schema for allowed entries - subroutine check(table, error) - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_key), allocatable :: list(:) - logical :: name_present - integer :: ikey - - name_present = .false. - - call table%get_keys(list) - - if (.not.allocated(list)) then - call syntax_error(error, "Executable section does not provide sufficient entries") - return - end if - - do ikey = 1, size(list) - select case(list(ikey)%key) - case default - call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in test entry") - exit - - case("name") - name_present = .true. - - case("source-dir", "main", "dependencies") - continue - - end select - end do - - if (.not.name_present) then - call syntax_error(error, "Executable name is not provided, please add a name entry") - end if - - end subroutine check - - - !> Write information on instance - subroutine info(self, unit, verbosity) - - !> Instance of the test configuration - class(test_t), intent(in) :: self - - !> Unit for IO - integer, intent(in) :: unit - - !> Verbosity of the printout - integer, intent(in), optional :: verbosity - - integer :: pr, ii - character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & - & fmti = '("#", 1x, a, t30, i0)' - - if (present(verbosity)) then - pr = verbosity - else - pr = 1 - end if - - if (pr < 1) return - - write(unit, fmt) "Test target" - if (allocated(self%name)) then - write(unit, fmt) "- name", self%name - end if - if (allocated(self%source_dir)) then - if (self%source_dir /= "test" .or. pr > 2) then - write(unit, fmt) "- source directory", self%source_dir - end if - end if - if (allocated(self%main)) then - if (self%main /= "main.f90" .or. pr > 2) then - write(unit, fmt) "- test source", self%main - end if - end if - - if (allocated(self%dependency)) then - if (size(self%dependency) > 1 .or. pr > 2) then - write(unit, fmti) "- dependencies", size(self%dependency) - end if - do ii = 1, size(self%dependency) - call self%dependency(ii)%info(unit, pr - 1) - end do - end if - - end subroutine info - - -end module fpm_config_test diff --git a/fpm/src/fpm/manifest.f90 b/fpm/src/fpm/manifest.f90 new file mode 100644 index 0000000..af4e0fa --- /dev/null +++ b/fpm/src/fpm/manifest.f90 @@ -0,0 +1,79 @@ +!> Package configuration data. +! +! This module provides the necessary procedure to translate a TOML document +! to the corresponding Fortran type, while verifying it with respect to +! its schema. +! +! Additionally, the required data types for users of this module are reexported +! to hide the actual implementation details. +module fpm_manifest + use fpm_manifest_executable, only : executable_t + use fpm_manifest_library, only : library_t + use fpm_manifest_package, only : package_t, new_package + use fpm_error, only : error_t, fatal_error, file_not_found_error + use fpm_toml, only : toml_table, read_package_file + implicit none + private + + public :: get_package_data, default_executable, default_library + public :: package_t + + +contains + + + !> Populate library in case we find the default src directory + subroutine default_library(self) + + !> Instance of the library meta data + type(library_t), intent(out) :: self + + self%source_dir = "src" + + end subroutine default_library + + + !> Populate executable in case we find the default app directory + subroutine default_executable(self, name) + + !> Instance of the executable meta data + type(executable_t), intent(out) :: self + + !> Name of the package + character(len=*), intent(in) :: name + + self%name = name + self%source_dir = "app" + self%main = "main.f90" + + end subroutine default_executable + + + !> Obtain package meta data from a configuation file + subroutine get_package_data(package, file, error) + + !> Parsed package meta data + type(package_t), intent(out) :: package + + !> Name of the package configuration file + character(len=*), intent(in) :: file + + !> Error status of the operation + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + + call read_package_file(table, file, error) + if (allocated(error)) return + + if (.not.allocated(table)) then + call fatal_error(error, "Unclassified error while reading: '"//file//"'") + return + end if + + call new_package(package, table, error) + + end subroutine get_package_data + + +end module fpm_manifest diff --git a/fpm/src/fpm/manifest/dependency.f90 b/fpm/src/fpm/manifest/dependency.f90 new file mode 100644 index 0000000..1ee61b7 --- /dev/null +++ b/fpm/src/fpm/manifest/dependency.f90 @@ -0,0 +1,241 @@ +!> Implementation of the meta data for dependencies. +! +! A dependency table can currently have the following fields +! +! ```toml +! [dependencies] +! "dep1" = { git = "url" } +! "dep2" = { git = "url", branch = "name" } +! "dep3" = { git = "url", tag = "name" } +! "dep4" = { git = "url", rev = "sha1" } +! "dep0" = { path = "path" } +! ``` +! +! To reduce the amount of boilerplate code this module provides two constructors +! for dependency types, one basic for an actual dependency (inline) table +! and another to collect all dependency objects from a dependencies table, +! which is handling the allocation of the objects and is forwarding the +! individual dependency tables to their respective constructors. +! The usual entry point should be the constructor for the super table. +! +! This objects contains a target to retrieve required `fpm` projects to +! build the target declaring the dependency. +! Resolving a dependency will result in obtaining a new package configuration +! data for the respective project. +module fpm_manifest_dependency + use fpm_error, only : error_t, syntax_error + use fpm_git, only : git_target_t, git_target_tag, git_target_branch, & + & git_target_revision, git_target_default + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: dependency_t, new_dependency, new_dependencies + + + !> Configuration meta data for a dependency + type :: dependency_t + + !> Name of the dependency + character(len=:), allocatable :: name + + !> Local target + character(len=:), allocatable :: path + + !> Git descriptor + type(git_target_t), allocatable :: git + + contains + + !> Print information on this instance + procedure :: info + + end type dependency_t + + +contains + + + !> Construct a new dependency configuration from a TOML data structure + subroutine new_dependency(self, table, error) + + !> Instance of the dependency configuration + type(dependency_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: url, obj + + call check(table, error) + if (allocated(error)) return + + call table%get_key(self%name) + + call get_value(table, "path", url) + if (allocated(url)) then + call move_alloc(url, self%path) + else + call get_value(table, "git", url) + + call get_value(table, "tag", obj) + if (allocated(obj)) then + self%git = git_target_tag(url, obj) + end if + + if (.not.allocated(self%git)) then + call get_value(table, "branch", obj) + if (allocated(obj)) then + self%git = git_target_branch(url, obj) + end if + end if + + if (.not.allocated(self%git)) then + call get_value(table, "revision", obj) + if (allocated(obj)) then + self%git = git_target_revision(url, obj) + end if + end if + + if (.not.allocated(self%git)) then + self%git = git_target_default(url) + end if + + end if + + end subroutine new_dependency + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: name + type(toml_key), allocatable :: list(:) + logical :: url_present, git_target_present + integer :: ikey + + url_present = .false. + git_target_present = .false. + + call table%get_key(name) + call table%get_keys(list) + + if (.not.allocated(list)) then + call syntax_error(error, "Dependency "//name//" does not provide sufficient entries") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in dependency "//name) + exit + + case("git", "path") + if (url_present) then + call syntax_error(error, "Dependency "//name//" cannot have both git and path entries") + exit + end if + url_present = .true. + + case("branch", "rev", "tag") + if (git_target_present) then + call syntax_error(error, "Dependency "//name//" can only have one of branch, rev or tag present") + exit + end if + git_target_present = .true. + + end select + end do + if (allocated(error)) return + + if (.not.url_present .and. git_target_present) then + call syntax_error(error, "Dependency "//name//" uses a local path, therefore no git identifiers are allowed") + end if + + end subroutine check + + + !> Construct new dependency array from a TOML data structure + subroutine new_dependencies(deps, table, error) + + !> Instance of the dependency configuration + type(dependency_t), allocatable, intent(out) :: deps(:) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: node + type(toml_key), allocatable :: list(:) + integer :: idep, stat + + call table%get_keys(list) + ! An empty table is okay + if (.not.allocated(list)) return + + allocate(deps(size(list))) + do idep = 1, size(list) + call get_value(table, list(idep)%key, node, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Dependency "//list(idep)%key//" must be a table entry") + exit + end if + call new_dependency(deps(idep), node, error) + if (allocated(error)) exit + end do + + end subroutine new_dependencies + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the dependency configuration + class(dependency_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + write(unit, fmt) "Dependency" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + + if (allocated(self%git)) then + write(unit, fmt) "- kind", "git" + call self%git%info(unit, pr - 1) + end if + + if (allocated(self%path)) then + write(unit, fmt) "- kind", "local" + write(unit, fmt) "- path", self%path + end if + + end subroutine info + + +end module fpm_manifest_dependency diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90 new file mode 100644 index 0000000..704396a --- /dev/null +++ b/fpm/src/fpm/manifest/executable.f90 @@ -0,0 +1,173 @@ +!> Implementation of the meta data for an executables. +! +! An executable table can currently have the following fields +! +! ```toml +! [[executable]] +! name = "string" +! source-dir = "path" +! main = "file" +! [executable.dependencies] +! ``` +module fpm_manifest_executable + use fpm_manifest_dependency, only : dependency_t, new_dependencies + use fpm_error, only : error_t, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: executable_t, new_executable + + + !> Configuation meta data for an executable + type :: executable_t + + !> Name of the resulting executable + character(len=:), allocatable :: name + + !> Source directory for collecting the executable + character(len=:), allocatable :: source_dir + + !> Name of the source file declaring the main program + character(len=:), allocatable :: main + + !> Dependency meta data for this executable + type(dependency_t), allocatable :: dependency(:) + + contains + + !> Print information on this instance + procedure :: info + + end type executable_t + + +contains + + + !> Construct a new executable configuration from a TOML data structure + subroutine new_executable(self, table, error) + + !> Instance of the executable configuration + type(executable_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: child + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "name", self%name) + call get_value(table, "source-dir", self%source_dir, "app") + call get_value(table, "main", self%main, "main.f90") + + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, error) + if (allocated(error)) return + end if + + end subroutine new_executable + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_keys(list) + + if (.not.allocated(list)) then + call syntax_error(error, "Executable section does not provide sufficient entries") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed executable entry") + exit + + case("name") + name_present = .true. + + case("source-dir", "main", "dependencies") + continue + + end select + end do + + if (.not.name_present) then + call syntax_error(error, "Executable name is not provided, please add a name entry") + end if + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the executable configuration + class(executable_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Executable target" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + if (allocated(self%source_dir)) then + if (self%source_dir /= "app" .or. pr > 2) then + write(unit, fmt) "- source directory", self%source_dir + end if + end if + if (allocated(self%main)) then + if (self%main /= "main.f90" .or. pr > 2) then + write(unit, fmt) "- program source", self%main + end if + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + +end module fpm_manifest_executable diff --git a/fpm/src/fpm/manifest/library.f90 b/fpm/src/fpm/manifest/library.f90 new file mode 100644 index 0000000..a297c2f --- /dev/null +++ b/fpm/src/fpm/manifest/library.f90 @@ -0,0 +1,126 @@ +!> Implementation of the meta data for libraries. +! +! A library table can currently have the following fields +! +! ```toml +! [library] +! source-dir = "path" +! build-script = "file" +! ``` +module fpm_manifest_library + use fpm_error, only : error_t, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: library_t, new_library + + + !> Configuration meta data for a library + type :: library_t + + !> Source path prefix + character(len=:), allocatable :: source_dir + + !> Alternative build script to be invoked + character(len=:), allocatable :: build_script + + contains + + !> Print information on this instance + procedure :: info + + end type library_t + + +contains + + + !> Construct a new library configuration from a TOML data structure + subroutine new_library(self, table, error) + + !> Instance of the library configuration + type(library_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "source-dir", self%source_dir, "src") + call get_value(table, "build-script", self%build_script) + + end subroutine new_library + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + integer :: ikey + + call table%get_keys(list) + + ! table can be empty + if (.not.allocated(list)) return + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file") + exit + + case("source-dir", "build-script") + continue + + end select + end do + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the library configuration + class(library_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Library target" + if (allocated(self%source_dir)) then + write(unit, fmt) "- source directory", self%source_dir + end if + if (allocated(self%build_script)) then + write(unit, fmt) "- custom build", self%build_script + end if + + end subroutine info + + +end module fpm_manifest_library diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 new file mode 100644 index 0000000..f318ad7 --- /dev/null +++ b/fpm/src/fpm/manifest/package.f90 @@ -0,0 +1,270 @@ +!> Define the package data containing the meta data from the configuration file. +! +! The package data defines a Fortran type corresponding to the respective +! TOML document, after creating it from a package file no more interaction +! with the TOML document is required. +! +! Every configuration type provides it custom constructor (prefixed with `new_`) +! and knows how to deserialize itself from a TOML document. +! To ensure we find no untracked content in the package file all keywords are +! checked and possible entries have to be explicitly allowed in the `check` +! function. +! If entries are mutally exclusive or interdependent inside the current table +! the `check` function is required to enforce this schema on the data structure. +! +! The package file root allows the following keywords +! +! ```toml +! name = "string" +! version = "string" +! license = "string" +! author = "string" +! maintainer = "string" +! copyright = "string +! [library] +! [dependencies] +! [dev-dependencies] +! [[executable]] +! [[test]] +! ``` +module fpm_manifest_package + use fpm_manifest_dependency, only : dependency_t, new_dependencies + use fpm_manifest_executable, only : executable_t, new_executable + use fpm_manifest_library, only : library_t, new_library + use fpm_manifest_test, only : test_t, new_test + use fpm_error, only : error_t, fatal_error, syntax_error + use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, & + & len + implicit none + private + + public :: package_t, new_package + + + !> Package meta data + type :: package_t + + !> Name of the package + character(len=:), allocatable :: name + + !> Library meta data + type(library_t), allocatable :: library + + !> Executable meta data + type(executable_t), allocatable :: executable(:) + + !> Dependency meta data + type(dependency_t), allocatable :: dependency(:) + + !> Development dependency meta data + type(dependency_t), allocatable :: dev_dependency(:) + + !> Test meta data + type(test_t), allocatable :: test(:) + + contains + + !> Print information on this instance + procedure :: info + + end type package_t + + +contains + + + !> Construct a new package configuration from a TOML data structure + subroutine new_package(self, table, error) + + !> Instance of the package configuration + type(package_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: child, node + class(toml_array), pointer :: children + integer :: ii, nn, stat + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "name", self%name) + + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, error) + if (allocated(error)) return + end if + + call get_value(table, "dev-dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dev_dependency, child, error) + if (allocated(error)) return + end if + + call get_value(table, "library", child, requested=.false.) + if (associated(child)) then + allocate(self%library) + call new_library(self%library, child, error) + end if + + call get_value(table, "executable", children, requested=.false.) + if (associated(children)) then + nn = len(children) + allocate(self%executable(nn)) + do ii = 1, nn + call get_value(children, ii, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve executable from array entry") + exit + end if + call new_executable(self%executable(ii), node, error) + if (allocated(error)) exit + end do + end if + + call get_value(table, "test", children, requested=.false.) + if (associated(children)) then + nn = len(children) + allocate(self%test(nn)) + do ii = 1, nn + call get_value(children, ii, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve test from array entry") + exit + end if + call new_test(self%test(ii), node, error) + if (allocated(error)) exit + end do + end if + + end subroutine new_package + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: name + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_key(name) + call table%get_keys(list) + + if (.not.allocated(list)) then + call syntax_error(error, "Package file is empty") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in package file") + exit + + case("name") + name_present = .true. + + case("version", "license", "author", "maintainer", "copyright", & + & "dependencies", "dev-dependencies", "test", "executable", & + & "library") + continue + + end select + end do + if (allocated(error)) return + + if (.not.name_present) then + call syntax_error(error, "Package name is not provided, please add a name entry") + end if + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the package configuration + class(package_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Package" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + + if (allocated(self%library)) then + write(unit, fmt) "- target", "archive" + call self%library%info(unit, pr - 1) + end if + + if (allocated(self%executable)) then + if (size(self%executable) > 1 .or. pr > 2) then + write(unit, fmti) "- executables", size(self%executable) + end if + do ii = 1, size(self%executable) + call self%executable(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%test)) then + if (size(self%test) > 1 .or. pr > 2) then + write(unit, fmti) "- tests", size(self%test) + end if + do ii = 1, size(self%test) + call self%test(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%dev_dependency)) then + if (size(self%dev_dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- development deps.", size(self%dev_dependency) + end if + do ii = 1, size(self%dev_dependency) + call self%dev_dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + +end module fpm_manifest_package diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90 new file mode 100644 index 0000000..9b50315 --- /dev/null +++ b/fpm/src/fpm/manifest/test.f90 @@ -0,0 +1,166 @@ +!> Implementation of the meta data for a test. +! +! The test data structure is effectively a decorated version of an executable +! and shares most of its properties, except for the defaults and can be +! handled under most circumstances just like any other executable. +! +! A test table can currently have the following fields +! +! ```toml +! [[test]] +! name = "string" +! source-dir = "path" +! main = "file" +! [test.dependencies] +! ``` +module fpm_manifest_test + use fpm_manifest_dependency, only : dependency_t, new_dependencies + use fpm_manifest_executable, only : executable_t + use fpm_error, only : error_t, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: test_t, new_test + + + !> Configuation meta data for an test + type, extends(executable_t) :: test_t + + contains + + !> Print information on this instance + procedure :: info + + end type test_t + + +contains + + + !> Construct a new test configuration from a TOML data structure + subroutine new_test(self, table, error) + + !> Instance of the test configuration + type(test_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + class(toml_table), pointer :: child + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "name", self%name) + call get_value(table, "source-dir", self%source_dir, "test") + call get_value(table, "main", self%main, "main.f90") + + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, error) + if (allocated(error)) return + end if + + end subroutine new_test + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + logical :: name_present + integer :: ikey + + name_present = .false. + + call table%get_keys(list) + + if (.not.allocated(list)) then + call syntax_error(error, "Executable section does not provide sufficient entries") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in test entry") + exit + + case("name") + name_present = .true. + + case("source-dir", "main", "dependencies") + continue + + end select + end do + + if (.not.name_present) then + call syntax_error(error, "Executable name is not provided, please add a name entry") + end if + + end subroutine check + + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the test configuration + class(test_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Test target" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + if (allocated(self%source_dir)) then + if (self%source_dir /= "test" .or. pr > 2) then + write(unit, fmt) "- source directory", self%source_dir + end if + end if + if (allocated(self%main)) then + if (self%main /= "main.f90" .or. pr > 2) then + write(unit, fmt) "- test source", self%main + end if + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + +end module fpm_manifest_test diff --git a/fpm/src/fpm/toml.f90 b/fpm/src/fpm/toml.f90 index d847c69..d95a093 100644 --- a/fpm/src/fpm/toml.f90 +++ b/fpm/src/fpm/toml.f90 @@ -27,13 +27,13 @@ contains !> Process the configuration file to a TOML data structure - subroutine read_package_file(table, config, error) + subroutine read_package_file(table, manifest, error) !> TOML data structure type(toml_table), allocatable, intent(out) :: table !> Name of the package configuration file - character(len=*), intent(in) :: config + character(len=*), intent(in) :: manifest !> Error status of the operation type(error_t), allocatable, intent(out) :: error @@ -42,14 +42,14 @@ contains integer :: unit logical :: exist - inquire(file=config, exist=exist) + inquire(file=manifest, exist=exist) if (.not.exist) then - call file_not_found_error(error, config) + call file_not_found_error(error, manifest) return end if - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) call toml_parse(table, unit, parse_error) close(unit) diff --git a/fpm/test/main.f90 b/fpm/test/main.f90 index c4bfee5..19bcdb6 100644 --- a/fpm/test/main.f90 +++ b/fpm/test/main.f90 @@ -3,7 +3,7 @@ program fpm_testing use, intrinsic :: iso_fortran_env, only : error_unit use testsuite, only : run_testsuite use test_toml, only : collect_toml - use test_config, only : collect_config + use test_manifest, only : collect_manifest implicit none integer :: stat character(len=*), parameter :: fmt = '("#", *(1x, a))' @@ -16,8 +16,8 @@ program fpm_testing error stop 1 end if - write(error_unit, fmt) "Testing:", "fpm_config" - call run_testsuite(collect_config, error_unit, stat) + write(error_unit, fmt) "Testing:", "fpm_manifest" + call run_testsuite(collect_manifest, error_unit, stat) if (stat > 0) then write(error_unit, '(i0, 1x, a)') stat, "tests failed!" diff --git a/fpm/test/test_config.f90 b/fpm/test/test_config.f90 deleted file mode 100644 index ecdf0a5..0000000 --- a/fpm/test/test_config.f90 +++ /dev/null @@ -1,188 +0,0 @@ -!> Define tests for the `fpm_config` modules -module test_config - use testsuite, only : new_unittest, unittest_t, error_t, test_failed - use fpm_config - implicit none - private - - public :: collect_config - - -contains - - - !> Collect all exported unit tests - subroutine collect_config(testsuite) - - !> Collection of tests - type(unittest_t), allocatable, intent(out) :: testsuite(:) - - testsuite = [ & - & new_unittest("valid-config", test_valid_config), & - & new_unittest("invalid-config", test_invalid_config, should_fail=.true.), & - & new_unittest("default-library", test_default_library), & - & new_unittest("default-executable", test_default_executable)] - - end subroutine collect_config - - - !> Try to read some unnecessary obscure and convoluted but not invalid package file - subroutine test_valid_config(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(package_t) :: package - character(len=*), parameter :: config = 'fpm-valid-config.toml' - character(len=:), allocatable :: string - integer :: unit - - open(file=config, newunit=unit) - write(unit, '(a)') & - & 'name = "example"', & - & '[dependencies.fpm]', & - & 'git = "https://github.com/fortran-lang/fpm"', & - & '[[executable]]', & - & 'name = "example-#1" # comment', & - & 'source-dir = "prog"', & - & '[dependencies]', & - & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & - & '"toml..f" = { path = ".." }', & - & '[["executable"]]', & - & 'name = "example-#2"', & - & 'source-dir = "prog"', & - & '[executable.dependencies]', & - & '[''library'']', & - & 'source-dir = """', & - & 'lib""" # comment' - close(unit) - - call get_package_data(package, config, error) - - open(file=config, newunit=unit) - close(unit, status='delete') - - if (allocated(error)) return - - if (package%name /= "example") then - call test_failed(error, "Package name is "//package%name//" but should be example") - return - end if - - if (.not.allocated(package%library)) then - call test_failed(error, "library is not present in package data") - return - end if - - if (.not.allocated(package%executable)) then - call test_failed(error, "executable is not present in package data") - return - end if - - if (size(package%executable) /= 2) then - call test_failed(error, "Number of executables in package is not two") - return - end if - - if (.not.allocated(package%dependency)) then - call test_failed(error, "dependency is not present in package data") - return - end if - - if (size(package%dependency) /= 3) then - call test_failed(error, "Number of dependencies in package is not three") - return - end if - - if (allocated(package%test)) then - call test_failed(error, "test is present in package but not in package file") - return - end if - - end subroutine test_valid_config - - - !> Try to read a valid TOML document which represent an invalid package file - subroutine test_invalid_config(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(package_t) :: package - character(len=*), parameter :: config = 'fpm-invalid-config.toml' - character(len=:), allocatable :: string - integer :: unit - - open(file=config, newunit=unit) - write(unit, '(a)') & - & '[package]', & - & 'name = "example"', & - & 'version = "0.1.0"' - close(unit) - - call get_package_data(package, config, error) - - open(file=config, newunit=unit) - close(unit, status='delete') - - end subroutine test_invalid_config - - - !> Create a default library - subroutine test_default_library(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(package_t) :: package - - allocate(package%library) - call default_library(package%library) - - if (.not.allocated(package%library%source_dir)) then - call test_failed(error, "Default library source-dir is not set") - return - end if - - if (package%library%source_dir /= "src") then - call test_failed(error, "Default library source-dir is "// & - & package%library%source_dir//" but should be src") - return - end if - - end subroutine test_default_library - - - !> Create a default executable - subroutine test_default_executable(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(package_t) :: package - character(len=*), parameter :: name = "default" - - allocate(package%executable(1)) - call default_executable(package%executable(1), name) - - if (.not.allocated(package%executable(1)%source_dir)) then - call test_failed(error, "Default executable source-dir is not set") - return - end if - - if (package%executable(1)%source_dir /= "app") then - call test_failed(error, "Default executable source-dir is "// & - & package%executable(1)%source_dir//" but should be app") - return - end if - - if (package%executable(1)%name /= name) then - call test_failed(error, "Default executable name is "// & - & package%executable(1)%name//" but should be "//name) - return - end if - - end subroutine test_default_executable - - -end module test_config diff --git a/fpm/test/test_manifest.f90 b/fpm/test/test_manifest.f90 new file mode 100644 index 0000000..08236d5 --- /dev/null +++ b/fpm/test/test_manifest.f90 @@ -0,0 +1,188 @@ +!> Define tests for the `fpm_manifest` modules +module test_manifest + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_manifest + implicit none + private + + public :: collect_manifest + + +contains + + + !> Collect all exported unit tests + subroutine collect_manifest(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("valid-manifest", test_valid_manifest), & + & new_unittest("invalid-manifest", test_invalid_manifest, should_fail=.true.), & + & new_unittest("default-library", test_default_library), & + & new_unittest("default-executable", test_default_executable)] + + end subroutine collect_manifest + + + !> Try to read some unnecessary obscure and convoluted but not invalid package file + subroutine test_valid_manifest(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: manifest = 'fpm-valid-manifest.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=manifest, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[dependencies.fpm]', & + & 'git = "https://github.com/fortran-lang/fpm"', & + & '[[executable]]', & + & 'name = "example-#1" # comment', & + & 'source-dir = "prog"', & + & '[dependencies]', & + & 'toml-f.git = "git@github.com:toml-f/toml-f.git"', & + & '"toml..f" = { path = ".." }', & + & '[["executable"]]', & + & 'name = "example-#2"', & + & 'source-dir = "prog"', & + & '[executable.dependencies]', & + & '[''library'']', & + & 'source-dir = """', & + & 'lib""" # comment' + close(unit) + + call get_package_data(package, manifest, error) + + open(file=manifest, newunit=unit) + close(unit, status='delete') + + if (allocated(error)) return + + if (package%name /= "example") then + call test_failed(error, "Package name is "//package%name//" but should be example") + return + end if + + if (.not.allocated(package%library)) then + call test_failed(error, "library is not present in package data") + return + end if + + if (.not.allocated(package%executable)) then + call test_failed(error, "executable is not present in package data") + return + end if + + if (size(package%executable) /= 2) then + call test_failed(error, "Number of executables in package is not two") + return + end if + + if (.not.allocated(package%dependency)) then + call test_failed(error, "dependency is not present in package data") + return + end if + + if (size(package%dependency) /= 3) then + call test_failed(error, "Number of dependencies in package is not three") + return + end if + + if (allocated(package%test)) then + call test_failed(error, "test is present in package but not in package file") + return + end if + + end subroutine test_valid_manifest + + + !> Try to read a valid TOML document which represent an invalid package file + subroutine test_invalid_manifest(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: manifest = 'fpm-invalid-manifest.toml' + character(len=:), allocatable :: string + integer :: unit + + open(file=manifest, newunit=unit) + write(unit, '(a)') & + & '[package]', & + & 'name = "example"', & + & 'version = "0.1.0"' + close(unit) + + call get_package_data(package, manifest, error) + + open(file=manifest, newunit=unit) + close(unit, status='delete') + + end subroutine test_invalid_manifest + + + !> Create a default library + subroutine test_default_library(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + + allocate(package%library) + call default_library(package%library) + + if (.not.allocated(package%library%source_dir)) then + call test_failed(error, "Default library source-dir is not set") + return + end if + + if (package%library%source_dir /= "src") then + call test_failed(error, "Default library source-dir is "// & + & package%library%source_dir//" but should be src") + return + end if + + end subroutine test_default_library + + + !> Create a default executable + subroutine test_default_executable(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(len=*), parameter :: name = "default" + + allocate(package%executable(1)) + call default_executable(package%executable(1), name) + + if (.not.allocated(package%executable(1)%source_dir)) then + call test_failed(error, "Default executable source-dir is not set") + return + end if + + if (package%executable(1)%source_dir /= "app") then + call test_failed(error, "Default executable source-dir is "// & + & package%executable(1)%source_dir//" but should be app") + return + end if + + if (package%executable(1)%name /= name) then + call test_failed(error, "Default executable name is "// & + & package%executable(1)%name//" but should be "//name) + return + end if + + end subroutine test_default_executable + + +end module test_manifest diff --git a/fpm/test/test_toml.f90 b/fpm/test/test_toml.f90 index 8d57150..d30ef0d 100644 --- a/fpm/test/test_toml.f90 +++ b/fpm/test/test_toml.f90 @@ -31,11 +31,11 @@ contains type(error_t), allocatable, intent(out) :: error type(toml_table), allocatable :: table - character(len=*), parameter :: config = 'fpm-valid-toml.toml' + character(len=*), parameter :: manifest = 'fpm-valid-toml.toml' character(len=:), allocatable :: string integer :: unit - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) write(unit, '(a)') & & 'name = "example"', & & '[dependencies.fpm]', & @@ -55,9 +55,9 @@ contains & 'lib""" # comment' close(unit) - call read_package_file(table, config, error) + call read_package_file(table, manifest, error) - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) close(unit, status='delete') end subroutine test_valid_toml @@ -70,11 +70,11 @@ contains type(error_t), allocatable, intent(out) :: error type(toml_table), allocatable :: table - character(len=*), parameter :: config = 'fpm-invalid-toml.toml' + character(len=*), parameter :: manifest = 'fpm-invalid-toml.toml' character(len=:), allocatable :: string integer :: unit - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) write(unit, '(a)') & & '# INVALID TOML DOC', & & 'name = "example"', & @@ -84,9 +84,9 @@ contains & '"toml..f" = { path = ".." }' close(unit) - call read_package_file(table, config, error) + call read_package_file(table, manifest, error) - open(file=config, newunit=unit) + open(file=manifest, newunit=unit) close(unit, status='delete') end subroutine test_invalid_toml -- cgit v1.2.3 From 1f637cc7d966c0ede903041ed0d5c6b5483020ea Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 3 Sep 2020 14:44:01 +0200 Subject: Add contributing guidelines - adds a draft for contributing guidelines for fpm --- CONTRIBUTING.md | 131 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 131 insertions(+) create mode 100644 CONTRIBUTING.md diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..b890980 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,131 @@ +# Contributing to the Fortran Package Manager + +First off, thank you for considering contributing to the Fortran Package Manager (fpm). +Please take a moment to review this guidelines to make the contribution process simple and effective for all involved. + +Respecting these guidelines helps communicate that you respect the time of the developers who manage and develop this open source project. +In return, they should return this respect by addressing your problem, evaluating changes, and helping you handle your pull requests. + +We encourage and enforce high quality code. +Generally, follow the +[style guide of the Fortran stdlib](https://github.com/fortran-lang/stdlib/blob/master/STYLE_GUIDE.md) +for any contributed Fortran code. +This allows code review discussions to focus on semantics and substance rather than pedantry. + + +## Reporting a Bug + +A bug is a _demonstratable problem_ caused by the code in this repository. +Good bug reports are extremely valuable for us - thank you! + +Before opening a bug report: + +1. Check if the issue has already been reported. +2. Check if it still is an issue or has already been fixed? + Try to reproduce it with the latest version from the default branch. +3. Isolate the problem and create a reduced test case. + +A good bug report should not leave others needing to chase you up for more information. +So please try to be as detailed as possible in your report, answer at least these questions: + +1. Which version of fpm are you using? + The current version is always a subject to change, so be more specific. +2. What steps will reproduce the issue? + We have to reproduce the issue, so we need all the input files. +3. What would be the expected outcome? +4. What did you see instead? + +All these details will help people to fix any potential bugs. + + +## Suggesting a New Feature + +Feature requests are welcome. +But take a moment to find out if your idea fits the scope and goals of the project. +It is up to you to provide a strong argument to convince the project's developers of the benefits of this feature. +Please provide as much detail and context as possible. + + +## Implementing a New Feature + +Contributions are welcome via GitHub pull requests. +But suggest a new feature in an issue first to discuss the scope of the necessary changes or the required functionality before submitting a pull request. +You can always choose from one of the +[existing issues](https://github.com/fortran-lang/fpm/issues). + +- Each pull request should implement _one_ feature or fix _one_ bug. + If you want to add or fix more than one thing, submit more than one pull request. +- Do not commit changes to files that are irrelevant to your feature or bugfix (_e.g._ `.gitignore`). +- Add tests for your new features or fixed bugs such that we can ensure that they stay functional and useful +- Be willing to accept criticism and work on improving your code. + Have one to three maintainers review your contribution. +- Generally, follow the [style guide of the Fortran stdlib](https://github.com/fortran-lang/stdlib/blob/master/STYLE_GUIDE.md) for any contributed Fortran code. + + +### For New Contributors + +If you 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). + +Don't know where to start? +You can start by looking through these +[help-wanted issues](https://github.com/fortran-lang/fpm/issues?q=label%3A%22help+wanted%22+is%3Aissue+is%3Aopen). + + +## Sign Your Work + +The sign-off is a simple line at the end of the explanation for a commit. +All commits needs to be signed. +Your signature certifies that you wrote the patch or otherwise have the right to contribute the material. +The rules are pretty simple, if you can certify the below +(from [developercertificate.org](https://developercertificate.org/)): + +``` +Developer Certificate of Origin +Version 1.1 + +Copyright (C) 2004, 2006 The Linux Foundation and its contributors. +1 Letterman Drive +Suite D4700 +San Francisco, CA, 94129 + +Everyone is permitted to copy and distribute verbatim copies of this +license document, but changing it is not allowed. + +Developer's Certificate of Origin 1.1 + +By making a contribution to this project, I certify that: + +(a) The contribution was created in whole or in part by me and I + have the right to submit it under the open source license + indicated in the file; or + +(b) The contribution is based upon previous work that, to the best + of my knowledge, is covered under an appropriate open source + license and I have the right under that license to submit that + work with modifications, whether created in whole or in part + by me, under the same open source license (unless I am + permitted to submit under a different license), as indicated + in the file; or + +(c) The contribution was provided directly to me by some other + person who certified (a), (b) or (c) and I have not modified + it. + +(d) I understand and agree that this project and the contribution + are public and that a record of the contribution (including all + personal information I submit with it, including my sign-off) is + maintained indefinitely and may be redistributed consistent with + this project or the open source license(s) involved. +``` + +Then you just add a line to every git commit message: + +``` +Signed-off-by: Joe Smith +``` + +Use your real name (sorry, no pseudonyms or anonymous contributions.) + +If you set your `user.name` and `user.email` git configs, you can sign your commit automatically with `git commit -s`. -- cgit v1.2.3 From 07c5828c9843e6e64aab50b7407bec05e38e27b3 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Thu, 3 Sep 2020 11:15:43 -0400 Subject: explicit imports throughout; reorder imports alphabetically; explicitly declare public names --- fpm/src/fpm.f90 | 12 ++++++------ fpm/src/fpm_backend.f90 | 17 ++++++++++------- fpm/src/fpm_command_line.f90 | 21 ++++++++++++++------- fpm/src/fpm_environment.f90 | 9 +++++---- fpm/src/fpm_filesystem.f90 | 18 +++++++++++------- fpm/src/fpm_model.f90 | 21 +++++++++++++-------- fpm/src/fpm_sources.f90 | 29 ++++++++++++++++------------- fpm/src/fpm_strings.f90 | 5 ++++- 8 files changed, 79 insertions(+), 53 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 4fb6bd4..5e27701 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,12 +1,12 @@ module fpm -use fpm_strings -use fpm_command_line -use fpm_manifest -use fpm_model + +use fpm_backend, only: build_package +use fpm_command_line, only: fpm_build_settings use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS use fpm_filesystem, only: number_of_rows, list_files, exists -use fpm_sources -use fpm_backend +use fpm_manifest, only: fpm_manifest_t +use fpm_model, only: build_model, fpm_model_t + implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 475dcdd..07cd646 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -1,11 +1,14 @@ module fpm_backend + ! Implements the native fpm build backend -! -use fpm_strings -use fpm_environment -use fpm_sources -use fpm_model -use fpm_filesystem + +use fpm_environment, only: run +use fpm_filesystem, only: exists, mkdir +use fpm_model, only: fpm_model_t +use fpm_sources, only: srcfile_t, FPM_UNIT_MODULE, FPM_UNIT_SUBMODULE, & + FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM +use fpm_strings, only: split + implicit none private @@ -102,4 +105,4 @@ recursive subroutine build_source(model,source_file,linking) end subroutine build_source -end module fpm_backend \ No newline at end of file +end module fpm_backend diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 9902110..5e9daee 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -2,27 +2,34 @@ module fpm_command_line use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS implicit none + private + public :: fpm_cmd_settings, & + fpm_build_settings, & + fpm_install_settings, & + fpm_new_settings, & + fpm_run_settings, & + fpm_test_settings, & + get_command_line_settings - type, public, abstract :: fpm_cmd_settings + type, abstract :: fpm_cmd_settings end type - type, public, extends(fpm_cmd_settings) :: fpm_new_settings + type, extends(fpm_cmd_settings) :: fpm_new_settings end type - type, public, extends(fpm_cmd_settings) :: fpm_build_settings + type, extends(fpm_cmd_settings) :: fpm_build_settings end type - type, public, extends(fpm_cmd_settings) :: fpm_run_settings + type, extends(fpm_cmd_settings) :: fpm_run_settings end type - type, public, extends(fpm_cmd_settings) :: fpm_test_settings + type, extends(fpm_cmd_settings) :: fpm_test_settings end type - type, public, extends(fpm_cmd_settings) :: fpm_install_settings + type, extends(fpm_cmd_settings) :: fpm_install_settings end type - public :: get_command_line_settings contains subroutine get_command_line_settings(cmd_settings) class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings diff --git a/fpm/src/fpm_environment.f90 b/fpm/src/fpm_environment.f90 index 5ef7e18..9ac42ac 100644 --- a/fpm/src/fpm_environment.f90 +++ b/fpm/src/fpm_environment.f90 @@ -1,12 +1,13 @@ module fpm_environment implicit none private + public :: get_os_type, run + public :: OS_LINUX, OS_MACOS, OS_WINDOWS - integer, parameter, public :: OS_LINUX = 1 - integer, parameter, public :: OS_MACOS = 2 - integer, parameter, public :: OS_WINDOWS = 3 + integer, parameter :: OS_LINUX = 1 + integer, parameter :: OS_MACOS = 2 + integer, parameter :: OS_WINDOWS = 3 - public :: get_os_type, run contains integer function get_os_type() result(r) ! Determine the OS type diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index c531e84..a86e813 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -1,10 +1,11 @@ module fpm_filesystem -use fpm_strings use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +use fpm_strings, only: f_string, string_t implicit none private -public :: number_of_rows, read_lines, list_files, mkdir, exists, get_temp_filename +public :: number_of_rows, read_lines, list_files, mkdir, exists, & + get_temp_filename integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -79,11 +80,14 @@ subroutine list_files(dir, files) select case (get_os_type()) case (OS_LINUX) - call execute_command_line("ls " // dir // " > "//temp_file, exitstat=stat) + call execute_command_line("ls " // dir // " > "//temp_file, & + exitstat=stat) case (OS_MACOS) - call execute_command_line("ls " // dir // " > "//temp_file, exitstat=stat) + call execute_command_line("ls " // dir // " > "//temp_file, & + exitstat=stat) case (OS_WINDOWS) - call execute_command_line("dir /b " // dir // " > "//temp_file, exitstat=stat) + call execute_command_line("dir /b " // dir // " > "//temp_file, & + exitstat=stat) end select if (stat /= 0) then print *, "execute_command_line() failed" @@ -118,7 +122,7 @@ function get_temp_filename() result(tempfile) interface - function c_tempnam(dir,pfx) result(tmp) BIND(C,name="tempnam") + function c_tempnam(dir,pfx) result(tmp) bind(c,name="tempnam") import type(c_ptr), intent(in), value :: dir type(c_ptr), intent(in), value :: pfx @@ -142,4 +146,4 @@ function get_temp_filename() result(tempfile) end function get_temp_filename -end module fpm_filesystem \ No newline at end of file +end module fpm_filesystem diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index c1489cf..b519c87 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -1,14 +1,19 @@ module fpm_model + ! Definition and validation of the backend model -! -use fpm_strings -use fpm_sources -use fpm_command_line -use fpm_filesystem -use fpm_manifest + +use fpm_command_line, only: fpm_build_settings +use fpm_filesystem, only: exists +use fpm_manifest, only: fpm_manifest_t +use fpm_sources, only: resolve_dependencies, scan_sources, srcfile_t +use fpm_strings, only: string_t + implicit none -type fpm_model_t +private +public :: build_model, fpm_model_t + +type :: fpm_model_t character(:), allocatable :: package_name ! Name of package type(srcfile_t), allocatable :: sources(:) @@ -52,4 +57,4 @@ subroutine build_model(model, settings, manifest) end subroutine build_model -end module fpm_model \ No newline at end of file +end module fpm_model diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 2960339..ab0f68a 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,19 +1,22 @@ module fpm_sources -use fpm_strings use fpm_filesystem, only: read_lines, list_files +use fpm_strings, only: lower, split, str_ends_with, string_t implicit none private -public srcfile_ptr, srcfile_t -public scan_sources, resolve_dependencies - -integer, parameter, public :: FPM_UNIT_UNKNOWN = -1 -integer, parameter, public :: FPM_UNIT_PROGRAM = 1 -integer, parameter, public :: FPM_UNIT_MODULE = 2 -integer, parameter, public :: FPM_UNIT_SUBMODULE = 3 -integer, parameter, public :: FPM_UNIT_SUBPROGRAM = 4 -integer, parameter, public :: FPM_UNIT_CSOURCE = 5 -integer, parameter, public :: FPM_UNIT_CHEADER = 6 +public :: srcfile_ptr, srcfile_t +public :: scan_sources, resolve_dependencies +public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & + FPM_UNIT_CHEADER + +integer, parameter :: FPM_UNIT_UNKNOWN = -1 +integer, parameter :: FPM_UNIT_PROGRAM = 1 +integer, parameter :: FPM_UNIT_MODULE = 2 +integer, parameter :: FPM_UNIT_SUBMODULE = 3 +integer, parameter :: FPM_UNIT_SUBPROGRAM = 4 +integer, parameter :: FPM_UNIT_CSOURCE = 5 +integer, parameter :: FPM_UNIT_CHEADER = 6 character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & ['iso_c_binding ', & @@ -21,7 +24,7 @@ character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & type srcfile_ptr ! For constructing arrays of src_file pointers - type(srcfile_t), pointer :: ptr => NULL() + type(srcfile_t), pointer :: ptr => null() end type srcfile_ptr type srcfile_t @@ -415,4 +418,4 @@ function find_module_dependency(sources,module_name) result(src_ptr) end function find_module_dependency -end module fpm_sources \ No newline at end of file +end module fpm_sources diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 09fa3c0..dd18f09 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -1,6 +1,9 @@ module fpm_strings implicit none +private +public :: f_string, lower, split, str_ends_with, string_t + type string_t character(len=:), allocatable :: s end type @@ -192,4 +195,4 @@ subroutine split(input_line,array,delimiters,order,nulls) end subroutine split -end module fpm_strings \ No newline at end of file +end module fpm_strings -- cgit v1.2.3 From 63f6b077b76bf9d4380fbbd71a9211f61e642000 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 3 Sep 2020 23:28:02 +0200 Subject: Remove DCO and signed commit requirement from guidelines --- CONTRIBUTING.md | 58 --------------------------------------------------------- 1 file changed, 58 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index b890980..bdc1547 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -71,61 +71,3 @@ You can learn how from Don't know where to start? You can start by looking through these [help-wanted issues](https://github.com/fortran-lang/fpm/issues?q=label%3A%22help+wanted%22+is%3Aissue+is%3Aopen). - - -## Sign Your Work - -The sign-off is a simple line at the end of the explanation for a commit. -All commits needs to be signed. -Your signature certifies that you wrote the patch or otherwise have the right to contribute the material. -The rules are pretty simple, if you can certify the below -(from [developercertificate.org](https://developercertificate.org/)): - -``` -Developer Certificate of Origin -Version 1.1 - -Copyright (C) 2004, 2006 The Linux Foundation and its contributors. -1 Letterman Drive -Suite D4700 -San Francisco, CA, 94129 - -Everyone is permitted to copy and distribute verbatim copies of this -license document, but changing it is not allowed. - -Developer's Certificate of Origin 1.1 - -By making a contribution to this project, I certify that: - -(a) The contribution was created in whole or in part by me and I - have the right to submit it under the open source license - indicated in the file; or - -(b) The contribution is based upon previous work that, to the best - of my knowledge, is covered under an appropriate open source - license and I have the right under that license to submit that - work with modifications, whether created in whole or in part - by me, under the same open source license (unless I am - permitted to submit under a different license), as indicated - in the file; or - -(c) The contribution was provided directly to me by some other - person who certified (a), (b) or (c) and I have not modified - it. - -(d) I understand and agree that this project and the contribution - are public and that a record of the contribution (including all - personal information I submit with it, including my sign-off) is - maintained indefinitely and may be redistributed consistent with - this project or the open source license(s) involved. -``` - -Then you just add a line to every git commit message: - -``` -Signed-off-by: Joe Smith -``` - -Use your real name (sorry, no pseudonyms or anonymous contributions.) - -If you set your `user.name` and `user.email` git configs, you can sign your commit automatically with `git commit -s`. -- cgit v1.2.3 From 5b833ce91986e6aa9c6d1ba3908a1b593c035fad Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Fri, 4 Sep 2020 20:52:50 +0200 Subject: Catch some previously unbound errors --- fpm/src/fpm/manifest/executable.f90 | 4 ++++ fpm/src/fpm/manifest/package.f90 | 9 +++++++-- fpm/src/fpm/manifest/test.f90 | 4 ++++ 3 files changed, 15 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90 index 704396a..94d4000 100644 --- a/fpm/src/fpm/manifest/executable.f90 +++ b/fpm/src/fpm/manifest/executable.f90 @@ -63,6 +63,10 @@ contains if (allocated(error)) return call get_value(table, "name", self%name) + if (.not.allocated(self%name)) then + call syntax_error(error, "Could not retrieve executable name") + return + end if call get_value(table, "source-dir", self%source_dir, "app") call get_value(table, "main", self%main, "main.f90") diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index f318ad7..95194d2 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -93,6 +93,10 @@ contains if (allocated(error)) return call get_value(table, "name", self%name) + if (.not.allocated(self%name)) then + call syntax_error(error, "Could not retrieve package name") + return + end if call get_value(table, "dependencies", child, requested=.false.) if (associated(child)) then @@ -110,6 +114,7 @@ contains if (associated(child)) then allocate(self%library) call new_library(self%library, child, error) + if (allocated(error)) return end if call get_value(table, "executable", children, requested=.false.) @@ -125,6 +130,7 @@ contains call new_executable(self%executable(ii), node, error) if (allocated(error)) exit end do + if (allocated(error)) return end if call get_value(table, "test", children, requested=.false.) @@ -140,6 +146,7 @@ contains call new_test(self%test(ii), node, error) if (allocated(error)) exit end do + if (allocated(error)) return end if end subroutine new_package @@ -154,14 +161,12 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: name type(toml_key), allocatable :: list(:) logical :: name_present integer :: ikey name_present = .false. - call table%get_key(name) call table%get_keys(list) if (.not.allocated(list)) then diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90 index 9b50315..c35ea63 100644 --- a/fpm/src/fpm/manifest/test.f90 +++ b/fpm/src/fpm/manifest/test.f90 @@ -56,6 +56,10 @@ contains if (allocated(error)) return call get_value(table, "name", self%name) + if (.not.allocated(self%name)) then + call syntax_error(error, "Could not retrieve test name") + return + end if call get_value(table, "source-dir", self%source_dir, "test") call get_value(table, "main", self%main, "main.f90") -- cgit v1.2.3 From 10b9ca3746292a1e2f1e40c3af86dd8d04d1bcea Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Fri, 4 Sep 2020 21:44:14 +0200 Subject: Increase testing coverage - fix unallocated access to error_t in file_not_found generator - account for fact that key-list will be allocated with size 0 for empty key-tables - test response of constructor on empty TOML tables --- fpm/src/fpm/error.f90 | 7 +- fpm/src/fpm/manifest/dependency.f90 | 9 ++- fpm/src/fpm/manifest/executable.f90 | 2 +- fpm/src/fpm/manifest/library.f90 | 2 +- fpm/src/fpm/manifest/package.f90 | 2 +- fpm/src/fpm/manifest/test.f90 | 6 +- fpm/src/fpm/toml.f90 | 5 +- fpm/test/test_manifest.f90 | 136 +++++++++++++++++++++++++++++++++++- fpm/test/test_toml.f90 | 18 ++++- 9 files changed, 170 insertions(+), 17 deletions(-) diff --git a/fpm/src/fpm/error.f90 b/fpm/src/fpm/error.f90 index 957d3bf..aebd7e4 100644 --- a/fpm/src/fpm/error.f90 +++ b/fpm/src/fpm/error.f90 @@ -49,11 +49,8 @@ contains !> Name of the missing file character(len=*), intent(in) :: file_name - character(len=:), allocatable :: message - - message = "'"//file_name//"' could not be found, check if the file exists" - - call move_alloc(message, error%message) + allocate(error) + error%message = "'"//file_name//"' could not be found, check if the file exists" end subroutine file_not_found_error diff --git a/fpm/src/fpm/manifest/dependency.f90 b/fpm/src/fpm/manifest/dependency.f90 index 1ee61b7..8a3d879 100644 --- a/fpm/src/fpm/manifest/dependency.f90 +++ b/fpm/src/fpm/manifest/dependency.f90 @@ -129,7 +129,7 @@ contains call table%get_key(name) call table%get_keys(list) - if (.not.allocated(list)) then + if (size(list) < 1) then call syntax_error(error, "Dependency "//name//" does not provide sufficient entries") return end if @@ -158,6 +158,11 @@ contains end do if (allocated(error)) return + if (.not.url_present) then + call syntax_error(error, "Dependency "//name//" does not provide a method to actually retrieve itself") + return + end if + if (.not.url_present .and. git_target_present) then call syntax_error(error, "Dependency "//name//" uses a local path, therefore no git identifiers are allowed") end if @@ -183,7 +188,7 @@ contains call table%get_keys(list) ! An empty table is okay - if (.not.allocated(list)) return + if (size(list) < 1) return allocate(deps(size(list))) do idep = 1, size(list) diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90 index 94d4000..f706001 100644 --- a/fpm/src/fpm/manifest/executable.f90 +++ b/fpm/src/fpm/manifest/executable.f90 @@ -96,7 +96,7 @@ contains call table%get_keys(list) - if (.not.allocated(list)) then + if (size(list) < 1) then call syntax_error(error, "Executable section does not provide sufficient entries") return end if diff --git a/fpm/src/fpm/manifest/library.f90 b/fpm/src/fpm/manifest/library.f90 index a297c2f..40e5e92 100644 --- a/fpm/src/fpm/manifest/library.f90 +++ b/fpm/src/fpm/manifest/library.f90 @@ -72,7 +72,7 @@ contains call table%get_keys(list) ! table can be empty - if (.not.allocated(list)) return + if (size(list) < 1) return do ikey = 1, size(list) select case(list(ikey)%key) diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index 95194d2..4c2c14a 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -169,7 +169,7 @@ contains call table%get_keys(list) - if (.not.allocated(list)) then + if (size(list) < 1) then call syntax_error(error, "Package file is empty") return end if diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90 index c35ea63..a6c6f64 100644 --- a/fpm/src/fpm/manifest/test.f90 +++ b/fpm/src/fpm/manifest/test.f90 @@ -89,8 +89,8 @@ contains call table%get_keys(list) - if (.not.allocated(list)) then - call syntax_error(error, "Executable section does not provide sufficient entries") + if (size(list) < 1) then + call syntax_error(error, "Test section does not provide sufficient entries") return end if @@ -110,7 +110,7 @@ contains end do if (.not.name_present) then - call syntax_error(error, "Executable name is not provided, please add a name entry") + call syntax_error(error, "Test name is not provided, please add a name entry") end if end subroutine check diff --git a/fpm/src/fpm/toml.f90 b/fpm/src/fpm/toml.f90 index d95a093..183278d 100644 --- a/fpm/src/fpm/toml.f90 +++ b/fpm/src/fpm/toml.f90 @@ -15,12 +15,13 @@ module fpm_toml use fpm_error, only : error_t, fatal_error, file_not_found_error use tomlf, only : toml_table, toml_array, toml_key, toml_stat, get_value, & & toml_parse, toml_error - use tomlf_type, only : len + use tomlf_type, only : new_table, len implicit none private public :: read_package_file - public :: toml_table, toml_array, toml_key, toml_stat, get_value, len + public :: toml_table, toml_array, toml_key, toml_stat, get_value + public :: new_table, len contains diff --git a/fpm/test/test_manifest.f90 b/fpm/test/test_manifest.f90 index 08236d5..117ea3a 100644 --- a/fpm/test/test_manifest.f90 +++ b/fpm/test/test_manifest.f90 @@ -21,7 +21,13 @@ contains & new_unittest("valid-manifest", test_valid_manifest), & & new_unittest("invalid-manifest", test_invalid_manifest, should_fail=.true.), & & new_unittest("default-library", test_default_library), & - & new_unittest("default-executable", test_default_executable)] + & new_unittest("default-executable", test_default_executable), & + & new_unittest("dependency-empty", test_dependency_empty, should_fail=.true.), & + & new_unittest("dependencies-empty", test_dependencies_empty), & + & new_unittest("executable-empty", test_executable_empty, should_fail=.true.), & + & new_unittest("library-empty", test_library_empty), & + & new_unittest("package-empty", test_package_empty, should_fail=.true.), & + & new_unittest("test-empty", test_test_empty, should_fail=.true.)] end subroutine collect_manifest @@ -185,4 +191,132 @@ contains end subroutine test_default_executable + !> Dependencies cannot be created from empty tables + subroutine test_dependency_empty(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(dependency_t) :: dependency + + call new_table(table) + table%key = "example" + + call new_dependency(dependency, table, error) + + call dependency%info(0) + + end subroutine test_dependency_empty + + + !> Dependency tables can be empty + subroutine test_dependencies_empty(error) + use fpm_manifest_dependency + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(dependency_t), allocatable :: dependencies(:) + + call new_table(table) + + call new_dependencies(dependencies, table, error) + if (allocated(error)) return + + if (allocated(dependencies)) then + call test_failed(error, "Found dependencies in empty table") + end if + + end subroutine test_dependencies_empty + + + !> Executables cannot be created from empty tables + subroutine test_executable_empty(error) + use fpm_manifest_executable + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(executable_t) :: executable + + call new_table(table) + + call new_executable(executable, table, error) + + end subroutine test_executable_empty + + + !> Libraries can be created from empty tables + subroutine test_library_empty(error) + use fpm_manifest_library + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(library_t) :: library + + call new_table(table) + + call new_library(library, table, error) + if (allocated(error)) return + + if (.not.allocated(library%source_dir)) then + call test_failed(error, "Default library source-dir is not set") + return + end if + + if (library%source_dir /= "src") then + call test_failed(error, "Default library source-dir is "// & + & library%source_dir//" but should be src") + return + end if + + end subroutine test_library_empty + + + !> Packages cannot be created from empty tables + subroutine test_package_empty(error) + use fpm_manifest_package + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(package_t) :: package + + call new_table(table) + + call new_package(package, table, error) + + end subroutine test_package_empty + + + !> Tests cannot be created from empty tables + subroutine test_test_empty(error) + use fpm_manifest_test + use fpm_toml, only : new_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(test_t) :: test + + call new_table(table) + + call new_test(test, table, error) + + end subroutine test_test_empty + + end module test_manifest diff --git a/fpm/test/test_toml.f90 b/fpm/test/test_toml.f90 index d30ef0d..0a5abd6 100644 --- a/fpm/test/test_toml.f90 +++ b/fpm/test/test_toml.f90 @@ -19,7 +19,8 @@ contains testsuite = [ & & new_unittest("valid-toml", test_valid_toml), & - & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.)] + & new_unittest("invalid-toml", test_invalid_toml, should_fail=.true.), & + & new_unittest("missing-file", test_missing_file, should_fail=.true.)] end subroutine collect_toml @@ -92,4 +93,19 @@ contains end subroutine test_invalid_toml + !> Try to read configuration from a non-existing file + subroutine test_missing_file(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), allocatable :: table + character(len=:), allocatable :: string + integer :: unit + + call read_package_file(table, 'low+chance+of+existing.toml', error) + + end subroutine test_missing_file + + end module test_toml -- cgit v1.2.3 From 89813e843ccde573bad9c7231ecbd7623c5f1a7b Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Sat, 5 Sep 2020 09:14:31 +0200 Subject: Pin commit of toml-f --- fpm/fpm.toml | 4 +++- fpm/test/test_manifest.f90 | 2 -- fpm/test/test_toml.f90 | 4 ---- 3 files changed, 3 insertions(+), 7 deletions(-) diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 9a0009f..b39d881 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -6,7 +6,9 @@ maintainer = "" copyright = "2020 fpm contributors" [dependencies] -toml-f = { git = "https://github.com/toml-f/toml-f" } +[dependencies.toml-f] +git = "https://github.com/toml-f/toml-f" +rev = "290ba87671ab593e7bd51599e1d80ea736b3cd36" [[test]] name = "fpm-test" diff --git a/fpm/test/test_manifest.f90 b/fpm/test/test_manifest.f90 index 117ea3a..7ad5e5a 100644 --- a/fpm/test/test_manifest.f90 +++ b/fpm/test/test_manifest.f90 @@ -40,7 +40,6 @@ contains type(package_t) :: package character(len=*), parameter :: manifest = 'fpm-valid-manifest.toml' - character(len=:), allocatable :: string integer :: unit open(file=manifest, newunit=unit) @@ -116,7 +115,6 @@ contains type(package_t) :: package character(len=*), parameter :: manifest = 'fpm-invalid-manifest.toml' - character(len=:), allocatable :: string integer :: unit open(file=manifest, newunit=unit) diff --git a/fpm/test/test_toml.f90 b/fpm/test/test_toml.f90 index 0a5abd6..ba48307 100644 --- a/fpm/test/test_toml.f90 +++ b/fpm/test/test_toml.f90 @@ -33,7 +33,6 @@ contains type(toml_table), allocatable :: table character(len=*), parameter :: manifest = 'fpm-valid-toml.toml' - character(len=:), allocatable :: string integer :: unit open(file=manifest, newunit=unit) @@ -72,7 +71,6 @@ contains type(toml_table), allocatable :: table character(len=*), parameter :: manifest = 'fpm-invalid-toml.toml' - character(len=:), allocatable :: string integer :: unit open(file=manifest, newunit=unit) @@ -100,8 +98,6 @@ contains type(error_t), allocatable, intent(out) :: error type(toml_table), allocatable :: table - character(len=:), allocatable :: string - integer :: unit call read_package_file(table, 'low+chance+of+existing.toml', error) -- cgit v1.2.3 From 7036ed9c7520b87dbef40bc7b68d2d2f7753fab9 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Sat, 5 Sep 2020 11:22:58 +0200 Subject: Remove leftover debug code --- fpm/test/test_manifest.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/fpm/test/test_manifest.f90 b/fpm/test/test_manifest.f90 index 7ad5e5a..223b346 100644 --- a/fpm/test/test_manifest.f90 +++ b/fpm/test/test_manifest.f90 @@ -205,8 +205,6 @@ contains call new_dependency(dependency, table, error) - call dependency%info(0) - end subroutine test_dependency_empty -- cgit v1.2.3 From 82146dec39b21b8cad6402508f748a67f914110d Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 5 Sep 2020 15:03:24 +0100 Subject: Use manifest data for library and executables Locations --- fpm/src/fpm.f90 | 24 ++------ fpm/src/fpm_backend.f90 | 2 +- fpm/src/fpm_model.f90 | 30 +++++---- fpm/src/fpm_sources.f90 | 158 ++++++++++++++++++++++++++++++++++++++---------- 4 files changed, 149 insertions(+), 65 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 86f9983..def32dd 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -20,6 +20,7 @@ contains subroutine cmd_build(settings) type(fpm_build_settings), intent(in) :: settings type(package_t) :: package +type(fpm_model_t) :: model type(error_t), allocatable :: error type(string_t), allocatable :: files(:) character(:), allocatable :: basename, linking @@ -46,27 +47,10 @@ if (.not.(allocated(package%library) .or. allocated(package%executable))) then error stop 1 end if -linking = "" -if (allocated(package%library)) then - call list_files(package%library%source_dir, files) - do i = 1, size(files) - if (str_ends_with(files(i)%s, ".f90")) then - n = len(files(i)%s) - basename = files(i)%s - call run("gfortran -c " // package%library%source_dir // "/" // & - & basename // " -o " // basename // ".o") - linking = linking // " " // basename // ".o" - end if - end do -end if +call build_model(model, settings, package) + +call build_package(model) -do i = 1, size(package%executable) - basename = package%executable(i)%main - call run("gfortran -c " // package%executable(i)%source_dir // "/" // & - & basename // " -o " // basename // ".o") - call run("gfortran " // basename // ".o " // linking // " -o " // & - & package%executable(i)%name) -end do end subroutine subroutine cmd_install() diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 07cd646..5a16193 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -54,7 +54,7 @@ subroutine build_package(model) call run("gfortran " // model%output_directory // '/' // basename // ".o "// & linking //" " //model%link_flags // " -o " // model%output_directory & - // '/' // model%package_name) + // '/' // model%sources(i)%exe_name) end if diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 12078b0..307033d 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -4,8 +4,10 @@ module fpm_model use fpm_command_line, only: fpm_build_settings use fpm_filesystem, only: exists -use fpm_manifest, only: package_t -use fpm_sources, only: resolve_dependencies, scan_sources, srcfile_t +use fpm_manifest, only: package_t, default_library, default_executable +use fpm_manifest_executable, only: executable_t +use fpm_sources, only: resolve_module_dependencies, add_sources_from_dir, & + add_executable_sources, srcfile_t use fpm_strings, only: string_t implicit none @@ -30,18 +32,14 @@ end type fpm_model_t contains -subroutine build_model(model, settings, manifest) +subroutine build_model(model, settings, package) ! Constructs a valid fpm model from command line settings and toml manifest ! type(fpm_model_t), intent(out) :: model type(fpm_build_settings), intent(in) :: settings - type(package_t), intent(in) :: manifest + type(package_t), intent(in) :: package - if (exists("src/fpm.f90")) then - model%package_name = "fpm" - else - model%package_name = "hello_world" - end if + model%package_name = package%name ! #TODO: Choose flags and output directory based on cli settings & manifest inputs model%fortran_compiler = 'gfortran' @@ -51,9 +49,19 @@ subroutine build_model(model, settings, manifest) '-J'//model%output_directory model%link_flags = '' - call scan_sources(model%sources,[string_t('app'),string_t('src')]) + ! Add sources from executable directories + if (allocated(package%executable)) then + call add_executable_sources(model%sources, package%executable) + end if + if (allocated(package%test)) then + call add_executable_sources(model%sources, package%test) + end if + + if (allocated(package%library)) then + call add_sources_from_dir(model%sources,package%library%source_dir) + end if - call resolve_dependencies(model%sources) + call resolve_module_dependencies(model%sources) end subroutine build_model diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index ab0f68a..bf6124a 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,11 +1,12 @@ module fpm_sources use fpm_filesystem, only: read_lines, list_files use fpm_strings, only: lower, split, str_ends_with, string_t +use fpm_manifest_executable, only: executable_t implicit none private public :: srcfile_ptr, srcfile_t -public :: scan_sources, resolve_dependencies +public :: add_sources_from_dir, add_executable_sources, resolve_module_dependencies public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CHEADER @@ -32,6 +33,8 @@ type srcfile_t ! and it's metadata character(:), allocatable :: file_name ! File path relative to cwd + character(:), allocatable :: exe_name + ! Name of executable for FPM_UNIT_PROGRAM type(string_t), allocatable :: modules_provided(:) ! Modules provided by this source file (lowerstring) integer :: unit_type = FPM_UNIT_UNKNOWN @@ -50,62 +53,151 @@ end type srcfile_t contains -subroutine scan_sources(sources,directories) - ! Enumerate Fortran sources and resolve file - ! dependencies +subroutine add_sources_from_dir(sources,directory,with_executables) + ! Enumerate sources in a directory ! - type(srcfile_t), allocatable, intent(out), target :: sources(:) - type(string_t), intent(in) :: directories(:) + type(srcfile_t), allocatable, intent(inout), target :: sources(:) + character(*), intent(in) :: directory + logical, intent(in), optional :: with_executables integer :: i, j - logical, allocatable :: is_source(:) - type(string_t), allocatable :: dir_files(:) + logical, allocatable :: is_source(:), exclude_source(:) type(string_t), allocatable :: file_names(:) type(string_t), allocatable :: src_file_names(:) + type(srcfile_t), allocatable :: dir_sources(:) - ! Scan directories for sources - allocate(file_names(0)) - do i=1,size(directories) + character(:), allocatable :: basename + character(:), allocatable :: file_parts(:) - call list_files(directories(i)%s, dir_files) - file_names = [file_names,(string_t(directories(i)%s//'/'//dir_files(j)%s),j=1,size(dir_files))] - - end do + ! Scan directory for sources + call list_files(directory, file_names) + file_names = [(string_t(directory//'/'//file_names(j)%s),j=1,size(file_names))] is_source = [(str_ends_with(lower(file_names(i)%s), ".f90") .or. & str_ends_with(lower(file_names(i)%s), ".c") .or. & str_ends_with(lower(file_names(i)%s), ".h"),i=1,size(file_names))] src_file_names = pack(file_names,is_source) - allocate(sources(size(src_file_names))) + allocate(dir_sources(size(src_file_names))) + allocate(exclude_source(size(src_file_names))) do i = 1, size(src_file_names) if (str_ends_with(lower(src_file_names(i)%s), ".f90")) then - sources(i) = parse_f_source(src_file_names(i)%s) + dir_sources(i) = parse_f_source(src_file_names(i)%s) end if if (str_ends_with(lower(src_file_names(i)%s), ".c") .or. & str_ends_with(lower(src_file_names(i)%s), ".h")) then - sources(i) = parse_c_source(src_file_names(i)%s) + dir_sources(i) = parse_c_source(src_file_names(i)%s) end if + ! Exclude executables unless specified otherwise + exclude_source(i) = (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM) + if (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM .and. & + present(with_executables)) then + if (with_executables) then + + exclude_source(i) = .false. + call split(src_file_names(i)%s,file_parts,delimiters='\/.') + basename = file_parts(size(file_parts)-1) + + dir_sources(i)%exe_name = basename + + end if + end if + + end do + + if (.not.allocated(sources)) then + sources = pack(dir_sources,.not.exclude_source) + else + sources = [sources, pack(dir_sources,.not.exclude_source)] + end if + +end subroutine add_sources_from_dir + + +subroutine add_executable_sources(sources,executables) + ! Add sources from executable directories specified in manifest + ! Only allow executables that are explicitly specified in manifest + ! + type(srcfile_t), allocatable, intent(inout), target :: sources(:) + class(executable_t), intent(in), optional :: executables(:) + + integer :: i, j + + type(string_t), allocatable :: exe_dirs(:) + logical, allocatable :: exclude_source(:) + type(srcfile_t), allocatable :: dir_sources(:) + + character(:), allocatable :: basename + character(:), allocatable :: file_parts(:) + + call get_executable_source_dirs(exe_dirs,executables) + + do i=1,size(exe_dirs) + call add_sources_from_dir(dir_sources,exe_dirs(i)%s, & + with_executables=.true.) + end do + + allocate(exclude_source(size(dir_sources))) + + do i = 1, size(dir_sources) + + ! Only allow executables in 'executables' list + exclude_source(i) = (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM) + + call split(dir_sources(i)%file_name,file_parts,delimiters='\/') + basename = file_parts(size(file_parts)) + + do j=1,size(executables) + if (executables(j)%main == basename) then + exclude_source(i) = .false. + dir_sources(i)%exe_name = executables(j)%name + exit + end if + end do + + end do + + if (.not.allocated(sources)) then + sources = pack(dir_sources,.not.exclude_source) + else + sources = [sources, pack(dir_sources,.not.exclude_source)] + end if + +end subroutine add_executable_sources + + +subroutine get_executable_source_dirs(exe_dirs,executables) + ! Build a list of unique source directories + ! from executables specified in manifest + type(string_t), allocatable, intent(inout) :: exe_dirs(:) + class(executable_t), intent(in) :: executables(:) + + type(string_t) :: dirs_temp(size(executables)) + + integer :: i, j, n + + n = 0 + do i=1,size(executables) + if (.not.any([(dirs_temp(j)%s==executables(i)%source_dir, & + j=1,n)])) then + + n = n + 1 + dirs_temp(n)%s = executables(i)%source_dir + + end if end do - ! do i=1,size(sources) - ! write(*,*) 'Filename: "',sources(i)%file_name,'"' - ! do j=1,size(sources(i)%modules_provided) - ! write(*,*) ' Provides: "',sources(i)%modules_provided(j)%s,'"' - ! end do - ! do j=1,size(sources(i)%modules_used) - ! write(*,*) ' Uses: "',sources(i)%modules_used(j)%s,'"' - ! end do - ! do j=1,size(sources(i)%include_dependencies) - ! write(*,*) ' Includes: "',sources(i)%include_dependencies(j)%s,'"' - ! end do - ! end do + if (.not.allocated(exe_dirs)) then + exe_dirs = dirs_temp(1:n) + else + exe_dirs = [exe_dirs,dirs_temp(1:n)] + end if -end subroutine scan_sources +end subroutine get_executable_source_dirs function parse_f_source(f_filename) result(f_source) @@ -364,7 +456,7 @@ function parse_c_source(c_filename) result(c_source) end function parse_c_source -subroutine resolve_dependencies(sources) +subroutine resolve_module_dependencies(sources) ! After enumerating all source files: resolve file dependencies ! by searching on module names ! @@ -392,7 +484,7 @@ subroutine resolve_dependencies(sources) end do -end subroutine resolve_dependencies +end subroutine resolve_module_dependencies function find_module_dependency(sources,module_name) result(src_ptr) type(srcfile_t), intent(in), target :: sources(:) -- cgit v1.2.3 From 15953e0cd3c0a526bfdfe3149df65a986a64beca Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 5 Sep 2020 13:49:19 -0400 Subject: add workflow and edit text throughout --- CONTRIBUTING.md | 153 ++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 100 insertions(+), 53 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index bdc1547..e5eca7d 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,68 +1,115 @@ # Contributing to the Fortran Package Manager -First off, thank you for considering contributing to the Fortran Package Manager (fpm). -Please take a moment to review this guidelines to make the contribution process simple and effective for all involved. - -Respecting these guidelines helps communicate that you respect the time of the developers who manage and develop this open source project. -In return, they should return this respect by addressing your problem, evaluating changes, and helping you handle your pull requests. - -We encourage and enforce high quality code. -Generally, follow the -[style guide of the Fortran stdlib](https://github.com/fortran-lang/stdlib/blob/master/STYLE_GUIDE.md) -for any contributed Fortran code. -This allows code review discussions to focus on semantics and substance rather than pedantry. - - -## Reporting a Bug - -A bug is a _demonstratable problem_ caused by the code in this repository. -Good bug reports are extremely valuable for us - thank you! +Thank you for considering contributing to the Fortran Package Manager (fpm). +Please review and follow these guidelines to make the contribution process +simple and effective for all involved. +It will help communicate that you respect the time of the community +developers. +In return, the community will help address your problem, evaluate changes, and +guide you through your pull requests. + +* [Style](#style) +* [Reporting a bug](#reporting-a-bug) +* [Suggesting a feature](#suggesting-a-feature) +* [Workflow](#workflow) +* [General guidelines](#general-guidelines) +* [For new contributors](#for-new-contributors) + +## Style + +We require high-quality code. +Please follow the +[Fortran stdlib style guide](https://github.com/fortran-lang/stdlib/blob/master/STYLE_GUIDE.md) +for any Fortran code that you contribute. +This allows us to focus on substance rather than style. + +## Reporting a bug + +A bug is a _demonstrable problem_ caused by the code in this repository. +Good bug reports are extremely valuable to us—thank you! Before opening a bug report: 1. Check if the issue has already been reported. -2. Check if it still is an issue or has already been fixed? - Try to reproduce it with the latest version from the default branch. -3. Isolate the problem and create a reduced test case. - -A good bug report should not leave others needing to chase you up for more information. -So please try to be as detailed as possible in your report, answer at least these questions: + ([issues](https://github.com/fortran-lang/fpm/issues)) +2. Check if it's still an issue or it has been fixed? + Try to reproduce it with the latest version from the master branch. +3. Isolate the problem and create a minimal test case. -1. Which version of fpm are you using? - The current version is always a subject to change, so be more specific. -2. What steps will reproduce the issue? - We have to reproduce the issue, so we need all the input files. -3. What would be the expected outcome? -4. What did you see instead? +A good bug report should include all information needed to reproduce the bug. +Please be as detailed as possible: -All these details will help people to fix any potential bugs. +1. Which version of fpm are you using? Please be specific. +2. What are the steps to reproduce the issue? +3. What is the expected outcome? +4. What happens instead? +This information will help the community diagnose the issue quickly and with +minimal back-and-forth. -## Suggesting a New Feature +## Suggesting a feature -Feature requests are welcome. -But take a moment to find out if your idea fits the scope and goals of the project. -It is up to you to provide a strong argument to convince the project's developers of the benefits of this feature. +Before suggesting a new feature, take a moment to find out if it fits +the scope of the project, or if it has already been discussed. +It's up to you to provide a strong argument to convince the community of the +benefits of this feature. Please provide as much detail and context as possible. - - -## Implementing a New Feature - -Contributions are welcome via GitHub pull requests. -But suggest a new feature in an issue first to discuss the scope of the necessary changes or the required functionality before submitting a pull request. -You can always choose from one of the -[existing issues](https://github.com/fortran-lang/fpm/issues). - -- Each pull request should implement _one_ feature or fix _one_ bug. - If you want to add or fix more than one thing, submit more than one pull request. -- Do not commit changes to files that are irrelevant to your feature or bugfix (_e.g._ `.gitignore`). -- Add tests for your new features or fixed bugs such that we can ensure that they stay functional and useful -- Be willing to accept criticism and work on improving your code. - Have one to three maintainers review your contribution. -- Generally, follow the [style guide of the Fortran stdlib](https://github.com/fortran-lang/stdlib/blob/master/STYLE_GUIDE.md) for any contributed Fortran code. - - -### For New Contributors +If possible, include a mocked-up snippet of what the output or behavior would +look like with this feature implemented. +"Crazy", out-of-the-box ideas are especially welcome. +It's quite possible that we're not considering an unusually creative solution. + +## Workflow + +fpm is a community project. +There is no one single person making final decisions. +This the workflow that we follow: + +1. Open a [new issue](https://github.com/fortran-lang/fpm/issues/new) to + describe a bug or propose a new feature. + Refer to the earlier sections on how to write a good bug report or feature + request. +2. Discuss with the community and reach majority consensus about what should be + done about the bug or feature request. + We define "majority" loosely as 80%. + This means that at least 4 of 5 people engaged in the discussion should be + able to agree on the next step. + This allows us to have the community mostly agree while not getting stuck if + one person disagrees. + At this stage, the scope of the fix/feature, its behavior, and API if + applicable should be defined. + Only when you have community concensus on these items you should proceed + to step 3. +3. Open a new Pull Request (PR) with your contribution. + The body of the PR should at least include a bullet-point summary of the + changes, and a detailed description is encouraged. + If the PR completely addresses the issue you opened in step 1, include in + the PR description the following line: `Fixes #`. +4. Request reviewers to your PR. + For small bug fixes or documentation improvements, 1 to 2 reviewers is + sufficient. + For implementation of bigger features, request 3 to 4 or more reviewers. + Ideally, request reviewers that participated in step 2. +5. If your PR implements a feature that adds or changes the behavior of fpm, + your PR must also include appropriate changes to the documentation. + +This workflow can evolve and change over time as we learn how best to work +together. +If you have an idea on how to improve the workflow itself, please open an issue +and we'll discuss it. + +## General guidelines + +* A PR should implement _only one_ feature or bug fix. +* Do not commit changes to files that are irrelevant to your feature or bug fix. +* Smaller PRs are better than large PRs, and will lead to a shorter review and + merge cycle +* Add tests for your feature or bug fix to be sure that it stays functional and useful +* Be open to constructive criticism and requests for improving your code. +* Again, please follow the + [Fortran stdlib style guide](https://github.com/fortran-lang/stdlib/blob/master/STYLE_GUIDE.md). + +## For New Contributors If you never created a pull request before, welcome :tada:. You can learn how from -- cgit v1.2.3 From d1921e6059e30c39168ab064f588497d8bf71984 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 5 Sep 2020 13:49:50 -0400 Subject: add a note and link to the contributing guide --- README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/README.md b/README.md index 54244fa..cd73807 100644 --- a/README.md +++ b/README.md @@ -12,6 +12,9 @@ Please follow the [issues](https://github.com/fortran-lang/fpm/issues) to contribute and/or stay up to date with the development. As the prototype matures and we enter production, we will do our best to stay backwards compatible. +To report a bug report or suggest a feature, please read our +[contributor guidelines](CONTRIBUTING.md). + ## Getting started ### Install Haskell -- cgit v1.2.3 From d63c6365dd8fd80f60b78026fd5f70947458927f Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 5 Sep 2020 13:54:28 -0400 Subject: minor grammar and style fix --- CONTRIBUTING.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index e5eca7d..ce62dbe 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -54,7 +54,7 @@ the scope of the project, or if it has already been discussed. It's up to you to provide a strong argument to convince the community of the benefits of this feature. Please provide as much detail and context as possible. -If possible, include a mocked-up snippet of what the output or behavior would +If applicable, include a mocked-up snippet of what the output or behavior would look like with this feature implemented. "Crazy", out-of-the-box ideas are especially welcome. It's quite possible that we're not considering an unusually creative solution. @@ -63,7 +63,7 @@ It's quite possible that we're not considering an unusually creative solution. fpm is a community project. There is no one single person making final decisions. -This the workflow that we follow: +This is the workflow that we follow: 1. Open a [new issue](https://github.com/fortran-lang/fpm/issues/new) to describe a bug or propose a new feature. -- cgit v1.2.3 From 900e439be00e31d77e1e9e4fd929c589ebfcb417 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 5 Sep 2020 14:41:09 -0400 Subject: add developer certification --- CONTRIBUTING.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index ce62dbe..abce974 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -8,6 +8,10 @@ developers. In return, the community will help address your problem, evaluate changes, and guide you through your pull requests. +By contributing to fpm, you certify that you own or are allowed to share the +content of your contribution under the +[fpm license](https://github.com/fortran-lang/fpm/blob/master/LICENSE). + * [Style](#style) * [Reporting a bug](#reporting-a-bug) * [Suggesting a feature](#suggesting-a-feature) -- cgit v1.2.3 From fdcf6b8be7cce30ac50794ce1e8169aa4aa2ef8c Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 7 Sep 2020 08:56:39 +0100 Subject: Refactor: add basename filesystem fcn Function to extract filename from path with or without suffix. --- fpm/src/fpm_backend.f90 | 22 +++++++++------------- fpm/src/fpm_filesystem.f90 | 32 ++++++++++++++++++++++++++++++-- fpm/src/fpm_sources.f90 | 19 ++++--------------- 3 files changed, 43 insertions(+), 30 deletions(-) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 5a16193..6d9f86b 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -3,7 +3,7 @@ module fpm_backend ! Implements the native fpm build backend use fpm_environment, only: run -use fpm_filesystem, only: exists, mkdir +use fpm_filesystem, only: basename, exists, mkdir use fpm_model, only: fpm_model_t use fpm_sources, only: srcfile_t, FPM_UNIT_MODULE, FPM_UNIT_SUBMODULE, & FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM @@ -21,8 +21,7 @@ subroutine build_package(model) type(fpm_model_t), intent(inout) :: model integer :: i - character(:), allocatable :: basename, linking - character(:), allocatable :: file_parts(:) + character(:), allocatable :: base, linking if(.not.exists(model%output_directory)) then call mkdir(model%output_directory) @@ -46,13 +45,12 @@ subroutine build_package(model) if (model%sources(i)%unit_type == FPM_UNIT_PROGRAM) then - call split(model%sources(i)%file_name,file_parts,delimiters='\/.') - basename = file_parts(size(file_parts)-1) + base = basename(model%sources(i)%file_name,suffix=.false.) call run("gfortran -c " // model%sources(i)%file_name // ' '//model%fortran_compile_flags & - // " -o " // model%output_directory // '/' // basename // ".o") + // " -o " // model%output_directory // '/' // base // ".o") - call run("gfortran " // model%output_directory // '/' // basename // ".o "// & + call run("gfortran " // model%output_directory // '/' // base // ".o "// & linking //" " //model%link_flags // " -o " // model%output_directory & // '/' // model%sources(i)%exe_name) @@ -72,8 +70,7 @@ recursive subroutine build_source(model,source_file,linking) character(:), allocatable, intent(inout) :: linking integer :: i - character(:), allocatable :: file_parts(:) - character(:), allocatable :: basename + character(:), allocatable :: base if (source_file%built) then return @@ -94,12 +91,11 @@ recursive subroutine build_source(model,source_file,linking) end do - call split(source_file%file_name,file_parts,delimiters='\/.') - basename = file_parts(size(file_parts)-1) + base = basename(source_file%file_name,suffix=.false.) call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags & - // " -o " // model%output_directory//'/'//basename // ".o") - linking = linking // " " // model%output_directory//'/'// basename // ".o" + // " -o " // model%output_directory//'/'//base // ".o") + linking = linking // " " // model%output_directory//'/'// base // ".o" source_file%built = .true. diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index a86e813..f69d0fd 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -1,16 +1,44 @@ module fpm_filesystem use fpm_environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_strings, only: f_string, string_t +use fpm_strings, only: f_string, string_t, split implicit none private -public :: number_of_rows, read_lines, list_files, mkdir, exists, & +public :: basename, number_of_rows, read_lines, list_files, mkdir, exists, & get_temp_filename integer, parameter :: LINE_BUFFER_LEN = 1000 contains + +function basename(path,suffix) result (base) + ! Extract filename from path with/without suffix + ! + character(*), intent(In) :: path + logical, intent(in), optional :: suffix + character(:), allocatable :: base + + character(:), allocatable :: file_parts(:) + logical :: with_suffix + + if (.not.present(suffix)) then + with_suffix = .true. + else + with_suffix = suffix + end if + + if (with_suffix) then + call split(path,file_parts,delimiters='\/') + base = file_parts(size(file_parts)) + else + call split(path,file_parts,delimiters='\/.') + base = file_parts(size(file_parts)-1) + end if + +end function basename + + integer function number_of_rows(s) result(nrows) ! determine number or rows integer,intent(in)::s diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index bf6124a..d044051 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,5 +1,5 @@ module fpm_sources -use fpm_filesystem, only: read_lines, list_files +use fpm_filesystem, only: basename, read_lines, list_files use fpm_strings, only: lower, split, str_ends_with, string_t use fpm_manifest_executable, only: executable_t implicit none @@ -66,9 +66,6 @@ subroutine add_sources_from_dir(sources,directory,with_executables) type(string_t), allocatable :: src_file_names(:) type(srcfile_t), allocatable :: dir_sources(:) - character(:), allocatable :: basename - character(:), allocatable :: file_parts(:) - ! Scan directory for sources call list_files(directory, file_names) file_names = [(string_t(directory//'/'//file_names(j)%s),j=1,size(file_names))] @@ -99,10 +96,7 @@ subroutine add_sources_from_dir(sources,directory,with_executables) if (with_executables) then exclude_source(i) = .false. - call split(src_file_names(i)%s,file_parts,delimiters='\/.') - basename = file_parts(size(file_parts)-1) - - dir_sources(i)%exe_name = basename + dir_sources(i)%exe_name = basename(src_file_names(i)%s,suffix=.false.) end if end if @@ -131,9 +125,6 @@ subroutine add_executable_sources(sources,executables) logical, allocatable :: exclude_source(:) type(srcfile_t), allocatable :: dir_sources(:) - character(:), allocatable :: basename - character(:), allocatable :: file_parts(:) - call get_executable_source_dirs(exe_dirs,executables) do i=1,size(exe_dirs) @@ -147,12 +138,10 @@ subroutine add_executable_sources(sources,executables) ! Only allow executables in 'executables' list exclude_source(i) = (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM) - - call split(dir_sources(i)%file_name,file_parts,delimiters='\/') - basename = file_parts(size(file_parts)) do j=1,size(executables) - if (executables(j)%main == basename) then + if (basename(dir_sources(i)%file_name,suffix=.true.) == & + executables(j)%main) then exclude_source(i) = .false. dir_sources(i)%exe_name = executables(j)%name exit -- cgit v1.2.3 From 44a848eaee454a486f08d389845b31d58a02f2c0 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 7 Sep 2020 09:21:09 +0100 Subject: Add: join_path for output paths Output objects now placed in same file layout as boostrap fpm --- fpm/src/fpm_backend.f90 | 41 ++++++++++++++++++++++++++++++----------- fpm/src/fpm_filesystem.f90 | 43 +++++++++++++++++++++++++++++++++++++++++-- fpm/src/fpm_model.f90 | 8 ++++---- fpm/src/fpm_sources.f90 | 6 +++++- 4 files changed, 80 insertions(+), 18 deletions(-) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 6d9f86b..d8bfd44 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -3,7 +3,7 @@ module fpm_backend ! Implements the native fpm build backend use fpm_environment, only: run -use fpm_filesystem, only: basename, exists, mkdir +use fpm_filesystem, only: basename, join_path, exists, mkdir use fpm_model, only: fpm_model_t use fpm_sources, only: srcfile_t, FPM_UNIT_MODULE, FPM_UNIT_SUBMODULE, & FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM @@ -21,11 +21,14 @@ subroutine build_package(model) type(fpm_model_t), intent(inout) :: model integer :: i - character(:), allocatable :: base, linking + character(:), allocatable :: base, linking, subdir - if(.not.exists(model%output_directory)) then + if (.not.exists(model%output_directory)) then call mkdir(model%output_directory) end if + if (.not.exists(join_path(model%output_directory,model%package_name))) then + call mkdir(join_path(model%output_directory,model%package_name)) + end if linking = "" do i=1,size(model%sources) @@ -41,18 +44,33 @@ subroutine build_package(model) end do + if (any([(model%sources(i)%unit_type == FPM_UNIT_PROGRAM,i=1,size(model%sources))])) then + if (.not.exists(join_path(model%output_directory,'test'))) then + call mkdir(join_path(model%output_directory,'test')) + end if + if (.not.exists(join_path(model%output_directory,'app'))) then + call mkdir(join_path(model%output_directory,'app')) + end if + end if + do i=1,size(model%sources) if (model%sources(i)%unit_type == FPM_UNIT_PROGRAM) then base = basename(model%sources(i)%file_name,suffix=.false.) + if (model%sources(i)%is_test) then + subdir = 'test' + else + subdir = 'app' + end if + call run("gfortran -c " // model%sources(i)%file_name // ' '//model%fortran_compile_flags & - // " -o " // model%output_directory // '/' // base // ".o") + // " -o " // join_path(model%output_directory,subdir,base) // ".o") - call run("gfortran " // model%output_directory // '/' // base // ".o "// & - linking //" " //model%link_flags // " -o " // model%output_directory & - // '/' // model%sources(i)%exe_name) + call run("gfortran " // join_path(model%output_directory, subdir, base) // ".o "// & + linking //" " //model%link_flags // " -o " // & + join_path(model%output_directory,subdir,model%sources(i)%exe_name) ) end if @@ -70,7 +88,7 @@ recursive subroutine build_source(model,source_file,linking) character(:), allocatable, intent(inout) :: linking integer :: i - character(:), allocatable :: base + character(:), allocatable :: object_file if (source_file%built) then return @@ -91,11 +109,12 @@ recursive subroutine build_source(model,source_file,linking) end do - base = basename(source_file%file_name,suffix=.false.) + object_file = join_path(model%output_directory, model%package_name, & + basename(source_file%file_name,suffix=.false.)//'.o') call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags & - // " -o " // model%output_directory//'/'//base // ".o") - linking = linking // " " // model%output_directory//'/'// base // ".o" + // " -o " // object_file) + linking = linking // " " // object_file source_file%built = .true. diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index f69d0fd..59be19a 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -4,8 +4,8 @@ use fpm_strings, only: f_string, string_t, split implicit none private -public :: basename, number_of_rows, read_lines, list_files, mkdir, exists, & - get_temp_filename +public :: basename, join_path, number_of_rows, read_lines, list_files,& + mkdir, exists, get_temp_filename integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -39,6 +39,45 @@ function basename(path,suffix) result (base) end function basename +function join_path(a1,a2,a3,a4,a5) result(path) + ! Construct path by joining strings with os file separator + ! + character(*), intent(in) :: a1, a2 + character(*), intent(in), optional :: a3,a4,a5 + character(:), allocatable :: path + + character(1) :: filesep + + select case (get_os_type()) + case (OS_LINUX,OS_MACOS) + filesep = '/' + case (OS_WINDOWS) + filesep = '\' + end select + + path = a1 // filesep // a2 + + if (present(a3)) then + path = path // filesep // a3 + else + return + end if + + if (present(a4)) then + path = path // filesep // a4 + else + return + end if + + if (present(a5)) then + path = path // filesep // a5 + else + return + end if + +end function join_path + + integer function number_of_rows(s) result(nrows) ! determine number or rows integer,intent(in)::s diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 307033d..0387dfb 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -3,7 +3,7 @@ module fpm_model ! Definition and validation of the backend model use fpm_command_line, only: fpm_build_settings -use fpm_filesystem, only: exists +use fpm_filesystem, only: exists, join_path use fpm_manifest, only: package_t, default_library, default_executable use fpm_manifest_executable, only: executable_t use fpm_sources, only: resolve_module_dependencies, add_sources_from_dir, & @@ -46,15 +46,15 @@ subroutine build_model(model, settings, package) model%output_directory = 'build/gfortran_debug' model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & - '-J'//model%output_directory + '-J'//join_path(model%output_directory,model%package_name) model%link_flags = '' ! Add sources from executable directories if (allocated(package%executable)) then - call add_executable_sources(model%sources, package%executable) + call add_executable_sources(model%sources, package%executable,is_test=.false.) end if if (allocated(package%test)) then - call add_executable_sources(model%sources, package%test) + call add_executable_sources(model%sources, package%test,is_test=.true.) end if if (allocated(package%library)) then diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index d044051..fb6e57a 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -35,6 +35,8 @@ type srcfile_t ! File path relative to cwd character(:), allocatable :: exe_name ! Name of executable for FPM_UNIT_PROGRAM + logical :: is_test = .false. + ! Is executable a test? type(string_t), allocatable :: modules_provided(:) ! Modules provided by this source file (lowerstring) integer :: unit_type = FPM_UNIT_UNKNOWN @@ -112,12 +114,13 @@ subroutine add_sources_from_dir(sources,directory,with_executables) end subroutine add_sources_from_dir -subroutine add_executable_sources(sources,executables) +subroutine add_executable_sources(sources,executables,is_test) ! Add sources from executable directories specified in manifest ! Only allow executables that are explicitly specified in manifest ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) class(executable_t), intent(in), optional :: executables(:) + logical, intent(in) :: is_test integer :: i, j @@ -144,6 +147,7 @@ subroutine add_executable_sources(sources,executables) executables(j)%main) then exclude_source(i) = .false. dir_sources(i)%exe_name = executables(j)%name + dir_sources(i)%is_test = is_test exit end if end do -- cgit v1.2.3 From dd6ac6fc0fedd377bb95f92616aec29a01f0dcbf Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 7 Sep 2020 10:10:02 +0100 Subject: Fix: for windows paths Adds windows_path filesystem function to convert to windows compatible paths --- fpm/src/fpm_filesystem.f90 | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 59be19a..8d92ced 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -5,7 +5,7 @@ implicit none private public :: basename, join_path, number_of_rows, read_lines, list_files,& - mkdir, exists, get_temp_filename + mkdir, exists, get_temp_filename, windows_path integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -119,8 +119,8 @@ subroutine mkdir(dir) call execute_command_line("mkdir -p " // dir , exitstat=stat) write(*,*) "mkdir -p " // dir case (OS_WINDOWS) - call execute_command_line("mkdir " // dir, exitstat=stat) - write(*,*) "mkdir " // dir + call execute_command_line("mkdir " // windows_path(dir), exitstat=stat) + write(*,*) "mkdir " // windows_path(dir) end select if (stat /= 0) then print *, "execute_command_line() failed" @@ -153,7 +153,7 @@ subroutine list_files(dir, files) call execute_command_line("ls " // dir // " > "//temp_file, & exitstat=stat) case (OS_WINDOWS) - call execute_command_line("dir /b " // dir // " > "//temp_file, & + call execute_command_line("dir /b " // windows_path(dir) // " > "//temp_file, & exitstat=stat) end select if (stat /= 0) then @@ -213,4 +213,18 @@ function get_temp_filename() result(tempfile) end function get_temp_filename +function windows_path(path) result(winpath) + ! Replace file system separators for windows + ! + character(*), intent(in) :: path + character(:), allocatable :: winpath + + winpath = path + + do while(index(winpath,'/') > 0) + winpath(index(winpath,'/'):index(winpath,'/')) = '\' + end do + +end function windows_path + end module fpm_filesystem -- cgit v1.2.3 From 5500927beb1a81a39cf3f155a66b8fe5cad5b769 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 7 Sep 2020 10:10:27 +0100 Subject: Update: test scripts for fortran fpm Fortran fpm can now build 'hello_complex' example --- ci/run_tests.bat | 21 ++++++++++++++++++++- ci/run_tests.sh | 10 +++++++++- 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/ci/run_tests.bat b/ci/run_tests.bat index ea50a70..9435e0d 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -21,5 +21,24 @@ if errorlevel 1 exit 1 ..\..\..\fpm\build\gfortran_debug\app\fpm build if errorlevel 1 exit 1 -.\build\gfortran_debug\hello_world +.\build\gfortran_debug\app\hello_world if errorlevel 1 exit 1 + + +cd ..\hello_complex +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\say_Hello +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\say_goodbye +if errorlevel 1 exit 1 + +.\build\gfortran_debug\test\greet_test +if errorlevel 1 exit 1 + +.\build\gfortran_debug\test\farewell_test +if errorlevel 1 exit 1 \ No newline at end of file diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 0d9e7b1..3033c2a 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -7,6 +7,14 @@ fpm build fpm run fpm test build/gfortran_debug/app/fpm + cd ../test/example_packages/hello_world ../../../fpm/build/gfortran_debug/app/fpm build -./build/gfortran_debug/hello_world +./build/gfortran_debug/app/hello_world + +cd ../hello_complex +../../../fpm/build/gfortran_debug/app/fpm build +./build/gfortran_debug/app/say_Hello +./build/gfortran_debug/app/say_goodbye +./build/gfortran_debug/test/greet_test +./build/gfortran_debug/test/farewell_test \ No newline at end of file -- cgit v1.2.3 From f32d6c3c6129630cf416e8d91298e3a5840001a3 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 7 Sep 2020 15:33:36 +0100 Subject: Fix: allocation for default library. --- fpm/src/fpm.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index def32dd..1bd4c7f 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -33,6 +33,7 @@ end if ! Populate library in case we find the default src directory if (.not.allocated(package%library) .and. exists("src")) then + allocate(package%library) call default_library(package%library) end if -- cgit v1.2.3 From 35ae709c0fed91d40422942eb3b3d8003828ebe9 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 7 Sep 2020 15:37:22 +0100 Subject: Fix: basename function with trim Output of split (M_strings) needs trimming. --- fpm/src/fpm_filesystem.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 8d92ced..297278b 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -30,10 +30,10 @@ function basename(path,suffix) result (base) if (with_suffix) then call split(path,file_parts,delimiters='\/') - base = file_parts(size(file_parts)) + base = trim(file_parts(size(file_parts))) else call split(path,file_parts,delimiters='\/.') - base = file_parts(size(file_parts)-1) + base = trim(file_parts(size(file_parts)-1)) end if end function basename -- cgit v1.2.3 From 9bd9d3ff3b87fa28c7c731a977a934c88cb55503 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 7 Sep 2020 15:47:29 +0100 Subject: Fix: more trimming of split string output. --- fpm/src/fpm_sources.f90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index fb6e57a..67d6fc5 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -236,7 +236,7 @@ function parse_f_source(f_filename) result(f_source) if (index(file_lines(i)%s,'::') > 0) then call split(file_lines(i)%s,line_parts,delimiters=':') - temp_string = line_parts(2) + temp_string = trim(line_parts(2)) call split(temp_string,line_parts,delimiters=' ,') mod_name = trim(lower(line_parts(1))) @@ -273,7 +273,7 @@ function parse_f_source(f_filename) result(f_source) if (pass == 2) then call split(file_lines(i)%s,line_parts,delimiters="'"//'"') - f_source%include_dependencies(n_include)%s = line_parts(2) + f_source%include_dependencies(n_include)%s = trim(line_parts(2)) end if end if @@ -322,12 +322,10 @@ function parse_f_source(f_filename) result(f_source) end if - ! Extract name of program if is program + ! Detect if is program if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. & index(adjustl(lower(file_lines(i)%s)),'program') == 1) then - call split(file_lines(i)%s,line_parts,delimiters=' ') - f_source%unit_type = FPM_UNIT_PROGRAM end if @@ -433,7 +431,7 @@ function parse_c_source(c_filename) result(c_source) if (pass == 2) then call split(file_lines(i)%s,line_parts,delimiters='"') - c_source%include_dependencies(n_include)%s = line_parts(2) + c_source%include_dependencies(n_include)%s = trim(line_parts(2)) end if end if -- cgit v1.2.3 From 20c37324fa7ed6ef65392704b577ba2f77fecae8 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Mon, 7 Sep 2020 12:18:51 -0400 Subject: Update CONTRIBUTING.md Co-authored-by: Laurence Kedward --- CONTRIBUTING.md | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index abce974..690fa23 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -83,7 +83,10 @@ This is the workflow that we follow: At this stage, the scope of the fix/feature, its behavior, and API if applicable should be defined. Only when you have community concensus on these items you should proceed - to step 3. + to writing code and opening a PR. + __When actively working on code towards a PR, please assign yourself to the issue on github.__ + This is good collaborative practice to avoid duplicated effort and also inform others what you + are currently working on. 3. Open a new Pull Request (PR) with your contribution. The body of the PR should at least include a bullet-point summary of the changes, and a detailed description is encouraged. -- cgit v1.2.3 From 78bf536251c03c4d7c7fb6134b59e0bcfa4a1bb6 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Mon, 7 Sep 2020 12:20:06 -0400 Subject: Update CONTRIBUTING.md Co-authored-by: Laurence Kedward --- CONTRIBUTING.md | 1 - 1 file changed, 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 690fa23..0e0aa8d 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -21,7 +21,6 @@ content of your contribution under the ## Style -We require high-quality code. Please follow the [Fortran stdlib style guide](https://github.com/fortran-lang/stdlib/blob/master/STYLE_GUIDE.md) for any Fortran code that you contribute. -- cgit v1.2.3 From 61c2a7dc438f716d4b85a584fb4ed0f4046c9bb5 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Mon, 7 Sep 2020 12:20:21 -0400 Subject: Update CONTRIBUTING.md Co-authored-by: Laurence Kedward --- CONTRIBUTING.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 0e0aa8d..1d6f6fa 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -117,7 +117,7 @@ and we'll discuss it. ## For New Contributors -If you never created a pull request before, welcome :tada:. +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). -- cgit v1.2.3 From a8ea9830c1bb64705688ac6b431aee7d8cee779b Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Mon, 7 Sep 2020 12:23:37 -0400 Subject: Update CONTRIBUTING.md --- CONTRIBUTING.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 1d6f6fa..afe81ca 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -122,5 +122,5 @@ You can learn how from [this great tutorial](https://egghead.io/series/how-to-contribute-to-an-open-source-project-on-github). Don't know where to start? -You can start by looking through these -[help-wanted issues](https://github.com/fortran-lang/fpm/issues?q=label%3A%22help+wanted%22+is%3Aissue+is%3Aopen). +You can start by looking through the list of +[open issues](https://github.com/fortran-lang/fpm/issues). -- cgit v1.2.3 From 518341b67b6063181c79b473595ef27b35ee2f62 Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 8 Sep 2020 10:50:48 +0100 Subject: Update: fpm_sources with ieee intrinsic module names --- fpm/src/fpm_sources.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 67d6fc5..d743006 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -21,7 +21,10 @@ integer, parameter :: FPM_UNIT_CHEADER = 6 character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & ['iso_c_binding ', & - 'iso_fortran_env'] + 'iso_fortran_env', & + 'ieee_arithmetic', & + 'ieee_exceptions', & + 'ieee_features '] type srcfile_ptr ! For constructing arrays of src_file pointers -- cgit v1.2.3 From 8c8e4e9ec834c4a08078eb82a685fc001baa89aa Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 8 Sep 2020 10:51:42 +0100 Subject: Fix: erroneous optional attribute --- fpm/src/fpm_sources.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index d743006..99652e7 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -122,7 +122,7 @@ subroutine add_executable_sources(sources,executables,is_test) ! Only allow executables that are explicitly specified in manifest ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) - class(executable_t), intent(in), optional :: executables(:) + class(executable_t), intent(in) :: executables(:) logical, intent(in) :: is_test integer :: i, j -- cgit v1.2.3 From fd49a2e6ee374d06206bd0ae47fce92c6339ea5d Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 8 Sep 2020 11:58:16 +0100 Subject: Updates: for improved readability Adds string_array_contains helper function for determining if array of string_t contains a particular string. --- fpm/src/fpm.f90 | 3 --- fpm/src/fpm_filesystem.f90 | 10 +++++++--- fpm/src/fpm_sources.f90 | 9 ++++----- fpm/src/fpm_strings.f90 | 19 +++++++++++++++++++ 4 files changed, 30 insertions(+), 11 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 1bd4c7f..69fe155 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -22,9 +22,6 @@ type(fpm_build_settings), intent(in) :: settings type(package_t) :: package type(fpm_model_t) :: model type(error_t), allocatable :: error -type(string_t), allocatable :: files(:) -character(:), allocatable :: basename, linking -integer :: i, n call get_package_data(package, "fpm.toml", error) if (allocated(error)) then print '(a)', error%message diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 297278b..d5c8e67 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -218,11 +218,15 @@ function windows_path(path) result(winpath) ! character(*), intent(in) :: path character(:), allocatable :: winpath - + + integer :: idx + winpath = path - do while(index(winpath,'/') > 0) - winpath(index(winpath,'/'):index(winpath,'/')) = '\' + idx = index(winpath,'/') + do while(idx > 0) + winpath(idx:idx) = '\' + idx = index(winpath,'/') end do end function windows_path diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 99652e7..b84e31d 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,6 +1,6 @@ module fpm_sources use fpm_filesystem, only: basename, read_lines, list_files -use fpm_strings, only: lower, split, str_ends_with, string_t +use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t implicit none @@ -97,7 +97,7 @@ subroutine add_sources_from_dir(sources,directory,with_executables) ! Exclude executables unless specified otherwise exclude_source(i) = (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM) if (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM .and. & - present(with_executables)) then + & present(with_executables)) then if (with_executables) then exclude_source(i) = .false. @@ -174,12 +174,11 @@ subroutine get_executable_source_dirs(exe_dirs,executables) type(string_t) :: dirs_temp(size(executables)) - integer :: i, j, n + integer :: i, n n = 0 do i=1,size(executables) - if (.not.any([(dirs_temp(j)%s==executables(i)%source_dir, & - j=1,n)])) then + if (.not.(executables(i)%source_dir .in. dirs_temp)) then n = n + 1 dirs_temp(n)%s = executables(i)%source_dir diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index dd18f09..a6511c9 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -3,11 +3,16 @@ implicit none private public :: f_string, lower, split, str_ends_with, string_t +public :: string_array_contains, operator(.in.) type string_t character(len=:), allocatable :: s end type +interface operator(.in.) + module procedure string_array_contains +end interface + contains logical function str_ends_with(s, e) result(r) @@ -76,6 +81,20 @@ elemental pure function lower(str,begin,end) result (string) end function lower +logical function string_array_contains(search_string,array) + ! Check if array of string_t contains a particular string + ! + character(*), intent(in) :: search_string + type(string_t), intent(in) :: array(:) + + integer :: i + + string_array_contains = any([(array(i)%s==search_string, & + i=1,size(array))]) + +end function string_array_contains + + subroutine split(input_line,array,delimiters,order,nulls) ! parse string on delimiter characters and store tokens into an allocatable array" ! Author: John S. Urban -- cgit v1.2.3 From 4c68956ada155ff15a0b22c1ac28f9c824c45091 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Tue, 8 Sep 2020 14:50:07 -0400 Subject: Update CONTRIBUTING.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Ondřej Čertík --- CONTRIBUTING.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index afe81ca..7ec202a 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -35,7 +35,7 @@ Before opening a bug report: 1. Check if the issue has already been reported. ([issues](https://github.com/fortran-lang/fpm/issues)) -2. Check if it's still an issue or it has been fixed? +2. Check if it is still an issue or it has been fixed? Try to reproduce it with the latest version from the master branch. 3. Isolate the problem and create a minimal test case. -- cgit v1.2.3 From ec959b665f478787ade0ac29697d25ebd5bfac56 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Tue, 8 Sep 2020 14:50:19 -0400 Subject: Update CONTRIBUTING.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Ondřej Čertík --- CONTRIBUTING.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 7ec202a..d6f0c23 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -54,7 +54,7 @@ minimal back-and-forth. Before suggesting a new feature, take a moment to find out if it fits the scope of the project, or if it has already been discussed. -It's up to you to provide a strong argument to convince the community of the +It is up to you to provide a strong argument to convince the community of the benefits of this feature. Please provide as much detail and context as possible. If applicable, include a mocked-up snippet of what the output or behavior would -- cgit v1.2.3 From 83c528cc04821e9817e5d5d8cadaa164fb067fe8 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Tue, 8 Sep 2020 14:50:27 -0400 Subject: Update CONTRIBUTING.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Ondřej Čertík --- CONTRIBUTING.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index d6f0c23..1332278 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -60,7 +60,7 @@ Please provide as much detail and context as possible. If applicable, include a mocked-up snippet of what the output or behavior would look like with this feature implemented. "Crazy", out-of-the-box ideas are especially welcome. -It's quite possible that we're not considering an unusually creative solution. +It's quite possible that we are not considering an unusually creative solution. ## Workflow -- cgit v1.2.3 From eed082b47c95b3732dee25822f8604e80fe34790 Mon Sep 17 00:00:00 2001 From: LKedward Date: Fri, 11 Sep 2020 16:16:36 +0100 Subject: Isolate model definition from model construction --- fpm/src/fpm.f90 | 42 +++++++++++++++++++++--- fpm/src/fpm_backend.f90 | 6 ++-- fpm/src/fpm_model.f90 | 87 ++++++++++++++++++++++++------------------------- fpm/src/fpm_sources.f90 | 46 +++----------------------- 4 files changed, 87 insertions(+), 94 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 69fe155..29d663c 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -4,10 +4,12 @@ use fpm_strings, only: string_t, str_ends_with use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only: number_of_rows, list_files, exists -use fpm_model, only: build_model, fpm_model_t -use fpm_manifest, only : get_package_data, default_executable, default_library, & - & package_t +use fpm_filesystem, only: join_path, number_of_rows, list_files, exists +use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t +use fpm_sources, only: add_executable_sources, add_sources_from_dir, & + resolve_module_dependencies +use fpm_manifest, only : get_package_data, default_executable, & + default_library, package_t use fpm_error, only : error_t implicit none private @@ -16,6 +18,38 @@ public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test contains +subroutine build_model(model, settings, package) + ! Constructs a valid fpm model from command line settings and toml manifest + ! + type(fpm_model_t), intent(out) :: model + type(fpm_build_settings), intent(in) :: settings + type(package_t), intent(in) :: package + + model%package_name = package%name + + ! #TODO: Choose flags and output directory based on cli settings & manifest inputs + model%fortran_compiler = 'gfortran' + model%output_directory = 'build/gfortran_debug' + model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & + '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & + '-J'//join_path(model%output_directory,model%package_name) + model%link_flags = '' + + ! Add sources from executable directories + if (allocated(package%executable)) then + call add_executable_sources(model%sources, package%executable,is_test=.false.) + end if + if (allocated(package%test)) then + call add_executable_sources(model%sources, package%test,is_test=.true.) + end if + + if (allocated(package%library)) then + call add_sources_from_dir(model%sources,package%library%source_dir) + end if + + call resolve_module_dependencies(model%sources) + +end subroutine build_model subroutine cmd_build(settings) type(fpm_build_settings), intent(in) :: settings diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index d8bfd44..62fd242 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -4,9 +4,9 @@ module fpm_backend use fpm_environment, only: run use fpm_filesystem, only: basename, join_path, exists, mkdir -use fpm_model, only: fpm_model_t -use fpm_sources, only: srcfile_t, FPM_UNIT_MODULE, FPM_UNIT_SUBMODULE, & - FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM +use fpm_model, only: fpm_model_t, srcfile_t, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & + FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM use fpm_strings, only: split implicit none diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 0387dfb..702ba6f 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -1,19 +1,51 @@ module fpm_model - ! Definition and validation of the backend model - -use fpm_command_line, only: fpm_build_settings -use fpm_filesystem, only: exists, join_path -use fpm_manifest, only: package_t, default_library, default_executable -use fpm_manifest_executable, only: executable_t -use fpm_sources, only: resolve_module_dependencies, add_sources_from_dir, & - add_executable_sources, srcfile_t use fpm_strings, only: string_t - implicit none private -public :: build_model, fpm_model_t +public :: srcfile_ptr, srcfile_t, fpm_model_t + +public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & + FPM_UNIT_CHEADER + +integer, parameter :: FPM_UNIT_UNKNOWN = -1 +integer, parameter :: FPM_UNIT_PROGRAM = 1 +integer, parameter :: FPM_UNIT_MODULE = 2 +integer, parameter :: FPM_UNIT_SUBMODULE = 3 +integer, parameter :: FPM_UNIT_SUBPROGRAM = 4 +integer, parameter :: FPM_UNIT_CSOURCE = 5 +integer, parameter :: FPM_UNIT_CHEADER = 6 + +type srcfile_ptr + ! For constructing arrays of src_file pointers + type(srcfile_t), pointer :: ptr => null() +end type srcfile_ptr + +type srcfile_t + ! Type for encapsulating a source file + ! and it's metadata + character(:), allocatable :: file_name + ! File path relative to cwd + character(:), allocatable :: exe_name + ! Name of executable for FPM_UNIT_PROGRAM + logical :: is_test = .false. + ! Is executable a test? + type(string_t), allocatable :: modules_provided(:) + ! Modules provided by this source file (lowerstring) + integer :: unit_type = FPM_UNIT_UNKNOWN + ! Type of program unit + type(string_t), allocatable :: modules_used(:) + ! Modules USEd by this source file (lowerstring) + type(string_t), allocatable :: include_dependencies(:) + ! Files INCLUDEd by this source file + type(srcfile_ptr), allocatable :: file_dependencies(:) + ! Resolved source file dependencies + + logical :: built = .false. + logical :: touched = .false. +end type srcfile_t type :: fpm_model_t character(:), allocatable :: package_name @@ -30,39 +62,4 @@ type :: fpm_model_t ! Base directory for build end type fpm_model_t -contains - -subroutine build_model(model, settings, package) - ! Constructs a valid fpm model from command line settings and toml manifest - ! - type(fpm_model_t), intent(out) :: model - type(fpm_build_settings), intent(in) :: settings - type(package_t), intent(in) :: package - - model%package_name = package%name - - ! #TODO: Choose flags and output directory based on cli settings & manifest inputs - model%fortran_compiler = 'gfortran' - model%output_directory = 'build/gfortran_debug' - model%fortran_compile_flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g '// & - '-fbounds-check -fcheck-array-temporaries -fbacktrace '// & - '-J'//join_path(model%output_directory,model%package_name) - model%link_flags = '' - - ! Add sources from executable directories - if (allocated(package%executable)) then - call add_executable_sources(model%sources, package%executable,is_test=.false.) - end if - if (allocated(package%test)) then - call add_executable_sources(model%sources, package%test,is_test=.true.) - end if - - if (allocated(package%library)) then - call add_sources_from_dir(model%sources,package%library%source_dir) - end if - - call resolve_module_dependencies(model%sources) - -end subroutine build_model - end module fpm_model diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index b84e31d..f2418b5 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,23 +1,15 @@ module fpm_sources +use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & + FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & + FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER use fpm_filesystem, only: basename, read_lines, list_files use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t implicit none private -public :: srcfile_ptr, srcfile_t public :: add_sources_from_dir, add_executable_sources, resolve_module_dependencies -public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & - FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & - FPM_UNIT_CHEADER - -integer, parameter :: FPM_UNIT_UNKNOWN = -1 -integer, parameter :: FPM_UNIT_PROGRAM = 1 -integer, parameter :: FPM_UNIT_MODULE = 2 -integer, parameter :: FPM_UNIT_SUBMODULE = 3 -integer, parameter :: FPM_UNIT_SUBPROGRAM = 4 -integer, parameter :: FPM_UNIT_CSOURCE = 5 -integer, parameter :: FPM_UNIT_CHEADER = 6 character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & ['iso_c_binding ', & @@ -26,36 +18,6 @@ character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & 'ieee_exceptions', & 'ieee_features '] -type srcfile_ptr - ! For constructing arrays of src_file pointers - type(srcfile_t), pointer :: ptr => null() -end type srcfile_ptr - -type srcfile_t - ! Type for encapsulating a source file - ! and it's metadata - character(:), allocatable :: file_name - ! File path relative to cwd - character(:), allocatable :: exe_name - ! Name of executable for FPM_UNIT_PROGRAM - logical :: is_test = .false. - ! Is executable a test? - type(string_t), allocatable :: modules_provided(:) - ! Modules provided by this source file (lowerstring) - integer :: unit_type = FPM_UNIT_UNKNOWN - ! Type of program unit - type(string_t), allocatable :: modules_used(:) - ! Modules USEd by this source file (lowerstring) - type(string_t), allocatable :: include_dependencies(:) - ! Files INCLUDEd by this source file - type(srcfile_ptr), allocatable :: file_dependencies(:) - ! Resolved source file dependencies - - logical :: built = .false. - logical :: touched = .false. -end type srcfile_t - - contains subroutine add_sources_from_dir(sources,directory,with_executables) -- cgit v1.2.3