[Fortran, (RFC) patch] PR49110/51055 Assignment to alloc. deferred-length character vars

[Tobias Burnus]

Dear all,

the following patch fixes

   character(len=:), allocatable :: str
   str = repeat('X', n)

Before the patch, the (re)allocation happened before the RHS was
evaluated. Thus, the string length wasn't known! (Work around: Add
parentheses around the function call.)


Note that the patch assumes that the function's result variable's length
specification expression is completely known to the caller. I think
that's always the case in gfortran - or is it not?.

I am not sure whether once can construct a valid program using INTERFACE
where that's not the case. The answer is probably no, given:
"If a type parameter of a function result or a bound of a function
result array is not a constant expression, the exact dependence on the
entities in the expression is a characteristic." (F2008, 12.3.3). --
Nevertheless, one has to think about whether there could be some issue.
If there is, I have no idea how one could handle it instead. Thus, there
be better no issue!


I am also not positive that len=: pointer results are properly handled,
but probably they are. (Untested; character array results are also
untested - and array constructors are known to be broken.)

Comments?

The attached patch builds and regtests.
OK for the trunk?

Tobias

[deferred-str-repeat.diff]

---

2012-05-11  Tobias Burnus  <burnus@...>

        PR fortran/49110
        PR fortran/51055
        * trans-expr.c (gfc_trans_assignment_1): Fix allocation
        handling for assignment of function results to allocatable
        deferred-length strings.

2012-05-11  Tobias Burnus  <burnus@...>

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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 8045b1f..8126697 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7002,17 +7003,18 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
     {
       tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0);
       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 save 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)
  && expr1->ts.deferred)
     gfc_add_block_to_block (&block, &rse.pre);
--- /dev/null 2012-05-11 07:40:56.923831265 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_3.f90 2012-05-11 12:18:46.000000000 +0200
@@ -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
--- /dev/null 2012-05-11 07:40:56.923831265 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_4.f90 2012-05-11 12:22:30.000000000 +0200
@@ -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

---

[Tobias Burnus]

Tobias Burnus wrote:
> Note that the patch assumes that the function's result variable's
> length specification expression is completely known to the caller. I
> think that's always the case in gfortran - or is it not?

Thinking about it, I came to the conclusion has explicitly been designed
such that it is known.

Note: The attached patch is required in addition to make sure that the
variable has the correct name mangling and to ensure that the string
length is TREE_PUBLIC() = 1, when needed.

The trans-expr.c part of the patch has been posted at
http://gcc.gnu.org/ml/fortran/2012-05/msg00054.html


Compile ("-c") the following code - with the function commented or not
and with PUBLIC and PRIVATE - and look resulting .o file via nm. It
shouldn't show the "str" variable (and the length variable) if (and
only) if it is private and not used in the function result expression.
Result for the program as shown below:

0000000000000008 B .__m_MOD_str
0000000000000000 T __m_MOD_bar
0000000000000000 B __m_MOD_str


module m
!  character(len=:), PRIVATE, allocatable :: str
   character(len=:), PUBLIC, allocatable :: str
contains
   ! Note due to technical reasons (TBP, generic, cf. resolve.c),
   ! a "PRIVATE :: bar" still counts a publicly using "str".
   function bar()
     character(len=len(str)) :: str
   end function bar
end module m

Tobias

[trunk.diff]

---

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index b03d393..3c1118e 100644
--- 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);
@@ -1395,29 +1405,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 
   gfc_finish_var_decl (decl, sym);
 
-  if (sym->ts.type == BT_CHARACTER)
-    {
-      /* Character variables need special handling.  */
-      gfc_allocate_lang_decl (decl);
-
-      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);
- }
-    }
-  else if (sym->attr.subref_array_pointer)
+  if (sym->attr.subref_array_pointer)
     {
       /* We need the span for these beasts.  */
       gfc_allocate_lang_decl (decl);

---

[Paul Richard Thomas]

Dear Tobias,

OK for trunk - just a wee typo to correct:
s/+     parameter available to the caller; gfortran save it in the
.mod files. */
/+     parameter available to the caller; gfortran saves it in the
.mod files. *//

Thanks for the patch.

Paul

On 13 May 2012 15:50, Tobias Burnus <burnus@...> wrote:

> Tobias Burnus wrote:
>>
>> Note that the patch assumes that the function's result variable's length
>> specification expression is completely known to the caller. I think that's
>> always the case in gfortran - or is it not?
>
>
> Thinking about it, I came to the conclusion has explicitly been designed
> such that it is known.
>
> Note: The attached patch is required in addition to make sure that the
> variable has the correct name mangling and to ensure that the string length
> is TREE_PUBLIC() = 1, when needed.
>
> The trans-expr.c part of the patch has been posted at
> http://gcc.gnu.org/ml/fortran/2012-05/msg00054.html
>
>
> Compile ("-c") the following code - with the function commented or not and
> with PUBLIC and PRIVATE - and look resulting .o file via nm. It shouldn't
> show the "str" variable (and the length variable) if (and only) if it is
> private and not used in the function result expression. Result for the
> program as shown below:
>
> 0000000000000008 B .__m_MOD_str
> 0000000000000000 T __m_MOD_bar
> 0000000000000000 B __m_MOD_str
>
>
> module m
> !  character(len=:), PRIVATE, allocatable :: str
>  character(len=:), PUBLIC, allocatable :: str
> contains
>  ! Note due to technical reasons (TBP, generic, cf. resolve.c),
>  ! a "PRIVATE :: bar" still counts a publicly using "str".
>  function bar()
>    character(len=len(str)) :: str
>  end function bar
> end module m
>
> Tobias

--
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

[Tobias Burnus]

Dear Paul,

On 05/14/2012 03:31 PM, Paul Richard Thomas wrote:
> OK for trunk - just a wee typo to correct:

Fixed. Thanks for the review! I have now committed the attached patch as
Rev. 187472.

Tobias

[deferred-str-repeat-v2.diff]

---

2012-05-14  Tobias Burnus  <burnus@...>

        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@...>

        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.

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index b03d393..1354ad0 100644
--- 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 81562d2..9d48a09 100644
--- 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)
--- /dev/null 2012-05-14 08:15:48.907781309 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 2012-05-11 12:18:46.000000000 +0200
@@ -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
--- /dev/null 2012-05-14 08:15:48.907781309 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_4.f90 2012-05-11 12:22:30.000000000 +0200
@@ -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

---