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_2.f90 | 148 ++++++++++++++++++++++++++++++
 1 file changed, 148 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/proc_decl_2.f90

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

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_2.f90 b/gcc/testsuite/gfortran.dg/proc_decl_2.f90
new file mode 100644
index 000000000..a16b4db5f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_2.f90
@@ -0,0 +1,148 @@
+! { dg-do run }
+! Various runtime tests of PROCEDURE declarations.
+! Contributed by Janus Weil <jaydub66@gmail.com>
+
+module m
+
+  use ISO_C_BINDING
+
+  abstract interface
+    subroutine csub() bind(c)
+    end subroutine csub
+  end interface
+
+  integer, parameter :: ckind = C_FLOAT_COMPLEX
+  abstract interface
+    function stub() bind(C)
+      import ckind
+      complex(ckind) stub
+    end function
+  end interface
+
+  procedure():: mp1
+  procedure(real), private:: mp2
+  procedure(mfun), public:: mp3
+  procedure(csub), public, bind(c) :: c, d
+  procedure(csub), public, bind(c, name="myB") :: b
+  procedure(stub), bind(C) :: e
+
+contains
+
+  real function mfun(x,y)
+    real x,y
+    mfun=4.2
+  end function
+
+  subroutine bar(a,b)
+    implicit none
+    interface
+      subroutine a()
+      end subroutine a
+    end interface
+    optional ::  a
+    procedure(a), optional :: b
+  end subroutine bar
+
+  subroutine bar2(x)
+    abstract interface
+      character function abs_fun()
+      end function
+    end interface
+    procedure(abs_fun):: x
+  end subroutine
+
+
+end module
+
+
+program p
+  implicit none
+
+  abstract interface
+    subroutine abssub(x)
+      real x
+    end subroutine
+  end interface
+
+  integer i
+  real r
+
+  procedure(integer):: p1
+  procedure(fun):: p2
+  procedure(abssub):: p3
+  procedure(sub):: p4
+  procedure():: p5
+  procedure(p4):: p6
+  procedure(integer) :: p7
+
+  i=p1()
+  if (i /= 5) call abort()
+  i=p2(3.1)
+  if (i /= 3) call abort()
+  r=4.2
+  call p3(r)
+  if (abs(r-5.2)>1e-6) call abort()
+  call p4(r)
+  if (abs(r-3.7)>1e-6) call abort()
+  call p5()
+  call p6(r)
+  if (abs(r-7.4)>1e-6) call abort()
+  i=p7(4)
+  if (i /= -8) call abort()
+  r=dummytest(p3)
+  if (abs(r-2.1)>1e-6) call abort()
+
+contains
+
+  integer function fun(x)
+    real x
+    fun=7
+  end function
+
+  subroutine sub(x)
+    real x
+  end subroutine
+
+  real function dummytest(dp)
+    procedure(abssub):: dp
+    real y
+    y=1.1
+    call dp(y)
+    dummytest=y
+  end function
+
+end program p
+
+
+integer function p1()
+  p1 = 5
+end function
+
+integer function p2(x)
+  real x
+  p2 = int(x)
+end function
+
+subroutine p3(x)
+  real,intent(inout):: x
+  x=x+1.0
+end subroutine
+
+subroutine p4(x)
+  real,intent(inout):: x
+  x=x-1.5
+end subroutine
+
+subroutine p5()
+end subroutine
+
+subroutine p6(x)
+  real,intent(inout):: x
+  x=x*2.
+end subroutine
+
+function p7(x)
+ implicit none
+ integer :: x, p7
+ p7 = x*(-2)
+end function
-- 
cgit v1.2.3