aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog12
-rw-r--r--gcc/fortran/trans-decl.c27
-rw-r--r--gcc/fortran/trans-expr.c15
-rw-r--r--gcc/testsuite/ChangeLog8
-rw-r--r--gcc/testsuite/gfortran.dg/deferred_type_param_4.f9033
-rw-r--r--gcc/testsuite/gfortran.dg/deferred_type_param_6.f9033
6 files changed, 107 insertions, 21 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bfafc1b..5e1dba9 100644
--- 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 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)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8b90aa8..9025441 100644
--- 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
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
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
generated by cgit v1.1 at 2024-10-06 21:21:38 +0000