From patchwork Sun Aug 10 11:55:49 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 378831 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 5C6E31400D6 for ; Sun, 10 Aug 2014 21:56:12 +1000 (EST) 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:subject:message-id:mime-version:content-type; q=dns; s= default; b=GKbloW50qA4ukF22ASltdaDXHiBqnVS702g98dtUihVNy4f3t5tqf 6dKnQ+uHDdbsp+KJ9GujdCbNsM1xMSUy7YL6DMVKG+TvVmjneDwQr6aU5o48DTOz 3MDS1chv4IpP1KE+z+aEiEg+lHSv1rpGRYVm2xNlRltYUlFab/c/h0= 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:subject:message-id:mime-version:content-type; s= default; bh=r5p5Vi1aXBC8jvmudqCL5MN/0bI=; b=dubU2OIYMeqpnkFgkLaL qbehEln7Rv/X9O26Q6vM9aXg2liAxAaLLIDLhDcMnFqdkDRwScdeFZqXgJfmtvhb /Hh+T+pgdfjqNyqxQpHXFs6gGzKFRMRqSzegFWtI2xzE8oUUBTCoaUo0VK+13PI4 IgC0Ubhq/zpEaU36qv7VWRw= Received: (qmail 6943 invoked by alias); 10 Aug 2014 11:55:56 -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 6917 invoked by uid 89); 10 Aug 2014 11:55:55 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.2 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, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.19) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Sun, 10 Aug 2014 11:55:53 +0000 Received: from vepi2.private ([84.63.36.188]) by mail.gmx.com (mrgmx003) with ESMTPSA (Nemesis) id 0MWk7n-1WvlOP1fvH-00XwYU; Sun, 10 Aug 2014 13:55:50 +0200 Date: Sun, 10 Aug 2014 13:55:49 +0200 From: Andre Vehreschild To: GCC-Fortran-ML , GCC-Patches-ML Subject: [PATCH, Fortran] PR fortran/60289 First try on: Fixing character array allocation for class(*) type variable Message-ID: <20140810135549.3b9ca9cd@vepi2.private> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; Hi, I am proposing another patch, this time to resolve PR60289. The issue in the bug reported is, that a code like: class(*), pointer :: P allocate(character(20)::P) is rejected by trunk's gfortran compiler. janus@gcc.gnu.org proposed a first patch in the PR, which my patch extends. Motivation: Previously parsing of the type association to the unlimited polymorphic variable P was not allowed and reported the error "Error: Allocating p at (1) with type-spec requires the same character-length parameter as in the declaration", after the errorneous error report was fixed by janus' patch, an ICE occured in trans-stmt.c's gfc_trans_allocate()-routine. The ICE reported in PR60289 is something different and does not occur in trunk anymore. The ICE reported now boils down to line 5056 in trans-stmt.c: tmp= al->expr->ts.u.cl->backend_decl; The dereferencing of ts.u's cl member is valid only, when ts.type is of BT_CHARACTER. With al->expr being an unlimited polymorphic type, the backend_decl is not available in cl. Although there is a backend_decl available in ts.u.derived, I was not able to get it compatible for the fold_convert in the line following the assignment to tmp: gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE(tmp), se_sz.expr)); My current solution therefore is to execute those two statements only, when ts.type is of BT_CHARACTER. Can someone explain what the fold_convert is doing in that specific place? I assume that it is checking for and ensuring some type compatibility. Is there some documentation available, explaining this? Is something similar needed for the unlimited polymorphic variable? Attached patch bootstraps and regtests ok on x86_64-unknown-linux-gnu. You may need to have my patch for 60255 incorporated, too, for testing. Regards, Andre diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 15d8dab..15d3613 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6878,7 +6878,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) 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); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 547e9c1..575342d 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5046,7 +5046,7 @@ gfc_trans_allocate (gfc_code * code) if (unlimited_char) tmp = TREE_TYPE (gfc_typenode_for_spec (&code->expr3->ts)); else - tmp = TREE_TYPE (gfc_typenode_for_spec (&al->expr->ts)); + tmp = TREE_TYPE (gfc_typenode_for_spec (&al->expr->ts)); tmp = TYPE_SIZE_UNIT (tmp); memsz = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp), tmp, @@ -5061,10 +5061,14 @@ gfc_trans_allocate (gfc_code * code) gfc_add_block_to_block (&se.pre, &se_sz.pre); 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; - gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), - se_sz.expr)); + /* Store the string length only when variable allocated is + a character array. */ + if(al->expr->ts.type== BT_CHARACTER) + { + 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)); tmp = TYPE_SIZE_UNIT (tmp); memsz = fold_build2_loc (input_location, MULT_EXPR, diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_20.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_20.f90 new file mode 100644 index 0000000..070ba89 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_20.f90 @@ -0,0 +1,24 @@ +! { dg-do run } +! Testing fix for +! PR fortran/60289 +! +program test + implicit none + + class(*), pointer :: P + + allocate(character(20)::P) + + select type(P) + type is (character(*)) + P ="some test string" + if (P .ne. "some test string") then + call abort() + end if + class default + call abort() + end select + + deallocate(P) +end program test +