gcc/testsuite/gfortran.dg/proc_decl_1.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-std=legacy" }
   3 !
   4 ! This tests various error messages for PROCEDURE declarations.
   5 ! Contributed by Janus Weil <jaydub66@gmail.com>
   6
   7 module m
   8
   9   abstract interface
  10     subroutine sub()
  11     end subroutine
  12     subroutine sub2() bind(c)
  13     end subroutine
  14   end interface
  15
  16   procedure(), public, private :: a  ! { dg-error "was already specified" }
  17   procedure(sub),bind(C) :: a2  ! { dg-error "requires an interface with BIND.C." }
  18   procedure(sub2), public, bind(c, name="myEF") :: e, f  ! { dg-error "Multiple identifiers provided with single NAME= specifier" }
  19   procedure(sub2), bind(C, name=""), pointer :: g  ! { dg-error "may not have POINTER attribute" }
  20
  21   public:: h
  22   procedure(),public:: h  ! { dg-error "was already specified" }
  23
  24 contains
  25
  26   subroutine abc
  27     procedure() :: abc2
  28   entry abc2(x)  ! { dg-error "PROCEDURE attribute conflicts with ENTRY attribute" }
  29     real x
  30   end subroutine
  31
  32 end module m
  33
  34 program prog
  35
  36   interface z
  37     subroutine z1()
  38     end subroutine
  39     subroutine z2(a)
  40       integer :: a
  41     end subroutine
  42   end interface
  43
  44   procedure(z) :: bar   ! { dg-error "may not be generic" }
  45
  46   procedure(), allocatable:: b  ! { dg-error "PROCEDURE attribute conflicts with ALLOCATABLE attribute" }
  47   procedure(), save:: c  ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
  48
  49   procedure(dcos) :: my1
  50   procedure(amax0) :: my2  ! { dg-error "not allowed in PROCEDURE statement" }
  51
  52   real f, x
  53   f(x) = sin(x**2)
  54   external oo
  55
  56   procedure(f) :: q  ! { dg-error "may not be a statement function" }
  57   procedure(oo) :: p  ! { dg-error "must be explicit" }
  58
  59   procedure ( ) :: r
  60   procedure ( up ) :: s  ! { dg-error "must be explicit" }
  61
  62   procedure(t) :: t  ! { dg-error "may not be used as its own interface" }
  63
  64   call s
  65
  66 contains
  67
  68   subroutine foo(a,c)  ! { dg-error "PROCEDURE attribute conflicts with INTENT attribute" }
  69     abstract interface
  70       subroutine b() bind(C)
  71       end subroutine b
  72     end interface
  73     procedure(b), bind(c,name="hjj") :: a  ! { dg-error "may not have BIND.C. attribute with NAME" }
  74     procedure(b),intent(in):: c
  75   end subroutine foo
  76
  77 end program