From: Paul Thomas <pault@gcc.gnu.org>
Date: Sat, 15 Nov 2008 17:26:13 +0000 (+0000)
Subject: re PR fortran/37926 (Program gives wrong output (connected to char len))
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=4d45d495663618e45f0a0baa481b74ee7a87a597;p=platform%2Fupstream%2Fgcc.git

re PR fortran/37926 (Program gives wrong output (connected to char len))

2008-11-15  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/37926
        * trans-expr.c (gfc_add_interface_mapping): Transfer the formal
	arglist and the always_explicit attribute if the dummy arg is a
	procedure.

2008-11-15  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/37926
        * gfortran.dg/dummy_procedure_3.f90: New test.

From-SVN: r141890
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c3b58b5..35466d4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2008-11-15  Paul Thomas  <pault@gcc.gnu.org>
+
+        PR fortran/37926
+        * trans-expr.c (gfc_add_interface_mapping): Transfer the formal
+	arglist and the always_explicit attribute if the dummy arg is a
+	procedure.
+
 2008-11-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/37988
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index a3265ac..ff74928 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1711,6 +1711,15 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping,
   new_sym->attr.flavor = sym->attr.flavor;
   new_sym->attr.function = sym->attr.function;
 
+  /* Ensure that the interface is available and that
+     descriptors are passed for array actual arguments.  */
+  if (sym->attr.flavor == FL_PROCEDURE)
+    {
+      copy_formal_args (new_sym, expr->symtree->n.sym);
+      new_sym->attr.always_explicit
+	    = expr->symtree->n.sym->attr.always_explicit;
+    }
+
   /* Create a fake symtree for it.  */
   root = NULL;
   new_symtree = gfc_new_symtree (&root, sym->name);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3ff73d2..78a345a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-11-15  Paul Thomas  <pault@gcc.gnu.org>
+
+        PR fortran/37926
+        * gfortran.dg/dummy_procedure_3.f90: New test.
+
 2008-11-15  Jakub Jelinek  <jakub@redhat.com>
 
 	PR target/38123
diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_3.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_3.f90
new file mode 100644
index 0000000..cde2f01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dummy_procedure_3.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! PR37926 - the interface did not transfer the formal
+! argument list for the call to 'asz' in the specification of 'p'.
+!
+! Contributed by Janus Weil  <janus@gcc.gnu.org>
+!
+module m
+contains
+  pure integer function mysize(a)
+    integer,intent(in) :: a(:)
+    mysize = size(a)
+  end function
+end module
+
+program prog
+  use m
+  implicit none
+  character(3) :: str
+  integer :: i(3) = (/1,2,3/)
+  str = p(i,mysize)
+  if (len(str) .ne. 3) call abort
+  if (str .ne. "BCD") call abort
+contains
+  function p(y,asz)
+    implicit none
+    integer :: y(:)
+    interface
+      pure integer function asz(c)
+        integer,intent(in) :: c(:)
+      end function
+    end interface
+    character(asz(y)) p
+    integer i
+    do i=1,asz(y)
+      p(i:i) = achar(iachar('A')+y(i))
+    end do
+  end function
+end
+! { dg-final { cleanup-modules "m" } }
+