gcc/SOURCES/gcc8-rh1711346.patch

2019-05-29  Jakub Jelinek  <jakub@redhat.com>

	PR fortran/90329
	* lto-streamer.h (LTO_minor_version): Bump to 2.

	Backported from mainline
	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.

	* lang.opt (fbroken-callers): Remove.
	(ftail-call-workaround, ftail-call-workaround=): New options.
	* gfortran.h (struct gfc_namespace): Add implicit_interface_calls.
	* interface.c (gfc_procedure_use): Set implicit_interface_calls
	for calls to implicit interface procedures.
	* trans-decl.c (create_function_arglist): Use flag_tail_call_workaround
	instead of flag_broken_callers.  If it is not 2, also require
	sym->ns->implicit_interface_calls.
	* invoke.texi (fbroken-callers): Remove documentation.
	(ftail-call-workaround, ftail-call-workaround=): Document.

	2019-05-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/90329
	* invoke.texi: Document -fbroken-callers.
	* lang.opt: Add -fbroken-callers.
	* trans-decl.c (create_function_arglist): Only set
	DECL_HIDDEN_STRING_LENGTH if flag_broken_callers is set.

	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.

--- gcc/calls.c
+++ gcc/calls.c
@@ -3754,6 +3754,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)
--- gcc/fortran/gfortran.h
+++ gcc/fortran/gfortran.h
@@ -1857,6 +1857,9 @@ typedef struct gfc_namespace
 
   /* Set to 1 for !$ACC ROUTINE namespaces.  */
   unsigned oacc_routine:1;
+
+  /* Set to 1 if there are any calls to procedures with implicit interface.  */
+  unsigned implicit_interface_calls:1;
 }
 gfc_namespace;
 
--- gcc/fortran/interface.c
+++ gcc/fortran/interface.c
@@ -3657,6 +3657,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	gfc_warning (OPT_Wimplicit_procedure,
 		     "Procedure %qs called at %L is not explicitly declared",
 		     sym->name, where);
+      gfc_find_proc_namespace (sym->ns)->implicit_interface_calls = 1;
     }
 
   if (sym->attr.if_source == IFSRC_UNKNOWN)
--- gcc/fortran/invoke.texi
+++ gcc/fortran/invoke.texi
@@ -181,7 +181,8 @@ and warnings}.
 @item Code Generation Options
 @xref{Code Gen Options,,Options for code generation conventions}.
 @gccoptlist{-faggressive-function-elimination -fblas-matmul-limit=@var{n} @gol
--fbounds-check -fcheck-array-temporaries @gol
+-fbounds-check -ftail-call-workaround -ftail-call-workaround=@var{n} @gol
+-fcheck-array-temporaries @gol
 -fcheck=@var{<all|array-temps|bounds|do|mem|pointer|recursion>} @gol
 -fcoarray=@var{<none|single|lib>} -fexternal-blas -ff2c
 -ffrontend-loop-interchange @gol
@@ -1580,6 +1581,39 @@ warnings for generated array temporaries.
 @c Note: This option is also referred in gcc's manpage
 Deprecated alias for @option{-fcheck=bounds}.
 
+@item -ftail-call-workaround
+@itemx -ftail-call-workaround=@var{n}
+@opindex @code{tail-call-workaround}
+Some C interfaces to Fortran codes violate the gfortran ABI by
+omitting the hidden character length arguments as described in
+@xref{Argument passing conventions}.  This can lead to crashes
+because pushing arguments for tail calls can overflow the stack.
+
+To provide a workaround for existing binary packages, this option
+disables tail call optimization for gfortran procedures with character
+arguments.  With @option{-ftail-call-workaround=2} tail call optimization
+is disabled in all gfortran procedures with character arguments,
+with @option{-ftail-call-workaround=1} or equivalent
+@option{-ftail-call-workaround} only in gfortran procedures with character
+arguments that call implicitly prototyped procedures.
+
+Using this option can lead to problems including crashes due to
+insufficient stack space.
+
+It is @emph{very strongly} recommended to fix the code in question.
+The @option{-fc-prototypes-external} option can be used to generate
+prototypes which conform to gfortran's ABI, for inclusion in the
+source code.
+
+Support for this option will likely be withdrawn in a future release
+of gfortran.
+
+The negative form, @option{-fno-tail-call-workaround} or equivalent
+@option{-ftail-call-workaround=0}, can be used to disable this option.
+
+Default is currently @option{-ftail-call-workaround}, this will change
+in future releases.
+
 @item -fcheck-array-temporaries
 @opindex @code{fcheck-array-temporaries}
 Deprecated alias for @option{-fcheck=array-temps}.
--- gcc/fortran/lang.opt
+++ gcc/fortran/lang.opt
@@ -742,6 +742,13 @@ fsign-zero
 Fortran Var(flag_sign_zero) Init(1)
 Apply negative sign to zero values.
 
+ftail-call-workaround
+Fortran Alias(ftail-call-workaround=,1,0)
+
+ftail-call-workaround=
+Fortran RejectNegative Joined UInteger IntegerRange(0, 2) Var(flag_tail_call_workaround) Init(1)
+Disallow tail call optimization when a calling routine may have omitted character lengths.
+
 funderscoring
 Fortran Var(flag_underscoring) Init(1)
 Append underscores to externally visible names.
--- gcc/fortran/trans-decl.c
+++ gcc/fortran/trans-decl.c
@@ -2513,6 +2513,17 @@ create_function_arglist (gfc_symbol * sym)
 	  TREE_READONLY (length) = 1;
 	  gfc_finish_decl (length);
 
+	  /* Marking the length DECL_HIDDEN_STRING_LENGTH will lead
+	     to tail calls being disabled.  Only do that if we
+	     potentially have broken callers.  */
+	  if (flag_tail_call_workaround
+	      && f->sym->ts.u.cl
+	      && f->sym->ts.u.cl->length
+	      && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	      && (flag_tail_call_workaround == 2
+		  || f->sym->ns->implicit_interface_calls))
+	    DECL_HIDDEN_STRING_LENGTH (length) = 1;
+
 	  /* Remember the passed value.  */
           if (!f->sym->ts.u.cl ||  f->sym->ts.u.cl->passed_length)
             {
--- gcc/lto-streamer.h
+++ gcc/lto-streamer.h
@@ -121,7 +121,7 @@ along with GCC; see the file COPYING3.  If not see
      form followed by the data for the string.  */
 
 #define LTO_major_version 7
-#define LTO_minor_version 1
+#define LTO_minor_version 2
 
 typedef unsigned char	lto_decl_flags_t;
 
--- gcc/tree-core.h
+++ gcc/tree-core.h
@@ -1644,6 +1644,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.  */
--- gcc/tree-streamer-in.c
+++ gcc/tree-streamer-in.c
@@ -252,7 +252,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);
@@ -260,12 +260,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))
--- gcc/tree-streamer-out.c
+++ 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))
--- gcc/tree.h
+++ gcc/tree.h
@@ -909,6 +909,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)