Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Source parsing: consider end program with no program header #1078

Merged
merged 4 commits into from
Oct 21, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion src/fpm_model.f90
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,7 @@ module fpm_model
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, &
FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, &
FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST, &
FPM_UNIT_CPPSOURCE, FPM_SCOPE_NAME
FPM_UNIT_CPPSOURCE, FPM_SCOPE_NAME, FPM_UNIT_NAME

!> Source type unknown
integer, parameter :: FPM_UNIT_UNKNOWN = -1
Expand Down
7 changes: 5 additions & 2 deletions src/fpm_source_parsing.f90
Original file line number Diff line number Diff line change
Expand Up @@ -333,8 +333,10 @@ function parse_f_source(f_filename,error) result(f_source)
end if

! Detect if contains a program
! (no modules allowed after program def)
if (index(file_lines_lower(i)%s,'program ') == 1) then
! - no modules allowed after program def
! - program header may be missing (only "end program" statement present)
if (index(file_lines_lower(i)%s,'program ')==1 .or. &
parse_sequence(file_lines_lower(i)%s,'end','program')) then

temp_string = split_n(file_lines_lower(i)%s,n=2,delims=' ',stat=stat)
if (stat == 0) then
Expand All @@ -351,6 +353,7 @@ function parse_f_source(f_filename,error) result(f_source)
f_source%unit_type = FPM_UNIT_PROGRAM

cycle


end if

Expand Down
94 changes: 93 additions & 1 deletion test/fpm_test/test_source_parsing.f90
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ module test_source_parsing
use fpm_source_parsing, only: parse_f_source, parse_c_source, parse_use_statement
use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, &
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, &
FPM_UNIT_CPPSOURCE
FPM_UNIT_CPPSOURCE, FPM_UNIT_NAME
use fpm_strings, only: operator(.in.), lower
use fpm_error, only: file_parse_error, fatal_error
implicit none
Expand All @@ -27,6 +27,8 @@ subroutine collect_source_parsing(testsuite)
& new_unittest("nonintrinsic-modules-used", test_nonintrinsic_modules_used), &
& new_unittest("include-stmt", test_include_stmt), &
& new_unittest("program", test_program), &
& new_unittest("program-noheader", test_program_noheader), &
& new_unittest("program-noheader-2", test_program_noheader_2), &
& new_unittest("module", test_module), &
& new_unittest("module-with-subprogram", test_module_with_subprogram), &
& new_unittest("module-with-c-api", test_module_with_c_api), &
Expand Down Expand Up @@ -380,6 +382,96 @@ subroutine test_program(error)

end subroutine test_program

!> Try to parse a simple fortran program with no "program" header
subroutine test_program_noheader(error)

!> Error handling
type(error_t), allocatable, intent(out) :: error

integer :: unit
character(:), allocatable :: temp_file
type(srcfile_t), allocatable :: f_source

allocate(temp_file, source=get_temp_filename())

open(file=temp_file, newunit=unit)
write(unit, '(a)') &
& 'use program_one', &
& 'implicit none', &
& 'integer :: module, program', &
& 'module = 1', &
& 'module= 1', &
& 'module =1', &
& 'module (i) =1', &
& 'program = 123', &
& 'contains', &
& 'subroutine f()', &
& 'end subroutine f', &
& 'end program'
close(unit)

f_source = parse_f_source(temp_file,error)
if (allocated(error)) then
return
end if

if (f_source%unit_type /= FPM_UNIT_PROGRAM) then
call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM, found '//&
FPM_UNIT_NAME(f_source%unit_type))
return
end if

if (size(f_source%modules_provided) /= 0) then
call test_failed(error,'Unexpected modules_provided - expecting zero')
return
end if

if (size(f_source%modules_used) /= 1) then
call test_failed(error,'Incorrect number of modules_used - expecting one')
return
end if

if (.not.('program_one' .in. f_source%modules_used)) then
call test_failed(error,'Missing module in modules_used')
return
end if

call f_source%test_serialization('srcfile_t: serialization', error)

end subroutine test_program_noheader

!> Try to parse a simple fortran program with no "program" header
subroutine test_program_noheader_2(error)

!> Error handling
type(error_t), allocatable, intent(out) :: error

integer :: unit
character(:), allocatable :: temp_file
type(srcfile_t), allocatable :: f_source

allocate(temp_file, source=get_temp_filename())

open(file=temp_file, newunit=unit)
write(unit, '(a)') &
& 'print *, "Hello World"', &
& 'end program'
close(unit)

f_source = parse_f_source(temp_file,error)
if (allocated(error)) then
return
end if

if (f_source%unit_type /= FPM_UNIT_PROGRAM) then
call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM, found '//&
FPM_UNIT_NAME(f_source%unit_type))
return
end if

call f_source%test_serialization('srcfile_t: serialization', error)

end subroutine test_program_noheader_2

!> Try to parse fortran module
subroutine test_module(error)
Expand Down
Loading