gcc/testsuite/gfortran.dg/proc_decl_1.f90

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