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);