| Message ID | 20141208183840.45364899@gmx.de |
|---|---|
| State | New |
| Headers | show |
Dear Paul, The problem for oo.f90 is pr 55901. I am updating my working tree with Andre’s patch. Cheers, Dominique > Le 8 déc. 2014 à 21:20, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit : > > Dear Andre, > > s/furure/future/ :-) > > Why are you using a double underscore in get__len_component? > > More seriously, I think that the len field should be added unconditionally to unlimited polymorphic variables. Otherwise, you might find unlimited polymorphic variables that are created in an already compiled module/subprogramme arriving without the requisite field. > > Michael Metcalf has posted an example that makes use of unlimited polymorphism at ftp://ftp.numerical.rl.ac.uk/pub/MRandC/oo.f90 . gfortran does not work correctly with it at the moment because of the lack of a len field. Removing all the string input allows it to run correctly. I think that you should ensure that your patch fixes the problem. > > A slight obstacle is that the substring at line 216 causes the emission of: > type is (character(*)) > 1 > Error: Associate-name '__tmp_CHARACTER_0_1' at (1) is used as array > > Just retaining print *, 'character = "', v, '"' allows the example to compile > > ifort compiles and runs it successfully and so I think that it would be nice if gfortran catches up on this one. > > Parenthetically, I wonder if this is not the time to implement PR53971... including responding to Mikael's comment? > > Anyway, this is a good start in the right direction. Please persist! > > Thanks > > Paul > > > On 8 December 2014 at 18:38, Andre Vehreschild <vehre@gmx.de> wrote: > Hi all, > > please find attached a more elaborate patch for pr60255. I totally agree that > my first attempt was just scratching the surface of the work needed. > > This patch also is *not* complete, but because I am really new to gfortran > patching, I don't want to present a final patch only to learn then, that I have > violated design rules, common practice or the like. Therefore please comment > and direct me to any sources/ideas to improve the patch. > > Topic: > The pr 60255 is about assigning a char array to an unlimited polymorphic > entity. In the comments the concern about the lost length information is > raised. The patch adds a _len component to the unlimited polymorphic entity > (after _data and _vtab) and adds an assignment of the string length to _len > when a string is pointer assigned to the unlimited poly entity. Furthermore is > the intrinsic len(unlimited poly pointing to a string) resolved to give the > _len component. > > Yet missing: > - assign _len component back to deferred char array length component > - transport length along chains of unlimited poly entities, i.e., a => b; c => > a where all objects are unlimited poly and b is a string. > - allocate() in this context > > Patch dependencies: > none > > Comments, concerns, candy welcome! > > Regards, > Andre > > On Sun, 17 Aug 2014 14:32:21 +0200 > dominiq@lps.ens.fr (Dominique Dhumieres) wrote: > > > > the testcase should check that the code generated is actually working, > > > not just that the ICE disappeared. > > > > I agree. Note that there is a test in the comment 3 of PR60255 that > > can be used to check the run time behavior (and possibly check the > > vtab issue). > > > > Dominique > > > -- > Andre Vehreschild * Email: vehre ad gmx dot de > > > > -- > The knack of flying is learning how to throw yourself at the ground and miss. > --Hitchhikers Guide to the Galaxy
Hi Paul, > s/furure/future/ :-) Hups, fixed. > Why are you using a double underscore in get__len_component? Because the component is called _len. The routine should be called "get _len component", but spaces aren't allowed :-) Anyways, does this violate some style guide? Should I remove one of underscores? > More seriously, I think that the len field should be added unconditionally > to unlimited polymorphic variables. Otherwise, you might find unlimited > polymorphic variables that are created in an already compiled > module/subprogramme arriving without the requisite field. I was thinking about that, too. For a start I just wanted to give an idea of where this is going. When more gfortran gurus vote for the unconditional add to u-poly variables, then I will change it. > Michael Metcalf has posted an example that makes use of unlimited > polymorphism at ftp://ftp.numerical.rl.ac.uk/pub/MRandC/oo.f90 . gfortran > does not work correctly with it at the moment because of the lack of a len > field. Removing all the string input allows it to run correctly. I think > that you should ensure that your patch fixes the problem. > > A slight obstacle is that the substring at line 216 causes the emission of: > type is (character(*)) > 1 > Error: Associate-name '__tmp_CHARACTER_0_1' at (1) is used as array > > Just retaining print *, 'character = "', v, '"' allows the example to > compile Ok, I take a look at it. As I am paid to fix certain bugs that prevent compiling another software, I will not prioritize working on 55901 as long as it is not needed in the software I focus on. Sorry for not being more enthusiastic, but there are more than 8 prs (and only one down yet) I have to fix and time is limited. What I did not mention in the previous mail is that I also plan to implement this fixes in the fortran-dev branch with the new array descriptor. Given that there is no other volunteer. :-) Please continue commenting. Regards, Andre > ifort compiles and runs it successfully and so I think that it would be > nice if gfortran catches up on this one. > > Parenthetically, I wonder if this is not the time to implement PR53971... > including responding to Mikael's comment? > > Anyway, this is a good start in the right direction. Please persist! > > Thanks > > Paul > > > On 8 December 2014 at 18:38, Andre Vehreschild <vehre@gmx.de> wrote: > > > Hi all, > > > > please find attached a more elaborate patch for pr60255. I totally agree > > that > > my first attempt was just scratching the surface of the work needed. > > > > This patch also is *not* complete, but because I am really new to gfortran > > patching, I don't want to present a final patch only to learn then, that I > > have > > violated design rules, common practice or the like. Therefore please > > comment > > and direct me to any sources/ideas to improve the patch. > > > > Topic: > > The pr 60255 is about assigning a char array to an unlimited polymorphic > > entity. In the comments the concern about the lost length information is > > raised. The patch adds a _len component to the unlimited polymorphic entity > > (after _data and _vtab) and adds an assignment of the string length to _len > > when a string is pointer assigned to the unlimited poly entity. > > Furthermore is > > the intrinsic len(unlimited poly pointing to a string) resolved to give the > > _len component. > > > > Yet missing: > > - assign _len component back to deferred char array length component > > - transport length along chains of unlimited poly entities, i.e., a => b; > > c => > > a where all objects are unlimited poly and b is a string. > > - allocate() in this context > > > > Patch dependencies: > > none > > > > Comments, concerns, candy welcome! > > > > Regards, > > Andre > > > > On Sun, 17 Aug 2014 14:32:21 +0200 > > dominiq@lps.ens.fr (Dominique Dhumieres) wrote: > > > > > > the testcase should check that the code generated is actually working, > > > > not just that the ICE disappeared. > > > > > > I agree. Note that there is a test in the comment 3 of PR60255 that > > > can be used to check the run time behavior (and possibly check the > > > vtab issue). > > > > > > Dominique > > > > > > -- > > Andre Vehreschild * Email: vehre ad gmx dot de > > > > >
Dear Andre,
The patch causes an ICE for the test gfortran.dg/unlimited_polymorphic_1.f03:
f951: internal compiler error: in gfc_add_component_ref, at fortran/class.c:236
f951: internal compiler error: Abort trap: 6
gfc: internal compiler error: Abort trap: 6 (program f951)
Abort
Reduced test for which the ICE is triggered by ‘len(w)'
MODULE m
contains
subroutine bar (arg, res)
class(*) :: arg
character(100) :: res
select type (w => arg)
type is (character(*))
write (res, '(I2)') len(w)
end select
end subroutine
END MODULE
Note that with your patch at https://gcc.gnu.org/ml/fortran/2014-08/msg00022.html, I get the same ICE for the Mikael’s test at https://gcc.gnu.org/ml/fortran/2014-08/msg00055.html (before your patch for pr60255, it used to give a wrong length: 80 instead of 20 AFAICR).
Note that the assert at fortran/class.c:236 is also triggered for pr61115.
Thanks for working on these issues,
Dominique
>> On 8 December 2014 at 18:38, Andre Vehreschild <vehre@gmx.de> wrote:
>> Hi all,
>>
>> please find attached a more elaborate patch for pr60255. I totally agree that
>> my first attempt was just scratching the surface of the work needed.
>>
>> This patch also is *not* complete, but because I am really new to gfortran
>> patching, I don't want to present a final patch only to learn then, that I have
>> violated design rules, common practice or the like. Therefore please comment
>> and direct me to any sources/ideas to improve the patch.
>>
>> Topic:
>> The pr 60255 is about assigning a char array to an unlimited polymorphic
>> entity. In the comments the concern about the lost length information is
>> raised. The patch adds a _len component to the unlimited polymorphic entity
>> (after _data and _vtab) and adds an assignment of the string length to _len
>> when a string is pointer assigned to the unlimited poly entity. Furthermore is
>> the intrinsic len(unlimited poly pointing to a string) resolved to give the
>> _len component.
>>
>> Yet missing:
>> - assign _len component back to deferred char array length component
>> - transport length along chains of unlimited poly entities, i.e., a => b; c =>
>> a where all objects are unlimited poly and b is a string.
>> - allocate() in this context
>>
>> Patch dependencies:
>> none
>>
>> Comments, concerns, candy welcome!
>>
>> Regards,
>> Andre
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 0286c9e..29e31e1 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -2403,6 +2403,38 @@ yes: return true; } +/* Add the component _len to the class-type variable in c->expr1. */ + +void +gfc_add_len_component (gfc_code *c) +{ + /* Just make sure input is correct. This is already at the calling site, + but may be this routine is called from somewhere else in the furure. */ + gcc_assert (UNLIMITED_POLY(c->expr1) + && c->expr2 + && c->expr2->ts.type== BT_CHARACTER); + + gfc_component *len; + gfc_expr *e; + /* Check that _len is not present already. */ + if ((len= gfc_find_component (c->expr1->ts.u.derived, "_len", true, true))) + return; + /* Create the new component. */ + if (!gfc_add_component (c->expr1->ts.u.derived, "_len", &len)) + // Possible errors are already reported in add_component + return; + len->ts.type = BT_INTEGER; + len->ts.kind = 4; + len->attr.access = ACCESS_PRIVATE; + + /* Build minimal expression to initialize component with zero. */ + e = gfc_get_expr(); + e->ts = c->expr1->ts; + e->expr_type = EXPR_VARIABLE; + len->initializer = gfc_get_int_expr (gfc_default_integer_kind, + NULL, 0); + gfc_free_expr (e); +} /* Find (or generate) the symbol for an intrinsic type's vtab. This is needed to support unlimited polymorphism. */ @@ -2415,18 +2447,9 @@ find_intrinsic_vtab (gfc_typespec *ts) gfc_symbol *copy = NULL, *src = NULL, *dst = NULL; int charlen = 0; - if (ts->type == BT_CHARACTER) - { - if (ts->deferred) - { - gfc_error ("TODO: Deferred character length variable at %C cannot " - "yet be associated with unlimited polymorphic entities"); - return NULL; - } - else if (ts->u.cl && ts->u.cl->length - && ts->u.cl->length->expr_type == EXPR_CONSTANT) - charlen = mpz_get_si (ts->u.cl->length->value.integer); - } + if (ts->type == BT_CHARACTER && !ts->deferred && ts->u.cl && ts->u.cl->length + && ts->u.cl->length->expr_type == EXPR_CONSTANT) + charlen = mpz_get_si (ts->u.cl->length->value.integer); /* Find the top-level namespace. */ for (ns = gfc_current_ns; ns; ns = ns->parent) @@ -2437,10 +2460,16 @@ find_intrinsic_vtab (gfc_typespec *ts) { char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1]; - if (ts->type == BT_CHARACTER) - sprintf (tname, "%s_%d_%d", gfc_basic_typename (ts->type), - charlen, ts->kind); - else + if (ts->type == BT_CHARACTER) { + if (!ts->deferred) + sprintf (tname, "%s_%d_%d", gfc_basic_typename (ts->type), + charlen, ts->kind); + else + /* The type is deferred here. Ensure that this is easily seen in the + vtable. */ + sprintf (tname, "%s_DEFERRED_%d", gfc_basic_typename (ts->type), + ts->kind); + } else sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind); sprintf (name, "__vtab_%s", tname); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1058502..f99c3f8 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3192,6 +3192,8 @@ gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *); unsigned int gfc_hash_value (gfc_symbol *); bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *, gfc_array_spec **); +void gfc_add_len_component(gfc_code *); +void gfc_assign_charlen_to_unlimited_poly(gfc_code *c); gfc_symbol *gfc_find_derived_vtab (gfc_symbol *); gfc_symbol *gfc_find_vtab (gfc_typespec *); gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, bool*, diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9d7d3c2..6e14e74 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10081,7 +10081,11 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) if (!t) break; - gfc_check_pointer_assign (code->expr1, code->expr2); + if (gfc_check_pointer_assign (code->expr1, code->expr2) + && UNLIMITED_POLY(code->expr1) + && code->expr2->ts.type== BT_CHARACTER) + gfc_add_len_component (code); + break; } diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 7ccabc7..88cd8e7 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -3687,6 +3687,31 @@ gfc_simplify_leadz (gfc_expr *e) return gfc_get_int_expr (gfc_default_integer_kind, &e->where, lz); } +static gfc_expr * +get__len_component (gfc_expr *e) +{ + gfc_expr *len_comp; + gfc_ref *ref, **last; + len_comp = gfc_copy_expr(e->symtree->n.sym->assoc->target); + /* We need to remove the last _data component ref from ptr. */ + last = &(len_comp->ref); + ref = len_comp->ref; + while (ref) + { + if (!ref->next + && ref->type == REF_COMPONENT + && strcmp("_data", ref->u.c.component->name)== 0) + { + gfc_free_ref_list(ref); + *last = NULL; + break; + } + last = &(ref->next); + ref = ref->next; + } + gfc_add_component_ref(len_comp, "_len"); + return len_comp; +} gfc_expr * gfc_simplify_len (gfc_expr *e, gfc_expr *kind) @@ -3711,6 +3736,13 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) mpz_set (result->value.integer, e->ts.u.cl->length->value.integer); return range_check (result, "LEN"); } + else if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_CHARACTER + && e->symtree->n.sym + && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target + && e->symtree->n.sym->assoc->target->ts.type == BT_DERIVED) + { + return get__len_component (e); + } else return NULL; } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f8e4df8..9a08bde 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1034,11 +1034,11 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op) gfc_add_vptr_component (lhs); if (UNLIMITED_POLY (expr1) - && expr2->expr_type == EXPR_NULL && expr2->ts.type == BT_UNKNOWN) - { - rhs = gfc_get_null_expr (&expr2->where); - goto assign_vptr; - } + && expr2->expr_type == EXPR_NULL && expr2->ts.type == BT_UNKNOWN) + { + rhs = gfc_get_null_expr (&expr2->where); + goto assign_vptr; + } if (expr2->expr_type == EXPR_NULL) vtab = gfc_find_vtab (&expr1->ts); @@ -6695,6 +6695,43 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) } +/* Create the character length assignment to the _len component. */ + +void +add_assignment_of_string_len_to_len_component (stmtblock_t *block, + gfc_expr *ptr, gfc_se *ptr_se, + gfc_se *str) +{ + gfc_expr *len_comp; + gfc_ref *ref, **last; + gfc_se lse; + len_comp = gfc_copy_expr(ptr); + /* We need to remove the last _data component ref from ptr. */ + last = &(len_comp->ref); + ref = len_comp->ref; + while (ref) + { + if (!ref->next + && ref->type == REF_COMPONENT + && strcmp("_data", ref->u.c.component->name)== 0) + { + gfc_free_ref_list(ref); + *last = NULL; + break; + } + last = &(ref->next); + ref = ref->next; + } + gfc_add_component_ref(len_comp, "_len"); + gfc_init_se (&lse, NULL); + gfc_conv_expr (&lse, len_comp); + + /* ptr % _len = len (str) */ + gfc_add_modify (block, lse.expr, str->string_length); + ptr_se->string_length = lse.expr; + gfc_free_expr (len_comp); +} + tree gfc_trans_pointer_assign (gfc_code * code) { @@ -6759,6 +6796,15 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &rse.pre); + /* For string assignments to unlimited polymorphic pointers add an + assignment of the string_length to the _len component of the pointer. */ + if (expr1->ts.type == BT_DERIVED + && expr1->ts.u.derived->attr.unlimited_polymorphic + && expr2->ts.type == BT_CHARACTER) + { + add_assignment_of_string_len_to_len_component (&block, expr1, &lse, &rse); + } + /* Check character lengths if character expression. The test is only really added if -fbounds-check is enabled. Exclude deferred character length lefthand sides. */ diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_19.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_19.f03 new file mode 100644 index 0000000..6042882 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_19.f03 @@ -0,0 +1,57 @@ +! { dg-do run } +! Testing fix for +! PR fortran/60255 +! +program test + implicit none + character(LEN=:), allocatable :: S + call subP(S) + call sub2() + call sub1("test") + +contains + + subroutine sub1(dcl) + character(len=*), target :: dcl + class(*), pointer :: ucp +! character(len=:), allocatable ::def + + ucp => dcl + + select type (ucp) + type is (character(len=*)) + if (len(ucp) .NE. 4) then + call abort() +! else +! def = ucp +! if (len(def) .NE. 4) then +! call abort() ! This abort is expected currently +! end if + end if + class default + call abort() + end select + end subroutine + + subroutine sub2 + character(len=:), allocatable, target :: dcl + class(*), pointer :: ucp + + dcl = "ttt" + ucp => dcl + + select type (ucp) + type is (character(len=*)) + if (len(ucp) .NE. 3) then + call abort() + end if + class default + call abort() + end select + end subroutine + + subroutine subP(P) + class(*) :: P + end subroutine + +end program diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_2.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_2.f03 index 8e80386..30e4797 100644 --- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_2.f03 +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_2.f03 @@ -5,7 +5,7 @@ ! Contributed by Paul Thomas <pault@gcc.gnu.org> ! and Tobias Burnus <burnus@gcc.gnu.org> ! - CHARACTER(:), allocatable, target :: chr ! { dg-error "TODO: Deferred character length variable" } + CHARACTER(:), allocatable, target :: chr ! F2008: C5100 integer :: i(2) logical :: flag