From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified
 gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream
 tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
---
 gcc/testsuite/gfortran.dg/proc_decl_1.f90 | 77 +++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/proc_decl_1.f90

(limited to 'gcc/testsuite/gfortran.dg/proc_decl_1.f90')

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
-- 
cgit v1.2.3