re PR fortran/20178 (COMPLEX function returns incompatible with g77)

gcc/fortran/
	PR fortran/20178
	* gfortran.h (gfc_option): Add flag_f2c.
	* invoke.texi: Document '-ff2c' command line option.  Adapt
	documentation for '-fno-second-underscore' and '-fno-underscoring'.
	* lang.opt (ff2c): New entry.
	* options.c (gfc-init_options): Set default calling convention
	to -fno-f2c.  Mark -fsecond-underscore unset.
	(gfc_post_options): Set -fsecond-underscore if not explicitly set
	by user.
	(handle_options): Set gfc_option.flag_f2c according to requested
	calling	convention.
	* trans-decl.c (gfc_get_extern_function_decl): Use special f2c
	intrinsics where necessary.
	(gfc_trans_deferred_vars): Change todo error to	assertion.
	* trans-expr.c (gfc_conv_variable): Dereference access
	to hidden result argument.
	(gfc_conv_function_call): Add hidden result argument to argument
	list if f2c calling conventions requested.  Slightly restructure
	tests.  Convert result of default REAL function to requested type
	if f2c calling conventions are used.  Dereference COMPLEX result
	if f2c cc are used.
	* trans-types.c (gfc_sym_type):  Return double for default REAL
	function if f2c cc are used.
	(gfc_return_by_reference): Slightly restructure logic.  Return
	COMPLEX by reference depending on calling conventions.
	(gfc_get_function_type): Correctly make hidden result argument a
	pass-by-reference argument for COMPLEX.  Remove old code which does
	this for derived types.
libgfortran/
	PR fortran/20178
	* Makefile.am (gfor_specific_src): Add 'intrinsics/f2c_intrinsics.F90'
	to dependencies.
	* Makefile.in: Regenerate.
	* intrinsics/f2c_specific.F90: New file.
gcc/testsuite/
	PR fortran/20178
	* gfortran.dg/f2c_1.f90, gfortran.dg/f2c_2.f90,
	gfortran.dg/f2c_3.f90: New tests.

From-SVN: r99544

1 files changed, 31 insertions, 4 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index caf3d75..35c3f12 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -362,6 +362,13 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	  && !sym->attr.dimension)
 	se->expr = gfc_build_indirect_ref (se->expr);
 
+      /* Dereference scalar hidden result.  */
+      if (gfc_option.flag_f2c 
+	  && (sym->attr.function || sym->attr.result)
+	  && sym->ts.type == BT_COMPLEX
+	  && !sym->attr.dimension)
+	se->expr = gfc_build_indirect_ref (se->expr);
+
       /* Dereference pointer variables.  */
       if ((sym->attr.pointer || sym->attr.allocatable)
 	  && (sym->attr.dummy
@@ -1138,7 +1145,13 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 				      convert (gfc_charlen_type_node, len));
 	}
       else
-	gcc_unreachable ();
+	{
+	  gcc_assert (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX);
+
+	  type = gfc_get_complex_type (sym->ts.kind);
+	  var = gfc_build_addr_expr (NULL, gfc_create_var (type, "cmplx"));
+	  arglist = gfc_chainon_list (arglist, var);
+	}
     }
 
   formal = sym->formal;
@@ -1240,14 +1253,25 @@ 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()
      where f is pointer valued, we have to dereference the result.  */
-  if (!se->want_pointer && !byref
-      && (sym->attr.pointer || (sym->result && sym->result->attr.pointer)))
+  if (!se->want_pointer && !byref && sym->attr.pointer)
     se->expr = gfc_build_indirect_ref (se->expr);
 
+  /* f2c calling conventions require a scalar default real function to
+     return a double precision result.  Convert this back to default
+     real.  We only care about the cases that can happen in Fortran 77.
+  */
+  if (gfc_option.flag_f2c && sym->ts.type == BT_REAL
+      && sym->ts.kind == gfc_default_real_kind
+      && !sym->attr.always_explicit)
+    se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
+
   /* A pure function may still have side-effects - it may modify its
      parameters.  */
   TREE_SIDE_EFFECTS (se->expr) = 1;
@@ -1282,7 +1306,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	      se->string_length = len;
 	    }
 	  else
-	    gcc_unreachable ();
+	    {
+	      gcc_assert (sym->ts.type == BT_COMPLEX && gfc_option.flag_f2c);
+	      se->expr = gfc_build_indirect_ref (var);
+	    }
 	}
     }
 }