Message ID | 20150104134016.4629833c@gmx.de |
---|---|
State | New |
Headers | show |
Dear Andre, Thanks for the patch. As I have said to you, off list, I think that the _size field in the vtable should contain the kind information and that the _len field should carry the length of the string in bytes. I think that it is better to optimise array access this way than to avoid the division in evaluating LEN (). I am happy to accept contrary opinions from the others. I do not believe that the bind_c issue is an issue. Your patch correctly deals with it IMHO. Subject to the above change in the value of _len, I think that your patch is OK for trunk. With best regards Paul On 4 January 2015 at 13:40, Andre Vehreschild <vehre@gmx.de> wrote: > Hi Janus, hi Paul, hi Tobias, > > Janus: During code review, I found that I had the code in > gfc_get_len_component() duplicated. So I now reintroduced and documented the > routine making is more commonly usable and added more documentation. The call > sites are now simplify.c (gfc_simplify_len) and trans-expr.c > (gfc_trans_pointer_assignment). Attached is the reworked version of the patch. > > Paul, Tobias: Can one of you have a look at line 253 of the patch? I need some > expertise on the bind_c behavior. My patch needs the check for is_bind_c added > in trans_expr.c (gfc_conv_expr) to prevent mistyping an associated variable > in a select type() during the conv. Background: This code fragment taken from > the testcase in the patch: > > 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 > > has the conditions required for line trans-expr.c:6630 of gfc_conv_expr when > the associate variable w is converted. This transforms the type of the > associate variable to something unexpected in the further processing leading to > some issues during fortraning. Janus told me, that the f90_type has been abused > for some other things (unlimited polymorphic treatment). Although I believe > that reading the comments above the if in question, the check I had to enhance > is treating bind_c stuff (see the threads content for more). I would feel safer > when one of you gfortran gurus can have a look and given an opinion, whether > the change is problematic. I couldn't figure why w is resolved to meet the > criteria (any ideas). Btw, all regtest are ok reporting no issues at all. > > Bootstraps and regtests ok on x86_64-linux-gnu > > Regards, > Andre > > > On Sat, 3 Jan 2015 16:45:07 +0100 > Janus Weil <janus@gcc.gnu.org> wrote: > >> Hi Andre, >> >> >> >> For the >> >> >> second one (in gfc_conv_expr), I don't directly see how it's related >> >> >> to deferred char-len. Why is this change needed? >> >> > >> >> > That change is needed, because in some rare case where an associated >> >> > variable in a "select type ()" is used, then the type and f90_type match >> >> > the condition while them not really being in a bind_c context. Therefore >> >> > I have added the check for bind_c. Btw, I now have removed the TODO, >> >> > because that case is covered by the regression tests. >> >> >> >> I don't understand how f90_type can be BT_VOID without being in a >> >> BIND_C context, but I'm not really a ISO_C_BINDING expert. Which test >> >> case is the one that triggered this? >> > >> > This case is triggered by the test-case in the patch, where in the select >> > type (w => arg) in module m routine bar the w meets the criteria to make the >> > condition become true. The type of w is then "fixed" and gfortran would >> > terminate, because the type of w would be set be and BT_INTEGER. I tried to >> > backtrace where this is coming from, but to no success. In the resolve () of >> > the select type it looks all quite ok, but in the trans stage the criteria >> > are met. Most intriguing to me is, that in the condition we are talking >> > about the type of w and f90_type of the derived class' ts >> > (expr->ts.u.derived->ts.f90_type) of w is examined. But >> > expr->ts.u.derived->ts does not describe the type of w, but of the class w >> > is associate with __STAR... >> > >> > So I am not quite sure how to fix this, if this really needs fixing. When I >> > understand you right, then f90_type should only be set in a bind_c context, >> > so adding that check wouldn't hurt, right? >> >> Yes, in principle adding the check for attr.bind_c looks ok to me >> (alternatively one could also check for attr.unlimited_polymorphic). I >> think originally BT_VOID was indeed only used in a bind_c context, but >> recently it has also been 'hijacked' for unlimited polymorphism, e.g. >> for the STAR symbol and some of the components of the intrinsic vtabs. >> >> What I don't really understand is why these problems are triggered by >> your patch now and have not crept up earlier in other use-cases of >> CLASS(*). >> >> >> >> >> 3) The function 'gfc_get_len_component' that you're introducing is >> >> >> only called in a single place. Do you expect this to be useful in >> >> >> other places in the future, or could one remove the function and >> >> >> insert the code inline? >> >> > >> >> > In one of the first versions it was uses from two locations. But I had to >> >> > remove one call site again. I am currently not sure, if I will be using >> >> > it in the patch for allocatable components when deferred char arrays are >> >> > handled. So what I do I do now? Inline it and when needed make it >> >> > explicit again in a future patch? >> >> >> >> I leave that up to you. In principle I'm fine with keeping it as it >> >> is. The only problem I see is that the function name sounds rather >> >> general, but it apparently expects the expression to be an ASSOCIATE >> >> symbol. >> > >> > I am nearly finished with the patch on allocatable scalar components and I >> > don't need the code there. Therefore I have inlined the routine. >> >> Ok, good. Could you please post an updated patch? >> >> >> > So, what do we do about the bind_c issue above? Is some bind_c guru >> > available to have a look at this? It would be very much appreciated. >> >> From my non-guru POV, it can stay as is. >> >> It would be helpful if someone like Paul or Tobias could have a look >> at the patch before it goes to trunk. I think it's pretty close to >> being ready for prime-time. Thanks for your work! >> >> Cheers, >> Janus > > > -- > Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen > Tel.: +49 241 9291018 * Email: vehre@gmx.de
Hi all, hi Paul, I started to implement the changes requested below, but I stumbled over an oddity: For a deferred length kind4 char array, the length of the string is stored without multiplication by 4 in the length variable attached. So when we now decide to store the length of the string in an unlimited polymorphic entity in bytes in the component formerly called _len and the size of each character in _vtype->_size then we have an inconsistency with the style deferred char lengths are stored. IMHO we should store this consistently, i.e., both 'length'-variables store either the length of the string ('length' = array_len) or the size of the memory needed ('length' = array_len * char_size). What do you think? Furthermore, think about debugging: When looking at an unlimited polymorphic entity storing a kind-4-char-array of length 7, then having a 'length' component set to 28 will lead to confusion. I humbly predict, that this will produce many entries in the bugtracker, because people don't understand that 'length' stores the product of elem_size times string_len, because all they see is an assignment of a length-7 char array. What do we do about it? Regards, Andre On Thu, 8 Jan 2015 20:56:43 +0100 Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote: > Dear Andre, > > Thanks for the patch. As I have said to you, off list, I think that > the _size field in the vtable should contain the kind information and > that the _len field should carry the length of the string in bytes. I > think that it is better to optimise array access this way than to > avoid the division in evaluating LEN (). I am happy to accept contrary > opinions from the others. > > I do not believe that the bind_c issue is an issue. Your patch > correctly deals with it IMHO. > > Subject to the above change in the value of _len, I think that your > patch is OK for trunk. > > With best regards > > Paul > > On 4 January 2015 at 13:40, Andre Vehreschild <vehre@gmx.de> wrote: > > Hi Janus, hi Paul, hi Tobias, > > > > Janus: During code review, I found that I had the code in > > gfc_get_len_component() duplicated. So I now reintroduced and documented the > > routine making is more commonly usable and added more documentation. The > > call sites are now simplify.c (gfc_simplify_len) and trans-expr.c > > (gfc_trans_pointer_assignment). Attached is the reworked version of the > > patch. > > > > Paul, Tobias: Can one of you have a look at line 253 of the patch? I need > > some expertise on the bind_c behavior. My patch needs the check for > > is_bind_c added in trans_expr.c (gfc_conv_expr) to prevent mistyping an > > associated variable in a select type() during the conv. Background: This > > code fragment taken from the testcase in the patch: > > > > 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 > > > > has the conditions required for line trans-expr.c:6630 of gfc_conv_expr when > > the associate variable w is converted. This transforms the type of the > > associate variable to something unexpected in the further processing > > leading to some issues during fortraning. Janus told me, that the f90_type > > has been abused for some other things (unlimited polymorphic treatment). > > Although I believe that reading the comments above the if in question, the > > check I had to enhance is treating bind_c stuff (see the threads content > > for more). I would feel safer when one of you gfortran gurus can have a > > look and given an opinion, whether the change is problematic. I couldn't > > figure why w is resolved to meet the criteria (any ideas). Btw, all regtest > > are ok reporting no issues at all. > > > > Bootstraps and regtests ok on x86_64-linux-gnu > > > > Regards, > > Andre > > > > > > On Sat, 3 Jan 2015 16:45:07 +0100 > > Janus Weil <janus@gcc.gnu.org> wrote: > > > >> Hi Andre, > >> > >> >> >> For the > >> >> >> second one (in gfc_conv_expr), I don't directly see how it's related > >> >> >> to deferred char-len. Why is this change needed? > >> >> > > >> >> > That change is needed, because in some rare case where an associated > >> >> > variable in a "select type ()" is used, then the type and f90_type > >> >> > match the condition while them not really being in a bind_c context. > >> >> > Therefore I have added the check for bind_c. Btw, I now have removed > >> >> > the TODO, because that case is covered by the regression tests. > >> >> > >> >> I don't understand how f90_type can be BT_VOID without being in a > >> >> BIND_C context, but I'm not really a ISO_C_BINDING expert. Which test > >> >> case is the one that triggered this? > >> > > >> > This case is triggered by the test-case in the patch, where in the select > >> > type (w => arg) in module m routine bar the w meets the criteria to make > >> > the condition become true. The type of w is then "fixed" and gfortran > >> > would terminate, because the type of w would be set be and BT_INTEGER. I > >> > tried to backtrace where this is coming from, but to no success. In the > >> > resolve () of the select type it looks all quite ok, but in the trans > >> > stage the criteria are met. Most intriguing to me is, that in the > >> > condition we are talking about the type of w and f90_type of the derived > >> > class' ts (expr->ts.u.derived->ts.f90_type) of w is examined. But > >> > expr->ts.u.derived->ts does not describe the type of w, but of the class > >> > w is associate with __STAR... > >> > > >> > So I am not quite sure how to fix this, if this really needs fixing. > >> > When I understand you right, then f90_type should only be set in a > >> > bind_c context, so adding that check wouldn't hurt, right? > >> > >> Yes, in principle adding the check for attr.bind_c looks ok to me > >> (alternatively one could also check for attr.unlimited_polymorphic). I > >> think originally BT_VOID was indeed only used in a bind_c context, but > >> recently it has also been 'hijacked' for unlimited polymorphism, e.g. > >> for the STAR symbol and some of the components of the intrinsic vtabs. > >> > >> What I don't really understand is why these problems are triggered by > >> your patch now and have not crept up earlier in other use-cases of > >> CLASS(*). > >> > >> > >> >> >> 3) The function 'gfc_get_len_component' that you're introducing is > >> >> >> only called in a single place. Do you expect this to be useful in > >> >> >> other places in the future, or could one remove the function and > >> >> >> insert the code inline? > >> >> > > >> >> > In one of the first versions it was uses from two locations. But I > >> >> > had to remove one call site again. I am currently not sure, if I will > >> >> > be using it in the patch for allocatable components when deferred > >> >> > char arrays are handled. So what I do I do now? Inline it and when > >> >> > needed make it explicit again in a future patch? > >> >> > >> >> I leave that up to you. In principle I'm fine with keeping it as it > >> >> is. The only problem I see is that the function name sounds rather > >> >> general, but it apparently expects the expression to be an ASSOCIATE > >> >> symbol. > >> > > >> > I am nearly finished with the patch on allocatable scalar components and > >> > I don't need the code there. Therefore I have inlined the routine. > >> > >> Ok, good. Could you please post an updated patch? > >> > >> > >> > So, what do we do about the bind_c issue above? Is some bind_c guru > >> > available to have a look at this? It would be very much appreciated. > >> > >> From my non-guru POV, it can stay as is. > >> > >> It would be helpful if someone like Paul or Tobias could have a look > >> at the patch before it goes to trunk. I think it's pretty close to > >> being ready for prime-time. Thanks for your work! > >> > >> Cheers, > >> Janus > > > > > > -- > > Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen > > Tel.: +49 241 9291018 * Email: vehre@gmx.de > > >
Dear Andre, Perhaps, rather than calling the new component _len, we should call it _mem_size or some such? Cheers Paul On 9 January 2015 at 11:52, Andre Vehreschild <vehre@gmx.de> wrote: > Hi all, hi Paul, > > I started to implement the changes requested below, but I stumbled over an > oddity: > > For a deferred length kind4 char array, the length of the string is stored > without multiplication by 4 in the length variable attached. So when we now > decide to store the length of the string in an unlimited polymorphic entity in > bytes in the component formerly called _len and the size of each character in > _vtype->_size then we have an inconsistency with the style deferred char > lengths are stored. IMHO we should store this consistently, i.e., both > 'length'-variables store either the length of the string ('length' = array_len) > or the size of the memory needed ('length' = array_len * char_size). What do > you think? > > Furthermore, think about debugging: When looking at an unlimited polymorphic > entity storing a kind-4-char-array of length 7, then having a 'length' component > set to 28 will lead to confusion. I humbly predict, that this will produce many > entries in the bugtracker, because people don't understand that 'length' stores > the product of elem_size times string_len, because all they see is an > assignment of a length-7 char array. > > What do we do about it? > > Regards, > Andre > > On Thu, 8 Jan 2015 20:56:43 +0100 > Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote: > >> Dear Andre, >> >> Thanks for the patch. As I have said to you, off list, I think that >> the _size field in the vtable should contain the kind information and >> that the _len field should carry the length of the string in bytes. I >> think that it is better to optimise array access this way than to >> avoid the division in evaluating LEN (). I am happy to accept contrary >> opinions from the others. >> >> I do not believe that the bind_c issue is an issue. Your patch >> correctly deals with it IMHO. >> >> Subject to the above change in the value of _len, I think that your >> patch is OK for trunk. >> >> With best regards >> >> Paul >> >> On 4 January 2015 at 13:40, Andre Vehreschild <vehre@gmx.de> wrote: >> > Hi Janus, hi Paul, hi Tobias, >> > >> > Janus: During code review, I found that I had the code in >> > gfc_get_len_component() duplicated. So I now reintroduced and documented the >> > routine making is more commonly usable and added more documentation. The >> > call sites are now simplify.c (gfc_simplify_len) and trans-expr.c >> > (gfc_trans_pointer_assignment). Attached is the reworked version of the >> > patch. >> > >> > Paul, Tobias: Can one of you have a look at line 253 of the patch? I need >> > some expertise on the bind_c behavior. My patch needs the check for >> > is_bind_c added in trans_expr.c (gfc_conv_expr) to prevent mistyping an >> > associated variable in a select type() during the conv. Background: This >> > code fragment taken from the testcase in the patch: >> > >> > 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 >> > >> > has the conditions required for line trans-expr.c:6630 of gfc_conv_expr when >> > the associate variable w is converted. This transforms the type of the >> > associate variable to something unexpected in the further processing >> > leading to some issues during fortraning. Janus told me, that the f90_type >> > has been abused for some other things (unlimited polymorphic treatment). >> > Although I believe that reading the comments above the if in question, the >> > check I had to enhance is treating bind_c stuff (see the threads content >> > for more). I would feel safer when one of you gfortran gurus can have a >> > look and given an opinion, whether the change is problematic. I couldn't >> > figure why w is resolved to meet the criteria (any ideas). Btw, all regtest >> > are ok reporting no issues at all. >> > >> > Bootstraps and regtests ok on x86_64-linux-gnu >> > >> > Regards, >> > Andre >> > >> > >> > On Sat, 3 Jan 2015 16:45:07 +0100 >> > Janus Weil <janus@gcc.gnu.org> wrote: >> > >> >> Hi Andre, >> >> >> >> >> >> For the >> >> >> >> second one (in gfc_conv_expr), I don't directly see how it's related >> >> >> >> to deferred char-len. Why is this change needed? >> >> >> > >> >> >> > That change is needed, because in some rare case where an associated >> >> >> > variable in a "select type ()" is used, then the type and f90_type >> >> >> > match the condition while them not really being in a bind_c context. >> >> >> > Therefore I have added the check for bind_c. Btw, I now have removed >> >> >> > the TODO, because that case is covered by the regression tests. >> >> >> >> >> >> I don't understand how f90_type can be BT_VOID without being in a >> >> >> BIND_C context, but I'm not really a ISO_C_BINDING expert. Which test >> >> >> case is the one that triggered this? >> >> > >> >> > This case is triggered by the test-case in the patch, where in the select >> >> > type (w => arg) in module m routine bar the w meets the criteria to make >> >> > the condition become true. The type of w is then "fixed" and gfortran >> >> > would terminate, because the type of w would be set be and BT_INTEGER. I >> >> > tried to backtrace where this is coming from, but to no success. In the >> >> > resolve () of the select type it looks all quite ok, but in the trans >> >> > stage the criteria are met. Most intriguing to me is, that in the >> >> > condition we are talking about the type of w and f90_type of the derived >> >> > class' ts (expr->ts.u.derived->ts.f90_type) of w is examined. But >> >> > expr->ts.u.derived->ts does not describe the type of w, but of the class >> >> > w is associate with __STAR... >> >> > >> >> > So I am not quite sure how to fix this, if this really needs fixing. >> >> > When I understand you right, then f90_type should only be set in a >> >> > bind_c context, so adding that check wouldn't hurt, right? >> >> >> >> Yes, in principle adding the check for attr.bind_c looks ok to me >> >> (alternatively one could also check for attr.unlimited_polymorphic). I >> >> think originally BT_VOID was indeed only used in a bind_c context, but >> >> recently it has also been 'hijacked' for unlimited polymorphism, e.g. >> >> for the STAR symbol and some of the components of the intrinsic vtabs. >> >> >> >> What I don't really understand is why these problems are triggered by >> >> your patch now and have not crept up earlier in other use-cases of >> >> CLASS(*). >> >> >> >> >> >> >> >> 3) The function 'gfc_get_len_component' that you're introducing is >> >> >> >> only called in a single place. Do you expect this to be useful in >> >> >> >> other places in the future, or could one remove the function and >> >> >> >> insert the code inline? >> >> >> > >> >> >> > In one of the first versions it was uses from two locations. But I >> >> >> > had to remove one call site again. I am currently not sure, if I will >> >> >> > be using it in the patch for allocatable components when deferred >> >> >> > char arrays are handled. So what I do I do now? Inline it and when >> >> >> > needed make it explicit again in a future patch? >> >> >> >> >> >> I leave that up to you. In principle I'm fine with keeping it as it >> >> >> is. The only problem I see is that the function name sounds rather >> >> >> general, but it apparently expects the expression to be an ASSOCIATE >> >> >> symbol. >> >> > >> >> > I am nearly finished with the patch on allocatable scalar components and >> >> > I don't need the code there. Therefore I have inlined the routine. >> >> >> >> Ok, good. Could you please post an updated patch? >> >> >> >> >> >> > So, what do we do about the bind_c issue above? Is some bind_c guru >> >> > available to have a look at this? It would be very much appreciated. >> >> >> >> From my non-guru POV, it can stay as is. >> >> >> >> It would be helpful if someone like Paul or Tobias could have a look >> >> at the patch before it goes to trunk. I think it's pretty close to >> >> being ready for prime-time. Thanks for your work! >> >> >> >> Cheers, >> >> Janus >> > >> > >> > -- >> > Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen >> > Tel.: +49 241 9291018 * Email: vehre@gmx.de >> >> >> > > > -- > Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen > Tel.: +49 241 9291018 * Email: vehre@gmx.de
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 5130022..eda825c 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -34,6 +34,12 @@ along with GCC; see the file COPYING3. If not see (pointer/allocatable/dimension/...). * _vptr: A pointer to the vtable entry (see below) of the dynamic type. + Only for unlimited polymorphic classes: + * _len: An integer(4) to store the string length when the unlimited + polymorphic pointer is used to point to a char array. The '_len' + component will be zero when no character array is stored in + '_data'. + For each derived type we set up a "vtable" entry, i.e. a structure with the following fields: * _hash: A hash value serving as a unique identifier for this type. @@ -544,10 +550,48 @@ gfc_intrinsic_hash_value (gfc_typespec *ts) } +/* Get the _len component from a class/derived object storing a string. + For unlimited polymorphic entities a ref to the _data component is available + while a ref to the _len component is needed. This routine traverese the + ref-chain and strips the last ref to a _data from it replacing it with a + ref to the _len component. */ + +gfc_expr * +gfc_get_len_component (gfc_expr *e) +{ + gfc_expr *ptr; + gfc_ref *ref, **last; + + ptr = gfc_copy_expr (e); + + /* We need to remove the last _data component ref from ptr. */ + last = &(ptr->ref); + ref = ptr->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; + } + /* And replace if with a ref to the _len component. */ + gfc_add_component_ref (ptr, "_len"); + return ptr; +} + + /* Build a polymorphic CLASS entity, using the symbol that comes from build_sym. A CLASS entity is represented by an encapsulating type, which contains the declared type as '_data' component, plus a pointer - component '_vptr' which determines the dynamic type. */ + component '_vptr' which determines the dynamic type. When this CLASS + entity is unlimited polymorphic, then also add a component '_len' to + store the length of string when that is stored in it. */ bool gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, @@ -645,19 +689,28 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, if (!gfc_add_component (fclass, "_vptr", &c)) return false; c->ts.type = BT_DERIVED; + c->attr.access = ACCESS_PRIVATE; + c->attr.pointer = 1; if (ts->u.derived->attr.unlimited_polymorphic) { vtab = gfc_find_derived_vtab (ts->u.derived); gcc_assert (vtab); c->ts.u.derived = vtab->ts.u.derived; + + /* Add component '_len'. Only unlimited polymorphic pointers may + have a string assigned to them, i.e., only those need the _len + component. */ + if (!gfc_add_component (fclass, "_len", &c)) + return false; + c->ts.type = BT_INTEGER; + c->ts.kind = 4; + c->attr.access = ACCESS_PRIVATE; + c->attr.artificial = 1; } else /* Build vtab later. */ c->ts.u.derived = NULL; - - c->attr.access = ACCESS_PRIVATE; - c->attr.pointer = 1; } if (!ts->u.derived->attr.unlimited_polymorphic) @@ -2415,18 +2468,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) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 41c6c57..d4bfeea 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3123,6 +3123,7 @@ bool gfc_is_class_scalar_expr (gfc_expr *); bool gfc_is_class_container_ref (gfc_expr *e); gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *); unsigned int gfc_hash_value (gfc_symbol *); +gfc_expr *gfc_get_len_component (gfc_expr *e); bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *, gfc_array_spec **); gfc_symbol *gfc_find_derived_vtab (gfc_symbol *); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index d46c5db..ac2d3f7 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -3713,6 +3713,14 @@ 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) + /* The expression in assoc->target points to a ref to the _data component + of the unlimited polymorphic entity. To get the _len component the last + _data ref needs to be stripped and a ref to the _len component added. */ + return gfc_get_len_component (e->symtree->n.sym->assoc->target); else return NULL; } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 3793cfb..2ebf959 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -94,6 +94,7 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) in future implementations. Use the corresponding APIs. */ #define CLASS_DATA_FIELD 0 #define CLASS_VPTR_FIELD 1 +#define CLASS_LEN_FIELD 2 #define VTABLE_HASH_FIELD 0 #define VTABLE_SIZE_FIELD 1 #define VTABLE_EXTENDS_FIELD 2 @@ -148,6 +149,20 @@ gfc_class_vptr_get (tree decl) } +tree +gfc_class_len_get (tree decl) +{ + tree len; + if (POINTER_TYPE_P (TREE_TYPE (decl))) + decl = build_fold_indirect_ref_loc (input_location, decl); + len = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (decl)), + CLASS_LEN_FIELD); + return fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (len), decl, len, + NULL_TREE); +} + + static tree gfc_vtable_field_get (tree decl, int field) { @@ -617,6 +632,45 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e, } } + /* When the actual arg is a char array, then set the _len component of the + unlimited polymorphic entity, too. */ + if (e->ts.type == BT_CHARACTER) + { + ctree = gfc_class_len_get (var); + /* Start with parmse->string_length because this seems to be set to a + correct value more often. */ + if (parmse->string_length) + gfc_add_modify (&parmse->pre, ctree, parmse->string_length); + /* When the string_length is not yet set, then try the backend_decl of + the cl. */ + else if (e->ts.u.cl->backend_decl) + gfc_add_modify (&parmse->pre, ctree, e->ts.u.cl->backend_decl); + /* If both of the above approaches fail, then try to generate an + expression from the input, which is only feasible currently, when the + expression can be evaluated to a constant one. */ + else + { + /* Try to simplify the expression. */ + gfc_simplify_expr (e, 0); + if (e->expr_type == EXPR_CONSTANT && !e->ts.u.cl->resolved) + { + /* Amazingly all data is present to compute the length of a + constant string, but the expression is not yet there. */ + e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER, 1, + &e->where); + mpz_set_ui (e->ts.u.cl->length->value.integer, + e->value.character.length); + gfc_conv_const_charlen (e->ts.u.cl); + e->ts.u.cl->resolved = 1; + gfc_add_modify (&parmse->pre, ctree, e->ts.u.cl->backend_decl); + } + else + { + gfc_error ("Can't compute the length of the char array at %L.", + &e->where); + } + } + } /* Pass the address of the class object. */ parmse->expr = gfc_build_addr_expr (NULL_TREE, var); } @@ -6489,6 +6543,14 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) fold_convert (TREE_TYPE (cm->backend_decl), val)); } + else if (cm->ts.type == BT_INTEGER && strcmp (cm->name, "_len") == 0) + { + gfc_expr *e = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0); + val = gfc_conv_constant_to_tree (e); + CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, + fold_convert (TREE_TYPE (cm->backend_decl), + val)); + } else { val = gfc_conv_initializer (c->expr, &cm->ts, @@ -6565,7 +6627,8 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) null_pointer_node. C_PTR and C_FUNPTR are converted to match the typespec for the C_PTR and C_FUNPTR symbols, which has already been updated to be an integer with a kind equal to the size of a (void *). */ - if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->ts.f90_type == BT_VOID) + if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->ts.f90_type == BT_VOID + && expr->ts.u.derived->attr.is_bind_c) { if (expr->expr_type == EXPR_VARIABLE && (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR @@ -6833,6 +6896,27 @@ 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_CLASS || expr1->ts.type == BT_DERIVED) + && expr1->ts.u.derived->attr.unlimited_polymorphic + && (expr2->ts.type == BT_CHARACTER || + ((expr2->ts.type == BT_DERIVED || expr2->ts.type == BT_CLASS) + && expr2->ts.u.derived->attr.unlimited_polymorphic))) + { + gfc_expr *len_comp; + gfc_se se; + len_comp = gfc_get_len_component (expr1); + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, len_comp); + + /* ptr % _len = len (str) */ + gfc_add_modify (&block, se.expr, rse.string_length); + lse.string_length = se.expr; + gfc_free_expr (len_comp); + } + /* 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/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 24e47f2..3a3c31b 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1143,6 +1143,22 @@ gfc_trans_critical (gfc_code *code) } +/* Return true, when the class has a _len component. */ + +static bool +class_has_len_component (gfc_symbol *sym) +{ + gfc_component *comp = sym->ts.u.derived->components; + while (comp) + { + if (strcmp (comp->name, "_len") == 0) + return true; + comp = comp->next; + } + return false; +} + + /* Do proper initialization for ASSOCIATE names. */ static void @@ -1156,6 +1172,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) tree offset; tree dim; int n; + tree charlen; + bool need_len_assign; gcc_assert (sym->assoc); e = sym->assoc->target; @@ -1166,6 +1184,20 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) unlimited = UNLIMITED_POLY (e); + /* Assignments to the string length need to be generated, when + ( sym is a char array or + sym has a _len component) + and the associated expression is unlimited polymorphic, which is + not (yet) correctly in 'unlimited', because for an already associated + BT_DERIVED the u-poly flag is not set, i.e., + __tmp_CHARACTER_0_1 => w => arg + ^ generated temp ^ from code, the w does not have the u-poly + flag set, where UNLIMITED_POLY(e) expects it. */ + need_len_assign = ((unlimited || (e->ts.type == BT_DERIVED + && e->ts.u.derived->attr.unlimited_polymorphic)) + && (sym->ts.type == BT_CHARACTER + || ((sym->ts.type == BT_CLASS || sym->ts.type == BT_DERIVED) + && class_has_len_component (sym)))); /* Do a `pointer assignment' with updated descriptor (or assign descriptor to array temporary) for arrays with either unknown shape or if associating to a variable. */ @@ -1265,8 +1297,11 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) unconditionally associate pointers and the symbol is scalar. */ if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension) { + tree target_expr; /* For a class array we need a descriptor for the selector. */ gfc_conv_expr_descriptor (&se, e); + /* Needed to get/set the _len component below. */ + target_expr = se.expr; /* Obtain a temporary class container for the result. */ gfc_conv_class_to_class (&se, e, sym->ts, false, true, false, false); @@ -1286,6 +1321,23 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_array_index_type, offset, tmp); } + if (need_len_assign) + { + /* Get the _len comp from the target expr by stripping _data + from it and adding component-ref to _len. */ + tmp = gfc_class_len_get (TREE_OPERAND (target_expr, 0)); + /* Get the component-ref for the temp structure's _len comp. */ + charlen = gfc_class_len_get (se.expr); + /* Add the assign to the beginning of the the block... */ + gfc_add_modify (&se.pre, charlen, + fold_convert (TREE_TYPE (charlen), tmp)); + /* and the oposite way at the end of the block, to hand changes + on the string length back. */ + gfc_add_modify (&se.post, tmp, + fold_convert (TREE_TYPE (tmp), charlen)); + /* Length assignment done, prevent adding it again below. */ + need_len_assign = false; + } gfc_conv_descriptor_offset_set (&se.pre, desc, offset); } else if (sym->ts.type == BT_CLASS && e->ts.type == BT_CLASS @@ -1300,7 +1352,13 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) se.expr = build_fold_indirect_ref_loc (input_location, se.expr); } else - gfc_conv_expr (&se, e); + { + /* For BT_CLASS and BT_DERIVED, this boils down to a pointer assign, + which has the string length included. For CHARACTERS it is still + needed and will be done at the end of this routine. */ + gfc_conv_expr (&se, e); + need_len_assign = need_len_assign && sym->ts.type == BT_CHARACTER; + } tmp = TREE_TYPE (sym->backend_decl); tmp = gfc_build_addr_expr (tmp, se.expr); @@ -1321,21 +1379,30 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_add_init_cleanup (block, tmp, NULL_TREE); } - /* Set the stringlength from the vtable size. */ - if (sym->ts.type == BT_CHARACTER && sym->attr.select_type_temporary) + /* Set the stringlength, when needed. */ + if (need_len_assign) { - tree charlen; gfc_se se; gfc_init_se (&se, NULL); - gcc_assert (UNLIMITED_POLY (e->symtree->n.sym)); - tmp = gfc_get_symbol_decl (e->symtree->n.sym); - tmp = gfc_vtable_size_get (tmp); + if (e->symtree->n.sym->ts.type == BT_CHARACTER) + { + /* What about deferred strings? */ + gcc_assert (!e->symtree->n.sym->ts.deferred); + tmp = e->symtree->n.sym->ts.u.cl->backend_decl; + } + else + tmp = gfc_class_len_get (gfc_get_symbol_decl (e->symtree->n.sym)); gfc_get_symbol_decl (sym); - charlen = sym->ts.u.cl->backend_decl; - gfc_add_modify (&se.pre, charlen, - fold_convert (TREE_TYPE (charlen), tmp)); - gfc_add_init_cleanup (block, gfc_finish_block( &se.pre), - gfc_finish_block (&se.post)); + charlen = sym->ts.type == BT_CHARACTER ? sym->ts.u.cl->backend_decl + : gfc_class_len_get (sym->backend_decl); + /* Prevent adding a noop len= len. */ + if (tmp != charlen) + { + gfc_add_modify (&se.pre, charlen, + fold_convert (TREE_TYPE (charlen), tmp)); + gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), + gfc_finish_block (&se.post)); + } } } @@ -5050,6 +5117,15 @@ gfc_trans_allocate (gfc_code * code) gfc_add_modify (&se.pre, se.string_length, fold_convert (TREE_TYPE (se.string_length), memsz)); + else if ((al->expr->ts.type == BT_DERIVED + || al->expr->ts.type == BT_CLASS) + && expr->ts.u.derived->attr.unlimited_polymorphic) + { + tmp = gfc_class_len_get (al->expr->symtree->n.sym->backend_decl); + gfc_add_modify (&se.pre, tmp, + fold_convert (TREE_TYPE (tmp), + memsz)); + } /* Convert to size in bytes, using the character KIND. */ if (unlimited_char) diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 51ad910..3926c2a 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -348,6 +348,7 @@ gfc_wrapped_block; /* Class API functions. */ tree gfc_class_data_get (tree); tree gfc_class_vptr_get (tree); +tree gfc_class_len_get (tree); void gfc_reset_vptr (stmtblock_t *, gfc_expr *); tree gfc_class_set_static_fields (tree, tree, tree); tree gfc_vtable_hash_get (tree); 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 diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_20.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_20.f03 new file mode 100644 index 0000000..c6c6d29 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_20.f03 @@ -0,0 +1,104 @@ +! { dg-do run } +! +! Testing fix for PR fortran/60255 +! +! Author: Andre Vehreschild <vehre@gmx.de> +! +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 + +program test + use m; + implicit none + character(LEN=:), allocatable, target :: S + character(LEN=100) :: res + class(*), pointer :: ucp + call sub1 ("long test string", 16) + call sub2 () + S = "test" + ucp => S + call sub3 (ucp) + call sub4 (S, 4) + call sub4 ("This is a longer string.", 24) + call bar (S, res) + if (trim (res) .NE. " 4") call abort () + call bar(ucp, res) + if (trim (res) .NE. " 4") call abort () + +contains + + subroutine sub1(dcl, ilen) + character(len=*), target :: dcl + integer(4) :: ilen + character(len=:), allocatable :: hlp + class(*), pointer :: ucp + + ucp => dcl + + select type (ucp) + type is (character(len=*)) + if (len(dcl) .NE. ilen) call abort () + if (len(ucp) .NE. ilen) call abort () + hlp = ucp + if (len(hlp) .NE. ilen) call abort () + 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) call abort () + class default + call abort() + end select + end subroutine + + subroutine sub3(ucp) + character(len=:), allocatable :: hlp + class(*), pointer :: ucp + + select type (ucp) + type is (character(len=*)) + if (len(ucp) .ne. 4) call abort () + hlp = ucp + if (len(hlp) .ne. 4) call abort () + class default + call abort() + end select + end subroutine + + subroutine sub4(ucp, ilen) + character(len=:), allocatable :: hlp + integer(4) :: ilen + class(*) :: ucp + + select type (ucp) + type is (character(len=*)) + if (len(ucp) .ne. ilen) call abort () + hlp = ucp + if (len(hlp) .ne. ilen) call abort () + class default + call abort() + end select + end subroutine +end program +