diff mbox

[fortran,committed] PR60289 was: PR fortran/60255 Deferred character length + PR60289 Also deferred char len.

Message ID 20150206122601.7d285bf1@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Feb. 6, 2015, 11:26 a.m. UTC 
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.thomas@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 <vehre@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.thomas@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
> 
> 
>
diff mbox

Patch

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  <vehre@gmx.de>, Janus Weil  <janus@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  <vehre@gmx.de>
+
+	* gfortran.dg/unlimited_polymorphic_22.f90: New test.
+
 2015-02-05  Tobias Burnus  <burnus@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 <vehre@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