From patchwork Tue Apr 25 08:52:36 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 754645 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 3wBxn06R28z9s7x for ; Tue, 25 Apr 2017 18:52:48 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="yYF3zm/+"; dkim-atps=neutral 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=hHgMIeHHg9+TOSI33UKL+se41ZXHFWicBghVYsDpv8vBgRVrCU 1QaXb9HeGSknbhN9C+9SldDTp190roz3gmwZVjItwm1+IzqF/4VATQe/ju3dnZDx h4+xYaL1+t8e5j6nEmifXX75idONcg0dXtNwNo2P06HNGbXVMHEXaV7fs= 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=ZfS47epEEm4SQWY9TWM5qpO9rxY=; b=yYF3zm/+bdtlJL32AXS6 nUgpBSHhmfJzd4x5BEWdyan4liJtmetckFfeCLOlhRn3q/QWzoBtkC/ArbywqCuh g4pvt0fTk8Nv60oJPEvhHpkfUMPhKMevQvrpRl9eC1MkOo9GkhIadP6Qqk2XFDYL Rsq+QTU0ehUKuHlzXCUX8hU= Received: (qmail 24190 invoked by alias); 25 Apr 2017 08:52:38 -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 24166 invoked by uid 89); 25 Apr 2017 08:52:37 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.0 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=i4, 1i, 9366 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; Tue, 25 Apr 2017 08:52:35 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 81D5D3524; Tue, 25 Apr 2017 04:52:36 -0400 (EDT) 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 lj1+7-yLegmp; Tue, 25 Apr 2017 04:52:36 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 6D00A34E6; Tue, 25 Apr 2017 04:52:36 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 68FF0521; Tue, 25 Apr 2017 04:52:36 -0400 (EDT) Date: Tue, 25 Apr 2017 04:52:36 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Implementation of AI12-0125, use of @ as abbreviation for LHS. Message-ID: <20170425085236.GA19436@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) With this patch the compiler now handles properly the use of @ as a prefix of a reference to a discriminated record component and to its bounds. The following must compile quietly in gnat2020 mode: --- procedure Discrs is begin declare -- Discrim-dependent subtypes subtype Index is Integer range 0 .. 123; type R1 (D1 : Index := 0) is record F1 : String (1 .. D1); end record; type R2 (D2 : Index := 0) is record F2 : R1 (D1 => D2); end record; X : R2; begin for I in 1 .. Index'Last loop X := (I, (I, (others => 'A'))); X.F2.F1 (1) := 'B'; X.F2.F1:= 'C' & @ (@'First .. @'Last - 1); X.F2 := (@.D1, 'D' & @.F1 (@.F1'First .. @.F1'Last - 1)); X := (D2 => @.D2, F2 => (D1 => @.D2, F1 => 'E' & @.F2.F1 (@.F2.F1'First .. @.F2.F1'Last - 1))); pragma Assert (X.F2.F1 = (if I <= 4 then String'("EDCB")(1..I) else "EDCB" & (1 .. I-4 => 'A'))); end loop; end; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Ed Schonberg * sem_ch5.adb (Analyze_Assignment): Reset Full_Analysis flag on the first pass over an assignment statement with target names, to prevent the generation of subtypes (such as discriminated record components)that may carry the target name outside of the tree for the assignment. The subtypes will be generated when the assignment is reanalyzed in full. (Analyze_Target_Name): Handle properly class-wide types. Index: sem_ch5.adb =================================================================== --- sem_ch5.adb (revision 247146) +++ sem_ch5.adb (working copy) @@ -64,10 +64,12 @@ package body Sem_Ch5 is - Current_LHS : Node_Id := Empty; - -- Holds the left-hand side of the assignment statement being analyzed. - -- Used to determine the type of a target_name appearing on the RHS, for - -- AI12-0125 and the use of '@' as an abbreviation for the LHS. + Current_Assignment : Node_Id := Empty; + -- This variable holds the node for an assignment that contains target + -- names. The corresponding flag has been set by the parser, and when + -- set the analysis of the RHS must be done with all expansion disabled, + -- because the assignment is reanalyzed after expansion has replaced all + -- occurrences of the target name appropriately. Unblocked_Exit_Count : Nat := 0; -- This variable is used when processing if statements, case statements, @@ -98,11 +100,12 @@ -- Ghost mode. procedure Analyze_Assignment (N : Node_Id) is - Lhs : constant Node_Id := Name (N); - Rhs : constant Node_Id := Expression (N); - T1 : Entity_Id; - T2 : Entity_Id; - Decl : Node_Id; + Lhs : constant Node_Id := Name (N); + Rhs : constant Node_Id := Expression (N); + T1 : Entity_Id; + T2 : Entity_Id; + Decl : Node_Id; + Save_Full_Analysis : Boolean; procedure Diagnose_Non_Variable_Lhs (N : Node_Id); -- N is the node for the left hand side of an assignment, and it is not @@ -284,10 +287,6 @@ -- Start of processing for Analyze_Assignment begin - -- Save LHS for use in target names (AI12-125) - - Current_LHS := Lhs; - Mark_Coextensions (N, Rhs); -- Analyze the target of the assignment first in case the expression @@ -301,7 +300,12 @@ -- during analysis and expansion are properly marked as Ghost. if Has_Target_Names (N) then + Current_Assignment := N; Expander_Mode_Save_And_Set (False); + Save_Full_Analysis := Full_Analysis; + Full_Analysis := False; + else + Current_Assignment := Empty; end if; Mark_And_Set_Ghost_Assignment (N, Mode); @@ -932,7 +936,6 @@ Analyze_Dimension (N); <> - Current_LHS := Empty; Restore_Ghost_Mode (Mode); -- If the right-hand side contains target names, expansion has been @@ -942,6 +945,7 @@ if Nkind (N) = N_Assignment_Statement and then Has_Target_Names (N) then Expander_Mode_Restore; + Full_Analysis := Save_Full_Analysis; end if; end Analyze_Assignment; @@ -3543,14 +3547,10 @@ procedure Analyze_Target_Name (N : Node_Id) is begin - if No (Current_LHS) then - Error_Msg_N ("target name can only appear within an assignment", N); - Set_Etype (N, Any_Type); + -- A target name has the type of the left-hand side of the enclosing + -- assignment. - else - Set_Has_Target_Names (Parent (Current_LHS)); - Set_Etype (N, Etype (Current_LHS)); - end if; + Set_Etype (N, Etype (Name (Current_Assignment))); end Analyze_Target_Name; ------------------------