| 1 | ! fpm-inspired source suffix classifier shape. |
| 2 | ! Conservatively written because the typed constructor spelling |
| 3 | ! `[character(len=20) :: ...]` is still a separate parser-gap note. |
| 4 | ! CHECK: 3 2 2 322 |
| 5 | ! IR_CHECK: call @classify_sources( |
| 6 | ! REPRO_CHECK: asm |
| 7 | ! REPRO_CHECK: obj |
| 8 | ! REPRO_CHECK: run |
| 9 | ! OPT_EQ: O0,O1,O2,O3,Os,Ofast => stdout|stderr|exit |
| 10 | ! PHASE_TRIANGULATE: ir|asm|obj|repro |
| 11 | module suffix_scan_mod |
| 12 | implicit none |
| 13 | contains |
| 14 | pure logical function has_suffix(name, suffix) |
| 15 | implicit none |
| 16 | character(len=*), intent(in) :: name |
| 17 | character(len=*), intent(in) :: suffix |
| 18 | integer(8) :: pos |
| 19 | |
| 20 | pos = index(name, suffix) |
| 21 | has_suffix = pos > 0_8 |
| 22 | end function has_suffix |
| 23 | |
| 24 | subroutine classify_sources(names, nf90, nfixed, ncpp) |
| 25 | implicit none |
| 26 | character(len=*), intent(in) :: names(:) |
| 27 | integer, intent(out) :: nf90, nfixed, ncpp |
| 28 | integer :: i |
| 29 | |
| 30 | nf90 = 0 |
| 31 | nfixed = 0 |
| 32 | ncpp = 0 |
| 33 | |
| 34 | do i = 1, size(names) |
| 35 | if (has_suffix(names(i), ".f90")) then |
| 36 | nf90 = nf90 + 1 |
| 37 | else if (has_suffix(names(i), ".f")) then |
| 38 | nfixed = nfixed + 1 |
| 39 | else if (has_suffix(names(i), ".F90")) then |
| 40 | ncpp = ncpp + 1 |
| 41 | end if |
| 42 | end do |
| 43 | end subroutine classify_sources |
| 44 | end module suffix_scan_mod |
| 45 | |
| 46 | program realworld_suffix_scan |
| 47 | use suffix_scan_mod |
| 48 | implicit none |
| 49 | character(len=20) :: names(8) |
| 50 | integer :: nf90, nfixed, ncpp |
| 51 | |
| 52 | names(1) = "main.f90" |
| 53 | names(2) = "lexer.f90" |
| 54 | names(3) = "legacy.f" |
| 55 | names(4) = "build.F90" |
| 56 | names(5) = "notes.txt" |
| 57 | names(6) = "scan.f90" |
| 58 | names(7) = "pack.f" |
| 59 | names(8) = "driver.F90" |
| 60 | |
| 61 | call classify_sources(names, nf90, nfixed, ncpp) |
| 62 | print *, nf90, nfixed, ncpp, 100 * nf90 + 10 * nfixed + ncpp |
| 63 | end program realworld_suffix_scan |
| 64 |