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
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);
