gcc/testsuite/gfortran.dg/allocate_with_source_30.f90

   1 ! { dg-do run }
   2 ! { dg-additional-options "-std=f2008 -fcheck=bounds -g -fdump-tree-original" }
   3 ! { dg-output "At line 43 .*" }
   4 ! { dg-shouldfail "Unequal character lengths .3/2. in ALLOCATE with SOURCE= or MOLD=" }
   5 !
   6 ! PR fortran/113793
   7 !
   8 ! Test runtime checks of string length for ALLOCATE with SOURCE= or MOLD=
   9
  10 program p
  11   implicit none
  12   character(kind=1,len=2) :: c1 =   "xx"
  13   character(kind=1,len=8) :: c2 =   "yy"
  14   character(kind=4,len=6) :: c3 = 4_"ww"
  15   call sub1 (len (c2), c2)
  16   call sub4 (len (c3), c3)
  17   call test (len (c1) + 1, c1)
  18 contains
  19   subroutine sub1 (n, s)
  20     integer,      intent(in) :: n
  21     character(*), intent(in) :: s
  22     character(len=8), allocatable :: f(:), g
  23     character(len=n), allocatable :: h(:), j
  24     ALLOCATE (f(7), source=s)
  25     ALLOCATE (g,    source=s)
  26     ALLOCATE (h(5), mold=s)
  27     ALLOCATE (j,    mold=s)
  28   end
  29   subroutine sub4 (n, s)
  30     integer,                 intent(in) :: n
  31     character(kind=4,len=*), intent(in) :: s
  32     character(kind=4,len=6), allocatable :: f(:), g
  33     character(kind=4,len=n), allocatable :: h(:), j
  34     ALLOCATE (f(3), source=s)
  35     ALLOCATE (g,    source=s)
  36     ALLOCATE (h(5), mold=s)
  37     ALLOCATE (j,    mold=s)
  38   end
  39   subroutine test (n, s)
  40     integer,      intent(in) :: n
  41     character(*), intent(in) :: s
  42     character(len=n), allocatable :: str
  43     ALLOCATE (str, source=s)
  44   end
  45 end
  46
  47 ! { dg-final { scan-tree-dump-times "__builtin_malloc .72.;" 1 "original" } }
  48 ! { dg-final { scan-tree-dump-times "__builtin_malloc .24.;" 1 "original" } }
  49 ! { dg-final { scan-tree-dump-times "__builtin_malloc .56.;" 1 "original" } }
  50 ! { dg-final { scan-tree-dump-times "__builtin_malloc .8.;" 1 "original" } }
  51 ! { dg-final { scan-tree-dump-times "ALLOCATE with SOURCE= or MOLD=" 9 "original" } }