From patchwork Fri Jan 16 12:55:52 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 429833 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 E8652140276 for ; Fri, 16 Jan 2015 23:56:13 +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:subject:message-id:mime-version:content-type; q=dns; s= default; b=eXK1jRtovKh6nMFURDFVXH49WKHHhWim1cViGyfu7I852CuQGWj6m PScHM+qw3d4bL8iovvdJShuGRXtnYPOYHJyBdSFMrpDWM3o6qoQikeYDlXvVkHH7 UKh+WO04By5QISB5CjTzQQ6GbMA8xikxI6KINXVb+2fmS/JCM1mH+Y= 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=exgtemxMF7o/Y0lGZ7BXJzxq4O8=; b=TP4PAzyplbsGgW096JaV Cjt/Z+UBsWqBIUJqlsFaniTQ3FgE8LBKhbJjoQ7KIOzm44YCimquIlTI9LJTBCuG uv7USN95+3ECwMjNRPt7/iNR7/omS8IlmjFH0b6/l7ilsINrxOgCVWwxxWhSZ1j3 ci0d5Co1er0bEBV5YzfLclE= Received: (qmail 28394 invoked by alias); 16 Jan 2015 12:56:04 -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 28366 invoked by uid 89); 16 Jan 2015 12:56:03 -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.15.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Fri, 16 Jan 2015 12:56:00 +0000 Received: from vepi2 ([84.63.49.248]) by mail.gmx.com (mrgmx001) with ESMTPSA (Nemesis) id 0MIuzJ-1Y9cX43n1V-002a1Y; Fri, 16 Jan 2015 13:55:56 +0100 Date: Fri, 16 Jan 2015 13:55:52 +0100 From: Andre Vehreschild To: GCC-Fortran-ML , GCC-Patches-ML , Tobias Burnus Subject: [Fortran, Patch] Fix for pr61275 - Invalid initialization expression for ALLOCATABLE component in structure constructor at (1) Message-ID: <20150116135552.1e747ac8@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; Hi all, please find attached a fix for pr61275. With the help of Tobias Burnus, who installed the changes necessary to replace deferred_parameter with artificial this patch now completes my latest fix on pr60357. This also means, that the patch for pr60357 is needed for this one to work! Special thanks to Tobias Burnus for his help. Bootstraps and regtests ok on x86_64-linux-gnu. Please comment. Regards, Andre diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index d4bfeea..9ce9ef0 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -850,9 +850,6 @@ typedef struct /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; - /* Is a parameter associated with a deferred type component. */ - unsigned deferred_parameter:1; - /* The namespace where the attribute has been set. */ struct gfc_namespace *volatile_ns, *asynchronous_ns; } diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 6b1822d..91b35cc 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2379,7 +2379,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, "structure constructor at %C", comp->name)) return false; } - else if (!comp->attr.deferred_parameter) + else if (!comp->attr.artificial) { gfc_error ("No initializer for component %qs given in the" " structure constructor at %C!", comp->name); @@ -2461,7 +2461,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c { /* Components without name are not allowed after the first named component initializer! */ - if (!comp || comp->attr.deferred_parameter) + if (!comp || comp->attr.artificial) { if (last_name) gfc_error ("Component initializer without name after component" diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8855a0e..9b23273 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12653,7 +12653,7 @@ resolve_fl_derived0 (gfc_symbol *sym) strlen->ts.type = BT_INTEGER; strlen->ts.kind = gfc_charlen_int_kind; strlen->attr.access = ACCESS_PRIVATE; - strlen->attr.deferred_parameter = 1; + strlen->attr.artificial = 1; } } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 3dd3dfc..610eec4 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1951,7 +1952,10 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref) se->expr = tmp; - if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer) + /* Allocatable deferred char arrays are to be handled by the gfc_deferred_ + strlen () conditional below. */ + if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer + && !(c->attr.allocatable && c->ts.deferred)) { tmp = c->ts.u.cl->backend_decl; /* Components must always be constant length. */ @@ -6550,7 +6553,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, gfc_add_expr_to_block (&block, tmp); } } - else if (!cm->attr.deferred_parameter) + else if (!cm->attr.artificial) { /* Scalar component (excluding deferred parameters). */ gfc_init_se (&se, NULL); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index cdc5897..52256e0 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1101,12 +1101,7 @@ gfc_typenode_for_spec (gfc_typespec * spec) break; case BT_CHARACTER: -#if 0 - if (spec->deferred) - basetype = gfc_get_character_type (spec->kind, NULL); - else -#endif - basetype = gfc_get_character_type (spec->kind, spec->u.cl); + basetype = gfc_get_character_type (spec->kind, spec->u.cl); break; case BT_HOLLERITH: @@ -2150,9 +2145,11 @@ gfc_sym_type (gfc_symbol * sym) if (sym->ts.type == BT_CHARACTER && ((sym->attr.function && sym->attr.is_bind_c) || (sym->attr.result && sym->ns->proc_name - && sym->ns->proc_name->attr.is_bind_c))) + && sym->ns->proc_name->attr.is_bind_c) + || (sym->ts.deferred && (!sym->ts.u.cl + || !sym->ts.u.cl->backend_decl)))) type = gfc_character1_type_node; else type = gfc_typenode_for_spec (&sym->ts); diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_14.f08 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_14.f08 new file mode 100644 index 0000000..194dff9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_14.f08 @@ -0,0 +1,46 @@ +! { dg-do run } +! Test for allocatable scalar components and deferred length char arrays. +! Check that fix for pr61275 works. +! Contributed by Antony Lewis and +! Andre Vehreschild +! +module typeA + Type A + integer :: X + integer, allocatable :: y + character(len=:), allocatable :: c + end type A +end module + +program test_allocatable_components + use typeA + Type(A) :: Me + Type(A) :: Ea + + Me= A(X= 1, Y= 2, C="correctly allocated") + + if (Me%X /= 1) call abort() + if (.not. allocated(Me%y) .or. Me%y /= 2) call abort() + if (.not. allocated(Me%c)) call abort() + if (len(Me%c) /= 19) call abort() + if (Me%c /= "correctly allocated") call abort() + + ! Now check explicitly allocated components. + Ea%X = 9 + allocate(Ea%y) + Ea%y = 42 + ! Implicit allocate on assign in the next line + Ea%c = "13 characters" + + if (Ea%X /= 9) call abort() + if (.not. allocated(Ea%y) .or. Ea%y /= 42) call abort() + if (.not. allocated(Ea%c)) call abort() + if (len(Ea%c) /= 13) call abort() + if (Ea%c /= "13 characters") call abort() + + deallocate(Ea%y) + deallocate(Ea%c) + if (allocated(Ea%y)) call abort() + if (allocated(Ea%c)) call abort() +end program +