re PR fortran/90329 (Incompatibility between gfortran and C lapack calls)

	PR fortran/90329
	* tree-core.h (struct tree_decl_common): Document
	decl_nonshareable_flag for PARM_DECLs.
	* tree.h (DECL_HIDDEN_STRING_LENGTH): Define.
	* calls.c (expand_call): Don't try tail call if caller
	has any DECL_HIDDEN_STRING_LENGTH PARM_DECLs that are or might be
	passed on the stack and callee needs to pass any arguments on the
	stack.
	* tree-streamer-in.c (unpack_ts_decl_common_value_fields): Use
	else if instead of series of mutually exclusive ifs.  Handle
	DECL_HIDDEN_STRING_LENGTH for PARM_DECLs.
	* tree-streamer-out.c (pack_ts_decl_common_value_fields): Likewise.

	* trans-decl.c (create_function_arglist): Set
	DECL_HIDDEN_STRING_LENGTH on hidden string length PARM_DECLs if
	len is constant.

From-SVN: r271285

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 84c0d38737db748d6b17283e3386a29538d7a029..3f73f321fbe51be44f055f1efb45bfc4e0c52832 100644 (file)
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,5 +1,18 @@
 2019-05-16  Jakub Jelinek  <jakub@redhat.com>
 
+       PR fortran/90329
+       * tree-core.h (struct tree_decl_common): Document
+       decl_nonshareable_flag for PARM_DECLs.
+       * tree.h (DECL_HIDDEN_STRING_LENGTH): Define.
+       * calls.c (expand_call): Don't try tail call if caller
+       has any DECL_HIDDEN_STRING_LENGTH PARM_DECLs that are or might be
+       passed on the stack and callee needs to pass any arguments on the
+       stack.
+       * tree-streamer-in.c (unpack_ts_decl_common_value_fields): Use
+       else if instead of series of mutually exclusive ifs.  Handle
+       DECL_HIDDEN_STRING_LENGTH for PARM_DECLs.
+       * tree-streamer-out.c (pack_ts_decl_common_value_fields): Likewise.
+
        * lto-streamer.h (LTO_major_version): Bump to 9.
 
 2019-05-16  Jun Ma <JunMa@linux.alibaba.com>

diff --git a/gcc/calls.c b/gcc/calls.c
index 6b22e7a2315052d0b9cf113c975b106fd68624fa..c8a426800411bc320dd1821e59bb599560c8cb07 100644 (file)
--- a/gcc/calls.c
+++ b/gcc/calls.c
@@ -3628,6 +3628,28 @@ expand_call (tree exp, rtx target, int ignore)
       || dbg_cnt (tail_call) == false)
     try_tail_call = 0;
 
+  /* Workaround buggy C/C++ wrappers around Fortran routines with
+     character(len=constant) arguments if the hidden string length arguments
+     are passed on the stack; if the callers forget to pass those arguments,
+     attempting to tail call in such routines leads to stack corruption.
+     Avoid tail calls in functions where at least one such hidden string
+     length argument is passed (partially or fully) on the stack in the
+     caller and the callee needs to pass any arguments on the stack.
+     See PR90329.  */
+  if (try_tail_call && maybe_ne (args_size.constant, 0))
+    for (tree arg = DECL_ARGUMENTS (current_function_decl);
+        arg; arg = DECL_CHAIN (arg))
+      if (DECL_HIDDEN_STRING_LENGTH (arg) && DECL_INCOMING_RTL (arg))
+       {
+         subrtx_iterator::array_type array;
+         FOR_EACH_SUBRTX (iter, array, DECL_INCOMING_RTL (arg), NONCONST)
+           if (MEM_P (*iter))
+             {
+               try_tail_call = 0;
+               break;
+             }
+       }
+
   /* If the user has marked the function as requiring tail-call
      optimization, attempt it.  */
   if (must_tail_call)

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b836610d820605e9110e2ba9343c68d92642f225..057afe66ce73e47424a6c31518a79865452d9733 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2019-05-16  Jakub Jelinek  <jakub@redhat.com>
+
+       PR fortran/90329
+       * trans-decl.c (create_function_arglist): Set
+       DECL_HIDDEN_STRING_LENGTH on hidden string length PARM_DECLs if
+       len is constant.
+
 2019-05-15  Janne Blomqvist  <jb@gcc.gnu.org>
 
        * parse.c (gfc_parse_file): Remove translation string markers.

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c010956a7efc98443bae0f70de6fb3b114321114..07d1c33af72c05d813b244389f1b510003302773 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2512,6 +2512,10 @@ create_function_arglist (gfc_symbol * sym)
          DECL_ARG_TYPE (length) = len_type;
          TREE_READONLY (length) = 1;
          gfc_finish_decl (length);
+         if (f->sym->ts.u.cl
+             && f->sym->ts.u.cl->length
+             && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+           DECL_HIDDEN_STRING_LENGTH (length) = 1;
 
          /* Remember the passed value.  */
           if (!f->sym->ts.u.cl ||  f->sym->ts.u.cl->passed_length)

diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index 552196b1b4264b167dc87bd8f545002126f31da6..fbed0c379b250eef3ad02cc44f60e43ad9728148 100644 (file)
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -1683,6 +1683,7 @@ struct GTY(()) tree_decl_common {
   /* In a VAR_DECL and PARM_DECL, this is DECL_READ_P.  */
   unsigned decl_read_flag : 1;
   /* In a VAR_DECL or RESULT_DECL, this is DECL_NONSHAREABLE.  */
+  /* In a PARM_DECL, this is DECL_HIDDEN_STRING_LENGTH.  */
   unsigned decl_nonshareable_flag : 1;
 
   /* DECL_OFFSET_ALIGN, used only for FIELD_DECLs.  */

diff --git a/gcc/tree-streamer-in.c b/gcc/tree-streamer-in.c
index 0084e4789344adffe3055e089e92889613aa4e1b..f6d137316ac5634b23fb5e8ad10abd32c295b4e4 100644 (file)
--- a/gcc/tree-streamer-in.c
+++ b/gcc/tree-streamer-in.c
@@ -251,7 +251,7 @@ unpack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr)
       LABEL_DECL_UID (expr) = -1;
     }
 
-  if (TREE_CODE (expr) == FIELD_DECL)
+  else if (TREE_CODE (expr) == FIELD_DECL)
     {
       DECL_PACKED (expr) = (unsigned) bp_unpack_value (bp, 1);
       DECL_NONADDRESSABLE_P (expr) = (unsigned) bp_unpack_value (bp, 1);
@@ -259,12 +259,15 @@ unpack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr)
       expr->decl_common.off_align = bp_unpack_value (bp, 8);
     }
 
-  if (VAR_P (expr))
+  else if (VAR_P (expr))
     {
       DECL_HAS_DEBUG_EXPR_P (expr) = (unsigned) bp_unpack_value (bp, 1);
       DECL_NONLOCAL_FRAME (expr) = (unsigned) bp_unpack_value (bp, 1);
     }
 
+  else if (TREE_CODE (expr) == PARM_DECL)
+    DECL_HIDDEN_STRING_LENGTH (expr) = (unsigned) bp_unpack_value (bp, 1);
+
   if (TREE_CODE (expr) == RESULT_DECL
       || TREE_CODE (expr) == PARM_DECL
       || VAR_P (expr))

diff --git a/gcc/tree-streamer-out.c b/gcc/tree-streamer-out.c
index b66426387d68af5b88b8fe349aff7470f457181d..3f619e830a7738c34c129d2aba93c2ed28183480 100644 (file)
--- a/gcc/tree-streamer-out.c
+++ b/gcc/tree-streamer-out.c
@@ -212,7 +212,7 @@ pack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr)
       bp_pack_var_len_unsigned (bp, EH_LANDING_PAD_NR (expr));
     }
 
-  if (TREE_CODE (expr) == FIELD_DECL)
+  else if (TREE_CODE (expr) == FIELD_DECL)
     {
       bp_pack_value (bp, DECL_PACKED (expr), 1);
       bp_pack_value (bp, DECL_NONADDRESSABLE_P (expr), 1);
@@ -220,12 +220,15 @@ pack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr)
       bp_pack_value (bp, expr->decl_common.off_align, 8);
     }
 
-  if (VAR_P (expr))
+  else if (VAR_P (expr))
     {
       bp_pack_value (bp, DECL_HAS_DEBUG_EXPR_P (expr), 1);
       bp_pack_value (bp, DECL_NONLOCAL_FRAME (expr), 1);
     }
 
+  else if (TREE_CODE (expr) == PARM_DECL)
+    bp_pack_value (bp, DECL_HIDDEN_STRING_LENGTH (expr), 1);
+
   if (TREE_CODE (expr) == RESULT_DECL
       || TREE_CODE (expr) == PARM_DECL
       || VAR_P (expr))

diff --git a/gcc/tree.h b/gcc/tree.h
index d65affea2ee174b133711df41fa263393d418a6b..3a1e6767cee14d157a79c3bbac527b57cca2b08f 100644 (file)
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -904,6 +904,11 @@ extern void omp_clause_range_check_failed (const_tree, const char *, int,
   (TREE_CHECK2 (NODE, VAR_DECL, \
                RESULT_DECL)->decl_common.decl_nonshareable_flag)
 
+/* In a PARM_DECL, set for Fortran hidden string length arguments that some
+   buggy callers don't pass to the callee.  */
+#define DECL_HIDDEN_STRING_LENGTH(NODE) \
+  (TREE_CHECK (NODE, PARM_DECL)->decl_common.decl_nonshareable_flag)
+
 /* In a CALL_EXPR, means that the call is the jump from a thunk to the
    thunked-to function.  */
 #define CALL_FROM_THUNK_P(NODE) (CALL_EXPR_CHECK (NODE)->base.protected_flag)