Skip to content

Commit d92053e

Browse files
authored
Source parsing: consider end program with no program header (#1078)
2 parents bba4ef6 + 670af19 commit d92053e

File tree

3 files changed

+99
-4
lines changed

3 files changed

+99
-4
lines changed

src/fpm_model.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ module fpm_model
5252
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, &
5353
FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, &
5454
FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST, &
55-
FPM_UNIT_CPPSOURCE, FPM_SCOPE_NAME
55+
FPM_UNIT_CPPSOURCE, FPM_SCOPE_NAME, FPM_UNIT_NAME
5656

5757
!> Source type unknown
5858
integer, parameter :: FPM_UNIT_UNKNOWN = -1

src/fpm_source_parsing.f90

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -334,8 +334,10 @@ function parse_f_source(f_filename,error) result(f_source)
334334
end if
335335

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

340342
temp_string = split_n(file_lines_lower(i)%s,n=2,delims=' ',stat=stat)
341343
if (stat == 0) then
@@ -352,6 +354,7 @@ function parse_f_source(f_filename,error) result(f_source)
352354
f_source%unit_type = FPM_UNIT_PROGRAM
353355

354356
cycle
357+
355358

356359
end if
357360

test/fpm_test/test_source_parsing.f90

Lines changed: 93 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ module test_source_parsing
55
use fpm_source_parsing, only: parse_f_source, parse_c_source, parse_use_statement
66
use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, &
77
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, &
8-
FPM_UNIT_CPPSOURCE
8+
FPM_UNIT_CPPSOURCE, FPM_UNIT_NAME
99
use fpm_strings, only: operator(.in.), lower
1010
use fpm_error, only: file_parse_error, fatal_error
1111
implicit none
@@ -27,6 +27,8 @@ subroutine collect_source_parsing(testsuite)
2727
& new_unittest("nonintrinsic-modules-used", test_nonintrinsic_modules_used), &
2828
& new_unittest("include-stmt", test_include_stmt), &
2929
& new_unittest("program", test_program), &
30+
& new_unittest("program-noheader", test_program_noheader), &
31+
& new_unittest("program-noheader-2", test_program_noheader_2), &
3032
& new_unittest("module", test_module), &
3133
& new_unittest("module-with-subprogram", test_module_with_subprogram), &
3234
& new_unittest("module-with-c-api", test_module_with_c_api), &
@@ -382,6 +384,96 @@ subroutine test_program(error)
382384

383385
end subroutine test_program
384386

387+
!> Try to parse a simple fortran program with no "program" header
388+
subroutine test_program_noheader(error)
389+
390+
!> Error handling
391+
type(error_t), allocatable, intent(out) :: error
392+
393+
integer :: unit
394+
character(:), allocatable :: temp_file
395+
type(srcfile_t), allocatable :: f_source
396+
397+
allocate(temp_file, source=get_temp_filename())
398+
399+
open(file=temp_file, newunit=unit)
400+
write(unit, '(a)') &
401+
& 'use program_one', &
402+
& 'implicit none', &
403+
& 'integer :: module, program', &
404+
& 'module = 1', &
405+
& 'module= 1', &
406+
& 'module =1', &
407+
& 'module (i) =1', &
408+
& 'program = 123', &
409+
& 'contains', &
410+
& 'subroutine f()', &
411+
& 'end subroutine f', &
412+
& 'end program'
413+
close(unit)
414+
415+
f_source = parse_f_source(temp_file,error)
416+
if (allocated(error)) then
417+
return
418+
end if
419+
420+
if (f_source%unit_type /= FPM_UNIT_PROGRAM) then
421+
call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM, found '//&
422+
FPM_UNIT_NAME(f_source%unit_type))
423+
return
424+
end if
425+
426+
if (size(f_source%modules_provided) /= 0) then
427+
call test_failed(error,'Unexpected modules_provided - expecting zero')
428+
return
429+
end if
430+
431+
if (size(f_source%modules_used) /= 1) then
432+
call test_failed(error,'Incorrect number of modules_used - expecting one')
433+
return
434+
end if
435+
436+
if (.not.('program_one' .in. f_source%modules_used)) then
437+
call test_failed(error,'Missing module in modules_used')
438+
return
439+
end if
440+
441+
call f_source%test_serialization('srcfile_t: serialization', error)
442+
443+
end subroutine test_program_noheader
444+
445+
!> Try to parse a simple fortran program with no "program" header
446+
subroutine test_program_noheader_2(error)
447+
448+
!> Error handling
449+
type(error_t), allocatable, intent(out) :: error
450+
451+
integer :: unit
452+
character(:), allocatable :: temp_file
453+
type(srcfile_t), allocatable :: f_source
454+
455+
allocate(temp_file, source=get_temp_filename())
456+
457+
open(file=temp_file, newunit=unit)
458+
write(unit, '(a)') &
459+
& 'print *, "Hello World"', &
460+
& 'end program'
461+
close(unit)
462+
463+
f_source = parse_f_source(temp_file,error)
464+
if (allocated(error)) then
465+
return
466+
end if
467+
468+
if (f_source%unit_type /= FPM_UNIT_PROGRAM) then
469+
call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM, found '//&
470+
FPM_UNIT_NAME(f_source%unit_type))
471+
return
472+
end if
473+
474+
call f_source%test_serialization('srcfile_t: serialization', error)
475+
476+
end subroutine test_program_noheader_2
385477

386478
!> Try to parse fortran module
387479
subroutine test_module(error)

0 commit comments

Comments
 (0)