gcc/testsuite/gfortran.dg/protected_4.f90

   1 ! { dg-do compile }
   2 ! { dg-shouldfail "Invalid Fortran 2003 code" }
   3 ! { dg-options "-std=f2003" }
   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 "variable definition context" }
  27   ap => null() ! { dg-error "pointer association context" }
  28   nullify(ap)  ! { dg-error "pointer association context" }
  29   ap => &      ! { dg-error "pointer association context" }
  30        & at    ! { dg-error "Pointer assignment target has PROTECTED attribute" }
  31   ap = 3       ! OK
  32   allocate(ap) ! { dg-error "pointer association context" }
  33   ap = 73      ! OK
  34   call increment(a,at) ! { dg-error "variable definition context" }
  35   call pointer_assignments(ap) ! { dg-error "pointer association context" }
  36   asgnd = pointer_check(ap)
  37 contains
  38   subroutine increment(a1,a3)
  39     integer, intent(inout) :: a1, a3
  40     a1 = a1 + 1
  41     a3 = a3 + 1
  42   end subroutine increment
  43   subroutine pointer_assignments(p)
  44     integer, pointer,intent(out) :: p
  45     p => null()
  46   end subroutine pointer_assignments
  47   function pointer_check(p)
  48     integer, pointer,intent(in) :: p
  49     logical :: pointer_check
  50     pointer_check = associated(p)
  51   end function pointer_check
  52 end program main
  53
  54 module test
  55   real :: a
  56   protected :: test ! { dg-error "MODULE attribute conflicts with PROTECTED" }
  57 end module test