]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
backport: re PR fortran/72698 (ICE in lhd_incomplete_type_error, at langhooks.c:205)
authorAndre Vehreschild <vehre@gcc.gnu.org>
Thu, 11 Aug 2016 07:57:58 +0000 (09:57 +0200)
committerAndre Vehreschild <vehre@gcc.gnu.org>
Thu, 11 Aug 2016 07:57:58 +0000 (09:57 +0200)
gcc/testsuite/ChangeLog:

2016-08-11  Andre Vehreschild  <vehre@gcc.gnu.org>

Backport from trunk:
PR fortran/72698
* gfortran.dg/allocate_with_source_20.f03: New test.

gcc/fortran/ChangeLog:

2016-08-11  Andre Vehreschild  <vehre@gcc.gnu.org>

Backport from trunk:
PR fortran/72698
* trans-stmt.c (gfc_trans_allocate): Prevent generating code for
copy of zero sized string and with it an ICE.

From-SVN: r239353

gcc/fortran/ChangeLog
gcc/fortran/trans-stmt.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/allocate_with_source_20.f03 [new file with mode: 0644]

index f45d0a86fabb7746421e5729d757e4158f5c7274..4872bf8deac222e7780a59802307c423dcafd92e 100644 (file)
@@ -1,3 +1,10 @@
+2016-08-11  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+       Backport from trunk:
+       PR fortran/72698
+       * trans-stmt.c (gfc_trans_allocate): Prevent generating code for
+       copy of zero sized string and with it an ICE.
+
 2016-08-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        Backport from trunk
index 1af8732703c272efbd7c7cb874d03bfb65b9d970..4891201120888e671a3a779ddfaf1533d79bdf24 100644 (file)
@@ -5303,7 +5303,8 @@ gfc_trans_allocate (gfc_code * code)
   stmtblock_t block;
   stmtblock_t post;
   tree nelems;
-  bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set;
+  bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set,
+      do_assign = true;
   gfc_symtree *newsym = NULL;
 
   if (!code->ext.alloc.list)
@@ -5393,6 +5394,14 @@ gfc_trans_allocate (gfc_code * code)
                  expr3_len = se.string_length;
                  gfc_add_block_to_block (&block, &se.pre);
                  gfc_add_block_to_block (&post, &se.post);
+                 /* Special case when string in expr3 is zero.  */
+                 if (code->expr3->ts.type == BT_CHARACTER
+                     && integer_zerop (se.string_length))
+                   {
+                     expr3 = expr3_tmp = NULL_TREE;
+                     expr3_len = integer_zero_node;
+                     do_assign = false;
+                   }
                }
              /* else expr3 = NULL_TREE set above.  */
            }
@@ -5415,7 +5424,16 @@ gfc_trans_allocate (gfc_code * code)
              gfc_add_block_to_block (&block, &se.pre);
              gfc_add_block_to_block (&post, &se.post);
 
-             if (!VAR_P (se.expr))
+             /* Special case when string in expr3 is zero.  */
+             if (code->expr3->ts.type == BT_CHARACTER
+                 && integer_zerop (se.string_length))
+               {
+                 gfc_init_se (&se, NULL);
+                 expr3_len = integer_zero_node;
+                 tmp = NULL_TREE;
+                 do_assign = false;
+               }
+             else if (!VAR_P (se.expr))
                {
                  tree var;
 
@@ -5956,7 +5974,7 @@ gfc_trans_allocate (gfc_code * code)
                            fold_convert (TREE_TYPE (al_len),
                                          integer_zero_node));
        }
-      if (code->expr3 && !code->expr3->mold)
+      if (code->expr3 && !code->expr3->mold && do_assign)
        {
          /* Initialization via SOURCE block
             (or static default initializer).  */
index b6dcc4ecd44c1069578c4d6cb09a4379286bb325..53d54d3791373377029ce702e1ea42714c29f4ec 100644 (file)
@@ -1,3 +1,9 @@
+2016-08-11  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+       Backport from trunk:
+       PR fortran/72698
+       * gfortran.dg/allocate_with_source_20.f03: New test.
+
 2016-08-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        Backport from trunk
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_20.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_20.f03
new file mode 100644 (file)
index 0000000..67b50ec
--- /dev/null
@@ -0,0 +1,21 @@
+! { dg-do run }
+
+! Check that PR72698 is fixed.
+! Contributed by Gerhard Steinmetz
+
+module m
+contains
+   integer function f()
+      f = 4
+   end
+end
+program p
+   use m
+   character(3), parameter :: c = 'abc'
+   character(:), allocatable :: z
+   allocate (z, source=repeat(c(2:1), f()))
+   if (len(z) /= 0) call abort()
+   if (z /= "") call abort()
+end
+
+