From: fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 28 Feb 2008 15:42:21 +0000 (+0000)
Subject: 	PR fortran/34868
X-Git-Tag: upstream/4.9.2~43488
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=36efa756238ed7e8e145614ee8519eed0249c738;p=platform%2Fupstream%2Flinaro-gcc.git

	PR fortran/34868

	* trans-expr.c (gfc_conv_variable): Don't build indirect
	references when explicit interface is mandated.
	* resolve.c (resolve_formal_arglist): Set attr.always_explicit
	on the result symbol as well as the procedure symbol.

	* gfortran.dg/f2c_9.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@132751 138bc75d-0d04-0410-961f-82ee72b054a4
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0b69dd5..2082054 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2008-02-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34868
+	* trans-expr.c (gfc_conv_variable): Don't build indirect
+	references when explicit interface is mandated.
+	* resolve.c (resolve_formal_arglist): Set attr.always_explicit
+	on the result symbol as well as the procedure symbol.
+
 2008-02-27  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/33387
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3df9791..ead60f2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -106,7 +106,10 @@ resolve_formal_arglist (gfc_symbol *proc)
   if (gfc_elemental (proc)
       || sym->attr.pointer || sym->attr.allocatable
       || (sym->as && sym->as->rank > 0))
-    proc->attr.always_explicit = 1;
+    {
+      proc->attr.always_explicit = 1;
+      sym->attr.always_explicit = 1;
+    }
 
   formal_arg_flag = 1;
 
@@ -187,7 +190,11 @@ resolve_formal_arglist (gfc_symbol *proc)
       if ((sym->as && sym->as->rank > 0 && sym->as->type == AS_ASSUMED_SHAPE)
 	  || sym->attr.pointer || sym->attr.allocatable || sym->attr.target
 	  || sym->attr.optional)
-	proc->attr.always_explicit = 1;
+	{
+	  proc->attr.always_explicit = 1;
+	  if (proc->result)
+	    proc->result->attr.always_explicit = 1;
+	}
 
       /* If the flavor is unknown at this point, it has to be a variable.
 	 A procedure specification would have already set the type.  */
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 471f168..a348451 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -513,7 +513,8 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
           /* Dereference scalar hidden result.  */
 	  if (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX
 	      && (sym->attr.function || sym->attr.result)
-	      && !sym->attr.dimension && !sym->attr.pointer)
+	      && !sym->attr.dimension && !sym->attr.pointer
+	      && !sym->attr.always_explicit)
 	    se->expr = build_fold_indirect_ref (se->expr);
 
           /* Dereference non-character pointer variables. 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 882de98..30d1b05 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-02-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34868
+	* gfortran.dg/f2c_9.f90: New test.
+
 2008-02-28  Sebastian Pop  <sebastian.pop@amd.com>
 
 	* testsuite/gcc.dg/tree-ssa/ldist-1.c: New.
diff --git a/gcc/testsuite/gfortran.dg/f2c_9.f90 b/gcc/testsuite/gfortran.dg/f2c_9.f90
new file mode 100644
index 0000000..59c3fbe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_9.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! { dg-options "-ff2c" }
+! PR 34868
+
+function f(a) result(res)
+  implicit none
+  real(8), intent(in) :: a(:)
+  complex(8) :: res
+
+  res = cmplx(sum(a),product(a),8)
+end function f
+
+function g(a)
+  implicit none
+  real(8), intent(in) :: a(:)
+  complex(8) :: g
+
+  g = cmplx(sum(a),product(a),8)
+end function g
+
+program test
+  real(8) :: a(1,5)
+  complex(8) :: c
+  integer :: i
+
+  interface
+    complex(8) function f(a)
+      real(8), intent(in) :: a(:)
+    end function f
+    function g(a) result(res)
+      real(8), intent(in) :: a(:)
+      complex(8) :: res
+    end function g
+  end interface
+
+  do i = 1, 5
+    a(1,i) = sqrt(real(i,kind(a)))
+  end do
+
+  c = f(a(1,:))
+  call check (real(c), sum(a))
+  call check (imag(c), product(a))
+
+  c = g(a(1,:))
+  call check (real(c), sum(a))
+  call check (imag(c), product(a))
+contains
+  subroutine check (a, b)
+    real(8), intent(in) :: a, b
+    if (abs(a - b) > 1.e-10_8) call abort
+  end subroutine check
+end program test