gfortran.h (gfc_copy_formal_args_intr): Update prototype.

2014-06-12  Tobias Burnus  <burnus@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.

From-SVN: r211587

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bdc102b4b54041ec55a9f6c19f7fecb071d68593..53aabd8faa045f065fe4338e915d123bff117bbd 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2014-06-12  Tobias Burnus  <burnus@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.
+
 2014-06-10  Dominique d'Humieres <dominiq@lps.ens.fr>
            Mikael Morin <mikael@gcc.gnu.org>
 

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7ff8a34f18afc566917b7d684403a70a3488777d..1df79fdbe05ab381d7fc3b8bd7b4c3f806e0a7ad 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2785,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 0e4c1812372c28419fe10b7b581c5f08b57d9013..bc2db7deb58afebb7d0a22266e9d60b136ed9562 100644 (file)
--- 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 a0995b51ccebaac311c1a08b1a98ce2c92fe08fe..922b421b5e1c96ee81cdf2a5e64c226b230357b2 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4042,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;
 
@@ -4062,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 a76d0f75cc1dc744243ccbcbd817acad33cd5cac..2ac39f67bf2d64a1f3d0dff64e262326490affdd 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2371,7 +2371,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 +2394,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 +2415,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 +4586,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);