gcc/testsuite/gfortran.dg/char4_decl-2.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 ! 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
  13 ! { dg-final { scan-tree-dump-times "character\\(kind=4\\) f \\(character\\(kind=4\\) x\\)" 1 "original" } }
  14
  15 character(kind=4) function f(x) bind(C)
  16   character(kind=4), value :: x
  17 end
  18
  19 program testit
  20   implicit none (type, external)
  21   character (kind=4, len=:), allocatable :: aa
  22   character (kind=4, len=:), pointer :: pp
  23
  24   pp => NULL ()
  25
  26   call frobf (aa, pp)
  27   if (.not. allocated (aa)) stop 101
  28   if (storage_size(aa) /= storage_size(4_'foo')) stop 1
  29   if (aa .ne. 4_'foo') stop 102
  30   if (.not. associated (pp)) stop 103
  31   if (storage_size(pp) /= storage_size(4_'bar')) stop 2
  32   if (pp .ne. 4_'bar') stop 104
  33
  34   pp => NULL ()
  35
  36   call frobc (aa, pp)
  37   if (.not. allocated (aa)) stop 105
  38   if (storage_size(aa) /= storage_size(4_'frog')) stop 3
  39   if (aa .ne. 4_'frog') stop 106
  40   if (.not. associated (pp)) stop 107
  41   if (storage_size(pp) /= storage_size(4_'toad')) stop 4
  42   if (pp .ne. 4_'toad') stop 108
  43
  44
  45   contains
  46
  47     subroutine frobf (a, p) Bind(C)
  48       character (kind=4, len=:), allocatable :: a
  49       character (kind=4, len=:), pointer :: p
  50       allocate (character(kind=4, len=3) :: p)
  51       a = 4_'foo'
  52       p = 4_'bar'
  53     end subroutine
  54
  55     subroutine frobc (a, p) Bind(C)
  56       character (kind=4, len=:), allocatable :: a
  57       character (kind=4, len=:), pointer :: p
  58       allocate (character(kind=4, len=4) :: p)
  59       a = 4_'frog'
  60       p = 4_'toad'
  61     end subroutine
  62
  63 end program