1 files changed, 77 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_1.f90 b/gcc/testsuite/gfortran.dg/proc_decl_1.f90
new file mode 100644
index 000000000..de7cb4159
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_1.f90
@@ -0,0 +1,77 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! This tests various error messages for PROCEDURE declarations.
+! Contributed by Janus Weil <jaydub66@gmail.com>
+
+module m
+
+  abstract interface
+    subroutine sub()
+    end subroutine
+    subroutine sub2() bind(c)
+    end subroutine
+  end interface
+
+  procedure(), public, private :: a  ! { dg-error "was already specified" }
+  procedure(sub),bind(C) :: a2  ! { dg-error "requires an interface with BIND.C." }
+  procedure(sub2), public, bind(c, name="myEF") :: e, f  ! { dg-error "Multiple identifiers provided with single NAME= specifier" }
+  procedure(sub2), bind(C, name=""), pointer :: g  ! { dg-error "may not have POINTER attribute" }
+
+  public:: h
+  procedure(),public:: h  ! { dg-error "was already specified" }
+
+contains
+
+  subroutine abc
+    procedure() :: abc2
+  entry abc2(x)  ! { dg-error "PROCEDURE attribute conflicts with ENTRY attribute" }
+    real x
+  end subroutine
+
+end module m
+
+program prog
+
+  interface z
+    subroutine z1()
+    end subroutine
+    subroutine z2(a)
+      integer :: a
+    end subroutine
+  end interface
+
+  procedure(z) :: bar   ! { dg-error "may not be generic" }
+
+  procedure(), allocatable:: b  ! { dg-error "PROCEDURE attribute conflicts with ALLOCATABLE attribute" }
+  procedure(), save:: c  ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
+
+  procedure(dcos) :: my1
+  procedure(amax0) :: my2  ! { dg-error "not allowed in PROCEDURE statement" }
+
+  real f, x
+  f(x) = sin(x**2)
+  external oo
+
+  procedure(f) :: q  ! { dg-error "may not be a statement function" }
+  procedure(oo) :: p  ! { dg-error "must be explicit" }
+
+  procedure ( ) :: r 
+  procedure ( up ) :: s  ! { dg-error "must be explicit" }
+
+  procedure(t) :: t  ! { dg-error "may not be used as its own interface" }
+
+  call s
+
+contains
+
+  subroutine foo(a,c)  ! { dg-error "PROCEDURE attribute conflicts with INTENT attribute" }
+    abstract interface
+      subroutine b() bind(C)
+      end subroutine b
+    end interface
+    procedure(b), bind(c,name="hjj") :: a  ! { dg-error "may not have BIND.C. attribute with NAME" }
+    procedure(b),intent(in):: c
+  end subroutine foo 
+
+end program