From patchwork Thu Jul 16 09:20:51 2020 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: 1330095 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4B6pfZ0LcQz9sRN for ; Thu, 16 Jul 2020 19:21:42 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 00BB5388CC00; Thu, 16 Jul 2020 09:21:00 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTP id AD4FF388A82A for ; Thu, 16 Jul 2020 09:20:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org AD4FF388A82A Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id CED94560A2; Thu, 16 Jul 2020 05:20:51 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com 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 w95X5SlfKPAV; Thu, 16 Jul 2020 05:20:51 -0400 (EDT) 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 A03AF56090; Thu, 16 Jul 2020 05:20:51 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 9F5A912D; Thu, 16 Jul 2020 05:20:51 -0400 (EDT) Date: Thu, 16 Jul 2020 05:20:51 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] AI12-0373 Additional check on Integer_Literal function Message-ID: <20200716092051.GA146518@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-9.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Arnaud Charlet Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Part (1) clarifies that we anticipated in Statically_Names_Object, update comment accordingly. Part 4 (4) clarifies: 4.2.1(3/5) says that the only parameter of a user-defined Integer_Literal function is of type String. But it doesn't specify a mode. Since the parameter is passed a string literal, a call to a function with a mode other than "in" would be illegal. Thus, defining the function with an "in out" parameter would be useless. Similarly, if the parameter was explicitly aliased, any call would be illegal as the actual is not aliased. So that would also be useless as well. We were doing it right except for checking the 'explicitly aliased' part. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_ch13.adb (Validate_Literal_Aspect): Ensure that the parameter is not aliased. Minor reformatting. * sem_util.adb (Statically_Names_Object): Update comment. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -16016,10 +16016,12 @@ package body Sem_Ch13 is Match_Found : Boolean := False; Is_Match : Boolean; Match : Interp; + begin if not Is_Type (Typ) then Error_Msg_N ("aspect can only be specified for a type", ASN); return; + elsif not Is_First_Subtype (Typ) then Error_Msg_N ("aspect cannot be specified for a subtype", ASN); return; @@ -16030,12 +16032,15 @@ package body Sem_Ch13 is Error_Msg_N ("aspect cannot be specified for a string type", ASN); return; end if; + Param_Type := Standard_Wide_Wide_String; + else if Is_Numeric_Type (Typ) then Error_Msg_N ("aspect cannot be specified for a numeric type", ASN); return; end if; + Param_Type := Standard_String; end if; @@ -16059,17 +16064,21 @@ package body Sem_Ch13 is and then Base_Type (Etype (It.Nam)) = Typ then declare - Params : constant List_Id := + Params : constant List_Id := Parameter_Specifications (Parent (It.Nam)); Param_Spec : Node_Id; Param_Id : Entity_Id; + begin if List_Length (Params) = 1 then Param_Spec := First (Params); + if not More_Ids (Param_Spec) then Param_Id := Defining_Identifier (Param_Spec); + if Base_Type (Etype (Param_Id)) = Param_Type - and then Ekind (Param_Id) = E_In_Parameter + and then Ekind (Param_Id) = E_In_Parameter + and then not Is_Aliased (Param_Id) then Is_Match := True; end if; @@ -16083,6 +16092,7 @@ package body Sem_Ch13 is Error_Msg_N ("aspect specification is ambiguous", ASN); return; end if; + Match_Found := True; Match := It; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -27054,6 +27054,7 @@ package body Sem_Util is ----------------------------- -- Statically_Names_Object -- ----------------------------- + function Statically_Names_Object (N : Node_Id) return Boolean is begin if Statically_Denotes_Object (N) then @@ -27126,28 +27127,16 @@ package body Sem_Util is then return False; end if; + declare Comp : constant Entity_Id := Original_Record_Component (Entity (Selector_Name (N))); begin - -- In not calling Has_Discriminant_Dependent_Constraint here, - -- we are anticipating a language definition fixup. The - -- current definition of "statically names" includes the - -- wording "the selector_name names a component that does - -- not depend on a discriminant", which suggests that this - -- call should not be commented out. But it appears likely - -- that this wording will be updated to only apply to a - -- component declared in a variant part. There is no need - -- to disallow something like - -- with Post => ... and then - -- Some_Record.Some_Discrim_Dep_Array_Component'Old (I) - -- since the evaluation of the 'Old prefix cannot raise an - -- exception. If the language is not updated, then the call - -- below to H_D_C_C will need to be uncommented. - - if Is_Declared_Within_Variant (Comp) - -- or else Has_Discriminant_Dependent_Constraint (Comp) - then + -- AI12-0373 confirms that we should not call + -- Has_Discriminant_Dependent_Constraint here which would be + -- too strong. + + if Is_Declared_Within_Variant (Comp) then return False; end if; end;