Skip to content

Commit faeba62

Browse files
committed
resolution for :
Replace fixed-size character length of I/O lines to allocatable arrays #902 Remove fixed-length I/O by using the already-available getline(3f) procedure, which can read an arbitrary-length input line. This should resolve #902.
1 parent c020044 commit faeba62

File tree

2 files changed

+85
-23
lines changed

2 files changed

+85
-23
lines changed

src/fpm_filesystem.F90

Lines changed: 19 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -6,17 +6,16 @@ module fpm_filesystem
66
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
77
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
88
use fpm_environment, only: separator, get_env, os_is_unix
9-
use fpm_strings, only: f_string, replace, string_t, split, notabs, str_begins_with_str
9+
use fpm_strings, only: f_string, replace, string_t, split, dilate, str_begins_with_str
1010
use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer
1111
use fpm_error, only : fpm_stop, error_t, fatal_error
1212
implicit none
1313
private
1414
public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, list_files, get_local_prefix, &
1515
mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, fileopen, fileclose, &
1616
filewrite, warnwrite, parent_dir, is_hidden_file, read_lines, read_lines_expanded, which, run, &
17-
LINE_BUFFER_LEN, os_delete_dir, is_absolute_path, env_variable, get_home, execute_and_read_output, &
17+
os_delete_dir, is_absolute_path, env_variable, get_home, execute_and_read_output, &
1818
get_dos_path
19-
integer, parameter :: LINE_BUFFER_LEN = 32768
2019

2120
#ifndef FPM_BOOTSTRAP
2221
interface
@@ -332,14 +331,13 @@ function read_lines_expanded(fh) result(lines)
332331
type(string_t), allocatable :: lines(:)
333332

334333
integer :: i
335-
integer :: ilen
336-
character(LINE_BUFFER_LEN) :: line_buffer_read, line_buffer_expanded
334+
integer :: iostat
335+
character(len=:),allocatable :: line_buffer_read
337336

338337
allocate(lines(number_of_rows(fh)))
339338
do i = 1, size(lines)
340-
read(fh, '(A)') line_buffer_read
341-
call notabs(line_buffer_read, line_buffer_expanded, ilen)
342-
lines(i)%s = trim(line_buffer_expanded)
339+
call getline(fh, line_buffer_read, iostat)
340+
lines(i)%s = dilate(line_buffer_read)
343341
end do
344342

345343
end function read_lines_expanded
@@ -350,12 +348,11 @@ function read_lines(fh) result(lines)
350348
type(string_t), allocatable :: lines(:)
351349

352350
integer :: i
353-
character(LINE_BUFFER_LEN) :: line_buffer
351+
integer :: iostat
354352

355353
allocate(lines(number_of_rows(fh)))
356354
do i = 1, size(lines)
357-
read(fh, '(A)') line_buffer
358-
lines(i)%s = trim(line_buffer)
355+
call getline(fh, lines(i)%s, iostat)
359356
end do
360357

361358
end function read_lines
@@ -560,6 +557,7 @@ logical function exists(filename) result(r)
560557
function get_temp_filename() result(tempfile)
561558
!
562559
use iso_c_binding, only: c_ptr, C_NULL_PTR, c_f_pointer
560+
integer, parameter :: MAX_FILENAME_LENGTH = 32768
563561
character(:), allocatable :: tempfile
564562

565563
type(c_ptr) :: c_tempfile_ptr
@@ -582,7 +580,7 @@ end subroutine c_free
582580
end interface
583581

584582
c_tempfile_ptr = c_tempnam(C_NULL_PTR, C_NULL_PTR)
585-
call c_f_pointer(c_tempfile_ptr,c_tempfile,[LINE_BUFFER_LEN])
583+
call c_f_pointer(c_tempfile_ptr,c_tempfile,[MAX_FILENAME_LENGTH])
586584

587585
tempfile = f_string(c_tempfile)
588586

@@ -644,8 +642,9 @@ subroutine getline(unit, line, iostat, iomsg)
644642
!> Error message
645643
character(len=:), allocatable, optional :: iomsg
646644

647-
character(len=LINE_BUFFER_LEN) :: buffer
648-
character(len=LINE_BUFFER_LEN) :: msg
645+
integer, parameter :: FILENAME_MAX = 4096
646+
character(len=FILENAME_MAX) :: buffer
647+
character(len=FILENAME_MAX) :: msg
649648
integer :: size
650649
integer :: stat
651650

@@ -1095,7 +1094,7 @@ subroutine execute_and_read_output(cmd, output, error, exitstat)
10951094

10961095
integer :: cmdstat, unit, stat = 0
10971096
character(len=:), allocatable :: cmdmsg, tmp_file
1098-
character(len=1000) :: output_line
1097+
character(len=:),allocatable :: output_line
10991098

11001099
tmp_file = get_temp_filename()
11011100

@@ -1105,12 +1104,12 @@ subroutine execute_and_read_output(cmd, output, error, exitstat)
11051104
open(newunit=unit, file=tmp_file, action='read', status='old')
11061105
output = ''
11071106
do
1108-
read(unit, *, iostat=stat) output_line
1109-
if (stat /= 0) exit
1110-
output = output//trim(output_line)//' '
1107+
call getline(unit, output_line, stat)
1108+
if (stat /= 0) exit
1109+
output = output//output_line//' '
11111110
end do
1112-
close(unit, status='delete')
1113-
end
1111+
close(unit, status='delete',iostat=stat)
1112+
end subroutine execute_and_read_output
11141113

11151114
!> Ensure a windows path is converted to an 8.3 DOS path if it contains spaces
11161115
function get_dos_path(path,error)

src/fpm_strings.f90

Lines changed: 66 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,8 @@
2323
!! - [[IS_FORTRAN_NAME]] determine whether a string is an acceptable Fortran entity name
2424
!! - [[TO_FORTRAN_NAME]] replace allowed special but unusuable characters in names with underscore
2525
!!### Whitespace
26-
!! - [[NOTABS]] Expand tab characters assuming a tab space every eight characters
26+
!! - [[NOTABS]] subroutine to expand tab characters assuming a tab space every eight characters
27+
!! - [[DILATE]] function to expand tab characters assuming a tab space every eight characters
2728
!! - [[LEN_TRIM]] Determine total trimmed length of **STRING_T** array
2829
!!### Miscellaneous
2930
!! - [[FNV_1A]] Hash a **CHARACTER(*)** string of default kind or a **TYPE(STRING_T)** array
@@ -43,7 +44,7 @@ module fpm_strings
4344
public :: to_fortran_name, is_fortran_name
4445
public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a
4546
public :: replace, resize, str, join, glob
46-
public :: notabs, remove_newline_characters
47+
public :: notabs, dilate, remove_newline_characters
4748

4849
!> Module naming
4950
public :: is_valid_module_name, is_valid_module_prefix, &
@@ -1015,7 +1016,7 @@ pure function to_fortran_name(string) result(res)
10151016
res = replace(string, SPECIAL_CHARACTERS, '_')
10161017
end function to_fortran_name
10171018

1018-
function is_fortran_name(line) result (lout)
1019+
elemental function is_fortran_name(line) result (lout)
10191020
! determine if a string is a valid Fortran name ignoring trailing spaces
10201021
! (but not leading spaces)
10211022
character(len=*),parameter :: int='0123456789'
@@ -1365,4 +1366,66 @@ elemental impure subroutine notabs(instr,outstr,ilen)
13651366

13661367
end subroutine notabs
13671368

1369+
!>AUTHOR: John S. Urban
1370+
!!LICENSE: Public Domain
1371+
!>
1372+
!!##NAME
1373+
!! dilate(3f) - [M_strings:NONALPHA] expand tab characters
1374+
!! (LICENSE:PD)
1375+
!!
1376+
!!##SYNOPSIS
1377+
!!
1378+
!! function dilate(INSTR) result(OUTSTR)
1379+
!!
1380+
!! character(len=*),intent=(in) :: INSTR
1381+
!! character(len=:),allocatable :: OUTSTR
1382+
!!
1383+
!!##DESCRIPTION
1384+
!! dilate() converts tabs in INSTR to spaces in OUTSTR. It assumes a
1385+
!! tab is set every 8 characters. Trailing spaces are removed.
1386+
!!
1387+
!! In addition, trailing carriage returns and line feeds are removed
1388+
!! (they are usually a problem created by going to and from MSWindows).
1389+
!!
1390+
!!##OPTIONS
1391+
!! instr Input line to remove tabs from
1392+
!!
1393+
!!##RESULTS
1394+
!! outstr Output string with tabs expanded.
1395+
!!
1396+
!!##EXAMPLES
1397+
!!
1398+
!! Sample program:
1399+
!!
1400+
!! program demo_dilate
1401+
!!
1402+
!! use M_strings, only : dilate
1403+
!! implicit none
1404+
!! character(len=:),allocatable :: in
1405+
!! integer :: i
1406+
!! in=' this is my string '
1407+
!! ! change spaces to tabs to make a sample input
1408+
!! do i=1,len(in)
1409+
!! if(in(i:i) == ' ')in(i:i)=char(9)
1410+
!! enddo
1411+
!! write(*,'(a)')in,dilate(in)
1412+
!! end program demo_dilate
1413+
!!
1414+
function dilate(instr) result(outstr)
1415+
1416+
character(len=*), intent(in) :: instr ! input line to scan for tab characters
1417+
character(len=:), allocatable :: outstr ! tab-expanded version of INSTR produced
1418+
integer :: i
1419+
integer :: icount
1420+
integer :: lgth
1421+
icount = 0
1422+
do i = 1, len(instr)
1423+
if (instr(i:i) == char(9)) icount = icount + 1
1424+
end do
1425+
allocate (character(len=(len(instr) + 8*icount)) :: outstr)
1426+
call notabs(instr, outstr, lgth)
1427+
outstr = outstr(:lgth)
1428+
1429+
end function dilate
1430+
13681431
end module fpm_strings

0 commit comments

Comments
 (0)