]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/83344 (Use of uninitialized memory with ASSOCIATE and strings)
authorPaul Thomas <pault@gcc.gnu.org>
Mon, 19 Feb 2018 22:09:13 +0000 (22:09 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Mon, 19 Feb 2018 22:09:13 +0000 (22:09 +0000)
2018-02-19  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/83344
PR fortran/83975
* resolve.c (resolve_assoc_var): Rearrange the logic for the
determination of the character length of associate names. If
the associate name is missing a length expression or the length
expression is not a constant and the target is not a variable,
make the associate name allocatable and deferred length.
* trans-decl.c (gfc_get_symbol_decl): Null the character length
backend_decl for deferred length associate names that are not
variables. Set 'length' to gfc_index_zero_node for character
associate names, whose character length is a PARM_DECL.

2018-02-19  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/83344
PR fortran/83975
* gfortran.dg/associate_22.f90: Enable commented out test.
* gfortran.dg/associate_36.f90: New test.

From-SVN: r257827

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/fortran/trans-decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/associate_22.f90
gcc/testsuite/gfortran.dg/associate_36.f90 [new file with mode: 0644]

index 32646ebf8f700eacaccd59b62bfe2f7dba4ddecf..e3818ab6a9271c8b1b10a8cb7661f18fde2f25f9 100644 (file)
@@ -1,3 +1,17 @@
+2018-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/83344
+       PR fortran/83975
+       * resolve.c (resolve_assoc_var): Rearrange the logic for the
+       determination of the character length of associate names. If
+       the associate name is missing a length expression or the length
+       expression is not a constant and the target is not a variable,
+       make the associate name allocatable and deferred length.
+       * trans-decl.c (gfc_get_symbol_decl): Null the character length
+       backend_decl for deferred length associate names that are not
+       variables. Set 'length' to gfc_index_zero_node for character
+       associate names, whose character length is a PARM_DECL.
+
 2018-02-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/35339
index e1d2aa27ad18e85f78b21c063db7161296c22638..fee5b1becf54cf1da2673eff903a05ca8662275e 100644 (file)
@@ -8635,30 +8635,26 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
     {
       if (!sym->ts.u.cl)
-       {
-         if (target->expr_type != EXPR_CONSTANT
-             && !target->ts.u.cl->length)
-           {
-             sym->ts.u.cl = gfc_get_charlen();
-             sym->ts.deferred = 1;
+       sym->ts.u.cl = target->ts.u.cl;
 
-             /* This is reset in trans-stmt.c after the assignment
-                of the target expression to the associate name.  */
-             sym->attr.allocatable = 1;
-           }
-         else
-           sym->ts.u.cl = target->ts.u.cl;
+      if (!sym->ts.u.cl->length
+         && !sym->ts.deferred
+         && target->expr_type == EXPR_CONSTANT)
+       {
+         sym->ts.u.cl->length =
+               gfc_get_int_expr (gfc_charlen_int_kind, NULL,
+                                 target->value.character.length);
        }
-
-      if (!sym->ts.u.cl->length && !sym->ts.deferred)
+      else if ((!sym->ts.u.cl->length
+               || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+               && target->expr_type != EXPR_VARIABLE)
        {
-         if (target->expr_type == EXPR_CONSTANT)
-           sym->ts.u.cl->length =
-             gfc_get_int_expr (gfc_charlen_int_kind, NULL,
-                               target->value.character.length);
-         else
-           gfc_error ("Not Implemented: Associate target with type character"
-                      " and non-constant length at %L", &target->where);
+         sym->ts.u.cl = gfc_get_charlen();
+         sym->ts.deferred = 1;
+
+         /* This is reset in trans-stmt.c after the assignment
+            of the target expression to the associate name.  */
+         sym->attr.allocatable = 1;
        }
     }
 
index 51de933e82daf3302fe91e0e54815b75983ed01e..a50c50da206c40d1cedbc3ddfef2251f48441a7c 100644 (file)
@@ -1707,12 +1707,13 @@ gfc_get_symbol_decl (gfc_symbol * sym)
          && sym->assoc && sym->assoc->target
          && ((sym->assoc->target->expr_type == EXPR_VARIABLE
               && sym->assoc->target->symtree->n.sym->ts.type != BT_CHARACTER)
-             || sym->assoc->target->expr_type == EXPR_FUNCTION))
+             || sym->assoc->target->expr_type != EXPR_VARIABLE))
        sym->ts.u.cl->backend_decl = NULL_TREE;
 
       if (sym->attr.associate_var
          && sym->ts.u.cl->backend_decl
-         && VAR_P (sym->ts.u.cl->backend_decl))
+         && (VAR_P (sym->ts.u.cl->backend_decl)
+             || TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL))
        length = gfc_index_zero_node;
       else
        length = gfc_create_string_length (sym);
index 286a6af5a4b19387558d5ad932871ff3b87079f3..531d29ad4cfddee65bf619dde18af49ca1705f01 100644 (file)
@@ -1,3 +1,10 @@
+2018-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/83344
+       PR fortran/83975
+       * gfortran.dg/associate_22.f90: Enable commented out test.
+       * gfortran.dg/associate_36.f90: New test.
+
 2018-02-19  Jakub Jelinek  <jakub@redhat.com>
 
        PR target/84146
index 2e2fb58cdba3dc3e5a3532fc7e61225f16885151..35daf89098df9f14c53c14bb5e6e1d8acc2d0152 100644 (file)
@@ -24,11 +24,10 @@ program foo
    end associate
 
    ! This failed.
-   ! This still doesn't work correctly, see PR 83344
-!   a = trim(s) // 'abc'
-!   associate(w => trim(s) // 'abc')
-!      if (trim(w) /= trim(a)) STOP 4
-!   end associate
+   a = trim(s) // 'abc'
+   associate(w => trim(s) // 'abc')
+      if (trim(w) /= trim(a)) STOP 4
+   end associate
 
    ! This failed.
    associate(x => trim('abc'))
diff --git a/gcc/testsuite/gfortran.dg/associate_36.f90 b/gcc/testsuite/gfortran.dg/associate_36.f90
new file mode 100644 (file)
index 0000000..ba236b4
--- /dev/null
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test the fix for PR83344.
+!
+! Contributed by <Janne Blomqvist  <jb@gcc.gnu.org>
+!
+program foo
+   implicit none
+   character(len=1) a
+   character(len=2) b
+   character(len=3) c
+   a = 'a'
+   call bah(a, len (a))
+   b = 'bb'
+   call bah(b, len (b))
+   c = 'ccc'
+   call bah(c, len (c))
+   contains
+      subroutine bah(x, clen)
+         implicit none
+         integer :: clen
+         character(len=*), intent(in) :: x
+         associate(y => x)
+            if (len(y) .ne. clen) stop 1
+            if (y .ne. x) stop 2
+         end associate
+      end subroutine bah
+end program foo