backport: re PR fortran/86248 (LEN_TRIM in specification expression causes link failure)

2019-10-27  Paul Thomas  <pault@gcc.gnu.org>

	Backport from mainline
	PR fortran/86248
	* resolve.c (flag_fn_result_spec): Correct a typo before the
	function declaration.
	* trans-decl.c (gfc_sym_identifier): Boost the length of 'name'
	to allow for all variants. Simplify the code by using a pointer
	to the symbol's proc_name and taking the return out of each of
	the conditional branches. Allow symbols with fn_result_spec set
	that do not come from a procedure namespace and have a module
	name to go through the non-fn_result_spec branch.

2019-10-27  Paul Thomas  <pault@gcc.gnu.org>

	Backport from mainline
	PR fortran/86248
	* gfortran.dg/char_result_19.f90 : New test.
	* gfortran.dg/char_result_mod_19.f90 : Module for the new test.

From-SVN: r277488

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a1f1b76b822ebf2b63e4b5f6ec5e1989107f886d..156f1d2bbc334f94b2717c44108fe0a4ee125190 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2019-10-27  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from mainline
+       PR fortran/86248
+       * resolve.c (flag_fn_result_spec): Correct a typo before the
+       function declaration.
+       * trans-decl.c (gfc_sym_identifier): Boost the length of 'name'
+       to allow for all variants. Simplify the code by using a pointer
+       to the symbol's proc_name and taking the return out of each of
+       the conditional branches. Allow symbols with fn_result_spec set
+       that do not come from a procedure namespace and have a module
+       name to go through the non-fn_result_spec branch.
+
 2019-10-18  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/69455

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6948394dcd461286f6a7cfd5efa2a7c75b82a528..d1801d42a5ec2953d5857226b361151763ea8c39 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7005,6 +7005,10 @@ gfc_expr_to_initialize (gfc_expr *e)
   for (ref = result->ref; ref; ref = ref->next)
     if (ref->type == REF_ARRAY && ref->next == NULL)
       {
+       if (ref->u.ar.dimen == 0
+           && ref->u.ar.as && ref->u.ar.as->corank)
+         return result;
+
        ref->u.ar.type = AR_FULL;
 
        for (i = 0; i < ref->u.ar.dimen; i++)
@@ -15948,8 +15952,8 @@ resolve_equivalence (gfc_equiv *eq)
 }
 
 
-/* Function called by resolve_fntype to flag other symbol used in the
-   length type parameter specification of function resuls.  */
+/* Function called by resolve_fntype to flag other symbols used in the
+   length type parameter specification of function results.  */
 
 static bool
 flag_fn_result_spec (gfc_expr *expr,

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 70f835a6f6babc2a973926781692b57800e1b24a..b3045a478de4d5a3ca3922f8c13cc10659457439 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -358,44 +358,37 @@ gfc_sym_identifier (gfc_symbol * sym)
 static const char *
 mangled_identifier (gfc_symbol *sym)
 {
-  static char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
+  gfc_symbol *proc = sym->ns->proc_name;
+  static char name[3*GFC_MAX_MANGLED_SYMBOL_LEN + 14];
   /* Prevent the mangling of identifiers that have an assigned
      binding label (mainly those that are bind(c)).  */
 
   if (sym->attr.is_bind_c == 1 && sym->binding_label)
     return sym->binding_label;
 
-  if (!sym->fn_result_spec)
+  if (!sym->fn_result_spec
+      || (sym->module && !(proc && proc->attr.flavor == FL_PROCEDURE)))
     {
       if (sym->module == NULL)
        return sym_identifier (sym);
       else
-       {
-         snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
-         return name;
-       }
+       snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
     }
   else
     {
       /* This is an entity that is actually local to a module procedure
         that appears in the result specification expression.  Since
         sym->module will be a zero length string, we use ns->proc_name
-        instead. */
-      if (sym->ns->proc_name && sym->ns->proc_name->module)
-       {
-         snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s",
-                   sym->ns->proc_name->module,
-                   sym->ns->proc_name->name,
-                   sym->name);
-         return name;
-       }
+        to provide the module name instead. */
+      if (proc && proc->module)
+       snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s",
+                 proc->module, proc->name, sym->name);
       else
-       {
-         snprintf (name, sizeof name, "__%s_PROC_%s",
-                   sym->ns->proc_name->name, sym->name);
-         return name;
-       }
+       snprintf (name, sizeof name, "__%s_PROC_%s",
+                 proc->name, sym->name);
     }
+
+  return name;
 }
 
 /* Get mangled identifier, adding the symbol to the global table if

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1028a20f3c21108cfa99483d3d88ebf9dc1ef3ff..8afe9297e469f375838ef91871d2951760e993da 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-10-27  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from mainline
+       PR fortran/86248
+       * gfortran.dg/char_result_19.f90 : New test.
+       * gfortran.dg/char_result_mod_19.f90 : Module for the new test.
+
 2019-10-26  Iain Sandoe  <iain@sandoe.co.uk>
 
        * config/rs6000/darwin.h (ASM_OUTPUT_MAX_SKIP_ALIGN):Guard

diff --git a/gcc/testsuite/gfortran.dg/char_result_19.f90 b/gcc/testsuite/gfortran.dg/char_result_19.f90
new file mode 100644 (file)
index 0000000..e66ebdc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_19.f90
@@ -0,0 +1,24 @@
+! { dg-do preprocess }
+! { dg-additional-options "-cpp" }
+!
+! Test the fix for PR86248
+!
+! Contributed by Bill Long  <longb@cray.com>
+!
+program test
+  use test_module
+  implicit none
+  integer :: i
+  character(:), allocatable :: chr
+  do i = 0, 2
+    chr = func_1 (i)
+    select case (i)
+      case (0)
+        if (chr .ne. 'el0') stop i
+      case (1)
+        if (chr .ne. 'el11') stop i
+      case (2)
+        if (chr .ne. 'el2') stop i
+    end select
+  end do
+end program test

diff --git a/gcc/testsuite/gfortran.dg/char_result_mod_19.f90 b/gcc/testsuite/gfortran.dg/char_result_mod_19.f90
new file mode 100644 (file)
index 0000000..a2b5e94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_mod_19.f90
@@ -0,0 +1,18 @@
+! { dg-do  run }
+! { dg-additional-sources char_result_19.f90 }
+!
+! Module for char_result_19.f90
+! Tests fix for PR86248
+!
+module test_module
+  implicit none
+  public :: func_1
+  private
+  character(len=*),dimension(0:2),parameter :: darray = (/"el0 ","el11","el2 "/)
+contains
+  function func_1 (func_1_input) result(f)
+    integer, intent(in) :: func_1_input
+    character(len = len_trim (darray(func_1_input))) :: f
+    f = darray(func_1_input)
+  end function func_1
+end module test_module