Parsing of c, cpp source files
The following statements are recognised and parsed:
#include
preprocessor statementType | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | c_filename | |||
type(error_t), | intent(out), | allocatable | :: | error |
function parse_c_source(c_filename,error) result(c_source)
character(*), intent(in) :: c_filename
type(srcfile_t) :: c_source
type(error_t), allocatable, intent(out) :: error
integer :: fh, n_include, i, pass, stat
type(string_t), allocatable :: file_lines(:)
c_source%file_name = c_filename
if (str_ends_with(lower(c_filename), ".c")) then
c_source%unit_type = FPM_UNIT_CSOURCE
else if (str_ends_with(lower(c_filename), ".h")) then
c_source%unit_type = FPM_UNIT_CHEADER
else if (str_ends_with(lower(c_filename), ".cpp")) then
c_source%unit_type = FPM_UNIT_CPPSOURCE
end if
allocate(c_source%modules_used(0))
allocate(c_source%modules_provided(0))
allocate(c_source%parent_modules(0))
open(newunit=fh,file=c_filename,status='old')
file_lines = read_lines(fh)
close(fh)
! Ignore empty files, returned as FPM_UNIT_UNKNOWN
if (len_trim(file_lines) < 1) then
c_source%unit_type = FPM_UNIT_UNKNOWN
return
end if
c_source%digest = fnv_1a(file_lines)
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
c_source%include_dependencies(n_include)%s = &
& split_n(file_lines(i)%s,n=2,delims='"',stat=stat)
if (stat /= 0) then
call file_parse_error(error,c_filename, &
'unable to get c include file',i, &
file_lines(i)%s,index(file_lines(i)%s,'"'))
return
end if
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