From 390957539f95f579d3e388a23af3d0571f498f98 Mon Sep 17 00:00:00 2001 From: Jim Wittig Date: Thu, 16 Oct 2025 10:12:26 -0600 Subject: [PATCH 1/4] Ensure the buffer provided to MPAS_io_get_var_generic is large enough. A fixed size array is provided as an output buffer when reading a 0d-char character variable. Call MPAS_io_inq_var prior to the read to get the size of the variable, and only proceed with the read if the size of the variable will fit in the provided array. Return an error code if the variable value is larger than the provided output buffer. --- src/core_test/Makefile | 3 +- src/core_test/mpas_test_core.F | 12 ++ src/core_test/mpas_test_core_io.F | 208 ++++++++++++++++++++++++++++++ src/framework/mpas_io.F | 91 +++++++++---- src/framework/mpas_io_types.inc | 3 +- 5 files changed, 288 insertions(+), 29 deletions(-) create mode 100644 src/core_test/mpas_test_core_io.F diff --git a/src/core_test/Makefile b/src/core_test/Makefile index 2d7bb95f1e..73d9874185 100644 --- a/src/core_test/Makefile +++ b/src/core_test/Makefile @@ -12,7 +12,8 @@ OBJS = mpas_test_core.o \ mpas_test_core_dmpar.o \ mpas_test_core_stream_inquiry.o \ mpas_test_openacc.o \ - mpas_test_core_stream_list.o + mpas_test_core_stream_list.o \ + mpas_test_core_io.o \ all: core_test diff --git a/src/core_test/mpas_test_core.F b/src/core_test/mpas_test_core.F index 2116cbf92a..9e0393b035 100644 --- a/src/core_test/mpas_test_core.F +++ b/src/core_test/mpas_test_core.F @@ -97,6 +97,7 @@ function test_core_run(domain) result(iErr)!{{{ use test_core_string_utils, only : mpas_test_string_utils use mpas_test_core_dmpar, only : mpas_test_dmpar use mpas_test_core_stream_inquiry, only : mpas_test_stream_inquiry + use test_core_io, only : test_core_io_test use mpas_test_core_openacc, only : mpas_test_openacc implicit none @@ -224,6 +225,17 @@ function test_core_run(domain) result(iErr)!{{{ call mpas_stream_mgr_write(domain % streamManager, forceWriteNow=.true.) + ! + ! Run io tests + ! + call mpas_log_write('') + call test_core_io_test(domain, threadErrs, iErr) + if (iErr == 0) then + call mpas_log_write('All tests PASSED') + else + call mpas_log_write('$i tests FAILED', intArgs=[iErr]) + end if + call mpas_log_write('') ! ! Run mpas_test_openacc ! diff --git a/src/core_test/mpas_test_core_io.F b/src/core_test/mpas_test_core_io.F new file mode 100644 index 0000000000..8cf19f9cf0 --- /dev/null +++ b/src/core_test/mpas_test_core_io.F @@ -0,0 +1,208 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +module test_core_io + +#define ERROR_WRITE(M) call mpas_log_write( M , messageType=MPAS_LOG_ERR) +#define ERROR_WRITE_ARGS(M, ARGS) call mpas_log_write( M , ARGS, messageType=MPAS_LOG_ERR) + use mpas_log + use mpas_io + + implicit none + private + public :: test_core_io_test + + contains + + !*********************************************************************** + ! + ! routine close_file_with_message + ! + !> \brief closes the provided file handle and writes an error message. + !----------------------------------------------------------------------- + subroutine close_file_with_message(fileHandle, message, args) + type(MPAS_IO_Handle_type), intent(inout) :: fileHandle + character (len=*), intent(in), optional :: message + integer, dimension(:), intent(in), optional :: args + + integer :: local_ierr + + ! log an error message + if (present(message)) then + if (present(args)) then + ERROR_WRITE_ARGS(message, intArgs=args) + else + ERROR_WRITE(message) + end if + end if + + ! close the provided file + call MPAS_io_close(fileHandle, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ERROR_WRITE_ARGS('MPAS_io_close failed with error code:$i', intArgs=(/local_ierr/)) + return + endif + + end subroutine close_file_with_message + + !*********************************************************************** + ! + ! routine test_read_string_buffer_check + ! + !> \brief verifies attempts to read strings into buffers which are too small + !> to hold the value fails safely. + !> \details + !> Run these tests with valgrind to ensure there are no buffer overflows when + !> attempting to read strings into undersized buffers. + !----------------------------------------------------------------------- + subroutine test_read_string_buffer_check(domain, threadErrs, ierr) + + type (domain_type), intent(inout) :: domain + integer, dimension(:), intent(out) :: threadErrs + integer, intent(out) :: ierr + + integer :: local_ierr, i + type(MPAS_IO_Handle_type) :: fileHandle + character (len=StrKIND), dimension(1), parameter :: dimNamesString = ['StrLen'] + character (len=StrKIND), dimension(2), parameter :: dimNamesStringTime = ['StrLen', 'Time '] + character (len=32), parameter :: varName1 = 'stringVar' + character (len=32), parameter :: varName2 = 'stringTimeVar' + character (len=*), parameter :: varValue1 = 'This is a string' + character (len=32), dimension(2), parameter :: varNames = [varName1, varName2] + integer, parameter :: bufferSize=128 + integer, parameter :: smallBufferSize=bufferSize/2 + character (len=bufferSize) :: buffer + character (len=smallBufferSize) :: smallBuffer + character (len=*), parameter :: filename = 'char_data.nc' + + ierr = 0 + + ! open a file to write char variables to + fileHandle = MPAS_io_open(filename, MPAS_IO_WRITE, MPAS_IO_NETCDF4, domain % ioContext, & + clobber_file=.true., truncate_file=.true., ierr=local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + ERROR_WRITE('Error opening file ' // trim(filename)) + return + end if + + ! define dimensions and char variables + call MPAS_io_def_dim(fileHandle, dimNamesStringTime(1), bufferSize, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error defining '//trim(dimNamesStringTime(1))//', error=$i', (/local_ierr/)) + return + end if + call MPAS_io_def_dim(fileHandle, dimNamesStringTime(2), MPAS_IO_UNLIMITED_DIM, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error defining '//trim(dimNamesStringTime(2))//', error=$i', (/local_ierr/)) + return + end if + call MPAS_io_def_var(fileHandle, varNames(1), MPAS_IO_CHAR, dimNamesString, ierr=local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error defining var "'//trim(varNames(1))//'" error=$i', (/local_ierr/)) + return + end if + call MPAS_io_def_var(fileHandle, varNames(2), MPAS_IO_CHAR, dimNamesStringTime, ierr=local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error defining var "'//trim(varNames(2))//'" error=$i', (/local_ierr/)) + return + end if + + ! write the string values + do i=1,2 + call MPAS_io_put_var_char0d(fileHandle, varNames(i), varValue1, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error writing "'//trim(varNames(i))// & + '", error=$i', (/local_ierr/)) + return + end if + + ! verify the strings are read into buffers which are large enough for the strin values + call MPAS_io_get_var_char0d(fileHandle, varNames(i), buffer, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error reading "'//trim(varNames(i))// & + '", error=$i', (/local_ierr/)) + return + end if + end do + + ! verify attempts to read strings into buffers which are too small generates an error + call mpas_log_write(' ') + call mpas_log_write('Expect to see the following error:') + call MPAS_io_err_mesg(domain % ioContext, MPAS_IO_ERR_INSUFFICIENT_ARG, .false.) + call mpas_log_write(' ') + do i=1,2 + ! this should return an error + call MPAS_io_get_var_char0d(fileHandle, varNames(i), smallBuffer, local_ierr) + call mpas_log_write(' ') + + if (local_ierr /= MPAS_IO_ERR_INSUFFICIENT_ARG) then + ierr = 1 + if (local_ierr == MPAS_IO_NOERR) then + call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i)'& + //' but recieved no error reading "'//trim(varName1), (/local_ierr/)) + else + call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i)'& + //' but recieved error $i reading "'//trim(varName1)//'"', & + (/MPAS_IO_ERR_INSUFFICIENT_ARG, local_ierr/)) + end if + return + end if + end do + call close_file_with_message(fileHandle) + + end subroutine test_read_string_buffer_check + + + !*********************************************************************** + ! Subroutine test_core_io_test + ! + !> \brief Core test suite for I/O + !> + !> \details This subroutine tests mpas_io features. + !> It calls individual tests for I/O operations. + !> See the subroutine body for details. + !> The results of each test are logged with a success or failure message. + !> + !> \param domain The domain object that contains the I/O context + !> \param threadErrs An array to store any errors encountered during + !> the test. + !> \param ierr The error code that indicates the result of the test. + ! + !----------------------------------------------------------------------- + subroutine test_core_io_test(domain, threadErrs, ierr) + + use mpas_log + + type (domain_type), intent(inout) :: domain + integer, dimension(:), intent(out) :: threadErrs + integer, intent(out) :: ierr + + integer :: test_status + + ierr = 0 + test_status = 0 + + call mpas_log_write('Testing char-0 buffer reads') + call test_read_string_buffer_check(domain, threadErrs, test_status) + if (test_status == 0) then + call mpas_log_write('char-0 buffer tests: SUCCESS') + else + call mpas_log_write('char-0 buffer tests: FAILURE', MPAS_LOG_ERR) + ierr = ierr + abs(test_status) + end if + + + end subroutine test_core_io_test + +end module test_core_io diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index 09514a3667..cd9d36cb75 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -7,6 +7,8 @@ ! module mpas_io +#define IO_DEBUG_WRITE(M, ARGS) !call mpas_log_write(M, ARGS) +#define IO_ERROR_WRITE(M, ARGS) call mpas_log_write( M, ARGS, messageType=MPAS_LOG_ERR) use mpas_derived_types use mpas_attlist use mpas_dmpar @@ -1847,6 +1849,13 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr character (len=:), pointer :: charVal_p character (len=:), dimension(:), pointer :: charArray1d_p + ! local variables returned from MPAS_io_inq_var + integer :: fieldtype + integer :: ndims + integer, dimension(:), pointer :: dimsizes + character (len=StrKIND), dimension(:), pointer :: dimnames + character (len=StrKind) :: message + #ifdef MPAS_SMIOL_SUPPORT type (SMIOLf_decomp), pointer :: null_decomp @@ -1984,22 +1993,40 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr ! call mpas_log_write(' value is char') charVal_p => charVal + + ! get the dimension of the char variable to ensure the provided output buffer is large enough + call MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsizes, local_ierr) + do i = 1, ndims + message = ' MPAS_io_get_var_generic len(charVal):$i var "'//trim(fieldname)// & + '" type is $i dim $i is '// trim(dimnames(i))//' size is $i' + IO_DEBUG_WRITE(message , intArgs=(/len(charVal), fieldtype, i, dimsizes(i)/)) + end do + ! because charVal is provided, assume dimension 1 is the string length + if (dimsizes(1) > len(charVal)) then + local_ierr = MPAS_IO_ERR_INSUFFICIENT_ARG + message = ' MPAS_io_get_var_generic var "'//trim(fieldname)// & + '" len too big, len=$i buflen=$i' + IO_ERROR_WRITE(message, intArgs=(/dimsizes(1), len(charVal)/)) + else #ifdef MPAS_SMIOL_SUPPORT - local_ierr = SMIOLf_get_var(handle % smiol_file, trim(fieldname), null_decomp, charVal_p) + local_ierr = SMIOLf_get_var(handle % smiol_file, trim(fieldname), null_decomp, charVal_p) #endif #ifdef MPAS_PIO_SUPPORT - if (field_cursor % fieldhandle % has_unlimited_dim) then - count2(1) = field_cursor % fieldhandle % dims(1) % dimsize - pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, tempchar) - charVal(1:count2(1)) = tempchar(1)(1:count2(1)) - else - start1(1) = 1 - count1(1) = field_cursor % fieldhandle % dims(1) % dimsize - pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start1, count1, tempchar) - charVal(1:count1(1)) = tempchar(1)(1:count1(1)) - end if + if (field_cursor % fieldhandle % has_unlimited_dim) then + count2(1) = field_cursor % fieldhandle % dims(1) % dimsize + pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, tempchar) + charVal(1:count2(1)) = tempchar(1)(1:count2(1)) + else + start1(1) = 1 + count1(1) = field_cursor % fieldhandle % dims(1) % dimsize + pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start1, count1, tempchar) + charVal(1:count1(1)) = tempchar(1)(1:count1(1)) + end if #endif + end if + deallocate(dimsizes) + deallocate(dimnames) else if (present(charArray1d)) then ! call mpas_log_write(' value is char1') #ifdef MPAS_PIO_SUPPORT @@ -2765,28 +2792,34 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr end if ! call mpas_log_write('Checking for error') + if (local_ierr == MPAS_IO_ERR_INSUFFICIENT_ARG) then + call MPAS_io_err_mesg(handle % ioContext, local_ierr, .false.) + io_global_err = local_ierr + if (present(ierr)) ierr = local_ierr + else #ifdef MPAS_PIO_SUPPORT - if (pio_ierr /= PIO_noerr) then - io_global_err = pio_ierr - if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND - return - end if + if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return + end if #endif #ifdef MPAS_SMIOL_SUPPORT - if (local_ierr /= SMIOL_SUCCESS) then - call mpas_log_write('SMIOLf_get_var failed with error $i', intArgs=[local_ierr], messageType=MPAS_LOG_ERR) - if (local_ierr == SMIOL_LIBRARY_ERROR) then - call mpas_log_write(trim(SMIOLf_lib_error_string(handle % ioContext % smiol_context)), messageType=MPAS_LOG_ERR) - else - call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) - end if + if (local_ierr /= SMIOL_SUCCESS) then + call mpas_log_write('SMIOLf_get_var failed with error $i', intArgs=[local_ierr], messageType=MPAS_LOG_ERR) + if (local_ierr == SMIOL_LIBRARY_ERROR) then + call mpas_log_write(trim(SMIOLf_lib_error_string(handle % ioContext % smiol_context)), messageType=MPAS_LOG_ERR) + else + call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) + end if - io_global_err = local_ierr - if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND - return - end if + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return + end if #endif + end if end subroutine MPAS_io_get_var_generic @@ -6498,6 +6531,10 @@ subroutine MPAS_io_err_mesg(ioContext, ierr, fatal) call mpas_log_write('MPAS IO Error: Would clobber existing file', MPAS_LOG_ERR) case (MPAS_IO_ERR_NOEXIST_READ) call mpas_log_write('MPAS IO Error: Attempting to read a file which does not exist.', MPAS_LOG_ERR) + case (MPAS_IO_ERR_MISSING_DIM) + call mpas_log_write('MPAS IO Error: Attempting to read a dimension which does not exist.', MPAS_LOG_ERR) + case (MPAS_IO_ERR_INSUFFICIENT_ARG) + call mpas_log_write('MPAS IO Error: Attempting to read a string into a buffer which is too small.', MPAS_LOG_ERR) case default call mpas_log_write('MPAS IO Error: Unrecognized error code...', MPAS_LOG_ERR) end select diff --git a/src/framework/mpas_io_types.inc b/src/framework/mpas_io_types.inc index 522e6e1ad5..8ea693c3ef 100644 --- a/src/framework/mpas_io_types.inc +++ b/src/framework/mpas_io_types.inc @@ -65,7 +65,8 @@ MPAS_IO_ERR_UNIMPLEMENTED = -18, & MPAS_IO_ERR_WOULD_CLOBBER = -19, & MPAS_IO_ERR_NOEXIST_READ = -20, & - MPAS_IO_ERR_MISSING_DIM = -21 + MPAS_IO_ERR_MISSING_DIM = -21, & + MPAS_IO_ERR_INSUFFICIENT_ARG = -22 type MPAS_IO_Handle_type logical :: initialized = .false. From 7f2f3a8356267ed1884a263dbd9e5ff79f7f12a0 Mon Sep 17 00:00:00 2001 From: Jim Wittig Date: Mon, 22 Dec 2025 14:06:48 -0700 Subject: [PATCH 2/4] Modifications per PR suggestions: 1. Fix Makefile 2. White space changes 3. Use size() function for loop upper bound 4. Fix typos 5. Copyright change --- src/core_test/Makefile | 4 +- src/core_test/mpas_test_core.F | 1 + src/core_test/mpas_test_core_io.F | 79 +++++++++++++++---------------- src/framework/mpas_io.F | 34 ++++++------- 4 files changed, 59 insertions(+), 59 deletions(-) diff --git a/src/core_test/Makefile b/src/core_test/Makefile index 73d9874185..e11e5dbb50 100644 --- a/src/core_test/Makefile +++ b/src/core_test/Makefile @@ -13,7 +13,7 @@ OBJS = mpas_test_core.o \ mpas_test_core_stream_inquiry.o \ mpas_test_openacc.o \ mpas_test_core_stream_list.o \ - mpas_test_core_io.o \ + mpas_test_core_io.o all: core_test @@ -45,7 +45,7 @@ mpas_test_core.o: mpas_test_core_halo_exch.o mpas_test_core_streams.o \ mpas_test_core_sorting.o mpas_halo_testing.o \ mpas_test_core_string_utils.o mpas_test_core_dmpar.o \ mpas_test_core_stream_inquiry.o mpas_test_openacc.o \ - mpas_test_core_stream_list.o + mpas_test_core_stream_list.o mpas_test_core_io.o mpas_test_core_halo_exch.o: diff --git a/src/core_test/mpas_test_core.F b/src/core_test/mpas_test_core.F index 9e0393b035..163a414602 100644 --- a/src/core_test/mpas_test_core.F +++ b/src/core_test/mpas_test_core.F @@ -236,6 +236,7 @@ function test_core_run(domain) result(iErr)!{{{ call mpas_log_write('$i tests FAILED', intArgs=[iErr]) end if call mpas_log_write('') + ! ! Run mpas_test_openacc ! diff --git a/src/core_test/mpas_test_core_io.F b/src/core_test/mpas_test_core_io.F index 8cf19f9cf0..ddae7b0b8a 100644 --- a/src/core_test/mpas_test_core_io.F +++ b/src/core_test/mpas_test_core_io.F @@ -1,9 +1,8 @@ -! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) -! and the University Corporation for Atmospheric Research (UCAR). +! Copyright (c) 2025 The University Corporation for Atmospheric Research (UCAR). ! ! Unless noted otherwise source code is licensed under the BSD license. ! Additional copyright and license information can be found in the LICENSE file -! distributed with this code, or at http://mpas-dev.github.com/license.html +! distributed with this code, or at https://mpas-dev.github.io/license.html . ! module test_core_io @@ -33,21 +32,21 @@ subroutine close_file_with_message(fileHandle, message, args) ! log an error message if (present(message)) then - if (present(args)) then - ERROR_WRITE_ARGS(message, intArgs=args) - else - ERROR_WRITE(message) - end if + if (present(args)) then + ERROR_WRITE_ARGS(message, intArgs=args) + else + ERROR_WRITE(message) + end if end if ! close the provided file call MPAS_io_close(fileHandle, local_ierr) if (local_ierr /= MPAS_IO_NOERR) then - ERROR_WRITE_ARGS('MPAS_io_close failed with error code:$i', intArgs=(/local_ierr/)) - return + ERROR_WRITE_ARGS('MPAS_io_close failed with error code:$i', intArgs=(/local_ierr/)) + return endif - end subroutine close_file_with_message + end subroutine close_file_with_message !*********************************************************************** ! @@ -117,23 +116,23 @@ subroutine test_read_string_buffer_check(domain, threadErrs, ierr) end if ! write the string values - do i=1,2 - call MPAS_io_put_var_char0d(fileHandle, varNames(i), varValue1, local_ierr) - if (local_ierr /= MPAS_IO_NOERR) then - ierr = 1 - call close_file_with_message(fileHandle, 'Error writing "'//trim(varNames(i))// & + do i=1,size(varNames) + call MPAS_io_put_var_char0d(fileHandle, varNames(i), varValue1, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error writing "'//trim(varNames(i))// & '", error=$i', (/local_ierr/)) - return - end if - - ! verify the strings are read into buffers which are large enough for the strin values - call MPAS_io_get_var_char0d(fileHandle, varNames(i), buffer, local_ierr) - if (local_ierr /= MPAS_IO_NOERR) then - ierr = 1 - call close_file_with_message(fileHandle, 'Error reading "'//trim(varNames(i))// & + return + end if + + ! verify the strings are read into buffers which are large enough for the string values + call MPAS_io_get_var_char0d(fileHandle, varNames(i), buffer, local_ierr) + if (local_ierr /= MPAS_IO_NOERR) then + ierr = 1 + call close_file_with_message(fileHandle, 'Error reading "'//trim(varNames(i))// & '", error=$i', (/local_ierr/)) - return - end if + return + end if end do ! verify attempts to read strings into buffers which are too small generates an error @@ -141,23 +140,23 @@ subroutine test_read_string_buffer_check(domain, threadErrs, ierr) call mpas_log_write('Expect to see the following error:') call MPAS_io_err_mesg(domain % ioContext, MPAS_IO_ERR_INSUFFICIENT_ARG, .false.) call mpas_log_write(' ') - do i=1,2 - ! this should return an error - call MPAS_io_get_var_char0d(fileHandle, varNames(i), smallBuffer, local_ierr) - call mpas_log_write(' ') - - if (local_ierr /= MPAS_IO_ERR_INSUFFICIENT_ARG) then - ierr = 1 - if (local_ierr == MPAS_IO_NOERR) then - call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i)'& + do i=1,size(varNames) + ! this should return an error + call MPAS_io_get_var_char0d(fileHandle, varNames(i), smallBuffer, local_ierr) + call mpas_log_write(' ') + + if (local_ierr /= MPAS_IO_ERR_INSUFFICIENT_ARG) then + ierr = 1 + if (local_ierr == MPAS_IO_NOERR) then + call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i)'& //' but recieved no error reading "'//trim(varName1), (/local_ierr/)) - else - call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i)'& + else + call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i)'& //' but recieved error $i reading "'//trim(varName1)//'"', & (/MPAS_IO_ERR_INSUFFICIENT_ARG, local_ierr/)) - end if - return - end if + end if + return + end if end do call close_file_with_message(fileHandle) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index cd9d36cb75..145208f4c8 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -1997,32 +1997,32 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr ! get the dimension of the char variable to ensure the provided output buffer is large enough call MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsizes, local_ierr) do i = 1, ndims - message = ' MPAS_io_get_var_generic len(charVal):$i var "'//trim(fieldname)// & - '" type is $i dim $i is '// trim(dimnames(i))//' size is $i' - IO_DEBUG_WRITE(message , intArgs=(/len(charVal), fieldtype, i, dimsizes(i)/)) + message = ' MPAS_io_get_var_generic len(charVal):$i var "'//trim(fieldname)// & + '" type is $i dim $i is '// trim(dimnames(i))//' size is $i' + IO_DEBUG_WRITE(message , intArgs=(/len(charVal), fieldtype, i, dimsizes(i)/)) end do ! because charVal is provided, assume dimension 1 is the string length if (dimsizes(1) > len(charVal)) then - local_ierr = MPAS_IO_ERR_INSUFFICIENT_ARG - message = ' MPAS_io_get_var_generic var "'//trim(fieldname)// & - '" len too big, len=$i buflen=$i' - IO_ERROR_WRITE(message, intArgs=(/dimsizes(1), len(charVal)/)) + local_ierr = MPAS_IO_ERR_INSUFFICIENT_ARG + message = ' MPAS_io_get_var_generic var "'//trim(fieldname)// & + '" len too big, len=$i buflen=$i' + IO_ERROR_WRITE(message, intArgs=(/dimsizes(1), len(charVal)/)) else #ifdef MPAS_SMIOL_SUPPORT - local_ierr = SMIOLf_get_var(handle % smiol_file, trim(fieldname), null_decomp, charVal_p) + local_ierr = SMIOLf_get_var(handle % smiol_file, trim(fieldname), null_decomp, charVal_p) #endif #ifdef MPAS_PIO_SUPPORT - if (field_cursor % fieldhandle % has_unlimited_dim) then - count2(1) = field_cursor % fieldhandle % dims(1) % dimsize - pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, tempchar) + if (field_cursor % fieldhandle % has_unlimited_dim) then + count2(1) = field_cursor % fieldhandle % dims(1) % dimsize + pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, tempchar) charVal(1:count2(1)) = tempchar(1)(1:count2(1)) - else - start1(1) = 1 - count1(1) = field_cursor % fieldhandle % dims(1) % dimsize - pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start1, count1, tempchar) - charVal(1:count1(1)) = tempchar(1)(1:count1(1)) - end if + else + start1(1) = 1 + count1(1) = field_cursor % fieldhandle % dims(1) % dimsize + pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start1, count1, tempchar) + charVal(1:count1(1)) = tempchar(1)(1:count1(1)) + end if #endif end if deallocate(dimsizes) From df2646a4fef30cf9ec4b9a0f1b9a3665022fc7b3 Mon Sep 17 00:00:00 2001 From: Jim Wittig Date: Tue, 23 Dec 2025 10:36:01 -0700 Subject: [PATCH 3/4] modifications per PR comments: 1. change MPAS_IO_ERR_INSUFFICIENT_ARG to MPAS_IO_ERR_INSUFFICIENT_BUF and update the corresponding message to be variable type agnostic. 2. fix whitespace and identifier capitalization. --- src/core_test/mpas_test_core_io.F | 10 +++++----- src/framework/mpas_io.F | 14 +++++++------- src/framework/mpas_io_types.inc | 2 +- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/core_test/mpas_test_core_io.F b/src/core_test/mpas_test_core_io.F index ddae7b0b8a..f6f94d3247 100644 --- a/src/core_test/mpas_test_core_io.F +++ b/src/core_test/mpas_test_core_io.F @@ -138,22 +138,22 @@ subroutine test_read_string_buffer_check(domain, threadErrs, ierr) ! verify attempts to read strings into buffers which are too small generates an error call mpas_log_write(' ') call mpas_log_write('Expect to see the following error:') - call MPAS_io_err_mesg(domain % ioContext, MPAS_IO_ERR_INSUFFICIENT_ARG, .false.) + call MPAS_io_err_mesg(domain % ioContext, MPAS_IO_ERR_INSUFFICIENT_BUF, .false.) call mpas_log_write(' ') do i=1,size(varNames) ! this should return an error call MPAS_io_get_var_char0d(fileHandle, varNames(i), smallBuffer, local_ierr) call mpas_log_write(' ') - if (local_ierr /= MPAS_IO_ERR_INSUFFICIENT_ARG) then + if (local_ierr /= MPAS_IO_ERR_INSUFFICIENT_BUF) then ierr = 1 if (local_ierr == MPAS_IO_NOERR) then - call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i)'& + call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_BUF ($i)'& //' but recieved no error reading "'//trim(varName1), (/local_ierr/)) else - call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_ARG ($i)'& + call close_file_with_message(fileHandle, 'Expected MPAS_IO_ERR_INSUFFICIENT_BUF ($i)'& //' but recieved error $i reading "'//trim(varName1)//'"', & - (/MPAS_IO_ERR_INSUFFICIENT_ARG, local_ierr/)) + (/MPAS_IO_ERR_INSUFFICIENT_BUF, local_ierr/)) end if return end if diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index 145208f4c8..423547c4f2 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -1854,7 +1854,7 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr integer :: ndims integer, dimension(:), pointer :: dimsizes character (len=StrKIND), dimension(:), pointer :: dimnames - character (len=StrKind) :: message + character (len=StrKIND) :: message #ifdef MPAS_SMIOL_SUPPORT type (SMIOLf_decomp), pointer :: null_decomp @@ -2003,8 +2003,8 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr end do ! because charVal is provided, assume dimension 1 is the string length if (dimsizes(1) > len(charVal)) then - local_ierr = MPAS_IO_ERR_INSUFFICIENT_ARG - message = ' MPAS_io_get_var_generic var "'//trim(fieldname)// & + local_ierr = MPAS_IO_ERR_INSUFFICIENT_BUF + message = 'MPAS_io_get_var_generic var "'//trim(fieldname)// & '" len too big, len=$i buflen=$i' IO_ERROR_WRITE(message, intArgs=(/dimsizes(1), len(charVal)/)) else @@ -2016,7 +2016,7 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr if (field_cursor % fieldhandle % has_unlimited_dim) then count2(1) = field_cursor % fieldhandle % dims(1) % dimsize pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, tempchar) - charVal(1:count2(1)) = tempchar(1)(1:count2(1)) + charVal(1:count2(1)) = tempchar(1)(1:count2(1)) else start1(1) = 1 count1(1) = field_cursor % fieldhandle % dims(1) % dimsize @@ -2792,7 +2792,7 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr end if ! call mpas_log_write('Checking for error') - if (local_ierr == MPAS_IO_ERR_INSUFFICIENT_ARG) then + if (local_ierr == MPAS_IO_ERR_INSUFFICIENT_BUF) then call MPAS_io_err_mesg(handle % ioContext, local_ierr, .false.) io_global_err = local_ierr if (present(ierr)) ierr = local_ierr @@ -6533,8 +6533,8 @@ subroutine MPAS_io_err_mesg(ioContext, ierr, fatal) call mpas_log_write('MPAS IO Error: Attempting to read a file which does not exist.', MPAS_LOG_ERR) case (MPAS_IO_ERR_MISSING_DIM) call mpas_log_write('MPAS IO Error: Attempting to read a dimension which does not exist.', MPAS_LOG_ERR) - case (MPAS_IO_ERR_INSUFFICIENT_ARG) - call mpas_log_write('MPAS IO Error: Attempting to read a string into a buffer which is too small.', MPAS_LOG_ERR) + case (MPAS_IO_ERR_INSUFFICIENT_BUF) + call mpas_log_write('MPAS IO Error: Attempting to read a variable into a buffer of insufficient size.', MPAS_LOG_ERR) case default call mpas_log_write('MPAS IO Error: Unrecognized error code...', MPAS_LOG_ERR) end select diff --git a/src/framework/mpas_io_types.inc b/src/framework/mpas_io_types.inc index 8ea693c3ef..dc7551857a 100644 --- a/src/framework/mpas_io_types.inc +++ b/src/framework/mpas_io_types.inc @@ -66,7 +66,7 @@ MPAS_IO_ERR_WOULD_CLOBBER = -19, & MPAS_IO_ERR_NOEXIST_READ = -20, & MPAS_IO_ERR_MISSING_DIM = -21, & - MPAS_IO_ERR_INSUFFICIENT_ARG = -22 + MPAS_IO_ERR_INSUFFICIENT_BUF = -22 type MPAS_IO_Handle_type logical :: initialized = .false. From 8e07d5626cea6abdc2bd659e6e7904708d0d0aed Mon Sep 17 00:00:00 2001 From: Jim Wittig Date: Wed, 24 Dec 2025 11:44:20 -0700 Subject: [PATCH 4/4] Modifications per PR comments: 1. Improve error message in MPAS_io_get_var_generic 2. Make IO_DEBUG_WRITE and IO_ERROR_WRITE macros more flexible 3. Improve readability of MPAS_io_get_var_generic --- src/framework/mpas_io.F | 52 +++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index 423547c4f2..01c05a0ce9 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -7,8 +7,9 @@ ! module mpas_io -#define IO_DEBUG_WRITE(M, ARGS) !call mpas_log_write(M, ARGS) -#define IO_ERROR_WRITE(M, ARGS) call mpas_log_write( M, ARGS, messageType=MPAS_LOG_ERR) +#define COMMA , +#define IO_DEBUG_WRITE(M) !call mpas_log_write(M) +#define IO_ERROR_WRITE(M) call mpas_log_write( M, messageType=MPAS_LOG_ERR) use mpas_derived_types use mpas_attlist use mpas_dmpar @@ -1998,15 +1999,16 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr call MPAS_io_inq_var(handle, fieldname, fieldtype, ndims, dimnames, dimsizes, local_ierr) do i = 1, ndims message = ' MPAS_io_get_var_generic len(charVal):$i var "'//trim(fieldname)// & - '" type is $i dim $i is '// trim(dimnames(i))//' size is $i' - IO_DEBUG_WRITE(message , intArgs=(/len(charVal), fieldtype, i, dimsizes(i)/)) + '" type is $i dim is $i '// trim(dimnames(i))//' size is $i' + IO_DEBUG_WRITE(message COMMA intArgs=(/len(charVal), fieldtype, i, dimsizes(i)/)) end do ! because charVal is provided, assume dimension 1 is the string length if (dimsizes(1) > len(charVal)) then local_ierr = MPAS_IO_ERR_INSUFFICIENT_BUF - message = 'MPAS_io_get_var_generic var "'//trim(fieldname)// & - '" len too big, len=$i buflen=$i' - IO_ERROR_WRITE(message, intArgs=(/dimsizes(1), len(charVal)/)) + message = 'Length of string variable "'//trim(fieldname)//'" in file "'//trim(handle % filename)//'"' + IO_ERROR_WRITE(message) + message = ' exceeds buffer size: len('//trim(fieldname)//')=$i, len(buffer)=$i' + IO_ERROR_WRITE(message COMMA intArgs=(/dimsizes(1), len(charVal)/)) else #ifdef MPAS_SMIOL_SUPPORT local_ierr = SMIOLf_get_var(handle % smiol_file, trim(fieldname), null_decomp, charVal_p) @@ -2796,30 +2798,30 @@ subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArr call MPAS_io_err_mesg(handle % ioContext, local_ierr, .false.) io_global_err = local_ierr if (present(ierr)) ierr = local_ierr - else + return + endif #ifdef MPAS_PIO_SUPPORT - if (pio_ierr /= PIO_noerr) then - io_global_err = pio_ierr - if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND - return - end if + if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return + end if #endif #ifdef MPAS_SMIOL_SUPPORT - if (local_ierr /= SMIOL_SUCCESS) then - call mpas_log_write('SMIOLf_get_var failed with error $i', intArgs=[local_ierr], messageType=MPAS_LOG_ERR) - if (local_ierr == SMIOL_LIBRARY_ERROR) then - call mpas_log_write(trim(SMIOLf_lib_error_string(handle % ioContext % smiol_context)), messageType=MPAS_LOG_ERR) - else - call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) - end if + if (local_ierr /= SMIOL_SUCCESS) then + call mpas_log_write('SMIOLf_get_var failed with error $i', intArgs=[local_ierr], messageType=MPAS_LOG_ERR) + if (local_ierr == SMIOL_LIBRARY_ERROR) then + call mpas_log_write(trim(SMIOLf_lib_error_string(handle % ioContext % smiol_context)), messageType=MPAS_LOG_ERR) + else + call mpas_log_write(trim(SMIOLf_error_string(local_ierr)), messageType=MPAS_LOG_ERR) + end if - io_global_err = local_ierr - if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND - return - end if -#endif + io_global_err = local_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + return end if +#endif end subroutine MPAS_io_get_var_generic