Hi Bernd,

Bernd Schmidt wrote:
On 06/04/2014 09:40 AM, Tobias Burnus wrote:
I intent to tests the build and test the patch - and then to
commit it as obvious. If you see problems with this approach
please scream now.

Even with this applied, I'm still seeing similar failures.

I didn't claim that the patch would fix everything – nor that it was well tested.

Can you try the attached version? The change is that I now properly use "se->ignore_optional" to test whether absent optional arguments should be skipped - rather than using this mornings ad-hoc solution of doing so unconditionally. Additionally, the patch has now survived stage2 building – which is more testing than I could do this morning.

Tobias
2014-06-04  Tobias Burnus  <bur...@net-b.de>

	* gfortran.h (gfc_copy_formal_args_intr): Update prototype.
	* symbol.c (gfc_copy_formal_args_intr): Handle the case
	that absent optional arguments should be ignored.
	* trans-intrinsic.c (gfc_get_symbol_for_expr): Ditto.
	(gfc_conv_intrinsic_funcall,
	conv_generic_with_optional_char_arg): Update call.
	* resolve.c (gfc_resolve_intrinsic): Ditto.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3e5cdbd..1df79fd 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2748,7 +2785,8 @@ gfc_symbol* gfc_get_ultimate_derived_super_type (gfc_symbol*);
 bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *);
 bool gfc_type_compatible (gfc_typespec *, gfc_typespec *);
 
-void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *);
+void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *,
+				gfc_actual_arglist *);
 
 void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too  */
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7579573..d224d6e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1674,7 +1674,7 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
       return false;
     }
 
-  gfc_copy_formal_args_intr (sym, isym);
+  gfc_copy_formal_args_intr (sym, isym, NULL);
 
   sym->attr.pure = isym->pure;
   sym->attr.elemental = isym->elemental;
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 3785c2e..922b421 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4015,16 +4042,21 @@ add_proc_interface (gfc_symbol *sym, ifsrc source, gfc_formal_arglist *formal)
    each arg is set according to the existing ones.  This function is
    used when creating procedure declaration variables from a procedure
    declaration statement (see match_proc_decl()) to create the formal
-   args based on the args of a given named interface.  */
+   args based on the args of a given named interface.
+
+   When an actual argument list is provided, skip the absent arguments.
+   To be used together with gfc_se->ignore_optional.  */
 
 void
-gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
+gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src,
+			   gfc_actual_arglist *actual)
 {
   gfc_formal_arglist *head = NULL;
   gfc_formal_arglist *tail = NULL;
   gfc_formal_arglist *formal_arg = NULL;
   gfc_intrinsic_arg *curr_arg = NULL;
   gfc_formal_arglist *formal_prev = NULL;
+  gfc_actual_arglist *act_arg = actual;
   /* Save current namespace so we can change it for formal args.  */
   gfc_namespace *parent_ns = gfc_current_ns;
 
@@ -4035,6 +4067,17 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
 
   for (curr_arg = src->formal; curr_arg; curr_arg = curr_arg->next)
     {
+      /* Skip absent arguments.  */
+      if (actual)
+	{
+	  gcc_assert (act_arg != NULL);
+	  if (act_arg->expr == NULL)
+	    {
+	      act_arg = act_arg->next;
+	      continue;
+	    }
+	  act_arg = act_arg->next;
+	}
       formal_arg = gfc_get_formal_arglist ();
       gfc_get_symbol (curr_arg->name, gfc_current_ns, &(formal_arg->sym));
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a76d0f7..b6b4546 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2371,7 +2744,7 @@ gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op)
    has the generic name.  */
 
 static gfc_symbol *
-gfc_get_symbol_for_expr (gfc_expr * expr)
+gfc_get_symbol_for_expr (gfc_expr * expr, bool ignore_optional)
 {
   gfc_symbol *sym;
 
@@ -2394,7 +2767,9 @@ gfc_get_symbol_for_expr (gfc_expr * expr)
       sym->as->rank = expr->rank;
     }
 
-  gfc_copy_formal_args_intr (sym, expr->value.function.isym);
+  gfc_copy_formal_args_intr (sym, expr->value.function.isym,
+			     ignore_optional ? expr->value.function.actual
+					     : NULL);
 
   return sym;
 }
@@ -2413,7 +2788,7 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
   else
     gcc_assert (expr->rank == 0);
 
-  sym = gfc_get_symbol_for_expr (expr);
+  sym = gfc_get_symbol_for_expr (expr, se->ignore_optional);
 
   /* Calls to libgfortran_matmul need to be appended special arguments,
      to be able to call the BLAS ?gemm functions if required and possible.  */
@@ -4584,7 +4959,8 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
     }
 
   /* Build the call itself.  */
-  sym = gfc_get_symbol_for_expr (expr);
+  gcc_assert (!se->ignore_optional);
+  sym = gfc_get_symbol_for_expr (expr, false);
   gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
 			  append_args);
   gfc_free_symbol (sym);

Reply via email to