From patchwork Fri Feb 6 11:26:01 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 437148 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 0837714012F for ; Fri, 6 Feb 2015 22:27:46 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; q=dns; s=default; b=aMnpnskTd9w13o72 qwxTb5pSnZcbpSiA/pziI4W97R+OCdRhrkmrp6E8EuYcVr5H63PPRAi5cZSBYyMH eztGQ4nvdc21haPOpFehjvFmYjid27LtB7MEH8bcQWB0zYDAovmq//txt56Kuj5N s6/RLHD2PlP3OVBcn7eOrDP1gII= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; s=default; bh=AXtUq3Rr4th3urfizwwTrP ZFyJc=; b=curg8pOX801GbXRpF9NYKiIHwziiHATakqeqcvWWebHLkkwbEc4yn0 qjKbbMKiTHpIhpaFFvIfGZJulJvAQK+weSKyt9CTfUW2YIOUMmGMW7VnXlD24fPL MRL7xl431CYQ/VHyDKaZwHJzt2T2YVbQko6eZMVtz6rdGa3GFJb94= Received: (qmail 24103 invoked by alias); 6 Feb 2015 11:26:15 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 24076 invoked by uid 89); 6 Feb 2015 11:26:15 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.4 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 3 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.17.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Fri, 06 Feb 2015 11:26:13 +0000 Received: from vepi2 ([84.63.49.248]) by mail.gmx.com (mrgmx103) with ESMTPSA (Nemesis) id 0MN1Gu-1YHWFx3DnU-006cUz; Fri, 06 Feb 2015 12:26:06 +0100 Date: Fri, 6 Feb 2015 12:26:01 +0100 From: Andre Vehreschild To: Paul Richard Thomas , "fortran@gcc.gnu.org" , GCC-Patches-ML Cc: Janus Weil , Antony Lewis , Tobias Burnus , Dominique =?UTF-8?B?ZCdIdW1pw6hyZXM=?= Subject: Re: [PATCH, fortran, committed] PR60289 was: PR fortran/60255 Deferred character length + PR60289 Also deferred char len. Message-ID: <20150206122601.7d285bf1@vepi2> In-Reply-To: References: <20150121164222.5452c406@vepi2> <20150129183032.5fea21ed@vepi2> <20150130111946.5682f1f2@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; Hi Paul, thanks for the review. Committed as r220474. Regards, Andre On Thu, 5 Feb 2015 15:15:02 +0100 Paul Richard Thomas wrote: > Dear Andre, > > That's fine to commit to trunk. > > Thanks for the patch > > Paul > > On 30 January 2015 at 11:19, Andre Vehreschild 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 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 > > > 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 , Janus Weil + + 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 + + * gfortran.dg/unlimited_polymorphic_22.f90: New test. + 2015-02-05 Tobias Burnus 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 +! +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