| Message ID | 4FAFBC1C.8070902@net-b.de |
|---|---|
| State | New |
| Headers | show |
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@net-b.de> 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
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);