Message ID | 27cd606a-f019-60b2-a9c8-0a570433b5eb@codesourcery.com |
---|---|
State | New |
Headers | show |
Series | Fortran: Avoid SAVE_EXPR for deferred-len char types | expand |
On Fri, Feb 17, 2023 at 12:13:52PM +0100, Tobias Burnus wrote: > Short version: > > This fixes potential and real bugs related to 'len=:' character variables > as for the length/byte size an old/saved expression is used instead of > the current value. - That's fine but not for allocatable/pointer with 'len=:'. > > > Main part of the patch: Strip the SAVE_EXPR from the size expression: > > if (len && deferred && TREE_CODE (TYPE_SIZE (type)) == SAVE_EXPR) > { > gcc_assert (TREE_CODE (TYPE_SIZE_UNIT (type)) == SAVE_EXPR); > TYPE_SIZE (type) = TREE_OPERAND (TYPE_SIZE (type), 0); > TYPE_SIZE_UNIT (type) = TREE_OPERAND (TYPE_SIZE_UNIT (type), 0); > } > > > OK for mainline? Short version: no. > > * * * > > Long version: > > BACKGROUND: > > > (A) VLA / EXPLICIT-SIZE ARRAYS + LEN=<expr|var> STRINGS > > > C knows something like VLA (variable length arrays), likewise Fortran > knows explicit size array and character length where the length/size > depends on an variable set before the current scoping unit. Examples: > > void f(int N) > { > int vla[N*5]; > } > > subroutine foo(n) > integer :: n > integer :: array(n*5) > integer :: my_len > ... > my_len = 5 > block > character(len=my_len, kind=4) :: str > > my_len = 99 > print *, len(str) ! still shows 5 - not 99 > end block > end Are you sure about the above comment? At the time that str is declared, it is given a kind type parameter of len=5 and kind=4. After changing my_len to 99 the kind type parameter of str does not change. 8.3 Automatic data objects If a type parameter in a declaration-type-spec or in a char-length in an entity-decl for a local variable of a subprogram or BLOCK construct is defined by an expression that is not a constant expression, the type parameter value is established on entry to a procedure defined by the subprogram, or on execution of the BLOCK statement, and is not affected by any redefinition or undefinition of the variables in the expression during execution of the procedure or BLOCK construct.
On 17.02.23 17:27, Steve Kargl wrote: > On Fri, Feb 17, 2023 at 12:13:52PM +0100, Tobias Burnus wrote: >> OK for mainline? > Short version: no. Would you mind to write a reasoning beyond only a single word? >> subroutine foo(n) >> integer :: n >> integer :: array(n*5) >> integer :: my_len >> ... >> my_len = 5 >> block >> character(len=my_len, kind=4) :: str >> >> my_len = 99 >> print *, len(str) ! still shows 5 - not 99 >> end block >> end > Are you sure about the above comment? Yes - for three reasons: * On the what-feels-right side: It does not make any sense to print any other value than 5 given that 'str' has been declared with len = 5. * On the GCC side, the SAVE_EXPR ensures that the length is evaluated early and then "saved" to ensure its original value is available * The quoted text from the standard implies that this is what should happen. Why do you think that printing "5" is wrong? GCC does so since years; it still does so with my patch. Hence, can you elaborate? And also state which value you did expect instead? * * * The patch itself is about *deferred* length parameters, i.e. 'len=:', and thus for code like: character(len=:), pointer :: str ... allocate(character(len=4) :: str) print *, len(str) ! should print 4 ... allocate(character(len=99) :: str) print *, len(str) ! should now print 99 ... Currently, the SAVE_EXPR causes that the original value might get used, which is often 0 (by chance 0 initialized) or some random value like 57385973, depending what on what was on the stack before. - There are more issues with deferred strings, but at least one is solved by not having a SAVE_EXPR for deferred-length character strings. Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On Mon, Feb 20, 2023 at 07:56:14AM +0100, Tobias Burnus wrote: > On 17.02.23 17:27, Steve Kargl wrote: > > On Fri, Feb 17, 2023 at 12:13:52PM +0100, Tobias Burnus wrote: > > > OK for mainline? > > Short version: no. > > Would you mind to write a reasoning beyond only a single word? > > > > subroutine foo(n) > > > integer :: n > > > integer :: array(n*5) > > > integer :: my_len > > > ... > > > my_len = 5 > > > block > > > character(len=my_len, kind=4) :: str > > > > > > my_len = 99 > > > print *, len(str) ! still shows 5 - not 99 > > > end block > > > end > > Are you sure about the above comment? > > Yes - for three reasons: > * On the what-feels-right side: It does not make any sense to print > any other value than 5 given that 'str' has been declared with len = 5. > * On the GCC side, the SAVE_EXPR ensures that the length is evaluated > early and then "saved" to ensure its original value is available > * The quoted text from the standard implies that this is what > should happen. Your comment in the above code suggest to me that you expected 99. Of course, the print statement should produce 5 and that is what gfortran does. If your patch only effects deferred character types, why are you including a useless code example. -- steve
On Mon, Feb 20, 2023 at 11:05 AM Tobias Burnus <tobias@codesourcery.com> wrote: > > On 17.02.23 17:27, Steve Kargl wrote: > > On Fri, Feb 17, 2023 at 12:13:52PM +0100, Tobias Burnus wrote: > >> OK for mainline? > > Short version: no. > > Would you mind to write a reasoning beyond only a single word? > > >> subroutine foo(n) > >> integer :: n > >> integer :: array(n*5) > >> integer :: my_len > >> ... > >> my_len = 5 > >> block > >> character(len=my_len, kind=4) :: str > >> > >> my_len = 99 > >> print *, len(str) ! still shows 5 - not 99 > >> end block > >> end > > Are you sure about the above comment? > > Yes - for three reasons: > * On the what-feels-right side: It does not make any sense to print > any other value than 5 given that 'str' has been declared with len = 5. > * On the GCC side, the SAVE_EXPR ensures that the length is evaluated > early and then "saved" to ensure its original value is available Generally SAVE_EXPR is used to make sure an expression is only evaluated once. It's DECL_EXPR that ensures something is evaluated early and available. So generally "unwrapping" a SAVE_EXPR looks dangerous to me unless the SAVE_EXPR is really never necessary. Richard. > * The quoted text from the standard implies that this is what > should happen. > > Why do you think that printing "5" is wrong? GCC does so since > years; it still does so with my patch. > > Hence, can you elaborate? And also state which value you did expect instead? > > * * * > > The patch itself is about *deferred* length parameters, i.e. > 'len=:', and thus for code like: > > character(len=:), pointer :: str > ... > allocate(character(len=4) :: str) > print *, len(str) ! should print 4 > ... > allocate(character(len=99) :: str) > print *, len(str) ! should now print 99 > ... > > Currently, the SAVE_EXPR causes that the original value might > get used, which is often 0 (by chance 0 initialized) or some > random value like 57385973, depending what on what was on the > stack before. - There are more issues with deferred strings, > but at least one is solved by not having a SAVE_EXPR for > deferred-length character strings. > > Tobias > > ----------------- > Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On 20.02.23 11:41, Richard Biener wrote: > Generally SAVE_EXPR is used to make sure an expression is only evaluated > once. It's DECL_EXPR that ensures something is evaluated early > and available. So generally "unwrapping" a SAVE_EXPR looks dangerous > to me unless the SAVE_EXPR is really never necessary. For VLA-kind of variables, SAVE_EXPR makes sense (code wise: if '!deferred') - and that use in gfortran should remain unchanged. However, Fortran also has deferred-length variables where one has: character(len=:), pointer :: str ! ... allocate(character(len=42) :: str) !... end which has the dump: integer(kind=8) .str; character(kind=1)[1:.str] * str; str = (character(kind=1)[1:.str] *) __builtin_malloc (42); .str = 42; The length variable is - a bit oddly - linked to the data variable its TREE_TYPE - i.e. via the upper bound for the domain / TYPE_SIZE / TYPE_SIZE_UNIT. Currently, it happens that the SAVE_EXPR is used, e.g. size = D.1234; // which D.1234 is the SAVE_EXPR instead of the current value size = .str; which leads to wrong results. As '.str' is an aritificial variable, the issue of a user modifying the value does not exist. * * * As mentioned in the TODO for 'deferred', I think we really want to have NULL as upper value for the domain for the type, but that requires literally hundred of changes to the compiler, which I do not want to due during Stage 4, but that are eventually required.* — In any case, this patch fixes some of the issues in the meanwhile. Tobias * The number of deferred-length bugs is really huge; especially when used with derived types. ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On Mon, Feb 20, 2023 at 12:07:43PM +0100, Tobias Burnus wrote: > As mentioned in the TODO for 'deferred', I think we really want > to have NULL as upper value for the domain for the type, but that > requires literally hundred of changes to the compiler, which > I do not want to due during Stage 4, but that are eventually > required.* — In any case, this patch fixes some of the issues > in the meanwhile. Yeah, the actual len can be in some type's lang_specific member. Anyway, for the patch for now, I'd probably instead of stripping SAVE_EXPR overwrite the 2 sizes with newly built expressions. Jakub
On 20.02.23 12:15, Jakub Jelinek wrote: > On Mon, Feb 20, 2023 at 12:07:43PM +0100, Tobias Burnus wrote: >> As mentioned in the TODO for 'deferred', I think we really want >> to have NULL as upper value for the domain for the type, but that >> requires literally hundred of changes to the compiler, which >> I do not want to due during Stage 4, but that are eventually >> required.* — In any case, this patch fixes some of the issues >> in the meanwhile. > Yeah, the actual len can be in some type's lang_specific member. Actually, I think it should be bound to the DECL and not to the TYPE, i.e. lang_decl not type_lang. I just see that, the latter already has a 'tree stringlen' (for I/O) which probably could be reused for this purpose. > Anyway, for the patch for now, I'd probably instead of stripping > SAVE_EXPR overwrite the 2 sizes with newly built expressions. What I now did. (Unchanged otherwise, except that I now also mention GFC_DECL_STRING_LEN in the TODO.) OK for mainline? Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On Mon, Feb 20, 2023 at 12:48:38PM +0100, Tobias Burnus wrote: > On 20.02.23 12:15, Jakub Jelinek wrote: > > On Mon, Feb 20, 2023 at 12:07:43PM +0100, Tobias Burnus wrote: > > > As mentioned in the TODO for 'deferred', I think we really want > > > to have NULL as upper value for the domain for the type, but that > > > requires literally hundred of changes to the compiler, which > > > I do not want to due during Stage 4, but that are eventually > > > required.* — In any case, this patch fixes some of the issues > > > in the meanwhile. > > Yeah, the actual len can be in some type's lang_specific member. > > Actually, I think it should be bound to the DECL and not to the TYPE, > i.e. lang_decl not type_lang. > > I just see that, the latter already has a 'tree stringlen' (for I/O) > which probably could be reused for this purpose. I'd drop the && TREE_CODE (TYPE_SIZE (type)) == SAVE_EXPR and assert == SAVE_EXPR part, with SAVE_EXPRs one never knows if they are added around the whole expression or say some subexpression has it and then some trivial arithmetics happens on the SAVE_EXPR tree. > > Anyway, for the patch for now, I'd probably instead of stripping > > SAVE_EXPR overwrite the 2 sizes with newly built expressions. > > What I now did. (Unchanged otherwise, except that I now also mention > GFC_DECL_STRING_LEN in the TODO.) > > OK for mainline? If Richard doesn't object. Jakub
On Mon, Feb 20, 2023 at 12:57 PM Jakub Jelinek <jakub@redhat.com> wrote: > > On Mon, Feb 20, 2023 at 12:48:38PM +0100, Tobias Burnus wrote: > > On 20.02.23 12:15, Jakub Jelinek wrote: > > > On Mon, Feb 20, 2023 at 12:07:43PM +0100, Tobias Burnus wrote: > > > > As mentioned in the TODO for 'deferred', I think we really want > > > > to have NULL as upper value for the domain for the type, but that > > > > requires literally hundred of changes to the compiler, which > > > > I do not want to due during Stage 4, but that are eventually > > > > required.* — In any case, this patch fixes some of the issues > > > > in the meanwhile. > > > Yeah, the actual len can be in some type's lang_specific member. > > > > Actually, I think it should be bound to the DECL and not to the TYPE, > > i.e. lang_decl not type_lang. > > > > I just see that, the latter already has a 'tree stringlen' (for I/O) > > which probably could be reused for this purpose. > > I'd drop the > && TREE_CODE (TYPE_SIZE (type)) == SAVE_EXPR > and assert == SAVE_EXPR part, with SAVE_EXPRs one never knows if they > are added around the whole expression or say some subexpression has > it and then some trivial arithmetics happens on the SAVE_EXPR tree. > > > > Anyway, for the patch for now, I'd probably instead of stripping > > > SAVE_EXPR overwrite the 2 sizes with newly built expressions. > > > > What I now did. (Unchanged otherwise, except that I now also mention > > GFC_DECL_STRING_LEN in the TODO.) > > > > OK for mainline? > > If Richard doesn't object. tree -gfc_get_character_type_len_for_eltype (tree eltype, tree len) +gfc_get_character_type_len_for_eltype (tree eltype, tree len, bool deferred) { tree bounds, type; bounds = build_range_type (gfc_charlen_type_node, gfc_index_one_node, len); type = build_array_type (eltype, bounds); TYPE_STRING_FLAG (type) = 1; - + if (len && deferred && TREE_CODE (TYPE_SIZE (type)) == SAVE_EXPR) + { + /* TODO: A more middle-end friendly alternative would be to use NULL_TREE + as upper bound and store the value, e.g. as GFC_DECL_STRING_LEN. + Caveat: this requires some cleanup throughout the code to consistently + use some wrapper function. */ + gcc_assert (TREE_CODE (TYPE_SIZE_UNIT (type)) == SAVE_EXPR); + tree tmp = TREE_TYPE (TYPE_SIZE (eltype)); ... you are probably breaking type sharing here. You could use build_array_type_1 and pass false for 'shared' to get around that. Note that there's also canonical type building done in case 'eltype' is not canonical itself. The solution to the actual problem is a hack - you are relying on re-evaluation of TYPE_SIZE, and for that, only from within accesses from inside the frontend? Since gimplification will produce the result into a single temporary again, re-storing the "breakage". So, does it _really_ fix things? Richard. > > Jakub >
Hi Richard, hi all, On 20.02.23 13:46, Richard Biener wrote: > + /* TODO: A more middle-end friendly alternative would be to use NULL_TREE > + as upper bound and store the value, e.g. as GFC_DECL_STRING_LEN. > + Caveat: this requires some cleanup throughout the code to consistently > + use some wrapper function. */ > + gcc_assert (TREE_CODE (TYPE_SIZE_UNIT (type)) == SAVE_EXPR); > + tree tmp = TREE_TYPE (TYPE_SIZE (eltype)); > > ... > > you are probably breaking type sharing here. You could use > build_array_type_1 and pass false for 'shared' to get around that. Note > that there's also canonical type building done in case 'eltype' is not > canonical itself. My feeling is that this is already somewhat broken. Currently, there is one type per decl as each has its own artificial length variable. I have no idea how this will be handled in the ME in terms of alias analysis. And whether shared=false makes sense here and what effect is has. (Probably yes.) In principle, integer(kind=8) .str., .str2; character(kind=1)[1:.str] * str; character(kind=1)[1:.str2] * str2; have the same type and iff .str == .str at runtime, they can alias. Example: str2 = str; .str2 = .str; I have no idea how the type analysis currently works (with or without SAVE_EXPR) nor what effect shared=false has in this case. > The solution to the actual problem is a hack - you are relying on > re-evaluation of TYPE_SIZE, and for that, only from within accesses > from inside the frontend? I think this mostly helps with access inside the FE of the type 'size = TYPE_SIZE_UNIT(type)', which is used surprisingly often and is often directly evaluated (i.e. assigned to a temporary). > Since gimplification will produce the result into a single temporary again, re-storing the "breakage". > So, does it_really_ fix things? It does seem to fix cases which do 'size = TYPE_SIZE_UNIT (type);' in the front end and then uses this size expression. Thus, there are fixed. However, there are many cases where things go wrong - with and without the patch. I keep discovering more and more :-( * * * I still think that the proper way is to have NULL_TREE as upper value would be better in several ways, except that there is (too) much code which relies on TYPE_UNIT_SIZE to work. (There are 117 occurrences). Additionally, there is more code doing assumptions in this area. Thus, the question is whether it makes sense as hackish partial solution or whether it should remain in the current broken stage until it is fixed properly. Tobias, who would like to have more time for fixing such issues. ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On Mon, Feb 20, 2023 at 5:23 PM Tobias Burnus <tobias@codesourcery.com> wrote: > > Hi Richard, hi all, > > On 20.02.23 13:46, Richard Biener wrote: > > + /* TODO: A more middle-end friendly alternative would be to use NULL_TREE > > + as upper bound and store the value, e.g. as GFC_DECL_STRING_LEN. > > + Caveat: this requires some cleanup throughout the code to consistently > > + use some wrapper function. */ > > + gcc_assert (TREE_CODE (TYPE_SIZE_UNIT (type)) == SAVE_EXPR); > > + tree tmp = TREE_TYPE (TYPE_SIZE (eltype)); > > > > ... > > > > you are probably breaking type sharing here. You could use > > build_array_type_1 and pass false for 'shared' to get around that. Note > > that there's also canonical type building done in case 'eltype' is not > > canonical itself. > > My feeling is that this is already somewhat broken. Currently, there > is one type per decl as each has its own artificial length variable. > I have no idea how this will be handled in the ME in terms of alias > analysis. And whether shared=false makes sense here and what effect > is has. (Probably yes.) > > In principle, > integer(kind=8) .str., .str2; > character(kind=1)[1:.str] * str; > character(kind=1)[1:.str2] * str2; > have the same type and iff .str == .str at runtime, they can alias. > Example: > str2 = str; > .str2 = .str; > > I have no idea how the type analysis currently works (with or without SAVE_EXPR) > nor what effect shared=false has in this case. alias analysis for array types looks only at the element type > > The solution to the actual problem is a hack - you are relying on > > re-evaluation of TYPE_SIZE, and for that, only from within accesses > > from inside the frontend? > > I think this mostly helps with access inside the FE of the type 'size = > TYPE_SIZE_UNIT(type)', which is used surprisingly often and is often > directly evaluated (i.e. assigned to a temporary). that's what I thought > > Since gimplification will produce the result into a single temporary again, re-storing the "breakage". > > So, does it_really_ fix things? > > It does seem to fix cases which do 'size = TYPE_SIZE_UNIT (type);' in > the front end and then uses this size expression. Thus, there are fixed. > However, there are many cases where things go wrong - with and without > the patch. I keep discovering more and more :-( I guess test coverage isn't too great with this feature then ;) > * * * > > I still think that the proper way is to have NULL_TREE as upper value > would be better in several ways, except that there is (too) much code Yep. > which relies on TYPE_UNIT_SIZE to work. (There are 117 occurrences). > Additionally, there is more code doing assumptions in this area. > > Thus, the question is whether it makes sense as hackish partial solution > or whether it should remain in the current broken stage until it is > fixed properly. I wonder if it makes more sense to individually fix the places using TYPE_UNIT_SIZE in a wrong way? You'd also get only "partial" fixes, but at least those will be true and good? Otherwise I defer to frontend maintainers if they agree to put in a (partially working) hack like this. Richard. > Tobias, > > who would like to have more time for fixing such issues. > > ----------------- > Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On Tue, Feb 21, 2023 at 08:30:50AM +0100, Richard Biener wrote: > > I think this mostly helps with access inside the FE of the type 'size = > > TYPE_SIZE_UNIT(type)', which is used surprisingly often and is often > > directly evaluated (i.e. assigned to a temporary). > > that's what I thought So, either we can do a temporary hack where we stick the non-SAVE_EXPR in there but somehow mark those types in type_lang_specific (if they aren't yet) and clear that when passing the type from FE to the middle-end. Or, stick some bogus value into TYPE_SIZE_UNIT (error_mark_node or something worse that triggers ICEs all around, say VOID_CST) and fix up what breaks, say add a short function which will replace TYPE_SIZE_UNIT (type) and do if (TYPE_LANG_SPECIFIC (type) && deferred_len (type)) return some_type_lang_specific_field (type); else return TYPE_SIZE_UNIT (type) and replace those. Or mass replace TYPE_SIZE_UNIT (type) in the FE with the new function. Though, there surely are spots for which deferred-len types may never appear... Jakub
Fortran: Avoid SAVE_EXPR for deferred-len char types Using TYPE_SIZE/TYPE_SIZE_UNIT with deferred-length character variables, i.e. 'character(len=:), allocatable/pointer' used a SAVE_EXPR, i.e. the value on entry to the scope instead of the latest value. Solution: Remove the SAVE_EXPR again in this case. gcc/fortran/ChangeLog: * trans-types.h (gfc_get_character_type, gfc_get_character_type_len, (gfc_get_character_type_len_for_eltype): Add argument 'bool deferred'. * trans-types.cc (gfc_get_character_type_len_for_eltype): Likewise; remove the SAVE_EXPR for the type size for deferred string lengths. (gfc_get_character_type_len, gfc_get_character_type): Add arg and pass on. (gfc_typenode_for_spec): Update call. * trans-array.cc (gfc_trans_create_temp_array, trans_array_constructor, gfc_conv_loop_setup, gfc_array_init_size, gfc_alloc_allocatable_for_assignment): Likewise. * trans-expr.cc (gfc_conv_substring, gfc_conv_concat_op, gfc_add_interface_mapping, gfc_conv_procedure_call, gfc_conv_statement_function, gfc_conv_string_parameter): Likewise. * trans-intrinsic.cc (gfc_conv_intrinsic_transfer, gfc_conv_intrinsic_repeat): Likewise. * trans-stmt.cc (forall_make_variable_temp, gfc_trans_assign_need_temp): Likewise. gcc/fortran/trans-array.cc | 11 ++++++----- gcc/fortran/trans-expr.cc | 15 ++++++++------- gcc/fortran/trans-intrinsic.cc | 5 +++-- gcc/fortran/trans-stmt.cc | 7 ++++--- gcc/fortran/trans-types.cc | 39 ++++++++++++++++++++++++++++++--------- gcc/fortran/trans-types.h | 6 +++--- 6 files changed, 54 insertions(+), 29 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 63bd1ac573a..b0abdadc3f5 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1480,7 +1480,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, elemsize = gfc_resize_class_size_with_len (pre, class_expr, elemsize); /* Casting the data as a character of the dynamic length ensures that assignment of elements works when needed. */ - eltype = gfc_get_character_type_len (1, elemsize); + eltype = gfc_get_character_type_len (1, elemsize, true); } memset (from, 0, sizeof (from)); @@ -2823,7 +2823,8 @@ trans_array_constructor (gfc_ss * ss, locus * where) store_backend_decl (&expr->ts.u.cl, ss_info->string_length, force_new_cl); - type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length); + type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length, + expr->ts.deferred); if (const_string) type = build_pointer_type (type); } @@ -5492,7 +5493,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) tmp_ss_info->data.temp.type = gfc_get_character_type_len_for_eltype (TREE_TYPE (tmp_ss_info->data.temp.type), - tmp_ss_info->string_length); + tmp_ss_info->string_length, false); tmp = tmp_ss_info->data.temp.type; memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info)); @@ -5737,7 +5738,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp), TREE_OPERAND (descriptor, 0), tmp, NULL_TREE); tmp = fold_convert (gfc_charlen_type_node, tmp); - type = gfc_get_character_type_len (expr->ts.kind, tmp); + type = gfc_get_character_type_len (expr->ts.kind, tmp, expr->ts.deferred); tmp = gfc_conv_descriptor_dtype (descriptor); gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type)); } @@ -10908,7 +10909,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, if (expr2->ts.type != BT_CLASS) type = gfc_typenode_for_spec (&expr2->ts); else - type = gfc_get_character_type_len (1, elemsize2); + type = gfc_get_character_type_len (1, elemsize2, true); gfc_add_modify (&fblock, tmp, gfc_get_dtype_rank_type (expr2->rank,type)); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index e85b53fae85..50f81ea8881 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -2589,7 +2589,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, char *msg; mpz_t length; - type = gfc_get_character_type (kind, ref->u.ss.length); + type = gfc_get_character_type (kind, ref->u.ss.length, false); type = build_pointer_type (type); gfc_init_se (&start, se); @@ -3709,7 +3709,7 @@ gfc_conv_concat_op (gfc_se * se, gfc_expr * expr) gfc_add_block_to_block (&se->pre, &lse.pre); gfc_add_block_to_block (&se->pre, &rse.pre); - type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl); + type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl, false); len = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); if (len == NULL_TREE) { @@ -4474,7 +4474,7 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping, convert it to a boundless character type. */ else if (!sym->attr.dimension && sym->ts.type == BT_CHARACTER) { - tmp = gfc_get_character_type_len (sym->ts.kind, NULL); + tmp = gfc_get_character_type_len (sym->ts.kind, NULL, sym->ts.deferred); tmp = build_pointer_type (tmp); if (sym->attr.pointer) value = build_fold_indirect_ref_loc (input_location, @@ -7614,7 +7614,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else if (ts.type == BT_CHARACTER) { /* Pass the string length. */ - type = gfc_get_character_type (ts.kind, ts.u.cl); + type = gfc_get_character_type (ts.kind, ts.u.cl, false); type = build_pointer_type (type); /* Emit a DECL_EXPR for the VLA type. */ @@ -8240,7 +8240,7 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr) fsym->ts.u.cl->backend_decl = gfc_conv_constant_to_tree (fsym->ts.u.cl->length); - type = gfc_get_character_type (fsym->ts.kind, fsym->ts.u.cl); + type = gfc_get_character_type (fsym->ts.kind, fsym->ts.u.cl, false); temp_vars[n] = gfc_create_var (type, fsym->name); arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); @@ -8289,7 +8289,7 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr) || tree_int_cst_lt (se->string_length, sym->ts.u.cl->backend_decl)) { - type = gfc_get_character_type (sym->ts.kind, sym->ts.u.cl); + type = gfc_get_character_type (sym->ts.kind, sym->ts.u.cl, false); tmp = gfc_create_var (type, sym->name); tmp = gfc_build_addr_expr (build_pointer_type (type), tmp); gfc_trans_string_copy (&se->pre, sym->ts.u.cl->backend_decl, tmp, @@ -10391,7 +10391,8 @@ gfc_conv_string_parameter (gfc_se * se) if (TREE_CODE (type) == ARRAY_TYPE) type = TREE_TYPE (type); type = gfc_get_character_type_len_for_eltype (type, - se->string_length); + se->string_length, + false); type = build_pointer_type (type); se->expr = gfc_build_addr_expr (type, se->expr); } diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 21eeb12ca89..babe30898a0 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -8548,7 +8548,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) case BT_CHARACTER: tmp = size_of_string_in_bytes (arg->expr->ts.kind, argse.string_length); mold_type = gfc_get_character_type_len (arg->expr->ts.kind, - argse.string_length); + argse.string_length, + arg->expr->ts.deferred); break; case BT_CLASS: tmp = gfc_class_vtab_size_get (argse.expr); @@ -9325,7 +9326,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) dlen = fold_build2_loc (input_location, MULT_EXPR, gfc_charlen_type_node, fold_convert (gfc_charlen_type_node, slen), fold_convert (gfc_charlen_type_node, ncopies)); - type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl); + type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl, false); dest = gfc_conv_string_tmp (se, build_pointer_type (type), dlen); /* Generate the code to do the repeat operation: diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 2b4278be748..9a1caf56bcb 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -3895,7 +3895,7 @@ forall_make_variable_temp (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) { tse.string_length = rse.string_length; tmp = gfc_get_character_type_len (gfc_default_character_kind, - tse.string_length); + tse.string_length, e->ts.deferred); tse.expr = gfc_conv_string_tmp (&tse, build_pointer_type (tmp), rse.string_length); gfc_add_block_to_block (pre, &tse.pre); @@ -4676,7 +4676,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_init_se (&ssse, NULL); gfc_conv_expr (&ssse, expr1); type = gfc_get_character_type_len (gfc_default_character_kind, - ssse.string_length); + ssse.string_length, false); } else { @@ -4689,7 +4689,8 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, expr1->ts.u.cl->backend_decl = tse.expr; } type = gfc_get_character_type_len (gfc_default_character_kind, - expr1->ts.u.cl->backend_decl); + expr1->ts.u.cl->backend_decl, + false); } } else diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 9c9489a42bd..591661c7630 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -1112,32 +1112,52 @@ gfc_get_pchar_type (int kind) } -/* Create a character type with the given kind and length. */ +/* Create a character type with the given kind and length; 'deferred' affects + the following: If 'len' is a variable/non-constant expression, it can be + either for + + * a stack-allocated variable where the length is taken from the outside + ('VLA') (global variable, dummy argument, variable from before a BLOCK) - in + this case, the value on entry needs to be preserved -> SAVE_EXPR. + + * or, 'len' is the hidden variable of a deferred-length ('len=:') variable, + such that the current value after the last pointer-assignment or allocation + must be used. In this case, there shall not be a SAVE_EXPR. */ tree -gfc_get_character_type_len_for_eltype (tree eltype, tree len) +gfc_get_character_type_len_for_eltype (tree eltype, tree len, bool deferred) { tree bounds, type; bounds = build_range_type (gfc_charlen_type_node, gfc_index_one_node, len); type = build_array_type (eltype, bounds); TYPE_STRING_FLAG (type) = 1; - + if (len && deferred && TREE_CODE (TYPE_SIZE (type)) == SAVE_EXPR) + { + /* TODO: A more middle-end friendly alternative would be to use NULL_TREE + as upper bound and store the value elsewhere; caveat: this requires + some cleanup throughout the code to consistently use some wrapper + function. */ + gcc_assert (TREE_CODE (TYPE_SIZE_UNIT (type)) == SAVE_EXPR); + TYPE_SIZE (type) = TREE_OPERAND (TYPE_SIZE (type), 0); + TYPE_SIZE_UNIT (type) = TREE_OPERAND (TYPE_SIZE_UNIT (type), 0); + } return type; } tree -gfc_get_character_type_len (int kind, tree len) +gfc_get_character_type_len (int kind, tree len, bool deferred) { gfc_validate_kind (BT_CHARACTER, kind, false); - return gfc_get_character_type_len_for_eltype (gfc_get_char_type (kind), len); + return gfc_get_character_type_len_for_eltype (gfc_get_char_type (kind), len, + deferred); } /* Get a type node for a character kind. */ tree -gfc_get_character_type (int kind, gfc_charlen * cl) +gfc_get_character_type (int kind, gfc_charlen * cl, bool deferred) { tree len; @@ -1145,7 +1165,7 @@ gfc_get_character_type (int kind, gfc_charlen * cl) if (len && POINTER_TYPE_P (TREE_TYPE (len))) len = build_fold_indirect_ref (len); - return gfc_get_character_type_len (kind, len); + return gfc_get_character_type_len (kind, len, deferred); } /* Convert a basic type. This will be an array for character types. */ @@ -1189,13 +1209,14 @@ gfc_typenode_for_spec (gfc_typespec * spec, int codim) break; case BT_CHARACTER: - basetype = gfc_get_character_type (spec->kind, spec->u.cl); + basetype = gfc_get_character_type (spec->kind, spec->u.cl, + spec->deferred); break; case BT_HOLLERITH: /* Since this cannot be used, return a length one character. */ basetype = gfc_get_character_type_len (gfc_default_character_kind, - gfc_index_one_node); + gfc_index_one_node, false); break; case BT_UNION: diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 2dc692325cf..b2a0375ddfa 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -81,9 +81,9 @@ tree gfc_get_complex_type (int); tree gfc_get_logical_type (int); tree gfc_get_char_type (int); tree gfc_get_pchar_type (int); -tree gfc_get_character_type (int, gfc_charlen *); -tree gfc_get_character_type_len (int, tree); -tree gfc_get_character_type_len_for_eltype (tree, tree); +tree gfc_get_character_type (int, gfc_charlen *, bool); +tree gfc_get_character_type_len (int, tree, bool); +tree gfc_get_character_type_len_for_eltype (tree, tree, bool); tree gfc_sym_type (gfc_symbol *, bool is_bind_c_arg = false); tree gfc_get_cfi_type (int dimen, bool restricted);