Skip to content

Commit

Permalink
Added error handling for zero-length file names
Browse files Browse the repository at this point in the history
  • Loading branch information
mkrack committed Nov 5, 2024
1 parent af28e69 commit 0063a57
Showing 1 changed file with 28 additions and 15 deletions.
43 changes: 28 additions & 15 deletions src/common/cp_files.F
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ SUBROUTINE assign_preconnection(file_name, unit_number)
END IF

IF (LEN_TRIM(file_name) == 0) THEN
CPABORT("No valid file name was specified")
CPABORT("No valid file name was specified.")
END IF

nc = SIZE(preconnected)
Expand All @@ -83,7 +83,7 @@ SUBROUTINE assign_preconnection(file_name, unit_number)
CALL print_preconnection_list()
CALL cp_abort(__LOCATION__, &
"Attempt to connect the already connected file <"// &
TRIM(file_name)//"> to another unit")
TRIM(file_name)//"> to another unit.")
END IF
END IF
END DO
Expand All @@ -99,7 +99,7 @@ SUBROUTINE assign_preconnection(file_name, unit_number)

IF (islot == -1) THEN
CALL print_preconnection_list()
CPABORT("No free slot found in the list of preconnected units")
CPABORT("No free slot found in the list of preconnected units.")
END IF

preconnected(islot)%file_name = TRIM(file_name)
Expand Down Expand Up @@ -169,7 +169,7 @@ SUBROUTINE close_file(unit_number, file_status, keep_preconnection)
IF (istat /= 0) THEN
WRITE (UNIT=message, FMT="(A,I0,A,I0,A)") &
"An error occurred inquiring the unit with the number ", unit_number, &
" (IOSTAT = ", istat, ")"
" (IOSTAT = ", istat, ")."
CPABORT(TRIM(message))
END IF
! Manage preconnections
Expand All @@ -181,7 +181,7 @@ SUBROUTINE close_file(unit_number, file_status, keep_preconnection)
IF (istat /= 0) THEN
WRITE (UNIT=message, FMT="(A,I0,A,I0,A)") &
"An error occurred closing the file with the logical unit number ", &
unit_number, " (IOSTAT = ", istat, ")"
unit_number, " (IOSTAT = ", istat, ")."
CPABORT(TRIM(message))
END IF
END IF
Expand Down Expand Up @@ -218,7 +218,7 @@ SUBROUTINE delete_preconnection(file_name, unit_number)
CALL cp_abort(__LOCATION__, &
"Attempt to disconnect the file <"// &
TRIM(file_name)// &
"> from an unlisted unit")
"> from an unlisted unit.")
END IF
END IF
END DO
Expand Down Expand Up @@ -345,7 +345,7 @@ SUBROUTINE open_file(file_name, file_status, file_form, file_action, &
pad_string = file_pad
IF (form_string == "UNFORMATTED") THEN
WRITE (UNIT=message, FMT="(A)") &
"The PAD specifier is not allowed for an UNFORMATTED file"
"The PAD specifier is not allowed for an UNFORMATTED file."
CPABORT(TRIM(message))
END IF
ELSE
Expand Down Expand Up @@ -373,11 +373,18 @@ SUBROUTINE open_file(file_name, file_status, file_form, file_action, &
IF (file_name(1:1) == " ") THEN
WRITE (UNIT=message, FMT="(A)") &
"The file name <"//TRIM(file_name)//"> has leading blanks."
CPWARN(TRIM(message))
CPABORT(TRIM(message))
END IF

real_file_name = ADJUSTL(file_name)
IF (status_string == "OLD") real_file_name = discover_file(file_name)
IF (status_string == "OLD") THEN
real_file_name = discover_file(file_name)
ELSE
! Strip leading and trailing blanks from file name
real_file_name = TRIM(ADJUSTL(file_name))
IF (LEN_TRIM(real_file_name) == 0) THEN
CPABORT("A file name length of zero for a new file is invalid.")
END IF
END IF

! Check the specified input file name
INQUIRE (FILE=TRIM(real_file_name), EXIST=exists, OPENED=is_open, IOSTAT=istat)
Expand Down Expand Up @@ -497,7 +504,8 @@ FUNCTION file_exists(file_name) RESULT(exist)
CHARACTER(LEN=default_path_length) :: real_file_name

real_file_name = discover_file(file_name)
INQUIRE (FILE=TRIM(real_file_name), exist=exist)
INQUIRE (FILE=TRIM(real_file_name), EXIST=exist)

END FUNCTION file_exists

! **************************************************************************************************
Expand All @@ -514,17 +522,22 @@ FUNCTION discover_file(file_name) RESULT(real_file_name)
INTEGER :: stat
LOGICAL :: exists

! Strip leading and trailing blanks from file name
real_file_name = TRIM(ADJUSTL(file_name))

! first try file-name directly
INQUIRE (file=TRIM(real_file_name), exist=exists, iostat=stat)
IF (LEN_TRIM(real_file_name) == 0) THEN
CPABORT("A file name length of zero for an existing file is invalid.")
END IF

! First try file name directly
INQUIRE (FILE=TRIM(real_file_name), EXIST=exists, IOSTAT=stat)
IF (stat == 0 .AND. exists) RETURN

! then try the data-dir
! Then try the data directory
data_dir = get_data_dir()
IF (LEN_TRIM(data_dir) > 0) THEN
candidate = join_paths(data_dir, real_file_name)
INQUIRE (file=TRIM(candidate), exist=exists, iostat=stat)
INQUIRE (FILE=TRIM(candidate), EXIST=exists, IOSTAT=stat)
IF (stat == 0 .AND. exists) THEN
real_file_name = candidate
RETURN
Expand Down

0 comments on commit 0063a57

Please sign in to comment.