gcc/testsuite/gfortran.dg/internal_pack_4.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! PR fortran/36132
   5 !
   6 ! Before invalid memory was accessed because an absent, optional
   7 ! argument was packed before passing it as absent actual.
   8 ! Getting it to crash is difficult, but valgrind shows the problem.
   9 !
  10 MODULE M1
  11   INTEGER, PARAMETER :: dp=KIND(0.0D0)
  12 CONTAINS
  13   SUBROUTINE S1(a)
  14          REAL(dp), DIMENSION(45), INTENT(OUT), &
  15       OPTIONAL                               :: a
  16       if (present(a)) call abort()
  17   END SUBROUTINE S1
  18   SUBROUTINE S2(a)
  19           REAL(dp), DIMENSION(:, :), INTENT(OUT), &
  20       OPTIONAL                               :: a
  21       CALL S1(a)
  22   END SUBROUTINE
  23 END MODULE M1
  24
  25 USE M1
  26 CALL S2()
  27 END
  28
  29 ! { dg-final { scan-tree-dump-times "a != 0B \\? _gfortran_internal_pack" 1 "original" } }
  30 ! { dg-final { scan-tree-dump-times "if \\(a != 0B &&" 1 "original" } }
  31 ! { dg-final { cleanup-tree-dump "original" } }