re PR fortran/34868 (ICE with -ff2c for function returning a complex number)

	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.

From-SVN: r132751

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0b69dd5927ad5a6bec797b33997b677be343e6bd..2082054df0aab39988aa9dff7e58cdb1635656f1 100644 (file)
--- 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 3df9791c876d3aede871b848a9b82236d76a2e93..ead60f240af33307467dc1aecf5d2100383430d8 100644 (file)
--- 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 471f168357a3dd9e5c6222c5fff611551740c7d5..a3484510b558a9b663f17213e2f2fc8ee77cf810 100644 (file)
--- 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 882de9891605817e7d6e59f4a39447833da83863..30d1b0527adaf1b750839a1bdbc145673a8935a8 100644 (file)
--- 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 (file)
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