]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/83149 ([6- and 7-branches] Missing test for sym->ns->proc_name: crash_s...
authorPaul Thomas <pault@gcc.gnu.org>
Wed, 16 May 2018 11:17:10 +0000 (11:17 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Wed, 16 May 2018 11:17:10 +0000 (11:17 +0000)
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: r260285

gcc/fortran/ChangeLog
gcc/fortran/trans-decl.c
gcc/fortran/trans-types.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/pr83149.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pr83149_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pr83149_a.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pr83149_b.f90 [new file with mode: 0644]

index 2b93fd4e769b047609c12e2a739ce60ab2f179f9..e4004d6940269da4bad2b3fec8280ee2038bb7a2 100644 (file)
@@ -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
index 796fd6da008b91b61637a956e03178aa860b9c71..1e2be2f2d0ebac069fb86a79f2de913276e8deb9 100644 (file)
@@ -603,10 +603,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
@@ -698,7 +700,8 @@ 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 && !sym->attr.automatic
+  if (!(sym->ns->proc_name && sym->ns->proc_name->attr.recursive)
+      && !sym->attr.automatic
       && 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.  */
index 724c0fa979f80bfc864a03ec9d5bc4bc3f4a5851..9a96ae7b69d25c37a366d8f243962cb6c45be3db 100644 (file)
@@ -2168,6 +2168,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
index 6ce55cae329097e96be508d60c8473c2b8094900..a262617bb1a53c3f23b2250e08a6564925cc05f5 100644 (file)
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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