diff mbox

[fortran] PR fortran/60255 Deferred character length

Message ID 20150104134016.4629833c@gmx.de
State New
Headers show

Commit Message

Andre Vehreschild Jan. 4, 2015, 12:40 p.m. UTC
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

Comments

Paul Richard Thomas Jan. 8, 2015, 7:56 p.m. UTC | #1
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 Jan. 9, 2015, 10:52 a.m. UTC | #2
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
> 
> 
>
Paul Richard Thomas Jan. 17, 2015, 10:57 a.m. UTC | #3
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 mbox

Patch

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
+