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

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

diff --git a/gcc/testsuite/gfortran.dg/actual_procedure_1.f90 b/gcc/testsuite/gfortran.dg/actual_procedure_1.f90
new file mode 100644
index 000000000..5327cb73d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_procedure_1.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+! Tests the fix for PR36433 in which a check for the array size
+! or character length of the actual arguments of foo and bar
+! would reject this legal code.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+module m
+contains
+  function proc4 (arg, chr)
+    integer, dimension(10) :: proc4
+    integer, intent(in) :: arg
+    character(8), intent(inout) :: chr
+    proc4 = arg
+    chr = "proc4"
+  end function
+  function chr_proc ()
+    character(8) :: chr_proc
+    chr_proc = "chr_proc"
+  end function
+end module
+
+program procPtrTest
+  use m
+  character(8) :: chr
+  interface
+    function proc_ext (arg, chr)
+      integer, dimension(10) :: proc_ext
+      integer, intent(in) :: arg
+      character(8), intent(inout) :: chr
+    end function
+  end interface
+! Check the passing of a module function
+  call foo (proc4, chr)
+  if (trim (chr) .ne. "proc4") call abort
+! Check the passing of an external function
+  call foo (proc_ext, chr)
+! Check the passing of a character function
+  if (trim (chr) .ne. "proc_ext") call abort
+  call bar (chr_proc)
+contains
+  subroutine foo (p, chr)
+    character(8), intent(inout) :: chr
+    integer :: i(10)
+    interface
+      function p (arg, chr)
+        integer, dimension(10) :: p
+        integer, intent(in) :: arg
+        character(8), intent(inout) :: chr
+      end function
+    end interface
+    i = p (99, chr)
+    if (any(i .ne. 99)) call abort
+  end subroutine
+  subroutine bar (p)
+    interface
+      function p ()
+        character(8):: p
+      end function
+    end interface
+    if (p () .ne. "chr_proc") call abort
+  end subroutine
+end program 
+
+function proc_ext (arg, chr)
+  integer, dimension(10) :: proc_ext
+  integer, intent(in) :: arg
+  character(8), intent(inout) :: chr
+  proc_ext = arg
+  chr = "proc_ext"
+end function
+! { dg-final { cleanup-modules "m" } }
\ No newline at end of file
-- 
cgit v1.2.3