re PR fortran/83149 ([6- and 7-branches] Missing test for sym->ns->proc_name: crash_s...

2018-05-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/83149
	Backport from trunk
	* trans-decl.c (gfc_finish_var_decl): Test sym->ns->proc_name
	before accessing its components.
	* trans-types.c (gfc_sym_type): If a character result has null
	backend_decl, try the procedure symbol.

2018-05-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/83149
	Backport from trunk
	* gfortran.dg/pr83149_1.f90: New test.
	* gfortran.dg/pr83149.f90: Additional source for previous.
	* gfortran.dg/pr83149_b.f90: New test.
	* gfortran.dg/pr83149_a.f90: Additional source for previous.

From-SVN: r260286

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e5674bdbce7e4309202da72b9f4944b5be19f152..88c80c97243b1206b0cc32835e89989ebc8f381d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2018-05-16  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/83149
+       Backport from trunk
+       * trans-decl.c (gfc_finish_var_decl): Test sym->ns->proc_name
+       before accessing its components.
+       * trans-types.c (gfc_sym_type): If a character result has null
+       backend_decl, try the procedure symbol.
+
 2018-16-05  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/83898

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 7b30380f50a1060aeedaf221731ff711ef6bb08d..66c3f75cca0150b39a2e9984bb65d1884c152fb8 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -571,10 +571,12 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
      function scope.  */
   if (current_function_decl != NULL_TREE)
     {
-      if (sym->ns->proc_name->backend_decl == current_function_decl
-         || sym->result == sym)
+      if (sym->ns->proc_name
+         && (sym->ns->proc_name->backend_decl == current_function_decl
+             || sym->result == sym))
        gfc_add_decl_to_function (decl);
-      else if (sym->ns->proc_name->attr.flavor == FL_LABEL)
+      else if (sym->ns->proc_name
+              && sym->ns->proc_name->attr.flavor == FL_LABEL)
        /* This is a BLOCK construct.  */
        add_decl_as_local (decl);
       else
@@ -646,7 +648,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
     }
 
   /* Keep variables larger than max-stack-var-size off stack.  */
-  if (!sym->ns->proc_name->attr.recursive
+  if (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive
       && INTEGER_CST_P (DECL_SIZE_UNIT (decl))
       && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
         /* Put variable length auto array pointers always into stack.  */

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 98013c95be84ad4d8deaa0d24dec9bc25345d524..87180ad8011fc7a38df38f30876dbcc65dc3884c 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2167,6 +2167,14 @@ gfc_sym_type (gfc_symbol * sym)
   if (sym->backend_decl && !sym->attr.function)
     return TREE_TYPE (sym->backend_decl);
 
+  if (sym->attr.result
+      && sym->ts.type == BT_CHARACTER
+      && sym->ts.u.cl->backend_decl == NULL_TREE
+      && sym->ns->proc_name
+      && sym->ns->proc_name->ts.u.cl
+      && sym->ns->proc_name->ts.u.cl->backend_decl != NULL_TREE)
+    sym->ts.u.cl->backend_decl = sym->ns->proc_name->ts.u.cl->backend_decl;
+
   if (sym->ts.type == BT_CHARACTER
       && ((sym->attr.function && sym->attr.is_bind_c)
          || (sym->attr.result

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4aa19625332dd48aeda38ffa36bba9289e67adf8..ad4945ec1c0ced316599d628cd0c7eca4337e376 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2018-05-16  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/83149
+       Backport from trunk
+       * gfortran.dg/pr83149_1.f90: New test.
+       * gfortran.dg/pr83149.f90: Additional source for previous.
+       * gfortran.dg/pr83149_b.f90: New test.
+       * gfortran.dg/pr83149_a.f90: Additional source for previous.
+
 2018-16-05  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/83898

diff --git a/gcc/testsuite/gfortran.dg/pr83149.f90 b/gcc/testsuite/gfortran.dg/pr83149.f90
new file mode 100644 (file)
index 0000000..fc0607e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr83149.f90
@@ -0,0 +1,14 @@
+! Compiled with pr83149_1.f90
+!
+module mod1
+  integer :: ncells
+end module
+
+module mod2
+contains
+  function get() result(array)
+    use mod1
+    real array(ncells)
+    array = 1.0
+  end function
+end module

diff --git a/gcc/testsuite/gfortran.dg/pr83149_1.f90 b/gcc/testsuite/gfortran.dg/pr83149_1.f90
new file mode 100644 (file)
index 0000000..3a8f5d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr83149_1.f90
@@ -0,0 +1,24 @@
+! Compiled with pr83149.f90
+! { dg-do run }
+! { dg-options "-fno-whole-file" }
+! { dg-compile-aux-modules "pr83149.f90" }
+! { dg-additional-sources pr83149.f90 }
+!
+! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
+!
+subroutine sub(s)
+  use mod2
+  real :: s
+  s = sum(get())
+end
+
+  use mod1
+  real :: s
+  ncells = 2
+  call sub (s)
+  if (int (s) .ne. ncells) stop 1
+  ncells = 10
+  call sub (s)
+  if (int (s) .ne. ncells) stop 2
+end
+

diff --git a/gcc/testsuite/gfortran.dg/pr83149_a.f90 b/gcc/testsuite/gfortran.dg/pr83149_a.f90
new file mode 100644 (file)
index 0000000..3f15198
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr83149_a.f90
@@ -0,0 +1,11 @@
+! Compiled with pr83149_b.f90
+!
+module mod
+  character(8) string
+contains
+  function get_string() result(s)
+    character(len_trim(string)) s
+    s = string
+  end function
+end module
+

diff --git a/gcc/testsuite/gfortran.dg/pr83149_b.f90 b/gcc/testsuite/gfortran.dg/pr83149_b.f90
new file mode 100644 (file)
index 0000000..f67ffd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr83149_b.f90
@@ -0,0 +1,16 @@
+! Compiled with pr83149_a.f90
+! { dg-do run }
+! { dg-options "-fno-whole-file" }
+! { dg-compile-aux-modules "pr83149_a.f90" }
+! { dg-additional-sources pr83149_a.f90 }
+!
+! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
+!
+  use mod
+  string = 'fubar'
+  select case (get_string())
+    case ('fubar')
+    case default
+      stop 1
+  end select
+end