From patchwork Thu Jan 11 09:04:08 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 858939 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-470785-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="ty5R9zA1"; dkim-atps=neutral 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 3zHKhV4rMgz9t3h for ; Thu, 11 Jan 2018 20:04:58 +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:mime-version:content-type; q=dns; s=default; b=TiGcPeJc0KdVEP7dkopH6uqZnNvENiTym9qojtSdevmUmuXPVQ rrxwUQo+OorIY0YkfjyAplJVAW/NzbNyvvugYcw+MKoUKZhl3bvIaRMD+S8EJxY1 cUxh+iTsNLagK8ptAGNNkv2iFFcbHQ9Cc30EpL/aAuFl+crJ+dgJ5IjDY= 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:mime-version:content-type; s= default; bh=ubuWf/bNQXFUYLspkKbLQ/tic9w=; b=ty5R9zA1Y2e6avzE6qGF glC4/BgLKXMjPC5y6Qs8QOuRJqtEXurp/lssoh/svA/Z8rieBaXJpCGc7lonX5En mHCzrgIaFiMCu2T2kZKv7U4sT/nZyKU4ckFlTteBrahEpABV3GIfuQYQh9J3t66S N+xx/IOmUlymDKfEzOHrzmA= Received: (qmail 11832 invoked by alias); 11 Jan 2018 09:04:39 -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 118236 invoked by uid 89); 11 Jan 2018 09:04:17 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-16.9 required=5.0 tests=BAYES_00, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=Choice, isolated, sk:discret X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 11 Jan 2018 09:04:10 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id A970F117BC0; Thu, 11 Jan 2018 04:04:08 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id qd-LfA-mtY88; Thu, 11 Jan 2018 04:04:08 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 988E1117BBE; Thu, 11 Jan 2018 04:04:08 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id 9726B50B; Thu, 11 Jan 2018 04:04:08 -0500 (EST) Date: Thu, 11 Jan 2018 04:04:08 -0500 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Crash on iterated_component_association in expression function Message-ID: <20180111090408.GA102867@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This patch improves on the handling of the Ada2020 construct Iterated_ Component_Association in various contexts, when the expression involved is a record or array aggregate. Executing: gnatmake -gnatX -q main ./main must yield: 123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ ---- with Text_IO; use Text_IO; with Exfor; use Exfor; procedure Main is Map : String := Table_ASCII; begin Put_Line (Map (50..91)); end; ---- package Exfor is function Table_ASCII return String is (for I in 1 .. Character'Pos (Character'Last) + 1 => Character'Val(I-1)); end Exfor; Tested on x86_64-pc-linux-gnu, committed on trunk 2018-01-11 Ed Schonberg gcc/ada/ * sem_aggr.adb (Resolve_Iterated_Component_Association): Perform analysis on a copy of the expression with a copy of the index variable, because full expansion will rewrite construct into a loop with the original loop variable. * exp_aggr.adb (Gen_Assign): Defer analysis and resolution if the expression is an iterated component association. Full analysis takes place when construct is rewritten as a loop. (In_Place_Assign_OK, Safe_Component): An iterated_component_association is not safe for in-place assignment. * sem_util.adb (Remove_Entity): Handle properly the case of an isolated entity with no homonym and no other entity in the scope. --- gcc/ada/exp_aggr.adb +++ gcc/ada/exp_aggr.adb @@ -240,7 +240,7 @@ package body Exp_Aggr is -- calling Flatten. -- -- This function also detects and warns about one-component aggregates that - -- appear in a non-static context. Even if the component value is static, + -- appear in a nonstatic context. Even if the component value is static, -- such an aggregate must be expanded into an assignment. function Backend_Processing_Possible (N : Node_Id) return Boolean; @@ -492,7 +492,7 @@ package body Exp_Aggr is end if; -- One-component aggregates are suspicious, and if the context type - -- is an object declaration with non-static bounds it will trip gcc; + -- is an object declaration with nonstatic bounds it will trip gcc; -- such an aggregate must be expanded into a single assignment. if Hiv = Lov and then Nkind (Parent (N)) = N_Object_Declaration then @@ -674,7 +674,7 @@ package body Exp_Aggr is -- Recurse to check subaggregates, which may appear in qualified -- expressions. If delayed, the front-end will have to expand. - -- If the component is a discriminated record, treat as non-static, + -- If the component is a discriminated record, treat as nonstatic, -- as the back-end cannot handle this properly. Expr := First (Expressions (N)); @@ -1537,11 +1537,17 @@ package body Exp_Aggr is -- of the generated loop will analyze the expression in the -- proper context, in which the loop parameter is visible. - if Present (Comp_Typ) and then not Is_Array_Type (Comp_Typ) - and then - Nkind (Parent (Expr_Q)) /= N_Iterated_Component_Association - then - Analyze_And_Resolve (Expr_Q, Comp_Typ); + if Present (Comp_Typ) and then not Is_Array_Type (Comp_Typ) then + if + Nkind (Parent (Expr_Q)) = N_Iterated_Component_Association + or else + Nkind (Parent (Parent ((Expr_Q)))) + = N_Iterated_Component_Association + then + null; + else + Analyze_And_Resolve (Expr_Q, Comp_Typ); + end if; end if; if Is_Delayed_Aggregate (Expr_Q) then @@ -4045,7 +4051,7 @@ package body Exp_Aggr is Next_Elmt (Disc2); end loop; - -- If any discriminant constraint is non-static, emit a check + -- If any discriminant constraint is nonstatic, emit a check if Present (Cond) then Insert_Action (N, @@ -4298,7 +4304,7 @@ package body Exp_Aggr is -- Check whether all components of the aggregate are compile-time known -- values, and can be passed as is to the back-end without further -- expansion. - -- An Iterated_Component_Association is treated as non-static, but there + -- An Iterated_Component_Association is treated as nonstatic, but there -- are possibilities for optimization here. function Flatten @@ -5493,6 +5499,16 @@ package body Exp_Aggr is -- For now, too complex to analyze return False; + + elsif + Nkind (Parent (Expr)) = N_Iterated_Component_Association + then + + -- Ditto for iterated component associations, which in + -- general require an enclosing loop and involve nonstatic + -- expressions. + + return False; end if; Comp := New_Copy_Tree (Expr); @@ -5555,7 +5571,7 @@ package body Exp_Aggr is -- bounds. Ditto for an allocator whose qualified expression -- is a constrained type. If the expression in the allocator -- is an unconstrained array, we accept an upper bound that - -- is not static, to allow for non-static expressions of the + -- is not static, to allow for nonstatic expressions of the -- base type. Clearly there are further possibilities (with -- diminishing returns) for safely building arrays in place -- here. @@ -7759,7 +7775,7 @@ package body Exp_Aggr is function Get_Component_Val (N : Node_Id) return Uint; -- Given a expression value N of the component type Ctyp, returns a -- value of Csiz (component size) bits representing this value. If - -- the value is non-static or any other reason exists why the value + -- the value is nonstatic or any other reason exists why the value -- cannot be returned, then Not_Handled is raised. -------------------------- gcc/ada/sem_aggr.adb +++ gcc/ada/sem_aggr.adb @@ -1657,12 +1657,13 @@ package body Sem_Aggr is (N : Node_Id; Index_Typ : Entity_Id) is - Id : constant Entity_Id := Defining_Identifier (N); Loc : constant Source_Ptr := Sloc (N); Choice : Node_Id; Dummy : Boolean; Ent : Entity_Id; + Expr : Node_Id; + Id : Entity_Id; begin Choice := First (Discrete_Choices (N)); @@ -1697,25 +1698,41 @@ package body Sem_Aggr is Ent := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L'); Set_Etype (Ent, Standard_Void_Type); Set_Parent (Ent, Parent (N)); + Push_Scope (Ent); + Id := Make_Defining_Identifier (Loc, + Chars => Chars (Defining_Identifier (N))); - -- Decorate the index variable in the current scope. The association - -- may have several choices, each one leading to a loop, so we create - -- this variable only once to prevent homonyms in this scope. + -- Insert and decorate the index variable in the current scope. -- The expression has to be analyzed once the index variable is -- directly visible. Mark the variable as referenced to prevent -- spurious warnings, given that subsequent uses of its name in the -- expression will reference the internal (synonym) loop variable. - if No (Scope (Id)) then - Enter_Name (Id); - Set_Etype (Id, Index_Typ); - Set_Ekind (Id, E_Variable); - Set_Scope (Id, Ent); - Set_Referenced (Id); + Enter_Name (Id); + Set_Etype (Id, Index_Typ); + Set_Ekind (Id, E_Variable); + Set_Scope (Id, Ent); + Set_Referenced (Id); + + -- Analyze a copy of the expression, to verify legality. We use + -- a copy because the expression will be analyzed anew when the + -- enclosing aggregate is expanded, and the construct is rewritten + -- as a loop with a new index variable. + + Expr := New_Copy_Tree (Expression (N)); + Dummy := Resolve_Aggr_Expr (Expr, False); + + -- An iterated_component_association may appear in a nested + -- aggregate for a multidimensional structure: preserve the bounds + -- computed for the expression, as well as the anonymous array + -- type generated for it; both are needed during array expansion. + -- This does not work for more than two levels of nesting. ??? + + if Nkind (Expr) = N_Aggregate then + Set_Aggregate_Bounds (Expression (N), Aggregate_Bounds (Expr)); + Set_Etype (Expression (N), Etype (Expr)); end if; - Push_Scope (Ent); - Dummy := Resolve_Aggr_Expr (Expression (N), False); End_Scope; end Resolve_Iterated_Component_Association; --- gcc/ada/sem_util.adb +++ gcc/ada/sem_util.adb @@ -22373,11 +22373,13 @@ package body Sem_Util is else Prev_Id := Current_Entity (Id); - while Present (Prev_Id) and then Homonym (Prev_Id) /= Id loop - Prev_Id := Homonym (Prev_Id); - end loop; + if Present (Prev_Id) then + while Present (Prev_Id) and then Homonym (Prev_Id) /= Id loop + Prev_Id := Homonym (Prev_Id); + end loop; - Set_Homonym (Prev_Id, Homonym (Id)); + Set_Homonym (Prev_Id, Homonym (Id)); + end if; end if; -- Remove the entity from the scope entity chain. When the entity is @@ -22397,7 +22399,9 @@ package body Sem_Util is Next_Entity (Prev_Id); end loop; - Set_Next_Entity (Prev_Id, Next_Entity (Id)); + if Present (Prev_Id) then + Set_Next_Entity (Prev_Id, Next_Entity (Id)); + end if; end if; -- Handle the case where the entity acts as the tail of the scope entity