gcc/testsuite/gfortran.dg/char4_decl.f90

   1 ! { dg-do run }
   2 ! { dg-additional-options "-fdump-tree-original" }
   3
   4 ! In this program shall be no kind=1,
   5 ! except for the 'argv' of the 'main' program.
   6
   7 ! Related PR fortran/107266
   8
   9 ! { dg-final { scan-tree-dump-times "kind=1" 1 "original" } }
  10 ! { dg-final { scan-tree-dump-times "character\\(kind=1\\) \\* \\* argv\\)" 1 "original" } }
  11
  12 program testit
  13   implicit none (type, external)
  14   character (kind=4, len=:), allocatable :: aa
  15   character (kind=4, len=:), pointer :: pp
  16
  17   pp => NULL ()
  18
  19   call frobf (aa, pp)
  20   if (.not. allocated (aa)) stop 101
  21   if (storage_size(aa) /= storage_size(4_'foo')) stop 1
  22   if (aa .ne. 4_'foo') stop 102
  23   if (.not. associated (pp)) stop 103
  24   if (storage_size(pp) /= storage_size(4_'bar')) stop 2
  25   if (pp .ne. 4_'bar') stop 104
  26
  27   pp => NULL ()
  28
  29   call frobc (aa, pp)
  30   if (.not. allocated (aa)) stop 105
  31   if (storage_size(aa) /= storage_size(4_'frog')) stop 3
  32   if (aa .ne. 4_'frog') stop 106
  33   if (.not. associated (pp)) stop 107
  34   if (storage_size(pp) /= storage_size(4_'toad')) stop 4
  35   if (pp .ne. 4_'toad') stop 108
  36
  37
  38   contains
  39
  40     subroutine frobf (a, p)
  41       character (kind=4, len=:), allocatable :: a
  42       character (kind=4, len=:), pointer :: p
  43       allocate (character(kind=4, len=3) :: p)
  44       a = 4_'foo'
  45       p = 4_'bar'
  46     end subroutine
  47
  48     subroutine frobc (a, p)
  49       character (kind=4, len=:), allocatable :: a
  50       character (kind=4, len=:), pointer :: p
  51       allocate (character(kind=4, len=4) :: p)
  52       a = 4_'frog'
  53       p = 4_'toad'
  54     end subroutine
  55
  56 end program