gcc/testsuite/gfortran.dg/protected_8.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/46122
   4 !
   5 ! PROTECT check
   6 !
   7 ! Contributed by Jared Ahern
   8 !
   9
  10 MODULE amod
  11    IMPLICIT NONE
  12    TYPE foo
  13       INTEGER :: i = 4
  14       INTEGER, POINTER :: j => NULL()
  15    END TYPE foo
  16    TYPE(foo), SAVE, PROTECTED :: a
  17    TYPE(foo), SAVE, PROTECTED, POINTER :: b
  18    INTEGER, SAVE, PROTECTED :: i = 5
  19    INTEGER, SAVE, PROTECTED, POINTER :: j => NULL()
  20 contains
  21   subroutine alloc()
  22     allocate(b,j)
  23   end subroutine alloc
  24 END MODULE amod
  25
  26 PROGRAM test
  27    USE amod
  28    IMPLICIT NONE
  29    INTEGER, TARGET :: k
  30    TYPE(foo), TARGET :: c
  31    k = 2   ! local
  32    c%i = 9 ! local
  33
  34    call alloc()
  35
  36    i = k    ! { dg-error "is PROTECTED" }
  37    j => k   ! { dg-error "is PROTECTED" }
  38    j = 3    ! OK 1
  39    a = c    ! { dg-error "is PROTECTED" }
  40    a%i = k  ! { dg-error "is PROTECTED" }
  41    a%j => k ! { dg-error "is PROTECTED" }
  42    a%j = 5  ! OK 2
  43    b => c   ! { dg-error "is PROTECTED" }
  44    b%i = k  ! OK 3
  45    b%j => k ! OK 4
  46    b%j = 5  ! OK 5
  47
  48 END PROGRAM test