gcc/testsuite/gfortran.dg/protected_4.f90

   1 ! { dg-do compile }
   2 ! { dg-shouldfail "Invalid Fortran 2003 code" }
   3 ! { dg-options "-std=f2003 -fall-intrinsics" }
   4 ! PR fortran/23994
   5 !
   6 ! Test PROTECTED attribute. Within the module everything is allowed.
   7 ! Outside (use-associated): For pointers, their association status
   8 ! may not be changed. For nonpointers, their value may not be changed.
   9 !
  10 ! Test of a invalid code
  11
  12 module protmod
  13   implicit none
  14   integer          :: a
  15   integer, target  :: at
  16   integer, pointer :: ap
  17   protected :: a, at, ap
  18 end module protmod
  19
  20 program main
  21   use protmod
  22   implicit none
  23   integer   :: j
  24   logical   :: asgnd
  25   protected :: j ! { dg-error "only allowed in specification part of a module" }
  26   a = 43       ! { dg-error "Assigning to PROTECTED variable" }
  27   ap => null() ! { dg-error "Assigning to PROTECTED variable" }
  28   nullify(ap)  ! { dg-error "Assigning to PROTECTED variable" }
  29   ap => at     ! { dg-error "Assigning to PROTECTED variable" }
  30   ap = 3       ! { dg-error "Assigning to PROTECTED variable" }
  31   allocate(ap) ! { dg-error "Assigning to PROTECTED variable" }
  32   ap = 73      ! { dg-error "Assigning to PROTECTED variable" }
  33   call increment(a,at) ! { dg-error "use-associated with PROTECTED attribute" }
  34   call pointer_assignments(ap) ! { dg-error "is use-associated with PROTECTED attribute" }
  35   asgnd = pointer_check(ap)
  36 contains
  37   subroutine increment(a1,a3)
  38     integer, intent(inout) :: a1, a3
  39     a1 = a1 + 1
  40     a3 = a3 + 1
  41   end subroutine increment
  42   subroutine pointer_assignments(p)
  43     integer, pointer,intent(out) :: p
  44     p => null()
  45   end subroutine pointer_assignments
  46   function pointer_check(p)
  47     integer, pointer,intent(in) :: p
  48     logical :: pointer_check
  49     pointer_check = associated(p)
  50   end function pointer_check
  51 end program main
  52
  53 module test
  54   real :: a
  55   protected :: test ! { dg-error "MODULE attribute conflicts with PROTECTED" }
  56 end module test
  57
  58 ! { dg-final { cleanup-modules "protmod test" } }