re PR fortran/87689 (PowerPC64 ELFv2 function parameter passing violation)

2019-02-18  Thomas Koenig  <tkoenig@gcc.gnu.org>

    PR fortran/87689
    * trans-decl.c (gfc_get_extern_function_decl): Add argument
    actual_args and pass it through to gfc_get_function_type.
    * trans-expr.c (conv_function_val): Add argument actual_args
    and pass it on to gfc_get_extern_function_decl.
    (conv_procedure_call): Pass actual arguments to conv_function_val.
    * trans-types.c (get_formal_from_actual_arglist): New function.
    (gfc_get_function_type): Add argument actual_args.  Generate
    formal args from actual args if necessary.
    * trans-types.h (gfc_get_function_type): Add optional argument.
    * trans.h (gfc_get_extern_function_decl): Add optional argument.

2019-02-18  Thomas Koenig  <tkoenig@gcc.gnu.org>

    PR fortran/87689
    * gfortran.dg/lto/20091028-1_0.f90: Add -Wno-lto-type-mismatch to
    options.
    * gfortran.dg/lto/20091028-2_0.f90: Likewise.
    * gfortran.dg/lto/pr87689_0.f: New file.
    * gfortran.dg/lto/pr87689_1.f: New file.

From-SVN: r268992

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a03cfd2a70bed7aaec2d6cbe1d39c637821f6d12..43eda8c56d754aadc88145395333a6bb7662a4ef 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2019-02-18  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/87689
+       * trans-decl.c (gfc_get_extern_function_decl): Add argument
+       actual_args and pass it through to gfc_get_function_type.
+       * trans-expr.c (conv_function_val): Add argument actual_args
+       and pass it on to gfc_get_extern_function_decl.
+       (conv_procedure_call): Pass actual arguments to conv_function_val.
+       * trans-types.c (get_formal_from_actual_arglist): New function.
+       (gfc_get_function_type): Add argument actual_args.  Generate
+       formal args from actual args if necessary.
+       * trans-types.h (gfc_get_function_type): Add optional argument.
+       * trans.h (gfc_get_extern_function_decl): Add optional argument.
+
 2019-02-18  Martin Liska  <mliska@suse.cz>
 
        * decl.c (gfc_match_gcc_builtin): Add support for filtering

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 9a8f2d36784ea94f73f12ab842c80c1ae2ea32df..3604cfcf5cb3e2858da27ef7dd33cee2f27e7722 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1962,7 +1962,7 @@ get_proc_pointer_decl (gfc_symbol *sym)
 /* Get a basic decl for an external function.  */
 
 tree
-gfc_get_extern_function_decl (gfc_symbol * sym)
+gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args)
 {
   tree type;
   tree fndecl;
@@ -2135,7 +2135,7 @@ module_sym:
       mangled_name = gfc_sym_mangled_function_id (sym);
     }
 
-  type = gfc_get_function_type (sym);
+  type = gfc_get_function_type (sym, actual_args);
   fndecl = build_decl (input_location,
                       FUNCTION_DECL, name, type);
 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e7c75913bfe3382361adb0b01e4661cad3153715..a75f8a7c250a19cdb1c90ccefe12cefdbeaddb92 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3895,7 +3895,8 @@ conv_base_obj_fcn_val (gfc_se * se, tree base_object, gfc_expr * expr)
 
 
 static void
-conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr)
+conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr,
+                  gfc_actual_arglist *actual_args)
 {
   tree tmp;
 
@@ -3913,7 +3914,7 @@ conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr)
   else
     {
       if (!sym->backend_decl)
-       sym->backend_decl = gfc_get_extern_function_decl (sym);
+       sym->backend_decl = gfc_get_extern_function_decl (sym, actual_args);
 
       TREE_USED (sym->backend_decl) = 1;
 
@@ -6580,7 +6581,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
   /* Generate the actual call.  */
   if (base_object == NULL_TREE)
-    conv_function_val (se, sym, expr);
+    conv_function_val (se, sym, expr, args);
   else
     conv_base_obj_fcn_val (se, base_object, expr);
 

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1302d2ac70a784e0dec24c961f412049fd7de9c8..2115db23f2cb9372bebaeaf7835838b72567f56f 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2970,9 +2970,54 @@ create_fn_spec (gfc_symbol *sym, tree fntype)
   return build_type_attribute_variant (fntype, tmp);
 }
 
+/* Helper function - if we do not find an interface for a procedure,
+   construct it from the actual arglist.  Luckily, this can only
+   happen for call by reference, so the information we actually need
+   to provide (and which would be impossible to guess from the call
+   itself) is not actually needed.  */
+
+static void
+get_formal_from_actual_arglist (gfc_symbol *sym, gfc_actual_arglist *actual_args)
+{
+  gfc_actual_arglist *a;
+  gfc_formal_arglist **f;
+  gfc_symbol *s;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  static int var_num;
+
+  f = &sym->formal;
+  for (a = actual_args; a != NULL; a = a->next)
+    {
+      if (a->expr)
+       {
+         (*f) = gfc_get_formal_arglist ();
+         snprintf (name, GFC_MAX_SYMBOL_LEN, "_formal_%d", var_num ++);
+         gfc_get_symbol (name, NULL, &s);
+         if (a->expr->ts.type == BT_PROCEDURE)
+           {
+             s->attr.flavor = FL_PROCEDURE;
+           }
+         else
+           {
+             s->ts = a->expr->ts;
+             s->attr.flavor = FL_VARIABLE;
+             if (a->expr->rank > 0)
+               {
+                 s->attr.dimension = 1;
+                 s->as = gfc_get_array_spec ();
+                 s->as->type = AS_ASSUMED_SIZE;
+               }
+           }
+         s->attr.dummy = 1;
+         s->attr.intent = INTENT_UNKNOWN;
+         (*f)->sym = s;
+       }
+      f = &((*f)->next);
+    }
+}
 
 tree
-gfc_get_function_type (gfc_symbol * sym)
+gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args)
 {
   tree type;
   vec<tree, va_gc> *typelist = NULL;
@@ -3030,6 +3075,10 @@ gfc_get_function_type (gfc_symbol * sym)
            vec_safe_push (typelist, build_pointer_type(gfc_charlen_type_node));
        }
     }
+  if (sym->backend_decl == error_mark_node && actual_args != NULL
+      && sym->formal == NULL && (sym->attr.proc == PROC_EXTERNAL
+                                || sym->attr.proc == PROC_UNKNOWN))
+    get_formal_from_actual_arglist (sym, actual_args);
 
   /* Build the argument types for the function.  */
   for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)

diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 2952d111c66e1acb7033f3102ea8a110e35a5547..7d591bac63a6c4ba4b1df75bdd6216674124e66e 100644 (file)
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -88,7 +88,7 @@ tree gfc_sym_type (gfc_symbol *);
 tree gfc_typenode_for_spec (gfc_typespec *, int c = 0);
 int gfc_copy_dt_decls_ifequal (gfc_symbol *, gfc_symbol *, bool);
 
-tree gfc_get_function_type (gfc_symbol *);
+tree gfc_get_function_type (gfc_symbol *, gfc_actual_arglist *args = NULL);
 
 tree gfc_type_for_size (unsigned, int);
 tree gfc_type_for_mode (machine_mode, int);

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 805ed76318fc156eaca2d7917efff3ef0f71d10a..7d46684e2a453c80f4b1b2317c6ce0f9995165b4 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -580,7 +580,8 @@ void gfc_merge_block_scope (stmtblock_t * block);
 tree gfc_get_label_decl (gfc_st_label *);
 
 /* Return the decl for an external function.  */
-tree gfc_get_extern_function_decl (gfc_symbol *);
+tree gfc_get_extern_function_decl (gfc_symbol *,
+                                  gfc_actual_arglist *args = NULL);
 
 /* Return the decl for a function.  */
 tree gfc_get_function_decl (gfc_symbol *);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 38de7998e3c1b3ad3a6f456138f18e2913f9b562..04f60aa0a8924afe416fa023db272a3c2f80dca3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2019-02-18  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/87689
+       * gfortran.dg/lto/20091028-1_0.f90: Add -Wno-lto-type-mismatch to
+       options.
+       * gfortran.dg/lto/20091028-2_0.f90: Likewise.
+       * gfortran.dg/lto/pr87689_0.f: New file.
+       * gfortran.dg/lto/pr87689_1.f: New file.
+
 2019-02-18  Wilco Dijkstra  <wdijkstr@arm.com>
 
        * g++.dg/wrappers/pr88680.C: Add -fno-short-enums.

diff --git a/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90 b/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90
index 3b32432f81d3385df66d9488b3ae3b42da1d979b..b83cf6d196c1492de4a03db8b0fdf9639a023eeb 100644 (file)
--- a/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90
+++ b/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90
@@ -1,5 +1,5 @@
 ! { dg-lto-do link }
-! { dg-extra-ld-options "-r -nostdlib -finline-functions -flinker-output=nolto-rel" }
+! { dg-extra-ld-options "-r -nostdlib -finline-functions -flinker-output=nolto-rel -Wno-lto-type-mismatch" }
 
 SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
                               DataHandle, Element, VarName, Data, code )

diff --git a/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90 b/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90
index 3b32432f81d3385df66d9488b3ae3b42da1d979b..b83cf6d196c1492de4a03db8b0fdf9639a023eeb 100644 (file)
--- a/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90
+++ b/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90
@@ -1,5 +1,5 @@
 ! { dg-lto-do link }
-! { dg-extra-ld-options "-r -nostdlib -finline-functions -flinker-output=nolto-rel" }
+! { dg-extra-ld-options "-r -nostdlib -finline-functions -flinker-output=nolto-rel -Wno-lto-type-mismatch" }
 
 SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
                               DataHandle, Element, VarName, Data, code )

diff --git a/gcc/testsuite/gfortran.dg/lto/pr87689_0.f b/gcc/testsuite/gfortran.dg/lto/pr87689_0.f
new file mode 100644 (file)
index 0000000..5beee93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr87689_0.f
@@ -0,0 +1,13 @@
+! { dg-lto-run }
+! PR 87689 - this used to fail for POWER, plus it used to
+! give warnings about mismatches with LTO.
+! Original test case by Judicaël Grasset.
+      program main
+        implicit none
+        character :: c
+        character(len=20) :: res, doesntwork_p8
+        external doesntwork_p8
+        c = 'o'
+        res = doesntwork_p8(c,1,2,3,4,5,6)
+        if (res /= 'foo') stop 3
+      end program main

diff --git a/gcc/testsuite/gfortran.dg/lto/pr87689_1.f b/gcc/testsuite/gfortran.dg/lto/pr87689_1.f
new file mode 100644 (file)
index 0000000..f293a00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr87689_1.f
@@ -0,0 +1,11 @@
+      function doesntwork_p8(c,a1,a2,a3,a4,a5,a6)
+        implicit none
+        character(len=20) :: doesntwork_p8
+        character :: c
+        integer :: a1,a2,a3,a4,a5,a6
+        if (a1 /= 1 .or. a2 /= 2 .or. a3 /= 3 .or. a4 /= 4 .or. a5 /= 5
+     &       .or. a6 /= 6) stop 1
+       if (c /= 'o ') stop 2
+       doesntwork_p8 = 'foo'
+       return
+       end