* [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) @ 2013-02-24 22:43 Paul Richard Thomas 2013-02-25 9:58 ` Tobias Burnus 2013-03-19 21:17 ` Tobias Burnus 0 siblings, 2 replies; 15+ messages in thread From: Paul Richard Thomas @ 2013-02-24 22:43 UTC (permalink / raw) To: fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 2606 bytes --] Dear All, The attached patch represents progress to date. It fixes the original problem in this PR and allows John Reid's version of iso_varying_string/vocabulary_word_count.f90 to compile and run correctly. It even bootstraps and regtests! However, it doe not fix: PR51976 comment #6 and PR51550 - allocate with typespec ICEs PR51976 comment #6 FORALL assignment is messed up and ICEs.. PR47545 the compiler complains about the lack of an initializer for the hidden character length field. PR45170 will need going through from one end to the other - there is a lot of "stuff" here! Of these, I consider the fix of the PR47545 problem to be a must and the allocate with typespec desirable. Cheers Paul 2013-02-24 Paul Thomas <pault@gcc.gnu.org> PR fortran/51976 * gfortran.h : Add deferred_parameter attribute. * primary.c (build_actual_constructor): It is not an error if a missing component has the deferred_parameter attribute; equally, if one is given a value, it is an error. * resolve.c (resolve_fl_derived0): Remove error for deferred character length components. Add the hidden string length field to the structure. Give it the deferred_parameter attribute. * trans-array.c (duplicate_allocatable): Add a strlen field which is used as the element size if it is non-null. (gfc_duplicate_allocatable, gfc_copy_allocatable_data): Pass a NULL to the new argument in duplicate_allocatable. (structure_alloc_comps): Set the hidden string length as appropriate. Use it in calls to duplicate_allocatable. (gfc_alloc_allocatable_for_assignment): When a deferred length backend declaration is variable, use that; otherwise use the string length from the expression evaluation. * trans-expr.c (gfc_conv_component_ref): If this is a deferred character length component, the string length should have the value of the hidden string length field. (gfc_trans_subcomponent_assign): Set the hidden string length field for deferred character length components. Allocate the necessary memory for the string. (alloc_scalar_allocatable_for_assignment): Same change as in gfc_alloc_allocatable_for_assignment above. * trans-stmt.c (gfc_trans_allocate): Likewise. * trans-types.c (gfc_get_derived_type): Set the tree type for a deferred character length component. * trans.c (gfc_deferred_strlen): New function. * trans.h : Prototype for the new function. 2013-02-24 Paul Thomas <pault@gcc.gnu.org> PR fortran/51976 * gfortran.dg/deferred_type_component_1.f90 : New test. [-- Attachment #2: submit.diff --] [-- Type: application/octet-stream, Size: 17268 bytes --] Index: gcc/fortran/gfortran.h =================================================================== *** gcc/fortran/gfortran.h (revision 196244) --- gcc/fortran/gfortran.h (working copy) *************** typedef struct *** 810,815 **** --- 810,818 ---- /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; + /* Is a parameter associated with a deferred type component. */ + unsigned deferred_parameter:1; + /* The namespace where the attribute has been set. */ struct gfc_namespace *volatile_ns, *asynchronous_ns; } Index: gcc/fortran/primary.c =================================================================== *** gcc/fortran/primary.c (revision 196244) --- gcc/fortran/primary.c (working copy) *************** build_actual_constructor (gfc_structure_ *** 2349,2355 **** } /* If it was not found, try the default initializer if there's any; ! otherwise, it's an error. */ if (!comp_iter) { if (comp->initializer) --- 2349,2355 ---- } /* If it was not found, try the default initializer if there's any; ! otherwise, it's an error unless this is a deferred parameter. */ if (!comp_iter) { if (comp->initializer) *************** build_actual_constructor (gfc_structure_ *** 2360,2366 **** return FAILURE; value = gfc_copy_expr (comp->initializer); } ! else { gfc_error ("No initializer for component '%s' given in the" " structure constructor at %C!", comp->name); --- 2360,2366 ---- return FAILURE; value = gfc_copy_expr (comp->initializer); } ! else if (!comp->attr.deferred_parameter) { gfc_error ("No initializer for component '%s' given in the" " structure constructor at %C!", comp->name); *************** gfc_convert_to_structure_constructor (gf *** 2443,2449 **** { /* Components without name are not allowed after the first named component initializer! */ ! if (!comp) { if (last_name) gfc_error ("Component initializer without name after component" --- 2443,2449 ---- { /* Components without name are not allowed after the first named component initializer! */ ! if (!comp || comp->attr.deferred_parameter) { if (last_name) gfc_error ("Component initializer without name after component" Index: gcc/fortran/resolve.c =================================================================== *** gcc/fortran/resolve.c (revision 196244) --- gcc/fortran/resolve.c (working copy) *************** resolve_fl_derived0 (gfc_symbol *sym) *** 12540,12553 **** if (c->attr.artificial) continue; - /* See PRs 51550, 47545, 48654, 49050, 51075 - and 45170. */ - if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function) - { - gfc_error ("Deferred-length character component '%s' at %L is not " - "yet supported", c->name, &c->loc); - return FAILURE; - } - /* F2008, C442. */ if ((!sym->attr.is_class || c != sym->components) && c->attr.codimension --- 12540,12545 ---- *************** resolve_fl_derived0 (gfc_symbol *sym) *** 12799,12804 **** --- 12791,12815 ---- return FAILURE; } + /* Add the hidden deferred length field. */ + if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function + && !sym->attr.is_class) + { + char name[GFC_MAX_SYMBOL_LEN+1]; + gfc_component *strlen; + sprintf (name, "_%s", c->name); + strlen = gfc_find_component (sym, name, true, true); + if (strlen == NULL) + { + if (gfc_add_component (sym, name, &strlen) == FAILURE) + return FAILURE; + strlen->ts.type = BT_INTEGER; + strlen->ts.kind = gfc_charlen_int_kind; + strlen->attr.access = ACCESS_PRIVATE; + strlen->attr.deferred_parameter = 1; + } + } + if (c->ts.type == BT_DERIVED && sym->component_access != ACCESS_PRIVATE && gfc_check_symbol_access (sym) Index: gcc/fortran/trans-array.c =================================================================== *** gcc/fortran/trans-array.c (revision 196244) --- gcc/fortran/trans-array.c (working copy) *************** get_full_array_size (stmtblock_t *block, *** 7308,7314 **** static tree duplicate_allocatable (tree dest, tree src, tree type, int rank, ! bool no_malloc) { tree tmp; tree size; --- 7308,7314 ---- static tree duplicate_allocatable (tree dest, tree src, tree type, int rank, ! bool no_malloc, tree strlen) { tree tmp; tree size; *************** duplicate_allocatable (tree dest, tree s *** 7329,7334 **** --- 7329,7337 ---- null_data = gfc_finish_block (&block); gfc_init_block (&block); + if (strlen != NULL_TREE) + size = strlen; + else size = TYPE_SIZE_UNIT (TREE_TYPE (type)); if (!no_malloc) { *************** duplicate_allocatable (tree dest, tree s *** 7349,7354 **** --- 7352,7360 ---- gfc_init_block (&block); nelems = get_full_array_size (&block, src, rank); + if (strlen != NULL_TREE) + tmp = fold_convert (gfc_array_index_type, strlen); + else tmp = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (gfc_get_element_type (type))); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, *************** duplicate_allocatable (tree dest, tree s *** 7391,7397 **** tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) { ! return duplicate_allocatable (dest, src, type, rank, false); } --- 7397,7403 ---- tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) { ! return duplicate_allocatable (dest, src, type, rank, false, NULL_TREE); } *************** gfc_duplicate_allocatable (tree dest, tr *** 7400,7406 **** tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank) { ! return duplicate_allocatable (dest, src, type, rank, true); } --- 7406,7412 ---- tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank) { ! return duplicate_allocatable (dest, src, type, rank, true, NULL_TREE); } *************** structure_alloc_comps (gfc_symbol * der_ *** 7637,7642 **** --- 7643,7658 ---- void_type_node, comp, build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&fnblock, tmp); + if (gfc_deferred_strlen (c, &comp)) + { + comp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (comp), + decl, comp, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (comp), comp, + build_int_cst (TREE_TYPE (comp), 0)); + gfc_add_expr_to_block (&fnblock, tmp); + } } else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) { *************** structure_alloc_comps (gfc_symbol * der_ *** 7730,7736 **** continue; } ! if (c->attr.allocatable && !c->attr.proc_pointer && !cmp_has_alloc_comps) { rank = c->as ? c->as->rank : 0; --- 7746,7769 ---- continue; } ! if (gfc_deferred_strlen (c, &tmp)) ! { ! tree len; ! len = tmp; ! tmp = fold_build3_loc (input_location, COMPONENT_REF, ! TREE_TYPE (len), ! decl, len, NULL_TREE); ! len = fold_build3_loc (input_location, COMPONENT_REF, ! TREE_TYPE (len), ! dest, len, NULL_TREE); ! tmp = fold_build2_loc (input_location, MODIFY_EXPR, ! TREE_TYPE (len), len, tmp); ! gfc_add_expr_to_block (&fnblock, tmp); ! tmp = duplicate_allocatable (dcmp, comp, ctype, rank, ! false, len); ! gfc_add_expr_to_block (&fnblock, tmp); ! } ! else if (c->attr.allocatable && !c->attr.proc_pointer && !cmp_has_alloc_comps) { rank = c->as ? c->as->rank : 0; *************** gfc_alloc_allocatable_for_assignment (gf *** 8183,8192 **** /* Get the new lhs size in bytes. */ if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { tmp = expr2->ts.u.cl->backend_decl; - gcc_assert (expr1->ts.u.cl->backend_decl); tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); } else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl) { --- 8216,8239 ---- /* Get the new lhs size in bytes. */ if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { + if (expr2->ts.deferred) + { + if (TREE_CODE (expr2->ts.u.cl->backend_decl) == VAR_DECL) + tmp = expr2->ts.u.cl->backend_decl; + else + tmp = rss->info->string_length; + } + else + { tmp = expr2->ts.u.cl->backend_decl; tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); + } + + if (expr1->ts.u.cl->backend_decl + && TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + else + gfc_add_modify (&fblock, lss->info->string_length, tmp); } else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl) { Index: gcc/fortran/trans-expr.c =================================================================== *** gcc/fortran/trans-expr.c (revision 196244) --- gcc/fortran/trans-expr.c (working copy) *************** gfc_conv_component_ref (gfc_se * se, gfc *** 1589,1594 **** --- 1589,1602 ---- se->string_length = tmp; } + if (gfc_deferred_strlen (c, &field)) + { + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), + decl, field, NULL_TREE); + se->string_length = tmp; + } + if (((c->attr.pointer || c->attr.allocatable) && (!c->attr.dimension && !c->attr.codimension) && c->ts.type != BT_CHARACTER) *************** gfc_trans_subcomponent_assign (tree dest *** 6031,6039 **** gfc_add_expr_to_block (&block, tmp); } } else { ! /* Scalar component. */ gfc_init_se (&se, NULL); gfc_init_se (&lse, NULL); --- 6039,6078 ---- gfc_add_expr_to_block (&block, tmp); } } + else if (gfc_deferred_strlen (cm, &tmp)) + { + tree strlen; + strlen = tmp; + gcc_assert (strlen); + strlen = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (strlen), + TREE_OPERAND (dest, 0), + strlen, NULL_TREE); + + if (expr->expr_type == EXPR_NULL) + { + tmp = build_int_cst (TREE_TYPE (cm->backend_decl), 0); + gfc_add_modify (&block, dest, tmp); + tmp = build_int_cst (TREE_TYPE (strlen), 0); + gfc_add_modify (&block, strlen, tmp); + } else { ! gfc_init_se (&se, NULL); ! gfc_conv_expr (&se, expr); ! tmp = build_call_expr_loc (input_location, ! builtin_decl_explicit (BUILT_IN_MALLOC), ! 1, se.string_length); ! gfc_add_modify (&block, dest, ! fold_convert (TREE_TYPE (dest), tmp)); ! gfc_add_modify (&block, strlen, se.string_length); ! tmp = gfc_build_memcpy_call (dest, se.expr, se.string_length); ! gfc_add_expr_to_block (&block, tmp); ! } ! } ! else if (!cm->attr.deferred_parameter) ! { ! /* Scalar component (excluding deferred parameters). */ gfc_init_se (&se, NULL); gfc_init_se (&lse, NULL); *************** alloc_scalar_allocatable_for_assignment *** 7629,7635 **** --- 7668,7677 ---- /* Update the lhs character length. */ size = string_length; + if (TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size); + else + gfc_add_modify (block, lse.string_length, size); } } Index: gcc/fortran/trans-stmt.c =================================================================== *** gcc/fortran/trans-stmt.c (revision 196244) --- gcc/fortran/trans-stmt.c (working copy) *************** gfc_trans_allocate (gfc_code * code) *** 5009,5014 **** --- 5009,5019 ---- if (tmp && TREE_CODE (tmp) == VAR_DECL) gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), memsz)); + else if (al->expr->ts.type == BT_CHARACTER + && al->expr->ts.deferred && se.string_length) + gfc_add_modify (&se.pre, se.string_length, + fold_convert (TREE_TYPE (se.string_length), + memsz)); /* Convert to size in bytes, using the character KIND. */ if (unlimited_char) Index: gcc/fortran/trans-types.c =================================================================== *** gcc/fortran/trans-types.c (revision 196244) --- gcc/fortran/trans-types.c (working copy) *************** gfc_get_derived_type (gfc_symbol * deriv *** 2482,2493 **** field_type = c->ts.u.derived->backend_decl; else { ! if (c->ts.type == BT_CHARACTER) { /* Evaluate the string length. */ gfc_conv_const_charlen (c->ts.u.cl); gcc_assert (c->ts.u.cl->backend_decl); } field_type = gfc_typenode_for_spec (&c->ts); } --- 2482,2496 ---- field_type = c->ts.u.derived->backend_decl; else { ! if (c->ts.type == BT_CHARACTER && !c->ts.deferred) { /* Evaluate the string length. */ gfc_conv_const_charlen (c->ts.u.cl); gcc_assert (c->ts.u.cl->backend_decl); } + else if (c->ts.type == BT_CHARACTER) + c->ts.u.cl->backend_decl + = build_int_cst (gfc_charlen_type_node, 0); field_type = gfc_typenode_for_spec (&c->ts); } Index: gcc/fortran/trans.c =================================================================== *** gcc/fortran/trans.c (revision 196244) --- gcc/fortran/trans.c (working copy) *************** gfc_likely (tree cond) *** 1843,1845 **** --- 1843,1864 ---- cond = fold_convert (boolean_type_node, cond); return cond; } + + + /* Get the string length for a deferred character length component. */ + + bool + gfc_deferred_strlen (gfc_component *c, tree *decl) + { + char name[GFC_MAX_SYMBOL_LEN+1]; + gfc_component *strlen; + if (!(c->ts.type == BT_CHARACTER && c->ts.deferred)) + return false; + sprintf (name, "_%s", c->name); + for (strlen = c; strlen; strlen = strlen->next) + if (strcmp (strlen->name, name) == 0) + break; + *decl = strlen ? strlen->backend_decl : NULL_TREE; + return strlen != NULL; + } + Index: gcc/fortran/trans.h =================================================================== *** gcc/fortran/trans.h (revision 196244) --- gcc/fortran/trans.h (working copy) *************** bool get_array_ctor_strlen (stmtblock_t *** 578,583 **** --- 578,586 ---- tree gfc_likely (tree); tree gfc_unlikely (tree); + /* Return the string length of a deferred character length component. */ + bool gfc_deferred_strlen (gfc_component *, tree *); + /* Generate a runtime error call. */ tree gfc_trans_runtime_error (bool, locus*, const char*, ...); Index: gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 =================================================================== *** gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 (revision 0) --- gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 (working copy) *************** *** 0 **** --- 1,54 ---- + ! { dg-do run } + ! Test fix for PR51976 - introduce deferred character length components + ! + ! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + ! + type t + character(len=:), allocatable :: str_comp + character(len=:), allocatable :: str_comp1 + end type t + type(t) :: x + type(t), allocatable, dimension(:) :: array + + ! Check scalars + allocate (x%str_comp, source = "abc") + call check (x%str_comp, "abc") + deallocate (x%str_comp) + allocate (x%str_comp, source = "abcdefghijklmnop") + call check (x%str_comp, "abcdefghijklmnop") + x%str_comp = "xyz" + call check (x%str_comp, "xyz") + x%str_comp = "abcdefghijklmnop" + x%str_comp1 = "lmnopqrst" + call foo (x%str_comp1, "lmnopqrst") + call bar (x, "abcdefghijklmnop", "lmnopqrst") + + ! Check arrays and structure constructors + allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")]) + call check (array(1)%str_comp, "abcedefg") + call check (array(1)%str_comp1, "hi") + call check (array(2)%str_comp, "jkl") + call check (array(2)%str_comp1, "mnop") + deallocate (array) + allocate (array(3), source = [x, x, x]) + array(2)%str_comp = "blooey" + call bar (array(1), "abcdefghijklmnop", "lmnopqrst") + call bar (array(2), "blooey", "lmnopqrst") + call bar (array(3), "abcdefghijklmnop", "lmnopqrst") + contains + subroutine foo (chr1, chr2) + character (*) :: chr1, chr2 + call check (chr1, chr2) + end subroutine + subroutine bar (a, chr1, chr2) + character (*) :: chr1, chr2 + type(t) :: a + call check (a%str_comp, chr1) + call check (a%str_comp1, chr2) + end subroutine + subroutine check (chr1, chr2) + character (*) :: chr1, chr2 + if (len(chr1) .ne. len (chr2)) call abort + if (chr1 .ne. chr2) call abort + end subroutine + end ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2013-02-24 22:43 [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) Paul Richard Thomas @ 2013-02-25 9:58 ` Tobias Burnus 2013-03-19 21:17 ` Tobias Burnus 1 sibling, 0 replies; 15+ messages in thread From: Tobias Burnus @ 2013-02-25 9:58 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: fortran, gcc-patches Paul Richard Thomas wrote: > The attached patch represents progress to date. It fixes the original > problem in this PR and allows John Reid's version of > iso_varying_string/vocabulary_word_count.f90 to compile and run > correctly. It even bootstraps and regtests! Great! It seems as if 4.9 will get a much-wished feature soon after 4.8 is branched. > + /* Is a parameter associated with a deferred type component. */ > + unsigned deferred_parameter:1; I quickly glanced at the patch and I am still not sure what "deferred_parameter" is exactly doing nor what "parameter" means in this context. I know a named constant ("PARAMETER") and (kind/length) type parameters of intrinsic types and (via "kind" and "len") derived types. Can you make it a bit clearer what this attribute is good for? – Do you need to handle it in module.c or in dump-parse-tree.c? (A while later) Looking at the patch a bit more carefully, "deferred_parameter" seems to be set for the hidden length component to a deferred-length character component. I think it is not really a (type) parameter; maybe "deferred_length_comp"? > /* If it was not found, try the default initializer if there's any; > ! otherwise, it's an error. */ > if (!comp_iter) > { > if (comp->initializer) > --- 2349,2355 ---- > /* If it was not found, try the default initializer if there's any; > ! otherwise, it's an error unless this is a deferred parameter. */ "a hidden deferred-length component"? > + /* Add the hidden deferred length field. */ Or "field" ;-) Otherwise, it looks okay to me – but I have not yet fully studied the patch nor applied and tried to break it ;-) For instance, trying "select type(comp%str); case (character(len=*); print *, len(comp%str)" where "str" is "class(*)". Tobias ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2013-02-24 22:43 [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) Paul Richard Thomas 2013-02-25 9:58 ` Tobias Burnus @ 2013-03-19 21:17 ` Tobias Burnus 2014-02-19 15:16 ` Janus Weil 1 sibling, 1 reply; 15+ messages in thread From: Tobias Burnus @ 2013-03-19 21:17 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 1485 bytes --] Dear Paul, dear all, On February 24, 2013 Paul Richard Thomas wrote: > The attached patch represents progress to date. It fixes the original > problem in this PR and allows John Reid's version of > iso_varying_string/vocabulary_word_count.f90 to compile and run > correctly. It even bootstraps and regtests! Attached is a re-diffed patch; I have additionally fixed some indenting issues. Additionally, I have tested the patch - and it fails with deferred-length *array* character components. See attached test case. Also, the following line of the included test case leaks memory: allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")]) I think at least the array bug should be fixed prior committal. (Fixing the memory leak and some of the below-mentioned issues would be nice, too.) Otherwise, I think the patch looks fine. For completeness, I have some naming remarks, which I would also like to considered: http://thread.gmane.org/gmane.comp.gcc.fortran/40393/focus=281580 Tobias > However, it doe not fix: > PR51976 comment #6 and PR51550 - allocate with typespec ICEs > PR51976 comment #6 FORALL assignment is messed up and ICEs.. > PR47545 the compiler complains about the lack of an initializer for > the hidden character length field. > PR45170 will need going through from one end to the other - there is a > lot of "stuff" here! > > Of these, I consider the fix of the PR47545 problem to be a must and > the allocate with typespec desirable. [-- Attachment #2: foo.f90 --] [-- Type: text/x-fortran, Size: 506 bytes --] type t character(len=:), pointer :: p(:) character(len=:), allocatable :: a(:) end type t type(T) :: x character(len=5), target :: y(2) y = ["abc","def"] x%p => y x%a = y print '(">",a,"<")', x%p ! Doesn't print anything print '(">",a,"<")', x%a ! Doesn't print anything print '(">",a,"<")', x%p(1) ! Doesn't print anything print '(">",a,"<")', x%p(2) ! Doesn't print anything print '(">",a,"<")', x%a(1) ! Prints "def " (expected: "abc ") print '(">",a,"<")', x%a(2) ! Prints "def " (okay) end [-- Attachment #3: deferred-len-comp.diff --] [-- Type: text/x-patch, Size: 16857 bytes --] 2013-03-19 Paul Thomas <pault <at> gcc.gnu.org> PR fortran/51976 * gfortran.h : Add deferred_parameter attribute. * primary.c (build_actual_constructor): It is not an error if a missing component has the deferred_parameter attribute; equally, if one is given a value, it is an error. * resolve.c (resolve_fl_derived0): Remove error for deferred character length components. Add the hidden string length field to the structure. Give it the deferred_parameter attribute. * trans-array.c (duplicate_allocatable): Add a strlen field which is used as the element size if it is non-null. (gfc_duplicate_allocatable, gfc_copy_allocatable_data): Pass a NULL to the new argument in duplicate_allocatable. (structure_alloc_comps): Set the hidden string length as appropriate. Use it in calls to duplicate_allocatable. (gfc_alloc_allocatable_for_assignment): When a deferred length backend declaration is variable, use that; otherwise use the string length from the expression evaluation. * trans-expr.c (gfc_conv_component_ref): If this is a deferred character length component, the string length should have the value of the hidden string length field. (gfc_trans_subcomponent_assign): Set the hidden string length field for deferred character length components. Allocate the necessary memory for the string. (alloc_scalar_allocatable_for_assignment): Same change as in gfc_alloc_allocatable_for_assignment above. * trans-stmt.c (gfc_trans_allocate): Likewise. * trans-types.c (gfc_get_derived_type): Set the tree type for a deferred character length component. * trans.c (gfc_deferred_strlen): New function. * trans.h : Prototype for the new function. 2013-03-19 Paul Thomas <pault <at> gcc.gnu.org> PR fortran/51976 * gfortran.dg/deferred_type_component_1.f90 : New test. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 76d2797..6956d33 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -811,6 +811,9 @@ typedef struct /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; + /* Is a parameter associated with a deferred type component. */ + unsigned deferred_parameter:1; + /* The namespace where the attribute has been set. */ struct gfc_namespace *volatile_ns, *asynchronous_ns; } diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index d149224..34a55b5 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2349,7 +2349,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, } /* If it was not found, try the default initializer if there's any; - otherwise, it's an error. */ + otherwise, it's an error unless this is a deferred parameter. */ if (!comp_iter) { if (comp->initializer) @@ -2360,7 +2360,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, return FAILURE; value = gfc_copy_expr (comp->initializer); } - else + else if (!comp->attr.deferred_parameter) { gfc_error ("No initializer for component '%s' given in the" " structure constructor at %C!", comp->name); @@ -2443,7 +2443,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c { /* Components without name are not allowed after the first named component initializer! */ - if (!comp) + if (!comp || comp->attr.deferred_parameter) { if (last_name) gfc_error ("Component initializer without name after component" diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e9b6fb9..f70a749 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12539,14 +12539,6 @@ resolve_fl_derived0 (gfc_symbol *sym) if (c->attr.artificial) continue; - /* See PRs 51550, 47545, 48654, 49050, 51075 - and 45170. */ - if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function) - { - gfc_error ("Deferred-length character component '%s' at %L is not " - "yet supported", c->name, &c->loc); - return FAILURE; - } - /* F2008, C442. */ if ((!sym->attr.is_class || c != sym->components) && c->attr.codimension @@ -12798,6 +12790,25 @@ resolve_fl_derived0 (gfc_symbol *sym) return FAILURE; } + /* Add the hidden deferred length field. */ + if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function + && !sym->attr.is_class) + { + char name[GFC_MAX_SYMBOL_LEN+1]; + gfc_component *strlen; + sprintf (name, "_%s", c->name); + strlen = gfc_find_component (sym, name, true, true); + if (strlen == NULL) + { + if (gfc_add_component (sym, name, &strlen) == FAILURE) + return FAILURE; + strlen->ts.type = BT_INTEGER; + strlen->ts.kind = gfc_charlen_int_kind; + strlen->attr.access = ACCESS_PRIVATE; + strlen->attr.deferred_parameter = 1; + } + } + if (c->ts.type == BT_DERIVED && sym->component_access != ACCESS_PRIVATE && gfc_check_symbol_access (sym) diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 75fed2f..7a2d5de 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7308,7 +7308,7 @@ get_full_array_size (stmtblock_t *block, tree decl, int rank) static tree duplicate_allocatable (tree dest, tree src, tree type, int rank, - bool no_malloc) + bool no_malloc, tree strlen) { tree tmp; tree size; @@ -7329,7 +7329,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, null_data = gfc_finish_block (&block); gfc_init_block (&block); - size = TYPE_SIZE_UNIT (TREE_TYPE (type)); + if (strlen != NULL_TREE) + size = strlen; + else + size = TYPE_SIZE_UNIT (TREE_TYPE (type)); + if (!no_malloc) { tmp = gfc_call_malloc (&block, type, size); @@ -7349,8 +7353,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, gfc_init_block (&block); nelems = get_full_array_size (&block, src, rank); - tmp = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); + if (strlen != NULL_TREE) + tmp = fold_convert (gfc_array_index_type, strlen); + else + tmp = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, nelems, tmp); if (!no_malloc) @@ -7391,7 +7398,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, false); + return duplicate_allocatable (dest, src, type, rank, false, NULL_TREE); } @@ -7400,7 +7407,7 @@ gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, true); + return duplicate_allocatable (dest, src, type, rank, true, NULL_TREE); } @@ -7637,6 +7644,16 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, void_type_node, comp, build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&fnblock, tmp); + if (gfc_deferred_strlen (c, &comp)) + { + comp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (comp), + decl, comp, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (comp), comp, + build_int_cst (TREE_TYPE (comp), 0)); + gfc_add_expr_to_block (&fnblock, tmp); + } } else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) { @@ -7730,8 +7747,25 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, continue; } - if (c->attr.allocatable && !c->attr.proc_pointer - && !cmp_has_alloc_comps) + if (gfc_deferred_strlen (c, &tmp)) + { + tree len; + len = tmp; + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (len), + decl, len, NULL_TREE); + len = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (len), + dest, len, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (len), len, tmp); + gfc_add_expr_to_block (&fnblock, tmp); + tmp = duplicate_allocatable (dcmp, comp, ctype, rank, + false, len); + gfc_add_expr_to_block (&fnblock, tmp); + } + else if (c->attr.allocatable && !c->attr.proc_pointer + && !cmp_has_alloc_comps) { rank = c->as ? c->as->rank : 0; tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank); @@ -8183,10 +8217,24 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Get the new lhs size in bytes. */ if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { - tmp = expr2->ts.u.cl->backend_decl; - gcc_assert (expr1->ts.u.cl->backend_decl); - tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); - gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + if (expr2->ts.deferred) + { + if (TREE_CODE (expr2->ts.u.cl->backend_decl) == VAR_DECL) + tmp = expr2->ts.u.cl->backend_decl; + else + tmp = rss->info->string_length; + } + else + { + tmp = expr2->ts.u.cl->backend_decl; + tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); + } + + if (expr1->ts.u.cl->backend_decl + && TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + else + gfc_add_modify (&fblock, lss->info->string_length, tmp); } else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl) { diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 2c3ff1f..c73741d 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1589,6 +1589,14 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref) se->string_length = tmp; } + if (gfc_deferred_strlen (c, &field)) + { + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), + decl, field, NULL_TREE); + se->string_length = tmp; + } + if (((c->attr.pointer || c->attr.allocatable) && (!c->attr.dimension && !c->attr.codimension) && c->ts.type != BT_CHARACTER) @@ -6031,9 +6039,40 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr) gfc_add_expr_to_block (&block, tmp); } } - else + else if (gfc_deferred_strlen (cm, &tmp)) + { + tree strlen; + strlen = tmp; + gcc_assert (strlen); + strlen = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (strlen), + TREE_OPERAND (dest, 0), + strlen, NULL_TREE); + + if (expr->expr_type == EXPR_NULL) + { + tmp = build_int_cst (TREE_TYPE (cm->backend_decl), 0); + gfc_add_modify (&block, dest, tmp); + tmp = build_int_cst (TREE_TYPE (strlen), 0); + gfc_add_modify (&block, strlen, tmp); + } + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, expr); + tmp = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_MALLOC), + 1, se.string_length); + gfc_add_modify (&block, dest, + fold_convert (TREE_TYPE (dest), tmp)); + gfc_add_modify (&block, strlen, se.string_length); + tmp = gfc_build_memcpy_call (dest, se.expr, se.string_length); + gfc_add_expr_to_block (&block, tmp); + } + } + else if (!cm->attr.deferred_parameter) { - /* Scalar component. */ + /* Scalar component (excluding deferred parameters). */ gfc_init_se (&se, NULL); gfc_init_se (&lse, NULL); @@ -7629,7 +7668,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block, /* Update the lhs character length. */ size = string_length; - gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size); + if (TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size); + else + gfc_add_modify (block, lse.string_length, size); } } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 430b10e..aad0139 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5009,6 +5009,11 @@ gfc_trans_allocate (gfc_code * code) if (tmp && TREE_CODE (tmp) == VAR_DECL) gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), memsz)); + else if (al->expr->ts.type == BT_CHARACTER + && al->expr->ts.deferred && se.string_length) + gfc_add_modify (&se.pre, se.string_length, + fold_convert (TREE_TYPE (se.string_length), + memsz)); /* Convert to size in bytes, using the character KIND. */ if (unlimited_char) diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index cdac0da..cda26ab 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2479,12 +2479,15 @@ gfc_get_derived_type (gfc_symbol * derived) field_type = c->ts.u.derived->backend_decl; else { - if (c->ts.type == BT_CHARACTER) + if (c->ts.type == BT_CHARACTER && !c->ts.deferred) { /* Evaluate the string length. */ gfc_conv_const_charlen (c->ts.u.cl); gcc_assert (c->ts.u.cl->backend_decl); } + else if (c->ts.type == BT_CHARACTER) + c->ts.u.cl->backend_decl + = build_int_cst (gfc_charlen_type_node, 0); field_type = gfc_typenode_for_spec (&c->ts); } diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index d7bdf26..986213a 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1843,3 +1843,21 @@ gfc_likely (tree cond) cond = fold_convert (boolean_type_node, cond); return cond; } + + +/* Get the string length for a deferred character length component. */ + +bool +gfc_deferred_strlen (gfc_component *c, tree *decl) +{ + char name[GFC_MAX_SYMBOL_LEN+1]; + gfc_component *strlen; + if (!(c->ts.type == BT_CHARACTER && c->ts.deferred)) + return false; + sprintf (name, "_%s", c->name); + for (strlen = c; strlen; strlen = strlen->next) + if (strcmp (strlen->name, name) == 0) + break; + *decl = strlen ? strlen->backend_decl : NULL_TREE; + return strlen != NULL; +} diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 03adfdd..95c1864 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -578,6 +578,9 @@ bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor_base, tree *); tree gfc_likely (tree); tree gfc_unlikely (tree); +/* Return the string length of a deferred character length component. */ +bool gfc_deferred_strlen (gfc_component *, tree *); + /* Generate a runtime error call. */ tree gfc_trans_runtime_error (bool, locus*, const char*, ...); diff --git a/gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 b/gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 new file mode 100644 index 0000000..17d1ac0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 @@ -0,0 +1,54 @@ +! { dg-do run } +! Test fix for PR51976 - introduce deferred character length components +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> +! + type t + character(len=:), allocatable :: str_comp + character(len=:), allocatable :: str_comp1 + end type t + type(t) :: x + type(t), allocatable, dimension(:) :: array + +! Check scalars + allocate (x%str_comp, source = "abc") + call check (x%str_comp, "abc") + deallocate (x%str_comp) + allocate (x%str_comp, source = "abcdefghijklmnop") + call check (x%str_comp, "abcdefghijklmnop") + x%str_comp = "xyz" + call check (x%str_comp, "xyz") + x%str_comp = "abcdefghijklmnop" + x%str_comp1 = "lmnopqrst" + call foo (x%str_comp1, "lmnopqrst") + call bar (x, "abcdefghijklmnop", "lmnopqrst") + +! Check arrays and structure constructors + allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")]) + call check (array(1)%str_comp, "abcedefg") + call check (array(1)%str_comp1, "hi") + call check (array(2)%str_comp, "jkl") + call check (array(2)%str_comp1, "mnop") + deallocate (array) + allocate (array(3), source = [x, x, x]) + array(2)%str_comp = "blooey" + call bar (array(1), "abcdefghijklmnop", "lmnopqrst") + call bar (array(2), "blooey", "lmnopqrst") + call bar (array(3), "abcdefghijklmnop", "lmnopqrst") +contains + subroutine foo (chr1, chr2) + character (*) :: chr1, chr2 + call check (chr1, chr2) + end subroutine + subroutine bar (a, chr1, chr2) + character (*) :: chr1, chr2 + type(t) :: a + call check (a%str_comp, chr1) + call check (a%str_comp1, chr2) + end subroutine + subroutine check (chr1, chr2) + character (*) :: chr1, chr2 + if (len(chr1) .ne. len (chr2)) call abort + if (chr1 .ne. chr2) call abort + end subroutine +end ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2013-03-19 21:17 ` Tobias Burnus @ 2014-02-19 15:16 ` Janus Weil 2014-02-19 15:51 ` Janus Weil 0 siblings, 1 reply; 15+ messages in thread From: Janus Weil @ 2014-02-19 15:16 UTC (permalink / raw) To: Tobias Burnus; +Cc: Paul Richard Thomas, fortran, gcc-patches Hi all, the patch below has been posted a long time ago, but was never actually committed (although it seems close to being finished). Could it still be considered for trunk? I think it is a rather popular feature, which would be helpful for many users ... Cheers, Janus 2013-03-19 22:17 GMT+01:00 Tobias Burnus <burnus@net-b.de>: > Dear Paul, dear all, > > > On February 24, 2013 Paul Richard Thomas wrote: >> >> The attached patch represents progress to date. It fixes the original >> problem in this PR and allows John Reid's version of >> iso_varying_string/vocabulary_word_count.f90 to compile and run >> correctly. It even bootstraps and regtests! > > > Attached is a re-diffed patch; I have additionally fixed some indenting > issues. > > Additionally, I have tested the patch - and it fails with deferred-length > *array* character components. See attached test case. Also, the following > line of the included test case leaks memory: > allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")]) > > I think at least the array bug should be fixed prior committal. (Fixing the > memory leak and some of the below-mentioned issues would be nice, too.) > Otherwise, I think the patch looks fine. For completeness, I have some > naming remarks, which I would also like to considered: > http://thread.gmane.org/gmane.comp.gcc.fortran/40393/focus=281580 > > Tobias > > >> However, it doe not fix: >> PR51976 comment #6 and PR51550 - allocate with typespec ICEs >> PR51976 comment #6 FORALL assignment is messed up and ICEs.. >> PR47545 the compiler complains about the lack of an initializer for >> the hidden character length field. >> PR45170 will need going through from one end to the other - there is a >> lot of "stuff" here! >> >> Of these, I consider the fix of the PR47545 problem to be a must and >> the allocate with typespec desirable. ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2014-02-19 15:16 ` Janus Weil @ 2014-02-19 15:51 ` Janus Weil 2014-02-19 21:24 ` Paul Richard Thomas 2014-02-22 15:39 ` Mikael Morin 0 siblings, 2 replies; 15+ messages in thread From: Janus Weil @ 2014-02-19 15:51 UTC (permalink / raw) To: Tobias Burnus; +Cc: Paul Richard Thomas, fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 2447 bytes --] The patch was not applying cleanly any more, so here is a re-diffed version for current trunk. It works nicely on the included test case as well as the one provided by Walter Spector in comment 12 of the PR. Since, also in the current state, "character(:)" works only in a subset of all cases, I think it cannot hurt to add more cases that work for 4.9 (even if still not all possible cases work). Please let me know what you think ... Cheers, Janus 2014-02-19 16:16 GMT+01:00 Janus Weil <janus@gcc.gnu.org>: > Hi all, > > the patch below has been posted a long time ago, but was never > actually committed (although it seems close to being finished). > > Could it still be considered for trunk? I think it is a rather popular > feature, which would be helpful for many users ... > > Cheers, > Janus > > > > 2013-03-19 22:17 GMT+01:00 Tobias Burnus <burnus@net-b.de>: >> Dear Paul, dear all, >> >> >> On February 24, 2013 Paul Richard Thomas wrote: >>> >>> The attached patch represents progress to date. It fixes the original >>> problem in this PR and allows John Reid's version of >>> iso_varying_string/vocabulary_word_count.f90 to compile and run >>> correctly. It even bootstraps and regtests! >> >> >> Attached is a re-diffed patch; I have additionally fixed some indenting >> issues. >> >> Additionally, I have tested the patch - and it fails with deferred-length >> *array* character components. See attached test case. Also, the following >> line of the included test case leaks memory: >> allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")]) >> >> I think at least the array bug should be fixed prior committal. (Fixing the >> memory leak and some of the below-mentioned issues would be nice, too.) >> Otherwise, I think the patch looks fine. For completeness, I have some >> naming remarks, which I would also like to considered: >> http://thread.gmane.org/gmane.comp.gcc.fortran/40393/focus=281580 >> >> Tobias >> >> >>> However, it doe not fix: >>> PR51976 comment #6 and PR51550 - allocate with typespec ICEs >>> PR51976 comment #6 FORALL assignment is messed up and ICEs.. >>> PR47545 the compiler complains about the lack of an initializer for >>> the hidden character length field. >>> PR45170 will need going through from one end to the other - there is a >>> lot of "stuff" here! >>> >>> Of these, I consider the fix of the PR47545 problem to be a must and >>> the allocate with typespec desirable. [-- Attachment #2: deferred-len-comp_2014-02-19.diff --] [-- Type: text/plain, Size: 15151 bytes --] Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 207896) +++ gcc/fortran/gfortran.h (working copy) @@ -811,6 +811,9 @@ typedef struct /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; + /* Is a parameter associated with a deferred type component. */ + unsigned deferred_parameter:1; + /* The namespace where the attribute has been set. */ struct gfc_namespace *volatile_ns, *asynchronous_ns; } Index: gcc/fortran/primary.c =================================================================== --- gcc/fortran/primary.c (revision 207896) +++ gcc/fortran/primary.c (working copy) @@ -2355,7 +2355,7 @@ build_actual_constructor (gfc_structure_ctor_compo } /* If it was not found, try the default initializer if there's any; - otherwise, it's an error. */ + otherwise, it's an error unless this is a deferred parameter. */ if (!comp_iter) { if (comp->initializer) @@ -2365,7 +2365,7 @@ build_actual_constructor (gfc_structure_ctor_compo return false; value = gfc_copy_expr (comp->initializer); } - else + else if (!comp->attr.deferred_parameter) { gfc_error ("No initializer for component '%s' given in the" " structure constructor at %C!", comp->name); @@ -2447,7 +2447,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, { /* Components without name are not allowed after the first named component initializer! */ - if (!comp) + if (!comp || comp->attr.deferred_parameter) { if (last_name) gfc_error ("Component initializer without name after component" Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 207896) +++ gcc/fortran/resolve.c (working copy) @@ -12105,14 +12105,6 @@ resolve_fl_derived0 (gfc_symbol *sym) if (c->attr.artificial) continue; - /* See PRs 51550, 47545, 48654, 49050, 51075 - and 45170. */ - if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function) - { - gfc_error ("Deferred-length character component '%s' at %L is not " - "yet supported", c->name, &c->loc); - return false; - } - /* F2008, C442. */ if ((!sym->attr.is_class || c != sym->components) && c->attr.codimension @@ -12364,6 +12356,25 @@ resolve_fl_derived0 (gfc_symbol *sym) return false; } + /* Add the hidden deferred length field. */ + if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function + && !sym->attr.is_class) + { + char name[GFC_MAX_SYMBOL_LEN+1]; + gfc_component *strlen; + sprintf (name, "_%s", c->name); + strlen = gfc_find_component (sym, name, true, true); + if (strlen == NULL) + { + if (!gfc_add_component (sym, name, &strlen)) + return false; + strlen->ts.type = BT_INTEGER; + strlen->ts.kind = gfc_charlen_int_kind; + strlen->attr.access = ACCESS_PRIVATE; + strlen->attr.deferred_parameter = 1; + } + } + if (c->ts.type == BT_DERIVED && sym->component_access != ACCESS_PRIVATE && gfc_check_symbol_access (sym) Index: gcc/fortran/trans-array.c =================================================================== --- gcc/fortran/trans-array.c (revision 207896) +++ gcc/fortran/trans-array.c (working copy) @@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl static tree duplicate_allocatable (tree dest, tree src, tree type, int rank, - bool no_malloc) + bool no_malloc, tree strlen) { tree tmp; tree size; @@ -7386,7 +7386,11 @@ duplicate_allocatable (tree dest, tree src, tree t null_data = gfc_finish_block (&block); gfc_init_block (&block); - size = TYPE_SIZE_UNIT (TREE_TYPE (type)); + if (strlen != NULL_TREE) + size = strlen; + else + size = TYPE_SIZE_UNIT (TREE_TYPE (type)); + if (!no_malloc) { tmp = gfc_call_malloc (&block, type, size); @@ -7410,8 +7414,11 @@ duplicate_allocatable (tree dest, tree src, tree t else nelems = gfc_index_one_node; - tmp = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); + if (strlen != NULL_TREE) + tmp = fold_convert (gfc_array_index_type, strlen); + else + tmp = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, nelems, tmp); if (!no_malloc) @@ -7452,7 +7459,7 @@ duplicate_allocatable (tree dest, tree src, tree t tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, false); + return duplicate_allocatable (dest, src, type, rank, false, NULL_TREE); } @@ -7461,7 +7468,7 @@ gfc_duplicate_allocatable (tree dest, tree src, tr tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, true); + return duplicate_allocatable (dest, src, type, rank, true, NULL_TREE); } @@ -7718,6 +7725,16 @@ structure_alloc_comps (gfc_symbol * der_type, tree void_type_node, comp, build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&fnblock, tmp); + if (gfc_deferred_strlen (c, &comp)) + { + comp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (comp), + decl, comp, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (comp), comp, + build_int_cst (TREE_TYPE (comp), 0)); + gfc_add_expr_to_block (&fnblock, tmp); + } } else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) { @@ -7855,9 +7872,26 @@ structure_alloc_comps (gfc_symbol * der_type, tree continue; } - if (c->attr.allocatable && !c->attr.proc_pointer - && !cmp_has_alloc_comps) + if (gfc_deferred_strlen (c, &tmp)) { + tree len; + len = tmp; + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (len), + decl, len, NULL_TREE); + len = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (len), + dest, len, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (len), len, tmp); + gfc_add_expr_to_block (&fnblock, tmp); + tmp = duplicate_allocatable (dcmp, comp, ctype, rank, + false, len); + gfc_add_expr_to_block (&fnblock, tmp); + } + else if (c->attr.allocatable && !c->attr.proc_pointer + && !cmp_has_alloc_comps) + { rank = c->as ? c->as->rank : 0; if (c->attr.codimension) tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank); @@ -8342,10 +8376,24 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo /* Get the new lhs size in bytes. */ if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { - tmp = expr2->ts.u.cl->backend_decl; - gcc_assert (expr1->ts.u.cl->backend_decl); - tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); - gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + if (expr2->ts.deferred) + { + if (TREE_CODE (expr2->ts.u.cl->backend_decl) == VAR_DECL) + tmp = expr2->ts.u.cl->backend_decl; + else + tmp = rss->info->string_length; + } + else + { + tmp = expr2->ts.u.cl->backend_decl; + tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); + } + + if (expr1->ts.u.cl->backend_decl + && TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + else + gfc_add_modify (&fblock, lss->info->string_length, tmp); } else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl) { Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (revision 207896) +++ gcc/fortran/trans-expr.c (working copy) @@ -1689,6 +1689,14 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref se->string_length = tmp; } + if (gfc_deferred_strlen (c, &field)) + { + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), + decl, field, NULL_TREE); + se->string_length = tmp; + } + if (((c->attr.pointer || c->attr.allocatable) && (!c->attr.dimension && !c->attr.codimension) && c->ts.type != BT_CHARACTER) @@ -6043,9 +6051,40 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp gfc_add_expr_to_block (&block, tmp); } } - else + else if (gfc_deferred_strlen (cm, &tmp)) { - /* Scalar component. */ + tree strlen; + strlen = tmp; + gcc_assert (strlen); + strlen = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (strlen), + TREE_OPERAND (dest, 0), + strlen, NULL_TREE); + + if (expr->expr_type == EXPR_NULL) + { + tmp = build_int_cst (TREE_TYPE (cm->backend_decl), 0); + gfc_add_modify (&block, dest, tmp); + tmp = build_int_cst (TREE_TYPE (strlen), 0); + gfc_add_modify (&block, strlen, tmp); + } + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, expr); + tmp = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_MALLOC), + 1, se.string_length); + gfc_add_modify (&block, dest, + fold_convert (TREE_TYPE (dest), tmp)); + gfc_add_modify (&block, strlen, se.string_length); + tmp = gfc_build_memcpy_call (dest, se.expr, se.string_length); + gfc_add_expr_to_block (&block, tmp); + } + } + else if (!cm->attr.deferred_parameter) + { + /* Scalar component (excluding deferred parameters). */ gfc_init_se (&se, NULL); gfc_init_se (&lse, NULL); @@ -7747,7 +7786,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock /* Update the lhs character length. */ size = string_length; - gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size); + if (TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size); + else + gfc_add_modify (block, lse.string_length, size); } } Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (revision 207896) +++ gcc/fortran/trans-stmt.c (working copy) @@ -5028,6 +5028,11 @@ gfc_trans_allocate (gfc_code * code) if (tmp && TREE_CODE (tmp) == VAR_DECL) gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), memsz)); + else if (al->expr->ts.type == BT_CHARACTER + && al->expr->ts.deferred && se.string_length) + gfc_add_modify (&se.pre, se.string_length, + fold_convert (TREE_TYPE (se.string_length), + memsz)); /* Convert to size in bytes, using the character KIND. */ if (unlimited_char) Index: gcc/fortran/trans-types.c =================================================================== --- gcc/fortran/trans-types.c (revision 207896) +++ gcc/fortran/trans-types.c (working copy) @@ -2486,12 +2486,15 @@ gfc_get_derived_type (gfc_symbol * derived) field_type = c->ts.u.derived->backend_decl; else { - if (c->ts.type == BT_CHARACTER) + if (c->ts.type == BT_CHARACTER && !c->ts.deferred) { /* Evaluate the string length. */ gfc_conv_const_charlen (c->ts.u.cl); gcc_assert (c->ts.u.cl->backend_decl); } + else if (c->ts.type == BT_CHARACTER) + c->ts.u.cl->backend_decl + = build_int_cst (gfc_charlen_type_node, 0); field_type = gfc_typenode_for_spec (&c->ts); } Index: gcc/fortran/trans.c =================================================================== --- gcc/fortran/trans.c (revision 207896) +++ gcc/fortran/trans.c (working copy) @@ -2044,3 +2044,21 @@ gfc_likely (tree cond) cond = fold_convert (boolean_type_node, cond); return cond; } + + +/* Get the string length for a deferred character length component. */ + +bool +gfc_deferred_strlen (gfc_component *c, tree *decl) +{ + char name[GFC_MAX_SYMBOL_LEN+1]; + gfc_component *strlen; + if (!(c->ts.type == BT_CHARACTER && c->ts.deferred)) + return false; + sprintf (name, "_%s", c->name); + for (strlen = c; strlen; strlen = strlen->next) + if (strcmp (strlen->name, name) == 0) + break; + *decl = strlen ? strlen->backend_decl : NULL_TREE; + return strlen != NULL; +} Index: gcc/fortran/trans.h =================================================================== --- gcc/fortran/trans.h (revision 207896) +++ gcc/fortran/trans.h (working copy) @@ -581,6 +581,9 @@ bool get_array_ctor_strlen (stmtblock_t *, gfc_con tree gfc_likely (tree); tree gfc_unlikely (tree); +/* Return the string length of a deferred character length component. */ +bool gfc_deferred_strlen (gfc_component *, tree *); + /* Generate a runtime error call. */ tree gfc_trans_runtime_error (bool, locus*, const char*, ...); Index: gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 (working copy) @@ -0,0 +1,54 @@ +! { dg-do run } +! Test fix for PR51976 - introduce deferred character length components +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> +! + type t + character(len=:), allocatable :: str_comp + character(len=:), allocatable :: str_comp1 + end type t + type(t) :: x + type(t), allocatable, dimension(:) :: array + +! Check scalars + allocate (x%str_comp, source = "abc") + call check (x%str_comp, "abc") + deallocate (x%str_comp) + allocate (x%str_comp, source = "abcdefghijklmnop") + call check (x%str_comp, "abcdefghijklmnop") + x%str_comp = "xyz" + call check (x%str_comp, "xyz") + x%str_comp = "abcdefghijklmnop" + x%str_comp1 = "lmnopqrst" + call foo (x%str_comp1, "lmnopqrst") + call bar (x, "abcdefghijklmnop", "lmnopqrst") + +! Check arrays and structure constructors + allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")]) + call check (array(1)%str_comp, "abcedefg") + call check (array(1)%str_comp1, "hi") + call check (array(2)%str_comp, "jkl") + call check (array(2)%str_comp1, "mnop") + deallocate (array) + allocate (array(3), source = [x, x, x]) + array(2)%str_comp = "blooey" + call bar (array(1), "abcdefghijklmnop", "lmnopqrst") + call bar (array(2), "blooey", "lmnopqrst") + call bar (array(3), "abcdefghijklmnop", "lmnopqrst") +contains + subroutine foo (chr1, chr2) + character (*) :: chr1, chr2 + call check (chr1, chr2) + end subroutine + subroutine bar (a, chr1, chr2) + character (*) :: chr1, chr2 + type(t) :: a + call check (a%str_comp, chr1) + call check (a%str_comp1, chr2) + end subroutine + subroutine check (chr1, chr2) + character (*) :: chr1, chr2 + if (len(chr1) .ne. len (chr2)) call abort + if (chr1 .ne. chr2) call abort + end subroutine +end ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2014-02-19 15:51 ` Janus Weil @ 2014-02-19 21:24 ` Paul Richard Thomas 2014-02-19 22:23 ` Tobias Burnus 2014-02-22 15:39 ` Mikael Morin 1 sibling, 1 reply; 15+ messages in thread From: Paul Richard Thomas @ 2014-02-19 21:24 UTC (permalink / raw) To: Janus Weil; +Cc: Tobias Burnus, fortran, gcc-patches Dear Janus, I had completely forgotten about this patch... I even thought that it had been applied :-) I'll have time, either tomorrow evening or Saturday to take a look. After nearly 11 months, a couple more days will not hurt! Thanks for bringing it to my attention. Paul On 19 February 2014 16:51, Janus Weil <janus@gcc.gnu.org> wrote: > The patch was not applying cleanly any more, so here is a re-diffed > version for current trunk. It works nicely on the included test case > as well as the one provided by Walter Spector in comment 12 of the PR. > > Since, also in the current state, "character(:)" works only in a > subset of all cases, I think it cannot hurt to add more cases that > work for 4.9 (even if still not all possible cases work). > > Please let me know what you think ... > > Cheers, > Janus > > > > > 2014-02-19 16:16 GMT+01:00 Janus Weil <janus@gcc.gnu.org>: >> Hi all, >> >> the patch below has been posted a long time ago, but was never >> actually committed (although it seems close to being finished). >> >> Could it still be considered for trunk? I think it is a rather popular >> feature, which would be helpful for many users ... >> >> Cheers, >> Janus >> >> >> >> 2013-03-19 22:17 GMT+01:00 Tobias Burnus <burnus@net-b.de>: >>> Dear Paul, dear all, >>> >>> >>> On February 24, 2013 Paul Richard Thomas wrote: >>>> >>>> The attached patch represents progress to date. It fixes the original >>>> problem in this PR and allows John Reid's version of >>>> iso_varying_string/vocabulary_word_count.f90 to compile and run >>>> correctly. It even bootstraps and regtests! >>> >>> >>> Attached is a re-diffed patch; I have additionally fixed some indenting >>> issues. >>> >>> Additionally, I have tested the patch - and it fails with deferred-length >>> *array* character components. See attached test case. Also, the following >>> line of the included test case leaks memory: >>> allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")]) >>> >>> I think at least the array bug should be fixed prior committal. (Fixing the >>> memory leak and some of the below-mentioned issues would be nice, too.) >>> Otherwise, I think the patch looks fine. For completeness, I have some >>> naming remarks, which I would also like to considered: >>> http://thread.gmane.org/gmane.comp.gcc.fortran/40393/focus=281580 >>> >>> Tobias >>> >>> >>>> However, it doe not fix: >>>> PR51976 comment #6 and PR51550 - allocate with typespec ICEs >>>> PR51976 comment #6 FORALL assignment is messed up and ICEs.. >>>> PR47545 the compiler complains about the lack of an initializer for >>>> the hidden character length field. >>>> PR45170 will need going through from one end to the other - there is a >>>> lot of "stuff" here! >>>> >>>> Of these, I consider the fix of the PR47545 problem to be a must and >>>> the allocate with typespec desirable. -- The knack of flying is learning how to throw yourself at the ground and miss. --Hitchhikers Guide to the Galaxy ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2014-02-19 21:24 ` Paul Richard Thomas @ 2014-02-19 22:23 ` Tobias Burnus 0 siblings, 0 replies; 15+ messages in thread From: Tobias Burnus @ 2014-02-19 22:23 UTC (permalink / raw) To: Paul Richard Thomas, Janus Weil; +Cc: fortran, gcc-patches Hi Paul, Paul Richard Thomas wrote: > I had completely forgotten about this patch... I even thought that it > had been applied :-) I'll have time, either tomorrow evening or Saturday to take a look. > After nearly 11 months, a couple more days will not hurt! I think it went as follows: We found out that some code doesn't - in particular code which uses array-valued deferred-length characters. After trying to fix it, you (Paul) decided that the simplest way to fix it would be the new array descriptor - and then it got stuck. Regarding this patch, I have mixed feelings. I think it is a much wished feature - but I am not sure about the stability of the patch and it is rather large, given that we are in stage 4. Regarding the new array descriptor: I think it would be useful if we could get the new descriptor working early in the GCC 4.10/5.0/2015 development stage. I think the main large task is to convert all all remaining stride-based code to stride-multiplier code without breaking vectorization and causing other regressions. Additionally, it would be nice to get rid of "offset" - and have in the descriptor always an lower_bound of 0, except for pointers/allocatables (cf. TS29113). I think the version on the branch is in a relatively good shape; however, the stride and offset changes seem to be of such a kind that one needs to modify several code locations simultaneously - otherwise, it will break badly. Additionally, all remaining regressions have to be fixed. When that's done, adding some extra field is all what's needed. (As follow up, enough remains to be done: I'd like to use it for all class(*), possibly even for nonarray class(type), assumed-rank needs an update, assumed-shape/-rank/deferred-shape character arrays also have to be adapted (also mandated by TS29113 for interop). And we should do an ABI cleanup in libgfortran as we have now the chance to break the ABI.) - Is anyone volunteering? Also planned for GCC post-4.9: Getting an initial really working coarray version. (Besides more mundane tasks like finishing finalization, completing OOP or ...) Tobias ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2014-02-19 15:51 ` Janus Weil 2014-02-19 21:24 ` Paul Richard Thomas @ 2014-02-22 15:39 ` Mikael Morin 2014-02-22 15:58 ` Steve Kargl 2014-03-01 15:58 ` Janus Weil 1 sibling, 2 replies; 15+ messages in thread From: Mikael Morin @ 2014-02-22 15:39 UTC (permalink / raw) To: Janus Weil, Tobias Burnus; +Cc: Paul Richard Thomas, fortran, gcc-patches Le 19/02/2014 16:51, Janus Weil a écrit : > The patch was not applying cleanly any more, so here is a re-diffed > version for current trunk. It works nicely on the included test case > as well as the one provided by Walter Spector in comment 12 of the PR. > > Since, also in the current state, "character(:)" works only in a > subset of all cases, I think it cannot hurt to add more cases that > work for 4.9 (even if still not all possible cases work). > > Please let me know what you think ... > > Cheers, > Janus > Review: > PR fortran/51976 > * gfortran.h : Add deferred_parameter attribute. Add the name of the struct before ':' like "(struct symbol_attribute)" or maybe just "(symbol_attribute)" > * trans.c (gfc_deferred_strlen): New function. > * trans.h : Prototype for the new function. This is really nitpicking but "(gfc_deferred_strlen)" should be in front of trans.h as well. Now regarding the patch itself, I don't know character handling very well, but it seems to me that the patch makes the (wrong) assumption that characters are of default kind, so that string length is the same as memory size. Namely: > Index: gcc/fortran/trans-array.c > =================================================================== > --- gcc/fortran/trans-array.c (revision 207896) > +++ gcc/fortran/trans-array.c (working copy) > @@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl > > static tree > duplicate_allocatable (tree dest, tree src, tree type, int rank, > - bool no_malloc) > + bool no_malloc, tree strlen) > { > tree tmp; > tree size; > @@ -7386,7 +7386,11 @@ duplicate_allocatable (tree dest, tree src, tree t > null_data = gfc_finish_block (&block); > > gfc_init_block (&block); > - size = TYPE_SIZE_UNIT (TREE_TYPE (type)); > + if (strlen != NULL_TREE) > + size = strlen; > + else > + size = TYPE_SIZE_UNIT (TREE_TYPE (type)); > + here... > if (!no_malloc) > { > tmp = gfc_call_malloc (&block, type, size); > @@ -7410,8 +7414,11 @@ duplicate_allocatable (tree dest, tree src, tree t > else > nelems = gfc_index_one_node; > > - tmp = fold_convert (gfc_array_index_type, > - TYPE_SIZE_UNIT (gfc_get_element_type (type))); > + if (strlen != NULL_TREE) > + tmp = fold_convert (gfc_array_index_type, strlen); > + else > + tmp = fold_convert (gfc_array_index_type, > + TYPE_SIZE_UNIT (gfc_get_element_type (type))); ... and/or here, > size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, > nelems, tmp); > if (!no_malloc) > Index: gcc/fortran/trans-expr.c > =================================================================== > --- gcc/fortran/trans-expr.c (revision 207896) > +++ gcc/fortran/trans-expr.c (working copy) > @@ -6043,9 +6051,40 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp > gfc_add_expr_to_block (&block, tmp); > } > } > - else > + else if (gfc_deferred_strlen (cm, &tmp)) > { > - /* Scalar component. */ > + tree strlen; > + strlen = tmp; > + gcc_assert (strlen); > + strlen = fold_build3_loc (input_location, COMPONENT_REF, > + TREE_TYPE (strlen), > + TREE_OPERAND (dest, 0), > + strlen, NULL_TREE); > + > + if (expr->expr_type == EXPR_NULL) > + { > + tmp = build_int_cst (TREE_TYPE (cm->backend_decl), 0); > + gfc_add_modify (&block, dest, tmp); > + tmp = build_int_cst (TREE_TYPE (strlen), 0); > + gfc_add_modify (&block, strlen, tmp); > + } > + else > + { > + gfc_init_se (&se, NULL); > + gfc_conv_expr (&se, expr); > + tmp = build_call_expr_loc (input_location, > + builtin_decl_explicit (BUILT_IN_MALLOC), > + 1, se.string_length); here, > + gfc_add_modify (&block, dest, > + fold_convert (TREE_TYPE (dest), tmp)); > + gfc_add_modify (&block, strlen, se.string_length); > + tmp = gfc_build_memcpy_call (dest, se.expr, se.string_length); > + gfc_add_expr_to_block (&block, tmp); > + } > + } > + else if (!cm->attr.deferred_parameter) > + { > + /* Scalar component (excluding deferred parameters). */ > gfc_init_se (&se, NULL); > gfc_init_se (&lse, NULL); > > Index: gcc/fortran/trans-stmt.c > =================================================================== > --- gcc/fortran/trans-stmt.c (revision 207896) > +++ gcc/fortran/trans-stmt.c (working copy) > @@ -5028,6 +5028,11 @@ gfc_trans_allocate (gfc_code * code) > if (tmp && TREE_CODE (tmp) == VAR_DECL) > gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), > memsz)); > + else if (al->expr->ts.type == BT_CHARACTER > + && al->expr->ts.deferred && se.string_length) > + gfc_add_modify (&se.pre, se.string_length, > + fold_convert (TREE_TYPE (se.string_length), > + memsz)); > and here. There may be other places that I have missed. > /* Convert to size in bytes, using the character KIND. */ > if (unlimited_char) As the patch seems to provide a wanted feature, and as the new code seems to be properly guarded, I'm not against it after the above has been checked and fixed if necessary. Mikael > Index: gcc/fortran/trans.c > =================================================================== > --- gcc/fortran/trans.c (revision 207896) > +++ gcc/fortran/trans.c (working copy) > @@ -2044,3 +2044,21 @@ gfc_likely (tree cond) > cond = fold_convert (boolean_type_node, cond); > return cond; > } > + > + > +/* Get the string length for a deferred character length component. */ > + > +bool > +gfc_deferred_strlen (gfc_component *c, tree *decl) > +{ > + char name[GFC_MAX_SYMBOL_LEN+1]; > + gfc_component *strlen; > + if (!(c->ts.type == BT_CHARACTER && c->ts.deferred)) > + return false; > + sprintf (name, "_%s", c->name); > + for (strlen = c; strlen; strlen = strlen->next) > + if (strcmp (strlen->name, name) == 0) > + break; maybe gfc_find_component could be used here. > + *decl = strlen ? strlen->backend_decl : NULL_TREE; > + return strlen != NULL; > +} ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2014-02-22 15:39 ` Mikael Morin @ 2014-02-22 15:58 ` Steve Kargl 2014-03-01 15:58 ` Janus Weil 1 sibling, 0 replies; 15+ messages in thread From: Steve Kargl @ 2014-02-22 15:58 UTC (permalink / raw) To: Mikael Morin Cc: Janus Weil, Tobias Burnus, Paul Richard Thomas, fortran, gcc-patches On Sat, Feb 22, 2014 at 04:38:52PM +0100, Mikael Morin wrote: > > + > > +bool > > +gfc_deferred_strlen (gfc_component *c, tree *decl) > > +{ > > + char name[GFC_MAX_SYMBOL_LEN+1]; Shouldn't this be +2? > > + gfc_component *strlen; > > + if (!(c->ts.type == BT_CHARACTER && c->ts.deferred)) > > + return false; > > + sprintf (name, "_%s", c->name); One for NULL termination and one for '_' character. > > + for (strlen = c; strlen; strlen = strlen->next) > > + if (strcmp (strlen->name, name) == 0) > > + break; > maybe gfc_find_component could be used here. > > > + *decl = strlen ? strlen->backend_decl : NULL_TREE; > > + return strlen != NULL; > > +} -- Steve ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2014-02-22 15:39 ` Mikael Morin 2014-02-22 15:58 ` Steve Kargl @ 2014-03-01 15:58 ` Janus Weil 2014-03-05 9:50 ` Mikael Morin 1 sibling, 1 reply; 15+ messages in thread From: Janus Weil @ 2014-03-01 15:58 UTC (permalink / raw) To: Mikael Morin; +Cc: Tobias Burnus, Paul Richard Thomas, fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 8475 bytes --] Hi Mikael, hi all, 2014-02-22 16:38 GMT+01:00 Mikael Morin <mikael.morin@sfr.fr>: > Le 19/02/2014 16:51, Janus Weil a écrit : >> The patch was not applying cleanly any more, so here is a re-diffed >> version for current trunk. It works nicely on the included test case >> as well as the one provided by Walter Spector in comment 12 of the PR. >> >> Since, also in the current state, "character(:)" works only in a >> subset of all cases, I think it cannot hurt to add more cases that >> work for 4.9 (even if still not all possible cases work). >> >> Please let me know what you think ... > > Review: > >> PR fortran/51976 >> * gfortran.h : Add deferred_parameter attribute. > Add the name of the struct before ':' > like "(struct symbol_attribute)" or maybe just "(symbol_attribute)" > >> * trans.c (gfc_deferred_strlen): New function. >> * trans.h : Prototype for the new function. > This is really nitpicking but "(gfc_deferred_strlen)" should be in front > of trans.h as well. Done. > Now regarding the patch itself, I don't know character handling very > well, but it seems to me that the patch makes the (wrong) assumption > that characters are of default kind, so that string length is the same > as memory size. > Namely: > >> Index: gcc/fortran/trans-array.c >> =================================================================== >> --- gcc/fortran/trans-array.c (revision 207896) >> +++ gcc/fortran/trans-array.c (working copy) >> @@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl >> >> static tree >> duplicate_allocatable (tree dest, tree src, tree type, int rank, >> - bool no_malloc) >> + bool no_malloc, tree strlen) >> { >> tree tmp; >> tree size; >> @@ -7386,7 +7386,11 @@ duplicate_allocatable (tree dest, tree src, tree t >> null_data = gfc_finish_block (&block); >> >> gfc_init_block (&block); >> - size = TYPE_SIZE_UNIT (TREE_TYPE (type)); >> + if (strlen != NULL_TREE) >> + size = strlen; >> + else >> + size = TYPE_SIZE_UNIT (TREE_TYPE (type)); >> + > here... Fixed (but actually in the code which calls duplicate_allocatable). >> size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, >> nelems, tmp); >> if (!no_malloc) >> Index: gcc/fortran/trans-expr.c >> =================================================================== >> --- gcc/fortran/trans-expr.c (revision 207896) >> +++ gcc/fortran/trans-expr.c (working copy) >> @@ -6043,9 +6051,40 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp >> gfc_add_expr_to_block (&block, tmp); >> } >> } >> - else >> + else if (gfc_deferred_strlen (cm, &tmp)) >> { >> - /* Scalar component. */ >> + tree strlen; >> + strlen = tmp; >> + gcc_assert (strlen); >> + strlen = fold_build3_loc (input_location, COMPONENT_REF, >> + TREE_TYPE (strlen), >> + TREE_OPERAND (dest, 0), >> + strlen, NULL_TREE); >> + >> + if (expr->expr_type == EXPR_NULL) >> + { >> + tmp = build_int_cst (TREE_TYPE (cm->backend_decl), 0); >> + gfc_add_modify (&block, dest, tmp); >> + tmp = build_int_cst (TREE_TYPE (strlen), 0); >> + gfc_add_modify (&block, strlen, tmp); >> + } >> + else >> + { >> + gfc_init_se (&se, NULL); >> + gfc_conv_expr (&se, expr); >> + tmp = build_call_expr_loc (input_location, >> + builtin_decl_explicit (BUILT_IN_MALLOC), >> + 1, se.string_length); > here, Also fixed (again by using size_of_string_in_bytes). >> + gfc_add_modify (&block, dest, >> + fold_convert (TREE_TYPE (dest), tmp)); >> + gfc_add_modify (&block, strlen, se.string_length); >> + tmp = gfc_build_memcpy_call (dest, se.expr, se.string_length); >> + gfc_add_expr_to_block (&block, tmp); >> + } >> + } >> + else if (!cm->attr.deferred_parameter) >> + { >> + /* Scalar component (excluding deferred parameters). */ >> gfc_init_se (&se, NULL); >> gfc_init_se (&lse, NULL); >> >> Index: gcc/fortran/trans-stmt.c >> =================================================================== >> --- gcc/fortran/trans-stmt.c (revision 207896) >> +++ gcc/fortran/trans-stmt.c (working copy) >> @@ -5028,6 +5028,11 @@ gfc_trans_allocate (gfc_code * code) >> if (tmp && TREE_CODE (tmp) == VAR_DECL) >> gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), >> memsz)); >> + else if (al->expr->ts.type == BT_CHARACTER >> + && al->expr->ts.deferred && se.string_length) >> + gfc_add_modify (&se.pre, se.string_length, >> + fold_convert (TREE_TYPE (se.string_length), >> + memsz)); >> > and here. There may be other places that I have missed. Actually I don't see a problem here. Also no further modifications were necessary to get a KIND=4 example to work. >> /* Convert to size in bytes, using the character KIND. */ >> if (unlimited_char) > > As the patch seems to provide a wanted feature, and as the new code > seems to be properly guarded, I'm not against it after the above has > been checked and fixed if necessary. Attached is a new version of the patch which fixes the above-mentioned problems and should make the non-default-kind cases work. I have added a KIND=4 version of the original test case, which seems to work properly. The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk? Btw, there was quite some user feedback along the lines of "we want this feature", but there was not a lot of actual testing. So, if you are interested in this feature, please try the patch and report back here with things like "I tested it and it works great on my 100kLOC code" or "I tested it and found the following problem ..." Cheers, Janus 2014-03-01 Paul Thomas <pault <at> gcc.gnu.org> Janus Weil <janus@gcc.gnu.org> PR fortran/51976 * gfortran.h (symbol_attribute): Add deferred_parameter attribute. * primary.c (build_actual_constructor): It is not an error if a missing component has the deferred_parameter attribute; equally, if one is given a value, it is an error. * resolve.c (resolve_fl_derived0): Remove error for deferred character length components. Add the hidden string length field to the structure. Give it the deferred_parameter attribute. * trans-array.c (duplicate_allocatable): Add a strlen field which is used as the element size if it is non-null. (gfc_duplicate_allocatable, gfc_copy_allocatable_data): Pass a NULL to the new argument in duplicate_allocatable. (structure_alloc_comps): Set the hidden string length as appropriate. Use it in calls to duplicate_allocatable. (gfc_alloc_allocatable_for_assignment): When a deferred length backend declaration is variable, use that; otherwise use the string length from the expression evaluation. * trans-expr.c (gfc_conv_component_ref): If this is a deferred character length component, the string length should have the value of the hidden string length field. (gfc_trans_subcomponent_assign): Set the hidden string length field for deferred character length components. Allocate the necessary memory for the string. (alloc_scalar_allocatable_for_assignment): Same change as in gfc_alloc_allocatable_for_assignment above. * trans-stmt.c (gfc_trans_allocate): Likewise. * trans-intrinsic (size_of_string_in_bytes): Make non-static. * trans-types.c (gfc_get_derived_type): Set the tree type for a deferred character length component. * trans.c (gfc_deferred_strlen): New function. * trans.h (size_of_string_in_bytes,gfc_deferred_strlen): New prototypes. 2014-03-01 Paul Thomas <pault <at> gcc.gnu.org> Janus Weil <janus@gcc.gnu.org> PR fortran/51976 * gfortran.dg/deferred_type_component_1.f90 : New test. * gfortran.dg/deferred_type_component_2.f90 : New test. [-- Attachment #2: deferred-len-comp_2014-03-01.diff --] [-- Type: text/plain, Size: 18409 bytes --] Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 208241) +++ gcc/fortran/gfortran.h (working copy) @@ -811,6 +811,9 @@ typedef struct /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; + /* Is a parameter associated with a deferred type component. */ + unsigned deferred_parameter:1; + /* The namespace where the attribute has been set. */ struct gfc_namespace *volatile_ns, *asynchronous_ns; } Index: gcc/fortran/primary.c =================================================================== --- gcc/fortran/primary.c (revision 208241) +++ gcc/fortran/primary.c (working copy) @@ -2355,7 +2355,7 @@ build_actual_constructor (gfc_structure_ctor_compo } /* If it was not found, try the default initializer if there's any; - otherwise, it's an error. */ + otherwise, it's an error unless this is a deferred parameter. */ if (!comp_iter) { if (comp->initializer) @@ -2365,7 +2365,7 @@ build_actual_constructor (gfc_structure_ctor_compo return false; value = gfc_copy_expr (comp->initializer); } - else + else if (!comp->attr.deferred_parameter) { gfc_error ("No initializer for component '%s' given in the" " structure constructor at %C!", comp->name); @@ -2447,7 +2447,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, { /* Components without name are not allowed after the first named component initializer! */ - if (!comp) + if (!comp || comp->attr.deferred_parameter) { if (last_name) gfc_error ("Component initializer without name after component" Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 208241) +++ gcc/fortran/resolve.c (working copy) @@ -12105,14 +12105,6 @@ resolve_fl_derived0 (gfc_symbol *sym) if (c->attr.artificial) continue; - /* See PRs 51550, 47545, 48654, 49050, 51075 - and 45170. */ - if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function) - { - gfc_error ("Deferred-length character component '%s' at %L is not " - "yet supported", c->name, &c->loc); - return false; - } - /* F2008, C442. */ if ((!sym->attr.is_class || c != sym->components) && c->attr.codimension @@ -12364,6 +12356,25 @@ resolve_fl_derived0 (gfc_symbol *sym) return false; } + /* Add the hidden deferred length field. */ + if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function + && !sym->attr.is_class) + { + char name[GFC_MAX_SYMBOL_LEN+1]; + gfc_component *strlen; + sprintf (name, "_%s", c->name); + strlen = gfc_find_component (sym, name, true, true); + if (strlen == NULL) + { + if (!gfc_add_component (sym, name, &strlen)) + return false; + strlen->ts.type = BT_INTEGER; + strlen->ts.kind = gfc_charlen_int_kind; + strlen->attr.access = ACCESS_PRIVATE; + strlen->attr.deferred_parameter = 1; + } + } + if (c->ts.type == BT_DERIVED && sym->component_access != ACCESS_PRIVATE && gfc_check_symbol_access (sym) Index: gcc/fortran/trans-array.c =================================================================== --- gcc/fortran/trans-array.c (revision 208241) +++ gcc/fortran/trans-array.c (working copy) @@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl static tree duplicate_allocatable (tree dest, tree src, tree type, int rank, - bool no_malloc) + bool no_malloc, tree str_sz) { tree tmp; tree size; @@ -7386,7 +7386,11 @@ duplicate_allocatable (tree dest, tree src, tree t null_data = gfc_finish_block (&block); gfc_init_block (&block); - size = TYPE_SIZE_UNIT (TREE_TYPE (type)); + if (str_sz != NULL_TREE) + size = str_sz; + else + size = TYPE_SIZE_UNIT (TREE_TYPE (type)); + if (!no_malloc) { tmp = gfc_call_malloc (&block, type, size); @@ -7410,8 +7414,11 @@ duplicate_allocatable (tree dest, tree src, tree t else nelems = gfc_index_one_node; - tmp = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); + if (str_sz != NULL_TREE) + tmp = fold_convert (gfc_array_index_type, str_sz); + else + tmp = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, nelems, tmp); if (!no_malloc) @@ -7452,7 +7459,7 @@ duplicate_allocatable (tree dest, tree src, tree t tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, false); + return duplicate_allocatable (dest, src, type, rank, false, NULL_TREE); } @@ -7461,7 +7468,7 @@ gfc_duplicate_allocatable (tree dest, tree src, tr tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, true); + return duplicate_allocatable (dest, src, type, rank, true, NULL_TREE); } @@ -7718,6 +7725,16 @@ structure_alloc_comps (gfc_symbol * der_type, tree void_type_node, comp, build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&fnblock, tmp); + if (gfc_deferred_strlen (c, &comp)) + { + comp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (comp), + decl, comp, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (comp), comp, + build_int_cst (TREE_TYPE (comp), 0)); + gfc_add_expr_to_block (&fnblock, tmp); + } } else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) { @@ -7855,9 +7872,27 @@ structure_alloc_comps (gfc_symbol * der_type, tree continue; } - if (c->attr.allocatable && !c->attr.proc_pointer - && !cmp_has_alloc_comps) + if (gfc_deferred_strlen (c, &tmp)) { + tree len, size; + len = tmp; + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (len), + decl, len, NULL_TREE); + len = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (len), + dest, len, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (len), len, tmp); + gfc_add_expr_to_block (&fnblock, tmp); + size = size_of_string_in_bytes (c->ts.kind, len); + tmp = duplicate_allocatable (dcmp, comp, ctype, rank, + false, size); + gfc_add_expr_to_block (&fnblock, tmp); + } + else if (c->attr.allocatable && !c->attr.proc_pointer + && !cmp_has_alloc_comps) + { rank = c->as ? c->as->rank : 0; if (c->attr.codimension) tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank); @@ -8342,10 +8377,24 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo /* Get the new lhs size in bytes. */ if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { - tmp = expr2->ts.u.cl->backend_decl; - gcc_assert (expr1->ts.u.cl->backend_decl); - tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); - gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + if (expr2->ts.deferred) + { + if (TREE_CODE (expr2->ts.u.cl->backend_decl) == VAR_DECL) + tmp = expr2->ts.u.cl->backend_decl; + else + tmp = rss->info->string_length; + } + else + { + tmp = expr2->ts.u.cl->backend_decl; + tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); + } + + if (expr1->ts.u.cl->backend_decl + && TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + else + gfc_add_modify (&fblock, lss->info->string_length, tmp); } else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl) { Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (revision 208241) +++ gcc/fortran/trans-expr.c (working copy) @@ -1689,6 +1689,14 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref se->string_length = tmp; } + if (gfc_deferred_strlen (c, &field)) + { + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), + decl, field, NULL_TREE); + se->string_length = tmp; + } + if (((c->attr.pointer || c->attr.allocatable) && (!c->attr.dimension && !c->attr.codimension) && c->ts.type != BT_CHARACTER) @@ -6043,9 +6051,42 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp gfc_add_expr_to_block (&block, tmp); } } - else + else if (gfc_deferred_strlen (cm, &tmp)) { - /* Scalar component. */ + tree strlen; + strlen = tmp; + gcc_assert (strlen); + strlen = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (strlen), + TREE_OPERAND (dest, 0), + strlen, NULL_TREE); + + if (expr->expr_type == EXPR_NULL) + { + tmp = build_int_cst (TREE_TYPE (cm->backend_decl), 0); + gfc_add_modify (&block, dest, tmp); + tmp = build_int_cst (TREE_TYPE (strlen), 0); + gfc_add_modify (&block, strlen, tmp); + } + else + { + tree size; + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, expr); + size = size_of_string_in_bytes (cm->ts.kind, se.string_length); + tmp = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_MALLOC), + 1, size); + gfc_add_modify (&block, dest, + fold_convert (TREE_TYPE (dest), tmp)); + gfc_add_modify (&block, strlen, se.string_length); + tmp = gfc_build_memcpy_call (dest, se.expr, size); + gfc_add_expr_to_block (&block, tmp); + } + } + else if (!cm->attr.deferred_parameter) + { + /* Scalar component (excluding deferred parameters). */ gfc_init_se (&se, NULL); gfc_init_se (&lse, NULL); @@ -7747,7 +7788,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock /* Update the lhs character length. */ size = string_length; - gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size); + if (TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size); + else + gfc_add_modify (block, lse.string_length, size); } } Index: gcc/fortran/trans-intrinsic.c =================================================================== --- gcc/fortran/trans-intrinsic.c (revision 208241) +++ gcc/fortran/trans-intrinsic.c (working copy) @@ -5166,7 +5166,7 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * e excluding the terminating null characters. The result has gfc_array_index_type type. */ -static tree +tree size_of_string_in_bytes (int kind, tree string_length) { tree bytesize; Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (revision 208241) +++ gcc/fortran/trans-stmt.c (working copy) @@ -5028,6 +5028,11 @@ gfc_trans_allocate (gfc_code * code) if (tmp && TREE_CODE (tmp) == VAR_DECL) gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), memsz)); + else if (al->expr->ts.type == BT_CHARACTER + && al->expr->ts.deferred && se.string_length) + gfc_add_modify (&se.pre, se.string_length, + fold_convert (TREE_TYPE (se.string_length), + memsz)); /* Convert to size in bytes, using the character KIND. */ if (unlimited_char) Index: gcc/fortran/trans-types.c =================================================================== --- gcc/fortran/trans-types.c (revision 208241) +++ gcc/fortran/trans-types.c (working copy) @@ -2486,12 +2486,15 @@ gfc_get_derived_type (gfc_symbol * derived) field_type = c->ts.u.derived->backend_decl; else { - if (c->ts.type == BT_CHARACTER) + if (c->ts.type == BT_CHARACTER && !c->ts.deferred) { /* Evaluate the string length. */ gfc_conv_const_charlen (c->ts.u.cl); gcc_assert (c->ts.u.cl->backend_decl); } + else if (c->ts.type == BT_CHARACTER) + c->ts.u.cl->backend_decl + = build_int_cst (gfc_charlen_type_node, 0); field_type = gfc_typenode_for_spec (&c->ts); } Index: gcc/fortran/trans.c =================================================================== --- gcc/fortran/trans.c (revision 208241) +++ gcc/fortran/trans.c (working copy) @@ -2044,3 +2044,21 @@ gfc_likely (tree cond) cond = fold_convert (boolean_type_node, cond); return cond; } + + +/* Get the string length for a deferred character length component. */ + +bool +gfc_deferred_strlen (gfc_component *c, tree *decl) +{ + char name[GFC_MAX_SYMBOL_LEN+1]; + gfc_component *strlen; + if (!(c->ts.type == BT_CHARACTER && c->ts.deferred)) + return false; + sprintf (name, "_%s", c->name); + for (strlen = c; strlen; strlen = strlen->next) + if (strcmp (strlen->name, name) == 0) + break; + *decl = strlen ? strlen->backend_decl : NULL_TREE; + return strlen != NULL; +} Index: gcc/fortran/trans.h =================================================================== --- gcc/fortran/trans.h (revision 208241) +++ gcc/fortran/trans.h (working copy) @@ -422,6 +422,8 @@ tree gfc_evaluate_now (tree, stmtblock_t *); /* Find the appropriate variant of a math intrinsic. */ tree gfc_builtin_decl_for_float_kind (enum built_in_function, int); +tree size_of_string_in_bytes (int, tree); + /* Intrinsic procedure handling. */ tree gfc_conv_intrinsic_subroutine (gfc_code *); void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *); @@ -581,6 +583,9 @@ bool get_array_ctor_strlen (stmtblock_t *, gfc_con tree gfc_likely (tree); tree gfc_unlikely (tree); +/* Return the string length of a deferred character length component. */ +bool gfc_deferred_strlen (gfc_component *, tree *); + /* Generate a runtime error call. */ tree gfc_trans_runtime_error (bool, locus*, const char*, ...); Index: gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 (working copy) @@ -0,0 +1,60 @@ +! { dg-do run } +! +! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length) +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + + type t + character(len=:), allocatable :: str_comp + character(len=:), allocatable :: str_comp1 + end type t + type(t) :: x + type(t), allocatable, dimension(:) :: array + + ! Check scalars + allocate (x%str_comp, source = "abc") + call check (x%str_comp, "abc") + deallocate (x%str_comp) + allocate (x%str_comp, source = "abcdefghijklmnop") + call check (x%str_comp, "abcdefghijklmnop") + x%str_comp = "xyz" + call check (x%str_comp, "xyz") + x%str_comp = "abcdefghijklmnop" + x%str_comp1 = "lmnopqrst" + call foo (x%str_comp1, "lmnopqrst") + call bar (x, "abcdefghijklmnop", "lmnopqrst") + + ! Check arrays and structure constructors + allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")]) + call check (array(1)%str_comp, "abcedefg") + call check (array(1)%str_comp1, "hi") + call check (array(2)%str_comp, "jkl") + call check (array(2)%str_comp1, "mnop") + deallocate (array) + allocate (array(3), source = [x, x, x]) + array(2)%str_comp = "blooey" + call bar (array(1), "abcdefghijklmnop", "lmnopqrst") + call bar (array(2), "blooey", "lmnopqrst") + call bar (array(3), "abcdefghijklmnop", "lmnopqrst") + +contains + + subroutine foo (chr1, chr2) + character (*) :: chr1, chr2 + call check (chr1, chr2) + end subroutine + + subroutine bar (a, chr1, chr2) + character (*) :: chr1, chr2 + type(t) :: a + call check (a%str_comp, chr1) + call check (a%str_comp1, chr2) + end subroutine + + subroutine check (chr1, chr2) + character (*) :: chr1, chr2 + if (len(chr1) .ne. len (chr2)) call abort + if (chr1 .ne. chr2) call abort + end subroutine + +end Index: gcc/testsuite/gfortran.dg/deferred_type_component_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/deferred_type_component_2.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/deferred_type_component_2.f90 (working copy) @@ -0,0 +1,60 @@ +! { dg-do run } +! +! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length) +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + + type t + character(len=:,kind=4), allocatable :: str_comp + character(len=:,kind=4), allocatable :: str_comp1 + end type t + type(t) :: x + type(t), allocatable, dimension(:) :: array + + ! Check scalars + allocate (x%str_comp, source = 4_"abc") + call check (x%str_comp, 4_"abc") + deallocate (x%str_comp) + allocate (x%str_comp, source = 4_"abcdefghijklmnop") + call check (x%str_comp, 4_"abcdefghijklmnop") + x%str_comp = 4_"xyz" + call check (x%str_comp, 4_"xyz") + x%str_comp = 4_"abcdefghijklmnop" + x%str_comp1 = 4_"lmnopqrst" + call foo (x%str_comp1, 4_"lmnopqrst") + call bar (x, 4_"abcdefghijklmnop", 4_"lmnopqrst") + + ! Check arrays and structure constructors + allocate (array(2), source = [t(4_"abcedefg",4_"hi"), t(4_"jkl",4_"mnop")]) + call check (array(1)%str_comp, 4_"abcedefg") + call check (array(1)%str_comp1, 4_"hi") + call check (array(2)%str_comp, 4_"jkl") + call check (array(2)%str_comp1, 4_"mnop") + deallocate (array) + allocate (array(3), source = [x, x, x]) + array(2)%str_comp = 4_"blooey" + call bar (array(1), 4_"abcdefghijklmnop", 4_"lmnopqrst") + call bar (array(2), 4_"blooey", 4_"lmnopqrst") + call bar (array(3), 4_"abcdefghijklmnop", 4_"lmnopqrst") + +contains + + subroutine foo (chr1, chr2) + character (len=*,kind=4) :: chr1, chr2 + call check (chr1, chr2) + end subroutine + + subroutine bar (a, chr1, chr2) + character (len=*,kind=4) :: chr1, chr2 + type(t) :: a + call check (a%str_comp, chr1) + call check (a%str_comp1, chr2) + end subroutine + + subroutine check (chr1, chr2) + character (len=*,kind=4) :: chr1, chr2 + if (len(chr1) .ne. len (chr2)) call abort + if (chr1 .ne. chr2) call abort + end subroutine + +end ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2014-03-01 15:58 ` Janus Weil @ 2014-03-05 9:50 ` Mikael Morin 2014-03-05 13:53 ` Janus Weil 0 siblings, 1 reply; 15+ messages in thread From: Mikael Morin @ 2014-03-05 9:50 UTC (permalink / raw) To: Janus Weil; +Cc: Tobias Burnus, Paul Richard Thomas, fortran, gcc-patches Le 01/03/2014 16:58, Janus Weil a écrit : >>> Index: gcc/fortran/trans-stmt.c >>> =================================================================== >>> --- gcc/fortran/trans-stmt.c (revision 207896) >>> +++ gcc/fortran/trans-stmt.c (working copy) >>> @@ -5028,6 +5028,11 @@ gfc_trans_allocate (gfc_code * code) >>> if (tmp && TREE_CODE (tmp) == VAR_DECL) >>> gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), >>> memsz)); >>> + else if (al->expr->ts.type == BT_CHARACTER >>> + && al->expr->ts.deferred && se.string_length) >>> + gfc_add_modify (&se.pre, se.string_length, >>> + fold_convert (TREE_TYPE (se.string_length), >>> + memsz)); >>> >> and here. There may be other places that I have missed. > > Actually I don't see a problem here. Also no further modifications > were necessary to get a KIND=4 example to work. > Mmmh, yes indeed. I assumed memsz was the memory size, which it isn't until a few lines down. Thanks for checking. > >>> /* Convert to size in bytes, using the character KIND. */ >>> if (unlimited_char) >> >> As the patch seems to provide a wanted feature, and as the new code >> seems to be properly guarded, I'm not against it after the above has >> been checked and fixed if necessary. > > Attached is a new version of the patch which fixes the above-mentioned > problems and should make the non-default-kind cases work. I have added > a KIND=4 version of the original test case, which seems to work > properly. > > The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk? > I'm asking for one more minor change, namely: > @@ -12364,6 +12356,25 @@ resolve_fl_derived0 (gfc_symbol *sym) > return false; > } > > + /* Add the hidden deferred length field. */ > + if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function > + && !sym->attr.is_class) > + { > + char name[GFC_MAX_SYMBOL_LEN+1]; > + gfc_component *strlen; > + sprintf (name, "_%s", c->name); It's not more costly to have a more explicit name like "_%s_length" or something, and I prefer having the latter in complicated dumps or in the debugger. OK with that change, with the associated buffer size update. Also Steve noted that the buffer size should take the terminating null character into account. Thanks for the patch. Mikael ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2014-03-05 9:50 ` Mikael Morin @ 2014-03-05 13:53 ` Janus Weil [not found] ` <CAGkQGiLbe7oLHC8N7OCALdTOVP8-COyCAmCUj-AfZK_DAAHqRA@mail.gmail.com> 0 siblings, 1 reply; 15+ messages in thread From: Janus Weil @ 2014-03-05 13:53 UTC (permalink / raw) To: Mikael Morin; +Cc: Tobias Burnus, Paul Richard Thomas, fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 1261 bytes --] Hi Mikael, >> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk? >> > I'm asking for one more minor change, namely: > >> @@ -12364,6 +12356,25 @@ resolve_fl_derived0 (gfc_symbol *sym) >> return false; >> } >> >> + /* Add the hidden deferred length field. */ >> + if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function >> + && !sym->attr.is_class) >> + { >> + char name[GFC_MAX_SYMBOL_LEN+1]; >> + gfc_component *strlen; >> + sprintf (name, "_%s", c->name); > > It's not more costly to have a more explicit name like "_%s_length" or > something, and I prefer having the latter in complicated dumps or in the > debugger. I agree. > OK with that change, with the associated buffer size update. Also Steve > noted that the buffer size should take the terminating null character > into account. Steve's comment somehow got lost in the noise. I have updated both the name and the buffer size now in resolve_fl_derived0 as well as gfc_deferred_strlen. Updated patch attached. A few people expressed mixed feelings, therefore I'll wait a couple of days to allow the naysayers to chime in. In the absence of further feedback, I'll commit the patch on the weekend. Cheers, Janus [-- Attachment #2: deferred-len-comp_2014-03-05.diff --] [-- Type: text/plain, Size: 18423 bytes --] Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 208344) +++ gcc/fortran/gfortran.h (working copy) @@ -811,6 +811,9 @@ typedef struct /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; + /* Is a parameter associated with a deferred type component. */ + unsigned deferred_parameter:1; + /* The namespace where the attribute has been set. */ struct gfc_namespace *volatile_ns, *asynchronous_ns; } Index: gcc/fortran/primary.c =================================================================== --- gcc/fortran/primary.c (revision 208344) +++ gcc/fortran/primary.c (working copy) @@ -2355,7 +2355,7 @@ build_actual_constructor (gfc_structure_ctor_compo } /* If it was not found, try the default initializer if there's any; - otherwise, it's an error. */ + otherwise, it's an error unless this is a deferred parameter. */ if (!comp_iter) { if (comp->initializer) @@ -2365,7 +2365,7 @@ build_actual_constructor (gfc_structure_ctor_compo return false; value = gfc_copy_expr (comp->initializer); } - else + else if (!comp->attr.deferred_parameter) { gfc_error ("No initializer for component '%s' given in the" " structure constructor at %C!", comp->name); @@ -2447,7 +2447,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, { /* Components without name are not allowed after the first named component initializer! */ - if (!comp) + if (!comp || comp->attr.deferred_parameter) { if (last_name) gfc_error ("Component initializer without name after component" Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 208344) +++ gcc/fortran/resolve.c (working copy) @@ -12105,14 +12105,6 @@ resolve_fl_derived0 (gfc_symbol *sym) if (c->attr.artificial) continue; - /* See PRs 51550, 47545, 48654, 49050, 51075 - and 45170. */ - if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function) - { - gfc_error ("Deferred-length character component '%s' at %L is not " - "yet supported", c->name, &c->loc); - return false; - } - /* F2008, C442. */ if ((!sym->attr.is_class || c != sym->components) && c->attr.codimension @@ -12364,6 +12356,25 @@ resolve_fl_derived0 (gfc_symbol *sym) return false; } + /* Add the hidden deferred length field. */ + if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function + && !sym->attr.is_class) + { + char name[GFC_MAX_SYMBOL_LEN+9]; + gfc_component *strlen; + sprintf (name, "_%s_length", c->name); + strlen = gfc_find_component (sym, name, true, true); + if (strlen == NULL) + { + if (!gfc_add_component (sym, name, &strlen)) + return false; + strlen->ts.type = BT_INTEGER; + strlen->ts.kind = gfc_charlen_int_kind; + strlen->attr.access = ACCESS_PRIVATE; + strlen->attr.deferred_parameter = 1; + } + } + if (c->ts.type == BT_DERIVED && sym->component_access != ACCESS_PRIVATE && gfc_check_symbol_access (sym) Index: gcc/fortran/trans-array.c =================================================================== --- gcc/fortran/trans-array.c (revision 208344) +++ gcc/fortran/trans-array.c (working copy) @@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl static tree duplicate_allocatable (tree dest, tree src, tree type, int rank, - bool no_malloc) + bool no_malloc, tree str_sz) { tree tmp; tree size; @@ -7386,7 +7386,11 @@ duplicate_allocatable (tree dest, tree src, tree t null_data = gfc_finish_block (&block); gfc_init_block (&block); - size = TYPE_SIZE_UNIT (TREE_TYPE (type)); + if (str_sz != NULL_TREE) + size = str_sz; + else + size = TYPE_SIZE_UNIT (TREE_TYPE (type)); + if (!no_malloc) { tmp = gfc_call_malloc (&block, type, size); @@ -7410,8 +7414,11 @@ duplicate_allocatable (tree dest, tree src, tree t else nelems = gfc_index_one_node; - tmp = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); + if (str_sz != NULL_TREE) + tmp = fold_convert (gfc_array_index_type, str_sz); + else + tmp = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, nelems, tmp); if (!no_malloc) @@ -7452,7 +7459,7 @@ duplicate_allocatable (tree dest, tree src, tree t tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, false); + return duplicate_allocatable (dest, src, type, rank, false, NULL_TREE); } @@ -7461,7 +7468,7 @@ gfc_duplicate_allocatable (tree dest, tree src, tr tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, true); + return duplicate_allocatable (dest, src, type, rank, true, NULL_TREE); } @@ -7718,6 +7725,16 @@ structure_alloc_comps (gfc_symbol * der_type, tree void_type_node, comp, build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&fnblock, tmp); + if (gfc_deferred_strlen (c, &comp)) + { + comp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (comp), + decl, comp, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (comp), comp, + build_int_cst (TREE_TYPE (comp), 0)); + gfc_add_expr_to_block (&fnblock, tmp); + } } else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) { @@ -7855,9 +7872,27 @@ structure_alloc_comps (gfc_symbol * der_type, tree continue; } - if (c->attr.allocatable && !c->attr.proc_pointer - && !cmp_has_alloc_comps) + if (gfc_deferred_strlen (c, &tmp)) { + tree len, size; + len = tmp; + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (len), + decl, len, NULL_TREE); + len = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (len), + dest, len, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (len), len, tmp); + gfc_add_expr_to_block (&fnblock, tmp); + size = size_of_string_in_bytes (c->ts.kind, len); + tmp = duplicate_allocatable (dcmp, comp, ctype, rank, + false, size); + gfc_add_expr_to_block (&fnblock, tmp); + } + else if (c->attr.allocatable && !c->attr.proc_pointer + && !cmp_has_alloc_comps) + { rank = c->as ? c->as->rank : 0; if (c->attr.codimension) tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank); @@ -8342,10 +8377,24 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo /* Get the new lhs size in bytes. */ if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { - tmp = expr2->ts.u.cl->backend_decl; - gcc_assert (expr1->ts.u.cl->backend_decl); - tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); - gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + if (expr2->ts.deferred) + { + if (TREE_CODE (expr2->ts.u.cl->backend_decl) == VAR_DECL) + tmp = expr2->ts.u.cl->backend_decl; + else + tmp = rss->info->string_length; + } + else + { + tmp = expr2->ts.u.cl->backend_decl; + tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); + } + + if (expr1->ts.u.cl->backend_decl + && TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + else + gfc_add_modify (&fblock, lss->info->string_length, tmp); } else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl) { Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (revision 208344) +++ gcc/fortran/trans-expr.c (working copy) @@ -1689,6 +1689,14 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref se->string_length = tmp; } + if (gfc_deferred_strlen (c, &field)) + { + tmp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (field), + decl, field, NULL_TREE); + se->string_length = tmp; + } + if (((c->attr.pointer || c->attr.allocatable) && (!c->attr.dimension && !c->attr.codimension) && c->ts.type != BT_CHARACTER) @@ -6043,9 +6051,42 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp gfc_add_expr_to_block (&block, tmp); } } - else + else if (gfc_deferred_strlen (cm, &tmp)) { - /* Scalar component. */ + tree strlen; + strlen = tmp; + gcc_assert (strlen); + strlen = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (strlen), + TREE_OPERAND (dest, 0), + strlen, NULL_TREE); + + if (expr->expr_type == EXPR_NULL) + { + tmp = build_int_cst (TREE_TYPE (cm->backend_decl), 0); + gfc_add_modify (&block, dest, tmp); + tmp = build_int_cst (TREE_TYPE (strlen), 0); + gfc_add_modify (&block, strlen, tmp); + } + else + { + tree size; + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, expr); + size = size_of_string_in_bytes (cm->ts.kind, se.string_length); + tmp = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_MALLOC), + 1, size); + gfc_add_modify (&block, dest, + fold_convert (TREE_TYPE (dest), tmp)); + gfc_add_modify (&block, strlen, se.string_length); + tmp = gfc_build_memcpy_call (dest, se.expr, size); + gfc_add_expr_to_block (&block, tmp); + } + } + else if (!cm->attr.deferred_parameter) + { + /* Scalar component (excluding deferred parameters). */ gfc_init_se (&se, NULL); gfc_init_se (&lse, NULL); @@ -7747,7 +7788,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock /* Update the lhs character length. */ size = string_length; - gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size); + if (TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size); + else + gfc_add_modify (block, lse.string_length, size); } } Index: gcc/fortran/trans-intrinsic.c =================================================================== --- gcc/fortran/trans-intrinsic.c (revision 208344) +++ gcc/fortran/trans-intrinsic.c (working copy) @@ -5166,7 +5166,7 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * e excluding the terminating null characters. The result has gfc_array_index_type type. */ -static tree +tree size_of_string_in_bytes (int kind, tree string_length) { tree bytesize; Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (revision 208344) +++ gcc/fortran/trans-stmt.c (working copy) @@ -5028,6 +5028,11 @@ gfc_trans_allocate (gfc_code * code) if (tmp && TREE_CODE (tmp) == VAR_DECL) gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), memsz)); + else if (al->expr->ts.type == BT_CHARACTER + && al->expr->ts.deferred && se.string_length) + gfc_add_modify (&se.pre, se.string_length, + fold_convert (TREE_TYPE (se.string_length), + memsz)); /* Convert to size in bytes, using the character KIND. */ if (unlimited_char) Index: gcc/fortran/trans-types.c =================================================================== --- gcc/fortran/trans-types.c (revision 208344) +++ gcc/fortran/trans-types.c (working copy) @@ -2486,12 +2486,15 @@ gfc_get_derived_type (gfc_symbol * derived) field_type = c->ts.u.derived->backend_decl; else { - if (c->ts.type == BT_CHARACTER) + if (c->ts.type == BT_CHARACTER && !c->ts.deferred) { /* Evaluate the string length. */ gfc_conv_const_charlen (c->ts.u.cl); gcc_assert (c->ts.u.cl->backend_decl); } + else if (c->ts.type == BT_CHARACTER) + c->ts.u.cl->backend_decl + = build_int_cst (gfc_charlen_type_node, 0); field_type = gfc_typenode_for_spec (&c->ts); } Index: gcc/fortran/trans.c =================================================================== --- gcc/fortran/trans.c (revision 208344) +++ gcc/fortran/trans.c (working copy) @@ -2044,3 +2044,21 @@ gfc_likely (tree cond) cond = fold_convert (boolean_type_node, cond); return cond; } + + +/* Get the string length for a deferred character length component. */ + +bool +gfc_deferred_strlen (gfc_component *c, tree *decl) +{ + char name[GFC_MAX_SYMBOL_LEN+9]; + gfc_component *strlen; + if (!(c->ts.type == BT_CHARACTER && c->ts.deferred)) + return false; + sprintf (name, "_%s_length", c->name); + for (strlen = c; strlen; strlen = strlen->next) + if (strcmp (strlen->name, name) == 0) + break; + *decl = strlen ? strlen->backend_decl : NULL_TREE; + return strlen != NULL; +} Index: gcc/fortran/trans.h =================================================================== --- gcc/fortran/trans.h (revision 208344) +++ gcc/fortran/trans.h (working copy) @@ -422,6 +422,8 @@ tree gfc_evaluate_now (tree, stmtblock_t *); /* Find the appropriate variant of a math intrinsic. */ tree gfc_builtin_decl_for_float_kind (enum built_in_function, int); +tree size_of_string_in_bytes (int, tree); + /* Intrinsic procedure handling. */ tree gfc_conv_intrinsic_subroutine (gfc_code *); void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *); @@ -581,6 +583,9 @@ bool get_array_ctor_strlen (stmtblock_t *, gfc_con tree gfc_likely (tree); tree gfc_unlikely (tree); +/* Return the string length of a deferred character length component. */ +bool gfc_deferred_strlen (gfc_component *, tree *); + /* Generate a runtime error call. */ tree gfc_trans_runtime_error (bool, locus*, const char*, ...); Index: gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 (working copy) @@ -0,0 +1,60 @@ +! { dg-do run } +! +! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length) +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + + type t + character(len=:), allocatable :: str_comp + character(len=:), allocatable :: str_comp1 + end type t + type(t) :: x + type(t), allocatable, dimension(:) :: array + + ! Check scalars + allocate (x%str_comp, source = "abc") + call check (x%str_comp, "abc") + deallocate (x%str_comp) + allocate (x%str_comp, source = "abcdefghijklmnop") + call check (x%str_comp, "abcdefghijklmnop") + x%str_comp = "xyz" + call check (x%str_comp, "xyz") + x%str_comp = "abcdefghijklmnop" + x%str_comp1 = "lmnopqrst" + call foo (x%str_comp1, "lmnopqrst") + call bar (x, "abcdefghijklmnop", "lmnopqrst") + + ! Check arrays and structure constructors + allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")]) + call check (array(1)%str_comp, "abcedefg") + call check (array(1)%str_comp1, "hi") + call check (array(2)%str_comp, "jkl") + call check (array(2)%str_comp1, "mnop") + deallocate (array) + allocate (array(3), source = [x, x, x]) + array(2)%str_comp = "blooey" + call bar (array(1), "abcdefghijklmnop", "lmnopqrst") + call bar (array(2), "blooey", "lmnopqrst") + call bar (array(3), "abcdefghijklmnop", "lmnopqrst") + +contains + + subroutine foo (chr1, chr2) + character (*) :: chr1, chr2 + call check (chr1, chr2) + end subroutine + + subroutine bar (a, chr1, chr2) + character (*) :: chr1, chr2 + type(t) :: a + call check (a%str_comp, chr1) + call check (a%str_comp1, chr2) + end subroutine + + subroutine check (chr1, chr2) + character (*) :: chr1, chr2 + if (len(chr1) .ne. len (chr2)) call abort + if (chr1 .ne. chr2) call abort + end subroutine + +end Index: gcc/testsuite/gfortran.dg/deferred_type_component_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/deferred_type_component_2.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/deferred_type_component_2.f90 (working copy) @@ -0,0 +1,60 @@ +! { dg-do run } +! +! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length) +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + + type t + character(len=:,kind=4), allocatable :: str_comp + character(len=:,kind=4), allocatable :: str_comp1 + end type t + type(t) :: x + type(t), allocatable, dimension(:) :: array + + ! Check scalars + allocate (x%str_comp, source = 4_"abc") + call check (x%str_comp, 4_"abc") + deallocate (x%str_comp) + allocate (x%str_comp, source = 4_"abcdefghijklmnop") + call check (x%str_comp, 4_"abcdefghijklmnop") + x%str_comp = 4_"xyz" + call check (x%str_comp, 4_"xyz") + x%str_comp = 4_"abcdefghijklmnop" + x%str_comp1 = 4_"lmnopqrst" + call foo (x%str_comp1, 4_"lmnopqrst") + call bar (x, 4_"abcdefghijklmnop", 4_"lmnopqrst") + + ! Check arrays and structure constructors + allocate (array(2), source = [t(4_"abcedefg",4_"hi"), t(4_"jkl",4_"mnop")]) + call check (array(1)%str_comp, 4_"abcedefg") + call check (array(1)%str_comp1, 4_"hi") + call check (array(2)%str_comp, 4_"jkl") + call check (array(2)%str_comp1, 4_"mnop") + deallocate (array) + allocate (array(3), source = [x, x, x]) + array(2)%str_comp = 4_"blooey" + call bar (array(1), 4_"abcdefghijklmnop", 4_"lmnopqrst") + call bar (array(2), 4_"blooey", 4_"lmnopqrst") + call bar (array(3), 4_"abcdefghijklmnop", 4_"lmnopqrst") + +contains + + subroutine foo (chr1, chr2) + character (len=*,kind=4) :: chr1, chr2 + call check (chr1, chr2) + end subroutine + + subroutine bar (a, chr1, chr2) + character (len=*,kind=4) :: chr1, chr2 + type(t) :: a + call check (a%str_comp, chr1) + call check (a%str_comp1, chr2) + end subroutine + + subroutine check (chr1, chr2) + character (len=*,kind=4) :: chr1, chr2 + if (len(chr1) .ne. len (chr2)) call abort + if (chr1 .ne. chr2) call abort + end subroutine + +end ^ permalink raw reply [flat|nested] 15+ messages in thread
[parent not found: <CAGkQGiLbe7oLHC8N7OCALdTOVP8-COyCAmCUj-AfZK_DAAHqRA@mail.gmail.com>]
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) [not found] ` <CAGkQGiLbe7oLHC8N7OCALdTOVP8-COyCAmCUj-AfZK_DAAHqRA@mail.gmail.com> @ 2014-03-06 20:59 ` Janus Weil [not found] ` <CAGkQGiK6v5WhibMJWMOzq=npWk5N1mGFJYEFV0tL6vf9+Xp4MQ@mail.gmail.com> 0 siblings, 1 reply; 15+ messages in thread From: Janus Weil @ 2014-03-06 20:59 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: Mikael Morin, gcc-patches, Tobias Burnus, fortran Hi Paul, > I am trying to respond to Mikael's comment that only kind=1 is handled. I'll > use your patch as a basis. actually the last version of the patch that I posted yesterday should already handle that (and includes a kind=4 test case). But if you find any remaining problems, please let me know. Also Tobias already told me privately that his "mixed feeling" were not strong enough to oppose against committing the patch. So right now the only thing standing between the patch and trunk seems to be you ;) Cheers, Janus > On Mar 5, 2014 2:53 PM, "Janus Weil" <janus@gcc.gnu.org> wrote: >> >> Hi Mikael, >> >> >> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk? >> >> >> > I'm asking for one more minor change, namely: >> > >> >> @@ -12364,6 +12356,25 @@ resolve_fl_derived0 (gfc_symbol *sym) >> >> return false; >> >> } >> >> >> >> + /* Add the hidden deferred length field. */ >> >> + if (c->ts.type == BT_CHARACTER && c->ts.deferred && >> >> !c->attr.function >> >> + && !sym->attr.is_class) >> >> + { >> >> + char name[GFC_MAX_SYMBOL_LEN+1]; >> >> + gfc_component *strlen; >> >> + sprintf (name, "_%s", c->name); >> > >> > It's not more costly to have a more explicit name like "_%s_length" or >> > something, and I prefer having the latter in complicated dumps or in the >> > debugger. >> >> I agree. >> >> >> > OK with that change, with the associated buffer size update. Also Steve >> > noted that the buffer size should take the terminating null character >> > into account. >> >> Steve's comment somehow got lost in the noise. I have updated both the >> name and the buffer size now in resolve_fl_derived0 as well as >> gfc_deferred_strlen. Updated patch attached. >> >> A few people expressed mixed feelings, therefore I'll wait a couple of >> days to allow the naysayers to chime in. In the absence of further >> feedback, I'll commit the patch on the weekend. >> >> Cheers, >> Janus ^ permalink raw reply [flat|nested] 15+ messages in thread
[parent not found: <CAGkQGiK6v5WhibMJWMOzq=npWk5N1mGFJYEFV0tL6vf9+Xp4MQ@mail.gmail.com>]
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) [not found] ` <CAGkQGiK6v5WhibMJWMOzq=npWk5N1mGFJYEFV0tL6vf9+Xp4MQ@mail.gmail.com> @ 2014-03-06 21:20 ` Janus Weil 2014-03-06 21:55 ` Janus Weil 0 siblings, 1 reply; 15+ messages in thread From: Janus Weil @ 2014-03-06 21:20 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: Mikael Morin, Tobias Burnus, gcc-patches, fortran Hi, > In that case, go for it! I am on vacation in Tenerife right now and have > very limited access. wow, in that case I guess you better enjoy your holidays ;) > Please commit the patch to trunk. Will do! Thanks, Janus > On Mar 6, 2014 9:59 PM, "Janus Weil" <janus@gcc.gnu.org> wrote: >> >> Hi Paul, >> >> > I am trying to respond to Mikael's comment that only kind=1 is handled. >> > I'll >> > use your patch as a basis. >> >> actually the last version of the patch that I posted yesterday should >> already handle that (and includes a kind=4 test case). But if you find >> any remaining problems, please let me know. >> >> Also Tobias already told me privately that his "mixed feeling" were >> not strong enough to oppose against committing the patch. So right now >> the only thing standing between the patch and trunk seems to be you ;) >> >> Cheers, >> Janus >> >> >> >> > On Mar 5, 2014 2:53 PM, "Janus Weil" <janus@gcc.gnu.org> wrote: >> >> >> >> Hi Mikael, >> >> >> >> >> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk? >> >> >> >> >> > I'm asking for one more minor change, namely: >> >> > >> >> >> @@ -12364,6 +12356,25 @@ resolve_fl_derived0 (gfc_symbol *sym) >> >> >> return false; >> >> >> } >> >> >> >> >> >> + /* Add the hidden deferred length field. */ >> >> >> + if (c->ts.type == BT_CHARACTER && c->ts.deferred && >> >> >> !c->attr.function >> >> >> + && !sym->attr.is_class) >> >> >> + { >> >> >> + char name[GFC_MAX_SYMBOL_LEN+1]; >> >> >> + gfc_component *strlen; >> >> >> + sprintf (name, "_%s", c->name); >> >> > >> >> > It's not more costly to have a more explicit name like "_%s_length" >> >> > or >> >> > something, and I prefer having the latter in complicated dumps or in >> >> > the >> >> > debugger. >> >> >> >> I agree. >> >> >> >> >> >> > OK with that change, with the associated buffer size update. Also >> >> > Steve >> >> > noted that the buffer size should take the terminating null character >> >> > into account. >> >> >> >> Steve's comment somehow got lost in the noise. I have updated both the >> >> name and the buffer size now in resolve_fl_derived0 as well as >> >> gfc_deferred_strlen. Updated patch attached. >> >> >> >> A few people expressed mixed feelings, therefore I'll wait a couple of >> >> days to allow the naysayers to chime in. In the absence of further >> >> feedback, I'll commit the patch on the weekend. >> >> >> >> Cheers, >> >> Janus ^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) 2014-03-06 21:20 ` Janus Weil @ 2014-03-06 21:55 ` Janus Weil 0 siblings, 0 replies; 15+ messages in thread From: Janus Weil @ 2014-03-06 21:55 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: Mikael Morin, Tobias Burnus, gcc-patches, fortran >> Please commit the patch to trunk. > > Will do! I have just committed the patch as r208386, thereby implementing deferred-length character components on 4.9 trunk. One big plea to the users: Please test this as soon as possible! Cheers, Janus >> On Mar 6, 2014 9:59 PM, "Janus Weil" <janus@gcc.gnu.org> wrote: >>> >>> Hi Paul, >>> >>> > I am trying to respond to Mikael's comment that only kind=1 is handled. >>> > I'll >>> > use your patch as a basis. >>> >>> actually the last version of the patch that I posted yesterday should >>> already handle that (and includes a kind=4 test case). But if you find >>> any remaining problems, please let me know. >>> >>> Also Tobias already told me privately that his "mixed feeling" were >>> not strong enough to oppose against committing the patch. So right now >>> the only thing standing between the patch and trunk seems to be you ;) >>> >>> Cheers, >>> Janus >>> >>> >>> >>> > On Mar 5, 2014 2:53 PM, "Janus Weil" <janus@gcc.gnu.org> wrote: >>> >> >>> >> Hi Mikael, >>> >> >>> >> >> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk? >>> >> >> >>> >> > I'm asking for one more minor change, namely: >>> >> > >>> >> >> @@ -12364,6 +12356,25 @@ resolve_fl_derived0 (gfc_symbol *sym) >>> >> >> return false; >>> >> >> } >>> >> >> >>> >> >> + /* Add the hidden deferred length field. */ >>> >> >> + if (c->ts.type == BT_CHARACTER && c->ts.deferred && >>> >> >> !c->attr.function >>> >> >> + && !sym->attr.is_class) >>> >> >> + { >>> >> >> + char name[GFC_MAX_SYMBOL_LEN+1]; >>> >> >> + gfc_component *strlen; >>> >> >> + sprintf (name, "_%s", c->name); >>> >> > >>> >> > It's not more costly to have a more explicit name like "_%s_length" >>> >> > or >>> >> > something, and I prefer having the latter in complicated dumps or in >>> >> > the >>> >> > debugger. >>> >> >>> >> I agree. >>> >> >>> >> >>> >> > OK with that change, with the associated buffer size update. Also >>> >> > Steve >>> >> > noted that the buffer size should take the terminating null character >>> >> > into account. >>> >> >>> >> Steve's comment somehow got lost in the noise. I have updated both the >>> >> name and the buffer size now in resolve_fl_derived0 as well as >>> >> gfc_deferred_strlen. Updated patch attached. >>> >> >>> >> A few people expressed mixed feelings, therefore I'll wait a couple of >>> >> days to allow the naysayers to chime in. In the absence of further >>> >> feedback, I'll commit the patch on the weekend. >>> >> >>> >> Cheers, >>> >> Janus ^ permalink raw reply [flat|nested] 15+ messages in thread
end of thread, other threads:[~2014-03-06 21:55 UTC | newest] Thread overview: 15+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2013-02-24 22:43 [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length) Paul Richard Thomas 2013-02-25 9:58 ` Tobias Burnus 2013-03-19 21:17 ` Tobias Burnus 2014-02-19 15:16 ` Janus Weil 2014-02-19 15:51 ` Janus Weil 2014-02-19 21:24 ` Paul Richard Thomas 2014-02-19 22:23 ` Tobias Burnus 2014-02-22 15:39 ` Mikael Morin 2014-02-22 15:58 ` Steve Kargl 2014-03-01 15:58 ` Janus Weil 2014-03-05 9:50 ` Mikael Morin 2014-03-05 13:53 ` Janus Weil [not found] ` <CAGkQGiLbe7oLHC8N7OCALdTOVP8-COyCAmCUj-AfZK_DAAHqRA@mail.gmail.com> 2014-03-06 20:59 ` Janus Weil [not found] ` <CAGkQGiK6v5WhibMJWMOzq=npWk5N1mGFJYEFV0tL6vf9+Xp4MQ@mail.gmail.com> 2014-03-06 21:20 ` Janus Weil 2014-03-06 21:55 ` Janus Weil
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).