PR 78867 Function returning string ICE with -flto

The fix for PR 78757 was slightly too cautious, and covered only the
case of functions returning pointers to characters. By moving the
block above the if statement the DECL_EXPR is created also for
functions returning non-pointer characters.

Regtested on x86_64-pc-linux-gnu.

fortran ChangeLog:

2016-12-21  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/78867
	* trans-expr.c (gfc_conv_procedure_call): Emit DECL_EXPR also for
	non-pointer character results.

testsuite ChangeLog:

2016-12-21  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/78867
	* gfortran.dg/string_length_4.f90: New test.

From-SVN: r243842

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e4bc0e8cafc5a1db45076edf8e872b07b642ec99..6bec5e794db02113272b748e7f9e4ab385510e81 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2016-12-21  Janne Blomqvist  <jb@gcc.gnu.org>
+
+       PR fortran/78867
+       * trans-expr.c (gfc_conv_procedure_call): Emit DECL_EXPR also for
+       non-pointer character results.
+
 2016-12-21  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        * iresolve.c (gfc_resolve_ftell): Call "ftell" instead of "ftell2".

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 823c96aa4cd2154e27bce9ea898b36b3293f6fc8..6ebdc8b3559a398ca9298e79e3ead31a15016513 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6002,6 +6002,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
          type = gfc_get_character_type (ts.kind, ts.u.cl);
          type = build_pointer_type (type);
 
+         /* Emit a DECL_EXPR for the VLA type.  */
+         tmp = TREE_TYPE (type);
+         if (TYPE_SIZE (tmp)
+             && TREE_CODE (TYPE_SIZE (tmp)) != INTEGER_CST)
+           {
+             tmp = build_decl (input_location, TYPE_DECL, NULL_TREE, tmp);
+             DECL_ARTIFICIAL (tmp) = 1;
+             DECL_IGNORED_P (tmp) = 1;
+             tmp = fold_build1_loc (input_location, DECL_EXPR,
+                                    TREE_TYPE (tmp), tmp);
+             gfc_add_expr_to_block (&se->pre, tmp);
+           }
+
          /* Return an address to a char[0:len-1]* temporary for
             character pointers.  */
          if ((!comp && (sym->attr.pointer || sym->attr.allocatable))
@@ -6009,19 +6022,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
            {
              var = gfc_create_var (type, "pstr");
 
-             /* Emit a DECL_EXPR for the VLA type.  */
-             tmp = TREE_TYPE (type);
-             if (TYPE_SIZE (tmp)
-                 && TREE_CODE (TYPE_SIZE (tmp)) != INTEGER_CST)
-               {
-                 tmp = build_decl (input_location, TYPE_DECL, NULL_TREE, tmp);
-                 DECL_ARTIFICIAL (tmp) = 1;
-                 DECL_IGNORED_P (tmp) = 1;
-                 tmp = fold_build1_loc (input_location, DECL_EXPR,
-                                        TREE_TYPE (tmp), tmp);
-                 gfc_add_expr_to_block (&se->pre, tmp);
-               }
-
              if ((!comp && sym->attr.allocatable)
                  || (comp && comp->attr.allocatable))
                {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4f5b6ae4702944f6c4f87b25978ac526f72cdfae..4a23c1f05ceef279fc6a3594024143d14431e3c1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-12-21  Janne Blomqvist  <jb@gcc.gnu.org>
+
+       PR fortran/78867
+       * gfortran.dg/string_length_4.f90: New test.
+
 2016-12-21  Georg-Johann Lay  <avr@gjlay.de>
 
        * gcc.target/avr/mmcu: New folder for compile-tests with -mmcu=.

diff --git a/gcc/testsuite/gfortran.dg/string_length_4.f90 b/gcc/testsuite/gfortran.dg/string_length_4.f90
new file mode 100644 (file)
index 0000000..759066b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_length_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-require-effective-target lto }
+! { dg-options "-flto" }
+! PR 78867, test case adapted from gfortran.dg/string_length_1.f90
+program pr78867
+  if (len(bar(2_8)) /= 2) call abort
+contains
+
+  function bar(i)
+    integer(8), intent(in) :: i
+    character(len=i) :: bar
+  
+    bar = ""
+  end function bar
+
+end program pr78867