diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index f3449e16d2..2db459f26f 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -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 diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index c1f4bab98f..4032292006 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -334,8 +334,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 @@ -352,6 +354,7 @@ function parse_f_source(f_filename,error) result(f_source) f_source%unit_type = FPM_UNIT_PROGRAM cycle + end if diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 616f4ffe64..b4947c2b7d 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -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 @@ -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), & @@ -382,6 +384,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)