trans-expr.c (gfc_conv_variable): POINTER results don't need f2c calling conventions.

fortran/
	* trans-expr.c (gfc_conv_variable): POINTER results don't need f2c
	calling conventions.  Look at sym instead of sym->result.
	* trans-types.c (gfc_sym_type): Remove workaround for frontend bug.
	Remove condition which is always false with workaround removed.
	(gfc_return_by_reference): Always look at sym, never at sym->result.
testsuite/
	* gfortran.dg/f2c_7.f90: New test.

From-SVN: r100857

gcc/fortran/ChangeLog

@@ -1,3 +1,11 @@
+2005-06-11  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-expr.c (gfc_conv_variable): POINTER results don't need f2c
+	calling conventions.  Look at sym instead of sym->result.
+	* trans-types.c (gfc_sym_type): Remove workaround for frontend bug.
+	Remove condition which is always false with workaround removed.
+	(gfc_return_by_reference): Always look at sym, never at sym->result.
+
 2005-06-11  Steven G. Kargl  <kargls@comcast.net>
         
 	PR fortran/17792

gcc/fortran/trans-expr.c

@@ -379,7 +379,7 @@ 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.dimension && !sym->attr.pointer)
 	    se->expr = gfc_build_indirect_ref (se->expr);
 
           /* Dereference non-character pointer variables. 
@@ -1315,9 +1315,6 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
 		     arglist, NULL_TREE);
 
-  if (sym->result)
-    sym = sym->result;
-
   /* If we have a pointer function, but we don't want a pointer, e.g.
      something like
         x = f()

gcc/fortran/trans-types.c

@@ -1268,11 +1268,6 @@ gfc_sym_type (gfc_symbol * sym)
 	return TREE_TYPE (sym->backend_decl);
     }
 
-  /* The frontend doesn't set all the attributes for a function with an
-     explicit result value, so we use that instead when present.  */
-  if (sym->attr.function && sym->result)
-    sym = sym->result;
-
   type = gfc_typenode_for_spec (&sym->ts);
   if (gfc_option.flag_f2c
       && sym->attr.function
@@ -1299,7 +1294,7 @@ gfc_sym_type (gfc_symbol * sym)
 	  /* If this is a character argument of unknown length, just use the
 	     base type.  */
 	  if (sym->ts.type != BT_CHARACTER
-	      || !(sym->attr.dummy || sym->attr.function || sym->attr.result)
+	      || !(sym->attr.dummy || sym->attr.function)
 	      || sym->ts.cl->backend_decl)
 	    {
 	      type = gfc_get_nodesc_array_type (type, sym->as,
@@ -1467,17 +1462,13 @@ gfc_get_derived_type (gfc_symbol * derived)
 int
 gfc_return_by_reference (gfc_symbol * sym)
 {
-  gfc_symbol *result;
-
   if (!sym->attr.function)
     return 0;
 
-  result = sym->result ? sym->result : sym;
-
-  if (result->attr.dimension)
+  if (sym->attr.dimension)
     return 1;
 
-  if (result->ts.type == BT_CHARACTER)
+  if (sym->ts.type == BT_CHARACTER)
     return 1;
 
   /* Possibly return complex numbers by reference for g77 compatibility.
@@ -1486,7 +1477,7 @@ gfc_return_by_reference (gfc_symbol * sym)
      require an explicit interface, as no compatibility problems can
      arise there.  */
   if (gfc_option.flag_f2c
-      && result->ts.type == BT_COMPLEX
+      && sym->ts.type == BT_COMPLEX
       && !sym->attr.intrinsic && !sym->attr.always_explicit)
     return 1;
   

gcc/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2005-06-12  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.dg/f2c_7.f90: New test.
+
 2005-06-12  James A. Morrison  <phython@gcc.gnu.org>
 
 	* gcc.dg/pr14796-1.c: New.

gcc/testsuite/gfortran.dg/f2c_7.f90

@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-options "-ff2c -O" }
+! Verifies that array results work with -ff2c
+! try all permutations of result clause in function yes/no
+!                     and result clause in interface yes/no
+! this is not possible in Fortran 77, but this exercises a previously
+! buggy codepath
+function c() result (r)
+  complex :: r(5)
+  r = 0.
+end function c
+
+function d()
+  complex :: d(5)
+  d = 1.
+end function d
+
+subroutine test_without_result
+interface
+   function c
+     complex :: c(5)
+   end function c
+end interface
+interface
+   function d
+     complex :: d(5)
+   end function d
+end interface
+complex z(5)
+z = c()
+if (any(z /= 0.)) call abort ()
+z = d()
+if (any(z /= 1.)) call abort ()
+end subroutine test_without_result
+
+subroutine test_with_result
+interface
+   function c result(r)
+     complex :: r(5)
+   end function c
+end interface
+interface
+   function d result(r)
+     complex :: r(5)
+   end function d
+end interface
+complex z(5)
+z = c()
+if (any(z /= 0.)) call abort ()
+z = d()
+if (any(z /= 1.)) call abort ()
+end subroutine test_with_result
+
+call test_without_result
+call test_with_result
+end
+