Ensure the buffer provided to MPAS_io_get_var_generic is large enough.

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
 
@@ -44,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:
 

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,18 @@ 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, 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
       !

src/core_test/mpas_test_core_io.F

@@ -0,0 +1,203 @@
+! 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 https://mpas-dev.github.io/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, ierr)
+
+      type (domain_type), intent(inout) :: domain
+      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,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 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
+      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_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_BUF) then
+            ierr = 1
+            if (local_ierr == MPAS_IO_NOERR) then
+               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_BUF ($i)'&
+                                        //' but recieved error $i reading "'//trim(varName1)//'"', &
+                                        (/MPAS_IO_ERR_INSUFFICIENT_BUF, 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 ierr        The error code that indicates the result of the test.
+   !
+   !-----------------------------------------------------------------------
+   subroutine test_core_io_test(domain, ierr)
+
+      use mpas_log
+
+      type (domain_type), intent(inout) :: domain
+      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, 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

src/framework/mpas_io.F

@@ -7,6 +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)
+
    use mpas_derived_types
    use mpas_attlist
    use mpas_dmpar
@@ -1847,6 +1850,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 +1994,41 @@ 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 is $i '// 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_BUF
+            message = 'Length of string variable "'//trim(fieldname)//'" in file "'//trim(handle % filename)//'"'
+            IO_ERROR_WRITE(message, intArgs=[0])
+            message = '    exceeds buffer size: len('//trim(fieldname)//')=$i, len(buffer)=$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,6 +2794,13 @@ 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_BUF) then
+         call MPAS_io_err_mesg(handle % ioContext, local_ierr, .false.)
+         io_global_err = local_ierr
+         if (present(ierr)) ierr = local_ierr
+         return
+      endif
+
 #ifdef MPAS_PIO_SUPPORT
       if (pio_ierr /= PIO_noerr) then
          io_global_err = pio_ierr
@@ -6498,6 +6534,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_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

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_BUF   = -22
 
    type MPAS_IO_Handle_type
       logical :: initialized = .false.