gcc/testsuite/gfortran.fortran-torture/execute/equiv_init_1.f90

   1 ! Program to test initialization of equivalence blocks.  PR13742.
   2 ! Some forms are not yet implemented.  These are indicated by !!$
   3
   4 subroutine test0s
   5   character*10 :: x = "abcdefghij"
   6   character*10 :: y
   7   equivalence (x,y)
   8
   9   character*10 :: xs(10)
  10   character*10 :: ys(10)
  11   equivalence (xs,ys)
  12   data xs /10*"abcdefghij"/
  13
  14   if (y.ne."abcdefghij") call abort
  15   if (ys(1).ne."abcdefghij") call abort
  16   if (ys(10).ne."abcdefghij") call abort
  17 end
  18
  19 subroutine test0
  20   integer :: x = 123
  21   integer :: y
  22   equivalence (x,y)
  23   if (y.ne.123) call abort
  24 end
  25
  26 subroutine test1
  27   integer :: a(3)
  28   integer :: x = 1
  29   integer :: y
  30   integer :: z = 3
  31   equivalence (a(1), x)
  32   equivalence (a(3), z)
  33   if (x.ne.1) call abort
  34   if (z.ne.3) call abort
  35   if (a(1).ne.1) call abort
  36   if (a(3).ne.3) call abort
  37 end
  38
  39 subroutine test2
  40   integer :: x
  41   integer :: z
  42   integer :: a(3) = 123
  43   equivalence (a(1), x)
  44   equivalence (a(3), z)
  45   if (x.ne.123) call abort
  46   if (z.ne.123) call abort
  47 end
  48
  49 subroutine test3
  50   integer :: x
  51 !!$  integer :: y = 2
  52   integer :: z
  53   integer :: a(3)
  54   equivalence (a(1),x), (a(2),y), (a(3),z)
  55   data a(1) /1/, a(3) /3/
  56   if (x.ne.1) call abort
  57 !!$  if (y.ne.2) call abort
  58   if (z.ne.3) call abort
  59 end
  60
  61 subroutine test4
  62   integer a(2)
  63   integer b(2)
  64   integer c
  65   equivalence (a(2),b(1)), (b(2),c)
  66   data a/1,2/
  67   data c/3/
  68   if (b(1).ne.2) call abort
  69   if (b(2).ne.3) call abort
  70 end
  71
  72 !!$subroutine test5
  73 !!$  integer a(2)
  74 !!$  integer b(2)
  75 !!$  integer c
  76 !!$  equivalence (a(2),b(1)), (b(2),c)
  77 !!$  data a(1)/1/
  78 !!$  data b(1)/2/
  79 !!$  data c/3/
  80 !!$  if (a(2).ne.2) call abort
  81 !!$  if (b(2).ne.3) call abort
  82 !!$  print *, "Passed test5"
  83 !!$end
  84
  85 program main
  86   call test0s
  87   call test0
  88   call test1
  89   call test2
  90   call test3
  91   call test4
  92 !!$  call test5
  93 end
  94