diff options
| -rw-r--r-- | fpm/src/FPM_Sourcefiles.f90 | 271 | ||||
| -rw-r--r-- | fpm/src/FPM_Strings.f90 | 154 |
2 files changed, 424 insertions, 1 deletions
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 |