re PR fortran/49110 (Deferred-length character result triggers (false positive) error...

2012-05-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/49110
        PR fortran/51055
        PR fortran/53329
        * trans-expr.c (gfc_trans_assignment_1): Fix allocation
        handling for assignment of function results to allocatable
        deferred-length strings.
        * trans-decl.c (gfc_create_string_length): For deferred-length
        module variables, include module name in the assembler name.
        (gfc_get_symbol_decl): Don't override the assembler name.

2012-05-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/49110
        PR fortran/51055
        PR fortran/53329
        * gfortran.dg/deferred_type_param_4.f90: New.
        * gfortran.dg/deferred_type_param_6.f90: New.

From-SVN: r187472

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bfafc1b100c33b593e0ac56a6effa9646f06a754..5e1dba9343597ff9683344264a66ef8f94d8d39c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2012-05-14  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/49110
+       PR fortran/51055
+       PR fortran/53329
+       * trans-expr.c (gfc_trans_assignment_1): Fix allocation
+       handling for assignment of function results to allocatable
+       deferred-length strings.
+       * trans-decl.c (gfc_create_string_length): For deferred-length
+       module variables, include module name in the assembler name.
+       (gfc_get_symbol_decl): Don't override the assembler name.
+
 2012-05-14  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
        PR 53063

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index b03d393aa8e77d3b9516b6cb47f6d149c9d0af4c..1354ad05e3da1361ab4485019bd7341cee642ad5 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1087,11 +1087,14 @@ gfc_create_string_length (gfc_symbol * sym)
   if (sym->ts.u.cl->backend_decl == NULL_TREE)
     {
       tree length;
-      char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
+      const char *name;
 
       /* Also prefix the mangled name.  */
-      strcpy (&name[1], sym->name);
-      name[0] = '.';
+      if (sym->module)
+       name = gfc_get_string (".__%s_MOD_%s", sym->module, sym->name);
+      else
+       name = gfc_get_string (".%s", sym->name);
+
       length = build_decl (input_location,
                           VAR_DECL, get_identifier (name),
                           gfc_charlen_type_node);
@@ -1101,6 +1104,13 @@ gfc_create_string_length (gfc_symbol * sym)
        gfc_defer_symbol_init (sym);
 
       sym->ts.u.cl->backend_decl = length;
+
+      if (sym->attr.save || sym->ns->proc_name->attr.flavor == FL_MODULE)
+       TREE_STATIC (length) = 1;
+
+      if (sym->ns->proc_name->attr.flavor == FL_MODULE
+         && (sym->attr.access != ACCESS_PRIVATE || sym->attr.public_used))
+       TREE_PUBLIC (length) = 1;
     }
 
   gcc_assert (sym->ts.u.cl->backend_decl != NULL_TREE);
@@ -1402,17 +1412,6 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 
       if (TREE_CODE (length) != INTEGER_CST)
        {
-         char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
-
-         if (sym->module)
-           {
-             /* Also prefix the mangled name for symbols from modules.  */
-             strcpy (&name[1], sym->name);
-             name[0] = '.';
-             strcpy (&name[1],
-                     IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (length)));
-             gfc_set_decl_assembler_name (decl, get_identifier (name));
-           }
          gfc_finish_var_decl (length, sym);
          gcc_assert (!sym->value);
        }

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 81562d2162d6faae650ae58a7466d35f13e60505..9d48a09e12983ca7377451d67828b98e9249c881 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7005,13 +7005,14 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
       gfc_add_expr_to_block (&loop.post, tmp);
     }
 
-  /* For a deferred character length function, the function call must
-     happen before the (re)allocation of the lhs, otherwise the character
-     length of the result is not known.  */
-  def_clen_func = (((expr2->expr_type == EXPR_FUNCTION)
-                          || (expr2->expr_type == EXPR_COMPCALL)
-                          || (expr2->expr_type == EXPR_PPC))
-                      && expr2->ts.deferred);
+  /* When assigning a character function result to a deferred-length variable,
+     the function call must happen before the (re)allocation of the lhs -
+     otherwise the character length of the result is not known.
+     NOTE: This relies on having the exact dependence of the length type
+     parameter available to the caller; gfortran saves it in the .mod files. */
+  def_clen_func = (expr2->expr_type == EXPR_FUNCTION
+                  || expr2->expr_type == EXPR_COMPCALL
+                  || expr2->expr_type == EXPR_PPC);
   if (gfc_option.flag_realloc_lhs
        && expr2->ts.type == BT_CHARACTER
        && (def_clen_func || expr2->expr_type == EXPR_OP)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8b90aa8daffd16d891b5372d9b3a655b61b0990e..9025441272486aeb1cd5a239efc3e65088519225 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2012-05-14  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/49110
+       PR fortran/51055
+       PR fortran/53329
+       * gfortran.dg/deferred_type_param_4.f90: New.
+       * gfortran.dg/deferred_type_param_6.f90: New.
+
 2012-05-14  Bernd Schmidt  <bernds@codesourcery.com>
 
        * gcc.target/i386/retarg.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_4.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_4.f90
new file mode 100644 (file)
index 0000000..c0583f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_type_param_4.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/51055
+! PR fortran/49110
+!
+!
+program test
+  implicit none
+  character(len=:), allocatable :: str
+  integer :: i
+  i = 5
+  str = f()
+  call printIt ()
+  i = 7
+  str = repeat('X', i)
+  call printIt ()
+contains
+  function f()
+    character(len=i) :: f
+    f = '1234567890'
+  end function f
+  subroutine printIt
+!    print *, len(str)
+!    print '(3a)', '>',str,'<'
+    if (i == 5) then
+      if (str /= "12345" .or. len(str) /= 5) call abort ()
+    else if (i == 7) then
+      if (str /= "XXXXXXX" .or. len(str) /= 7) call abort ()
+    else
+      call abort ()
+    end if
+  end subroutine
+end

diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90
new file mode 100644 (file)
index 0000000..eb00778
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/51055
+! PR fortran/49110
+!
+
+subroutine test()
+  implicit none
+  integer :: i = 5
+  character(len=:), allocatable :: s1
+  call sub(s1, i)
+  if (len(s1) /= 5) call abort()
+  if (s1 /= "ZZZZZ") call abort()
+contains
+  subroutine sub(str,j)
+    character(len=:), allocatable :: str
+    integer :: j
+    str = REPEAT("Z",j)
+    if (len(str) /= 5) call abort()
+    if (str /= "ZZZZZ") call abort()
+  end subroutine sub
+end subroutine test
+
+program a
+ character(len=:),allocatable :: s
+ integer :: j=2
+ s = repeat ('x', j)
+ if (len(repeat(' ',j)) /= 2) call abort()
+ if (repeat('y',j) /= "yy") call abort()
+ if (len(s) /= 2) call abort()
+ if (s /= "xx") call abort()
+ call test()
+end program a