gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90

   1 ! { dg-do compile }
   2 !
   3 ! Contributed by Reinhold Bader
   4 !
   5
   6 program pmup
   7   implicit none
   8   type t
   9     integer :: b, a
  10   end type t
  11
  12   CLASS(*), allocatable :: a(:)[:]
  13   integer :: ii
  14
  15   !! --- ONE ---
  16   allocate(real :: a(3)[*])
  17   IF (this_image() == num_images()) THEN
  18     SELECT TYPE (a)
  19       TYPE IS (real)
  20       a(:)[1] = 2.0
  21     END SELECT
  22   END IF
  23   SYNC ALL
  24
  25   IF (this_image() == 1) THEN
  26     SELECT TYPE (a)
  27       TYPE IS (real)
  28         IF (ALL(A(:)[1] == 2.0)) THEN
  29           !WRITE(*,*) 'OK'
  30         ELSE
  31           WRITE(*,*) 'FAIL'
  32           call abort()
  33         END IF
  34       TYPE IS (t)
  35         ii = a(1)[1]%a
  36         call abort()
  37       CLASS IS (t)
  38         ii = a(1)[1]%a
  39         call abort()
  40     END SELECT
  41   END IF
  42
  43   !! --- TWO ---
  44   deallocate(a)
  45   allocate(t :: a(3)[*])
  46   IF (this_image() == num_images()) THEN
  47     SELECT TYPE (a)
  48       TYPE IS (t)     ! FIXME: When implemented, turn into "do-do run"
  49       a(:)[1]%a = 4.0 ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
  50     END SELECT
  51   END IF
  52   SYNC ALL
  53
  54   IF (this_image() == 1) THEN
  55     SELECT TYPE (a)
  56    TYPE IS (real)
  57       ii = a(1)[1]
  58       call abort()
  59     TYPE IS (t)                       ! FIXME: When implemented, turn into "do-do run"
  60       IF (ALL(A(:)[1]%a == 4.0)) THEN ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
  61         !WRITE(*,*) 'OK'
  62       ELSE
  63         WRITE(*,*) 'FAIL'
  64         call abort()
  65       END IF
  66     CLASS IS (t)
  67       ii = a(1)[1]%a
  68       call abort()
  69     END SELECT
  70   END IF
  71 end program