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.

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