Hi Paul,
thanks for the review.
Committed as r220474.
Regards,
Andre
On Thu, 5 Feb 2015 15:15:02 +0100
Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote:
> Dear Andre,
>
> That's fine to commit to trunk.
>
> Thanks for the patch
>
> Paul
>
> On 30 January 2015 at 11:19, Andre Vehreschild <ve...@gmx.de> wrote:
> > Hi Paul,
> >
> > thanks for the review. Meanwhile I reread the patch myself and figured, that
> > the comment in the second patch-block was ill-placed and formulated. I
> > therefore changed it to look like this now:
> >
> > diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
> > index 52caaa4..24fab5c 100644
> > --- a/gcc/fortran/trans-stmt.c
> > +++ b/gcc/fortran/trans-stmt.c
> > @@ -5166,7 +5166,16 @@ gfc_trans_allocate (gfc_code * code)
> > se_sz.expr = gfc_evaluate_now (se_sz.expr, &se.pre);
> > gfc_add_block_to_block (&se.pre, &se_sz.post);
> > /* Store the string length. */
> > - tmp = al->expr->ts.u.cl->backend_decl;
> > + if ((expr->symtree->n.sym->ts.type == BT_CLASS
> > + || expr->symtree->n.sym->ts.type == BT_DERIVED)
> > + && expr->ts.u.derived->attr.unlimited_polymorphic)
> > + /* For unlimited polymorphic entities get the backend_decl
> > of
> > + the _len component for that. */
> > + tmp = gfc_class_len_get (gfc_get_symbol_decl (
> > + expr->symtree->n.sym));
> > + else
> > + /* Else use what is stored in the charlen->backend_decl. */
> > + tmp = al->expr->ts.u.cl->backend_decl;
> > gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
> > se_sz.expr));
> > tmp = TREE_TYPE (gfc_typenode_for_spec
> > (&code->ext.alloc.ts));
> >
> > I still hope this is ok for commit. As a newbie, I don't want to mess it up
> > in the beginning and therefore ask one more time for permission.
> >
> > On Thu, 29 Jan 2015 20:13:49 +0000
> > Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote:
> >
> >> I must apologise. I have been working so hard on my own projects that
> >> I failed completely to notice that your patch had not been applied.
> >
> > No problem. Hadn't I been asked, I would have forgotten about it, too. I am
> > working on a bunch of class-array issues starting with pr60322 currently. I
> > hope to be able to submit a patch for it today.
> >
> > Regards,
> > Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 220473)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -5167,7 +5167,16 @@
se_sz.expr = gfc_evaluate_now (se_sz.expr, &se.pre);
gfc_add_block_to_block (&se.pre, &se_sz.post);
/* Store the string length. */
- tmp = al->expr->ts.u.cl->backend_decl;
+ if ((expr->symtree->n.sym->ts.type == BT_CLASS
+ || expr->symtree->n.sym->ts.type == BT_DERIVED)
+ && expr->ts.u.derived->attr.unlimited_polymorphic)
+ /* For unlimited polymorphic entities get the backend_decl of
+ the _len component for that. */
+ tmp = gfc_class_len_get (gfc_get_symbol_decl (
+ expr->symtree->n.sym));
+ else
+ /* Else use what is stored in the charlen->backend_decl. */
+ tmp = al->expr->ts.u.cl->backend_decl;
gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
se_sz.expr));
tmp = TREE_TYPE (gfc_typenode_for_spec (&code->ext.alloc.ts));
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (Revision 220473)
+++ gcc/fortran/resolve.c (Arbeitskopie)
@@ -6933,7 +6933,9 @@
goto failure;
}
- if (code->ext.alloc.ts.type == BT_CHARACTER && !e->ts.deferred)
+ /* Check F08:C632. */
+ if (code->ext.alloc.ts.type == BT_CHARACTER && !e->ts.deferred
+ && !UNLIMITED_POLY (e))
{
int cmp = gfc_dep_compare_expr (e->ts.u.cl->length,
code->ext.alloc.ts.u.cl->length);
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 220473)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,17 @@
+
+2015-01-29 Andre Vehreschild <ve...@gmx.de>, Janus Weil <ja...@gcc.gnu.org>
+
+ PR fortran/60289
+ Initial patch by Janus Weil
+ * resolve.c (resolve_allocate_expr): Add check for comp. only when
+ target is not unlimited polymorphic.
+ * trans-stmt.c (gfc_trans_allocate): Assign correct value to _len
+ component of unlimited polymorphic entities.
+
+2015-01-29 Andre Vehreschild <ve...@gmx.de>
+
+ * gfortran.dg/unlimited_polymorphic_22.f90: New test.
+
2015-02-05 Tobias Burnus <bur...@net-b.de>
PR fortran/64943
Index: gcc/testsuite/gfortran.dg/unlimited_polymorphic_22.f90
===================================================================
--- gcc/testsuite/gfortran.dg/unlimited_polymorphic_22.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/unlimited_polymorphic_22.f90 (Revision 220474)
@@ -0,0 +1,56 @@
+! { dg-do run }
+! Testing fix for PR fortran/60289
+! Contributed by: Andre Vehreschild <ve...@gmx.de>
+!
+program test
+ implicit none
+
+ class(*), pointer :: P
+ integer :: string_len = 10 *2
+
+ allocate(character(string_len)::P)
+
+ select type(P)
+ type is (character(*))
+ P ="some test string"
+ if (P .ne. "some test string") then
+ call abort ()
+ end if
+ if (len(P) .ne. 20) then
+ call abort ()
+ end if
+ if (len(P) .eq. len("some test string")) then
+ call abort ()
+ end if
+ class default
+ call abort ()
+ end select
+
+ deallocate(P)
+
+ ! Now for kind=4 chars.
+
+ allocate(character(len=20,kind=4)::P)
+
+ select type(P)
+ type is (character(len=*,kind=4))
+ P ="some test string"
+ if (P .ne. 4_"some test string") then
+ call abort ()
+ end if
+ if (len(P) .ne. 20) then
+ call abort ()
+ end if
+ if (len(P) .eq. len("some test string")) then
+ call abort ()
+ end if
+ type is (character(len=*,kind=1))
+ call abort ()
+ class default
+ call abort ()
+ end select
+
+ deallocate(P)
+
+
+end program test
