From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x32e.google.com (mail-wm1-x32e.google.com [IPv6:2a00:1450:4864:20::32e]) by sourceware.org (Postfix) with ESMTPS id A6ACE3856DD3 for ; Tue, 8 Nov 2022 08:43:20 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org A6ACE3856DD3 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wm1-x32e.google.com with SMTP id p16so8340008wmc.3 for ; Tue, 08 Nov 2022 00:43:20 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=HP119jXVQ2Oo1EtX4Pnw7TR6m/hPQYaln7mn0oPGuHs=; b=JiPqPgTWsb2v7f5rT1Ej0NAypx9+CrMekfqwfq3vKmIYYnkcBOsLPSFzheFH0edUXr AcwLgsqFo0A79aEO8JVK+HOV05DtzcLMoPeWR44WLMs7wdEUHubVkFSyyahCDaZ9E3S8 HPFsBsigcCj0XyjklrQHBYvFHB6m3dHFF5ZXoM1uAwgfwzti1kAbGZxxnINUwYbEElTU U9OYpbfer6A6zyn6fPm8+QoYmE/isfi8NGJNLTGGTNXfo2It5WLXbSlY3T5YXCVR6Lwr trfuMxPsI2n5x1CapImbiPZIqzAUvhmmqQN9iL5d+hihFT+VLlgIch83GCFptGBgO2ZT Msdw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=HP119jXVQ2Oo1EtX4Pnw7TR6m/hPQYaln7mn0oPGuHs=; b=aG67pPH3s5mIqTbqeit58jEciNcSny2NlPaeMxl2mT3kTTmN2AyQ7vacxG2nACAk/5 Npt+xx1XLHh/zsfEDCKWLmdKt3+UMHAcwAD65O2rLNxoA0JkldcNhTtgRlaXsFMtxYvJ zZP10JSu6n5291TWoJGWsLYD4yMGtFYSLJLDvkzxFg4M0urK4VYcFbPJoDwKAEfo/ktX YRTAqYeYOdDG5+sID7dUkf4geYDa9m7oY/zgVHGeW0rfC4FsXGOKR1Q/2krirxuBIYdo iF7XRk936Q6eIX10DVIaVI36uAE0ko2sL7JcSfvj4GFyAUV/vUNzytl+TrFemk3+BBer nZgg== X-Gm-Message-State: ANoB5pmZrgCrJuOVeoWBAjDAOdVmY9fMK3lFO5KpCTis29S2nJTTqbSs M7SpkNgCKKjbVtgqVQsBQKQTMTk+t/odUQ== X-Google-Smtp-Source: AA0mqf4gz0R9ZDjehMuK3plMkpJNnEoeInp1qzNJ+1cBRbY74DqZBZwBaiM/fH43/L1osB5gfCuvLQ== X-Received: by 2002:a05:600c:4f0f:b0:3cf:b73f:bf86 with SMTP id l15-20020a05600c4f0f00b003cfb73fbf86mr1730763wmq.137.1667896999174; Tue, 08 Nov 2022 00:43:19 -0800 (PST) Received: from localhost.localdomain (static-176-191-105-132.ftth.abo.bbox.fr. [176.191.105.132]) by smtp.gmail.com with ESMTPSA id h8-20020a05600c2ca800b003b4a699ce8esm14688881wmc.6.2022.11.08.00.43.18 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 08 Nov 2022 00:43:18 -0800 (PST) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Implement RM 4.5.7(10/3) name resolution rule Date: Tue, 8 Nov 2022 09:43:15 +0100 Message-Id: <20221108084315.301840-1-poulhies@adacore.com> X-Mailer: git-send-email 2.34.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.0 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,KAM_ASCII_DIVIDERS,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: From: Eric Botcazou This rule deals with the specific case of a conditional expression that is the operand of a type conversion and effectively distributes the conversion to the dependent expressions with the help of the dynamic semantics. gcc/ada/ * sem_ch4.adb (Analyze_Case_Expression): Compute the interpretations of the expression only at the end of the analysis, but skip doing it if it is the operand of a type conversion. (Analyze_If_Expression): Likewise. * sem_res.adb (Resolve): Deal specially with conditional expression that is the operand of a type conversion. (Resolve_Dependent_Expression): New procedure. (Resolve_Case_Expression): Call Resolve_Dependent_Expression. (Resolve_If_Expression): Likewise. (Resolve_If_Expression.Apply_Check): Take result type as parameter. (Resolve_Type_Conversion): Do not warn about a redundant conversion when the operand is a conditional expression. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch4.adb | 129 +++++++++++++++++++++++++------------------- gcc/ada/sem_res.adb | 109 ++++++++++++++++++++++++++++--------- 2 files changed, 156 insertions(+), 82 deletions(-) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 0c02fd80675..23040d7033b 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1740,6 +1740,70 @@ package body Sem_Ch4 is return; end if; + -- The expression must be of a discrete type which must be determinable + -- independently of the context in which the expression occurs, but + -- using the fact that the expression must be of a discrete type. + -- Moreover, the type this expression must not be a character literal + -- (which is always ambiguous). + + -- If error already reported by Resolve, nothing more to do + + if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then + return; + + -- Special case message for character literal + + elsif Exp_Btype = Any_Character then + Error_Msg_N + ("character literal as case expression is ambiguous", Expr); + return; + end if; + + -- If the case expression is a formal object of mode in out, then + -- treat it as having a nonstatic subtype by forcing use of the base + -- type (which has to get passed to Check_Case_Choices below). Also + -- use base type when the case expression is parenthesized. + + if Paren_Count (Expr) > 0 + or else (Is_Entity_Name (Expr) + and then Ekind (Entity (Expr)) = E_Generic_In_Out_Parameter) + then + Exp_Type := Exp_Btype; + end if; + + -- The case expression alternatives cover the range of a static subtype + -- subject to aspect Static_Predicate. Do not check the choices when the + -- case expression has not been fully analyzed yet because this may lead + -- to bogus errors. + + if Is_OK_Static_Subtype (Exp_Type) + and then Has_Static_Predicate_Aspect (Exp_Type) + and then In_Spec_Expression + then + null; + + -- Call Analyze_Choices and Check_Choices to do the rest of the work + + else + Analyze_Choices (Alternatives (N), Exp_Type); + Check_Choices (N, Alternatives (N), Exp_Type, Others_Present); + + if Exp_Type = Universal_Integer and then not Others_Present then + Error_Msg_N + ("case on universal integer requires OTHERS choice", Expr); + return; + end if; + end if; + + -- RM 4.5.7(10/3): If the case_expression is the operand of a type + -- conversion, the type of the case_expression is the target type + -- of the conversion. + + if Nkind (Parent (N)) = N_Type_Conversion then + Set_Etype (N, Etype (Parent (N))); + return; + end if; + -- Loop through the interpretations of the first expression and check -- the other expressions if present. @@ -1763,25 +1827,6 @@ package body Sem_Ch4 is end loop; end if; - -- The expression must be of a discrete type which must be determinable - -- independently of the context in which the expression occurs, but - -- using the fact that the expression must be of a discrete type. - -- Moreover, the type this expression must not be a character literal - -- (which is always ambiguous). - - -- If error already reported by Resolve, nothing more to do - - if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then - return; - - -- Special casee message for character literal - - elsif Exp_Btype = Any_Character then - Error_Msg_N - ("character literal as case expression is ambiguous", Expr); - return; - end if; - -- If no possible interpretation has been found, the type of the wrong -- alternative doesn't match any interpretation of the FIRST expression. @@ -1829,43 +1874,6 @@ package body Sem_Ch4 is Etype (Second_Expr)); end if; end if; - - return; - end if; - - -- If the case expression is a formal object of mode in out, then - -- treat it as having a nonstatic subtype by forcing use of the base - -- type (which has to get passed to Check_Case_Choices below). Also - -- use base type when the case expression is parenthesized. - - if Paren_Count (Expr) > 0 - or else (Is_Entity_Name (Expr) - and then Ekind (Entity (Expr)) = E_Generic_In_Out_Parameter) - then - Exp_Type := Exp_Btype; - end if; - - -- The case expression alternatives cover the range of a static subtype - -- subject to aspect Static_Predicate. Do not check the choices when the - -- case expression has not been fully analyzed yet because this may lead - -- to bogus errors. - - if Is_OK_Static_Subtype (Exp_Type) - and then Has_Static_Predicate_Aspect (Exp_Type) - and then In_Spec_Expression - then - null; - - -- Call Analyze_Choices and Check_Choices to do the rest of the work - - else - Analyze_Choices (Alternatives (N), Exp_Type); - Check_Choices (N, Alternatives (N), Exp_Type, Others_Present); - - if Exp_Type = Universal_Integer and then not Others_Present then - Error_Msg_N - ("case on universal integer requires OTHERS choice", Expr); - end if; end if; end Analyze_Case_Expression; @@ -2555,6 +2563,15 @@ package body Sem_Ch4 is Analyze_Expression (Else_Expr); end if; + -- RM 4.5.7(10/3): If the if_expression is the operand of a type + -- conversion, the type of the if_expression is the target type + -- of the conversion. + + if Nkind (Parent (N)) = N_Type_Conversion then + Set_Etype (N, Etype (Parent (N))); + return; + end if; + -- Loop through the interpretations of the THEN expression and check the -- ELSE expression if present. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e5b3612d186..c8652c959b7 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -171,6 +171,13 @@ package body Sem_Res is -- of the task, it must be replaced with a reference to the discriminant -- of the task being called. + procedure Resolve_Dependent_Expression + (N : Node_Id; + Expr : Node_Id; + Typ : Entity_Id); + -- Internal procedure to resolve the dependent expression Expr of the + -- conditional expression N with type Typ. + procedure Resolve_Op_Concat_Arg (N : Node_Id; Arg : Node_Id; @@ -291,12 +298,6 @@ package body Sem_Res is -- Called after N has been resolved and evaluated, but before range checks -- have been applied. This rewrites the conversion into a simpler form. - function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id; - -- A universal_fixed expression in an universal context is unambiguous if - -- there is only one applicable fixed point type. Determining whether there - -- is only one requires a search over all visible entities, and happens - -- only in very pathological cases (see 6115-006). - function Try_User_Defined_Literal (N : Node_Id; Typ : Entity_Id) return Boolean; @@ -306,6 +307,12 @@ package body Sem_Res is -- If such aspect exists, replace literal with a call to the -- corresponding function and return True, return false otherwise. + function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id; + -- A universal_fixed expression in an universal context is unambiguous if + -- there is only one applicable fixed point type. Determining whether there + -- is only one requires a search over all visible entities, and happens + -- only in very pathological cases (see 6115-006). + ------------------------- -- Ambiguous_Character -- ------------------------- @@ -2461,6 +2468,15 @@ package body Sem_Res is Found := True; Expr_Type := Etype (Expression (N)); + -- The resolution of a conditional expression that is the operand of a + -- type conversion is determined by the conversion (RM 4.5.7(10/3)). + + elsif Nkind (N) in N_Case_Expression | N_If_Expression + and then Nkind (Parent (N)) = N_Type_Conversion + then + Found := True; + Expr_Type := Etype (Parent (N)); + -- If not overloaded, then we know the type, and all that needs doing -- is to check that this type is compatible with the context. @@ -7390,7 +7406,8 @@ package body Sem_Res is return; end if; - Resolve (Alt_Expr, Typ); + Resolve_Dependent_Expression (N, Alt_Expr, Typ); + Check_Unset_Reference (Alt_Expr); Alt_Typ := Etype (Alt_Expr); @@ -7671,6 +7688,34 @@ package body Sem_Res is Check_Unset_Reference (Expr); end Resolve_Declare_Expression; + ----------------------------------- + -- Resolve_Dependent_Expression -- + ----------------------------------- + + procedure Resolve_Dependent_Expression + (N : Node_Id; + Expr : Node_Id; + Typ : Entity_Id) + is + begin + -- RM 4.5.7(8/3) says that the expected type of dependent expressions is + -- that of the conditional expression but RM 4.5.7(10/3) forces the type + -- of the conditional expression without changing the expected type (the + -- expected type of the operand of a type conversion is any type), so we + -- may have a gap between these two types that is bridged by the dynamic + -- semantics specified by RM 4.5.7(20/3) with the associated legality + -- rule RM 4.5.7(16/3) that will be automatically enforced. + + if Nkind (Parent (N)) = N_Type_Conversion + and then Nkind (Expr) /= N_Raise_Expression + then + Convert_To_And_Rewrite (Typ, Expr); + Analyze_And_Resolve (Expr); + else + Resolve (Expr, Typ); + end if; + end Resolve_Dependent_Expression; + ----------------------------------------- -- Resolve_Discrete_Subtype_Indication -- ----------------------------------------- @@ -9307,7 +9352,9 @@ package body Sem_Res is --------------------------- procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id) is - procedure Apply_Check (Expr : Node_Id); + Condition : constant Node_Id := First (Expressions (N)); + + procedure Apply_Check (Expr : Node_Id; Result_Type : Entity_Id); -- When a dependent expression is of a subtype different from -- the context subtype, then insert a qualification to ensure -- the generation of a constraint check. This was previously @@ -9315,21 +9362,11 @@ package body Sem_Res is -- that the context in general allows sliding, while a qualified -- expression forces equality of bounds. - Result_Type : Entity_Id := Typ; - -- So in most cases the type of the If_Expression and of its - -- dependent expressions is that of the context. However, if - -- the expression is the index of an Indexed_Component, we must - -- ensure that a proper index check is applied, rather than a - -- range check on the index type (which might be discriminant - -- dependent). In this case we resolve with the base type of the - -- index type, and the index check is generated in the resolution - -- of the indexed_component above. - ----------------- -- Apply_Check -- ----------------- - procedure Apply_Check (Expr : Node_Id) is + procedure Apply_Check (Expr : Node_Id; Result_Type : Entity_Id) is Expr_Typ : constant Entity_Id := Etype (Expr); Loc : constant Source_Ptr := Sloc (Expr); @@ -9357,10 +9394,19 @@ package body Sem_Res is -- Local variables - Condition : constant Node_Id := First (Expressions (N)); Else_Expr : Node_Id; Then_Expr : Node_Id; + Result_Type : Entity_Id; + -- So in most cases the type of the if_expression and of its + -- dependent expressions is that of the context. However, if + -- the expression is the index of an Indexed_Component, we must + -- ensure that a proper index check is applied, rather than a + -- range check on the index type (which might be discriminant + -- dependent). In this case we resolve with the base type of the + -- index type, and the index check is generated in the resolution + -- of the indexed_component above. + -- Start of processing for Resolve_If_Expression begin @@ -9375,6 +9421,9 @@ package body Sem_Res is or else Nkind (Parent (Parent (N))) = N_Indexed_Component) then Result_Type := Base_Type (Typ); + + else + Result_Type := Typ; end if; Then_Expr := Next (Condition); @@ -9383,21 +9432,23 @@ package body Sem_Res is return; end if; - Else_Expr := Next (Then_Expr); - Resolve (Condition, Any_Boolean); - Resolve (Then_Expr, Result_Type); Check_Unset_Reference (Condition); + + Resolve_Dependent_Expression (N, Then_Expr, Result_Type); + Check_Unset_Reference (Then_Expr); + Apply_Check (Then_Expr, Result_Type); - Apply_Check (Then_Expr); + Else_Expr := Next (Then_Expr); -- If ELSE expression present, just resolve using the determined type if Present (Else_Expr) then - Resolve (Else_Expr, Result_Type); + Resolve_Dependent_Expression (N, Else_Expr, Result_Type); + Check_Unset_Reference (Else_Expr); - Apply_Check (Else_Expr); + Apply_Check (Else_Expr, Result_Type); -- Apply RM 4.5.7 (17/3): whether the expression is statically or -- dynamically tagged must be known statically. @@ -12158,6 +12209,12 @@ package body Sem_Res is then null; + -- Never give a warning if the operand is a conditional expression + -- because RM 4.5.7(10/3) forces its type to be the target type. + + elsif Nkind (Orig_N) in N_Case_Expression | N_If_Expression then + null; + -- Finally, if this type conversion occurs in a context requiring -- a prefix, and the expression is a qualified expression then the -- type conversion is not redundant, since a qualified expression -- 2.34.1