re PR testsuite/26981 (g++.old-deja/g++.other/init18.C fails)

2006-04-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/26981
	* trans.h : Prototype for gfc_conv_missing_dummy.
	* trans-expr (gfc_conv_missing_dummy): New function
	(gfc_conv_function_call): Call it and tidy up some of the code.
	* trans-intrinsic (gfc_conv_intrinsic_function_args): The same.

	PR fortran/26976
	* array.c (gfc_array_dimen_size): If available, return shape[dimen].
	* resolve.c (resolve_function): If available, use the argument shape for the
	function expression.
	* iresolve.c (gfc_resolve_transfer): Set shape[0] = size.

2006-04-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/26981
	* gfortran.dg/missing_optional_dummy_1.f90: New test.

	PR fortran/26976
	* gfortran.dg/compliant_elemental_intrinsics_1.f90: New test.
	* gfortran.dg/initialization_1.f90: Make assignment compliant.
	* gfortran.dg/transfer_array_intrinsic_1.f90: Simplify.
	* gfortran.dg/transfer_array_intrinsic_2.f90: Make assignments compliant and detect
	bigendian-ness.

From-SVN: r112634

1 files changed, 20 insertions, 6 deletions

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 87d3a74..b69ffef 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -165,28 +165,42 @@ static tree
 gfc_conv_intrinsic_function_args (gfc_se * se, gfc_expr * expr)
 {
   gfc_actual_arglist *actual;
-  tree args;
+  gfc_expr *e;
+  gfc_intrinsic_arg  *formal;
   gfc_se argse;
+  tree args;
 
   args = NULL_TREE;
-  for (actual = expr->value.function.actual; actual; actual = actual->next)
+  formal = expr->value.function.isym->formal;
+
+  for (actual = expr->value.function.actual; actual; actual = actual->next,
+       formal = formal ? formal->next : NULL)
     {
+      e = actual->expr;
       /* Skip omitted optional arguments.  */
-      if (!actual->expr)
+      if (!e)
 	continue;
 
       /* Evaluate the parameter.  This will substitute scalarized
          references automatically.  */
       gfc_init_se (&argse, se);
 
-      if (actual->expr->ts.type == BT_CHARACTER)
+      if (e->ts.type == BT_CHARACTER)
 	{
-	  gfc_conv_expr (&argse, actual->expr);
+	  gfc_conv_expr (&argse, e);
 	  gfc_conv_string_parameter (&argse);
 	  args = gfc_chainon_list (args, argse.string_length);
 	}
       else
-        gfc_conv_expr_val (&argse, actual->expr);
+        gfc_conv_expr_val (&argse, e);
+
+      /* If an optional argument is itself an optional dummy argument,
+	 check its presence and substitute a null if absent.  */
+      if (e->expr_type ==EXPR_VARIABLE
+	    && e->symtree->n.sym->attr.optional
+	    && formal
+	    && formal->optional)
+	gfc_conv_missing_dummy (&argse, e, formal->ts);
 
       gfc_add_block_to_block (&se->pre, &argse.pre);
       gfc_add_block_to_block (&se->post, &argse.post);