From patchwork Mon May 15 09:43:29 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 94048 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp6793645vqo; Mon, 15 May 2023 02:52:04 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ5RLnCfxPNi9gNdWzp007vdHVRX+7ZohuoRK2OOXbKzuYEJgpFDiW6TFzQTu+I1+Cgw9et4 X-Received: by 2002:a17:907:7b9c:b0:966:7a0a:28c0 with SMTP id ne28-20020a1709077b9c00b009667a0a28c0mr25281864ejc.58.1684144324346; Mon, 15 May 2023 02:52:04 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1684144324; cv=none; d=google.com; s=arc-20160816; b=Zz4ZKIStwEWSkavtw0+P8R3dBc455lsXrCPGOF0PxjvOS3VBtrY2jY4637QdhgBovr Yt2dPQYOruq1lnbYQxw8irNp0ISH+V1WOpZYeKcKnAIRYjOshLvKcEAALho3k7rO+SCz 3OWrow8e2nxfxOsnPZfuPYFzZPYVuE/8jMGwu4zUrvGWzdtqHYn9uELraabMH2bTMLad tVrpRGhciFBP4k47k23rikhu2mGx2a36dtegMikkr1SZa/HbX/bBuN4JO/AkEmim3dKW jFO+xeKW7tMqw1iwDfiQCOSYgynOPR8MLDWiuQTO+Cga2vq2TRprqavd0amuB8u1iaa6 SeGg== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence :content-transfer-encoding:mime-version:message-id:date:subject:cc :to:dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=XBOOZbKKA5hC6KTAMf0pwdOrbOMrP9iMGQGKyJXglYw=; b=dddAQ7UhRJtjWgHtXoBoz5At2WjP0j+rum5rLs+IdChTqavYe3uDKzBL6cdFiAkETf Tnl0NyYkeIPHxIziUs0ABjjl/vHS+MAd63z/FATgcPl+kloBEKnDXDyPznj9VN5eCd8x dtizKpTgTCohWvapXjVqvgFAISO4XYgoK47jyBimfHUFYVJ2wXrIbBSvOQ1GYsiEmzyO omOsF82HMj5O3TcH/YeGtpUuB0/rBIsdJby37Ob7uPesacRBBRI5MaZAnAt39GGX8jKp AZ+Og/rhFqPtjG25GB7L81tR7GoutVyCYduVEXtluBaNBMfYF1aFJRh5vmHRt0F/Hh5A h7Xw== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=tvyvuWAp; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id og35-20020a1709071de300b00969e7cb39f8si11555920ejc.287.2023.05.15.02.52.04 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 May 2023 02:52:04 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=tvyvuWAp; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C089738555A8 for ; Mon, 15 May 2023 09:47:12 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C089738555A8 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684144032; bh=XBOOZbKKA5hC6KTAMf0pwdOrbOMrP9iMGQGKyJXglYw=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=tvyvuWApfyyS9qdjZXH2850bupKHEdYXF91abiI+L/8Q3zsF4ZB4FwlOGX/xKGqAn kWmWQFe+osLNNiGNMFz9Wfw3rRIRuucYA4tiMq/FLuDNHAxiHw3Fkzx7WbYDAw03MP WFI9vrKth880O3M+BlzEqP+7cdD8Tt2w/9XbZQqo= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x435.google.com (mail-wr1-x435.google.com [IPv6:2a00:1450:4864:20::435]) by sourceware.org (Postfix) with ESMTPS id AFB593852920 for ; Mon, 15 May 2023 09:43:33 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org AFB593852920 Received: by mail-wr1-x435.google.com with SMTP id ffacd0b85a97d-306dbad5182so8174001f8f.1 for ; Mon, 15 May 2023 02:43:33 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1684143812; x=1686735812; 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=XBOOZbKKA5hC6KTAMf0pwdOrbOMrP9iMGQGKyJXglYw=; b=Vq9P/97N3dAK8OWzpnBsnquc/JRmHxOAkFKpx2w2hIxM5fvrssfNP/Z2c4nKN0YV8W hbo9kVp00Ji1HuB9LgEEDAlO9lqczMhNOF1APe44JoCAMcErTX2m45yjDAN4ipN5JhEP 5U7erFZZA8oQYAmH9vmJOUaZtr0ZrlAmY06eFeMHmqwATyGYVz3EcZOtT8AgaKD8FE/1 4oEVHr7aRKcknDAbn6OZuXc580gXheEsS94fwnO7LjY+NwO4mxZS2HRamd2lLfipb+j6 aEq/lyPlvT3JQz1cxveHh9pZBY62EDVNDZYrAXlWTIEQ8f9kfKzmaZFgBfMjhUNVZvvI jK1A== X-Gm-Message-State: AC+VfDz4OnuSN63MQVqf+W5aGywC6AIxIHUFOMXZ7Cnc4wEqXp0iTniC Pqog19W3ScWs0KrZMklbiPUpAo350vThpbcu2ts+qw== X-Received: by 2002:a5d:5746:0:b0:306:4239:4cd with SMTP id q6-20020a5d5746000000b00306423904cdmr23677205wrw.31.1684143812347; Mon, 15 May 2023 02:43:32 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id l4-20020a5d4104000000b00304832cd960sm31958574wrp.10.2023.05.15.02.43.31 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 May 2023 02:43:31 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Steve Baird Subject: [COMMITTED] ada: Emit warnings for (some) ineffective static predicate tests Date: Mon, 15 May 2023 11:43:29 +0200 Message-Id: <20230515094329.1408226-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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: , X-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1765953319300715910?= X-GMAIL-MSGID: =?utf-8?q?1765953319300715910?= From: Steve Baird Generate a warning if a static predicate tests for a value that does not belong to the parent subtype. For example, in subtype S is Positive with Static_Predicate => S not in 0 | 11 | 222; the 0 is ineffective because Positive already excludes that value. Generation of this new warning is controlled by the -gnatw_s switch, which can also be enabled via -gnatwa. gcc/ada/ * warnsw.ads: Add a new element, Warn_On_Ineffective_Predicate_Test, to the Opt_Warnings_Enum enumeration type. * warnsw.adb: Bind "-gnatw_s" to the new Warn_On_Ineffective_Predicate_Test switch. Add the new switch to the set of switches enabled by -gnata . * sem_ch13.adb (Build_Discrete_Static_Predicate): Declare new local procedure, Warn_If_Test_Ineffective, which conditionally generates new warning. Call this new procedure when building a new element of an RList. * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Document the -gnatw_s switch (and the corresponding -gnatw_S switch). * gnat_ugn.texi: Regenerate. Tested on x86_64-pc-linux-gnu, committed on master. --- ...building_executable_programs_with_gnat.rst | 21 ++++ gcc/ada/gnat_ugn.texi | 35 +++++- gcc/ada/sem_ch13.adb | 113 ++++++++++++++---- gcc/ada/warnsw.adb | 6 +- gcc/ada/warnsw.ads | 9 +- 5 files changed, 158 insertions(+), 26 deletions(-) diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 634bbc94c31..79da3c2cbcc 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -2801,6 +2801,8 @@ of the pragma in the :title:`GNAT_Reference_manual`). * :switch:`-gnatw.s` (overridden size clause) + * :switch:`-gnatw_s` (ineffective predicate test) + * :switch:`-gnatwt` (tracking of deleted conditional code) * :switch:`-gnatw.u` (unordered enumeration) @@ -3834,6 +3836,25 @@ of the pragma in the :title:`GNAT_Reference_manual`). warnings when an array component size overrides a size clause. +.. index:: -gnatw_s (gcc) +.. index:: Warnings + +:switch:`-gnatw_s` + *Activate warnings on ineffective predicate tests.* + + This switch activates warnings on Static_Predicate aspect + specifications that test for values that do not belong to + the parent subtype. Not all such ineffective tests are detected. + +.. index:: -gnatw_S (gcc) + +:switch:`-gnatw_S` + *Suppress warnings on ineffective predicate tests.* + + This switch suppresses warnings on Static_Predicate aspect + specifications that test for values that do not belong to + the parent subtype. + .. index:: -gnatwt (gcc) .. index:: Deactivated code, warnings .. index:: Deleted code, warnings diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index e8512cb0471..bd2cb3e5629 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -10742,6 +10742,9 @@ switch are: @item @code{-gnatw.s} (overridden size clause) +@item +@code{-gnatw_s} (ineffective predicate test) + @item @code{-gnatwt} (tracking of deleted conditional code) @@ -12155,6 +12158,36 @@ representation clauses that override size clauses, and similar warnings when an array component size overrides a size clause. @end table +@geindex -gnatw_s (gcc) + +@geindex Warnings + + +@table @asis + +@item @code{-gnatw_s} + +`Activate warnings on ineffective predicate tests.' + +This switch activates warnings on Static_Predicate aspect +specifications that test for values that do not belong to +the parent subtype. Not all such ineffective tests are detected. +@end table + +@geindex -gnatw_S (gcc) + + +@table @asis + +@item @code{-gnatw_S} + +`Suppress warnings on ineffective predicate tests.' + +This switch suppresses warnings on Static_Predicate aspect +specifications that test for values that do not belong to +the parent subtype. +@end table + @geindex -gnatwt (gcc) @geindex Deactivated code @@ -29433,8 +29466,8 @@ to permit their use in free software. @printindex ge -@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @anchor{cf}@w{ } +@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @c %**end of body @bye diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 82345eca09e..1c757228241 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -8872,6 +8872,10 @@ package body Sem_Ch13 is -- Given a type, if it has a static predicate, then set Result to the -- predicate as a range list, otherwise set Static.all to False. + procedure Warn_If_Test_Ineffective (REntry : REnt; N : Node_Id); + -- Issue a warning if REntry includes only values that are + -- outside the range TLo .. THi. + ----------- -- "and" -- ----------- @@ -9126,8 +9130,9 @@ package body Sem_Ch13 is (Exp : Node_Id; Static : access Boolean) return RList is - Op : Node_Kind; - Val : Uint; + Op : Node_Kind; + Val : Uint; + Val_Bearer : Node_Id; begin -- Static expression can only be true or false @@ -9178,14 +9183,14 @@ package body Sem_Ch13 is if Is_Type_Ref (Left_Opnd (Exp)) and then Is_OK_Static_Expression (Right_Opnd (Exp)) then - Val := Expr_Value (Right_Opnd (Exp)); + Val_Bearer := Right_Opnd (Exp); -- Typ is right operand elsif Is_Type_Ref (Right_Opnd (Exp)) and then Is_OK_Static_Expression (Left_Opnd (Exp)) then - Val := Expr_Value (Left_Opnd (Exp)); + Val_Bearer := Left_Opnd (Exp); -- Invert sense of comparison @@ -9204,30 +9209,41 @@ package body Sem_Ch13 is return False_Range; end if; + Val := Expr_Value (Val_Bearer); + -- Construct range according to comparison operation - case Op is - when N_Op_Eq => - return RList'(1 => REnt'(Val, Val)); + declare + REntry : REnt; + begin + case Op is + when N_Op_Eq => + REntry := (Val, Val); - when N_Op_Ge => - return RList'(1 => REnt'(Val, BHi)); + when N_Op_Ge => + REntry := (Val, THi); - when N_Op_Gt => - return RList'(1 => REnt'(Val + 1, BHi)); + when N_Op_Gt => + REntry := (Val + 1, THi); - when N_Op_Le => - return RList'(1 => REnt'(BLo, Val)); + when N_Op_Le => + REntry := (TLo, Val); - when N_Op_Lt => - return RList'(1 => REnt'(BLo, Val - 1)); + when N_Op_Lt => + REntry := (TLo, Val - 1); - when N_Op_Ne => - return RList'(REnt'(BLo, Val - 1), REnt'(Val + 1, BHi)); + when N_Op_Ne => + Warn_If_Test_Ineffective ((Val, Val), Val_Bearer); + return RList'(REnt'(TLo, Val - 1), + REnt'(Val + 1, THi)); - when others => - raise Program_Error; - end case; + when others => + raise Program_Error; + end case; + + Warn_If_Test_Ineffective (REntry, Val_Bearer); + return RList'(1 => REntry); + end; -- Membership (IN) @@ -9443,7 +9459,12 @@ package body Sem_Ch13 is else SLo := Expr_Value (Low_Bound (N)); SHi := Expr_Value (High_Bound (N)); - return RList'(1 => REnt'(SLo, SHi)); + declare + REntry : constant REnt := (SLo, SHi); + begin + Warn_If_Test_Ineffective (REntry, N); + return RList'(1 => REntry); + end; end if; -- Others case @@ -9469,7 +9490,12 @@ package body Sem_Ch13 is elsif Is_OK_Static_Expression (N) then Val := Expr_Value (N); - return RList'(1 => REnt'(Val, Val)); + declare + REntry : constant REnt := (Val, Val); + begin + Warn_If_Test_Ineffective (REntry, N); + return RList'(1 => REntry); + end; -- Identifier (other than static expression) case @@ -9541,6 +9567,49 @@ package body Sem_Ch13 is end; end Stat_Pred; + procedure Warn_If_Test_Ineffective (REntry : REnt; N : Node_Id) is + + procedure IPT_Warning (Msg : String); + -- Emit warning + + ----------------- + -- IPT_Warning -- + ----------------- + procedure IPT_Warning (Msg : String) is + begin + Error_Msg_N ("ineffective predicate test " & Msg & "?_s?", N); + end IPT_Warning; + + -- Start of processing for Warn_If_Test_Ineffective + + begin + -- Do nothing if warning disabled + + if not Warn_On_Ineffective_Predicate_Test then + null; + + -- skip null-range corner cases + + elsif (REntry.Lo > REntry.Hi) or else (TLo > THi) then + null; + + -- warn if no overlap between subtype bounds and the given range + + elsif REntry.Lo > THi or else REntry.Hi < TLo then + Error_Msg_Uint_1 := REntry.Lo; + if REntry.Lo /= REntry.Hi then + Error_Msg_Uint_2 := REntry.Hi; + IPT_Warning ("range: ^ .. ^"); + elsif Is_Enumeration_Type (Typ) and then + Nkind (N) in N_Identifier | N_Expanded_Name + then + IPT_Warning ("value: &"); + else + IPT_Warning ("value: ^"); + end if; + end if; + end Warn_If_Test_Ineffective; + -- Start of processing for Build_Discrete_Static_Predicate begin diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index d1574887de9..1931e02f592 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -93,14 +93,15 @@ package body Warnsw is '_' => ('b' | 'd' | 'e' | 'f' | 'g' | 'h' | 'i' | 'j' | 'k' | 'l' | 'm' | - 'n' | 'o' | 's' | 't' | 'u' | 'v' | 'w' | 'x' | 'y' | 'z' => + 'n' | 'o' | 't' | 'u' | 'v' | 'w' | 'x' | 'y' | 'z' => No_Such_Warning, 'a' => X.Warn_On_Anonymous_Allocators, 'c' => X.Warn_On_Unknown_Compile_Time_Warning, 'p' => X.Warn_On_Pedantic_Checks, 'q' => X.Warn_On_Ignored_Equality, - 'r' => X.Warn_On_Component_Order)); + 'r' => X.Warn_On_Component_Order, + 's' => X.Warn_On_Ineffective_Predicate_Test)); All_Warnings : constant Warnings_State := -- Warnings set by -gnatw.e (X.Elab_Info_Messages | @@ -130,6 +131,7 @@ package body Warnsw is X.Warn_On_Biased_Representation | -- -gnatw.b X.Warn_On_Constant | -- -gnatwk X.Warn_On_Export_Import | -- -gnatwx + X.Warn_On_Ineffective_Predicate_Test | -- -gnatw_s X.Warn_On_Late_Primitives | -- -gnatw.j X.Warn_On_Modified_Unread | -- -gnatwm X.Warn_On_No_Value_Assigned | -- -gnatwv diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads index 2636aba153a..cee1f302490 100644 --- a/gcc/ada/warnsw.ads +++ b/gcc/ada/warnsw.ads @@ -71,6 +71,7 @@ package Warnsw is Warn_On_Export_Import, Warn_On_Hiding, Warn_On_Ignored_Equality, + Warn_On_Ineffective_Predicate_Test, Warn_On_Late_Primitives, Warn_On_Modified_Unread, Warn_On_No_Value_Assigned, @@ -155,6 +156,7 @@ package Warnsw is Warn_On_Elab_Access | Warn_On_Hiding | Warn_On_Ignored_Equality | + Warn_On_Ineffective_Predicate_Test | Warn_On_Late_Primitives | Warn_On_Modified_Unread | Warn_On_Non_Local_Exception | @@ -215,7 +217,7 @@ package Warnsw is -- of the old ABE mechanism. Implementation_Unit_Warnings : Boolean renames F (X.Implementation_Unit_Warnings); - -- Set True to active warnings for use of implementation internal units. + -- Set True to activate warnings for use of implementation internal units. -- Modified by use of -gnatwi/-gnatwI. Ineffective_Inline_Warnings : Boolean renames F (X.Ineffective_Inline_Warnings); @@ -333,6 +335,11 @@ package Warnsw is -- whose type has the user-defined "=" as primitive). Off by default, and -- set by -gnatw_q (but not -gnatwa). + Warn_On_Ineffective_Predicate_Test : Boolean renames F (X.Warn_On_Ineffective_Predicate_Test); + -- Set to True to generate warnings if a static predicate is testing for + -- values that do not belong to the parent subtype. Modified by use of + -- -gnatw_s/S. + Warn_On_Late_Primitives : Boolean renames F (X.Warn_On_Late_Primitives); -- Warn when tagged type public primitives are defined after its private -- extensions.