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