From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTP id 2D66C387089B for ; Wed, 16 Dec 2020 13:15:35 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 2D66C387089B 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 EBA02561FB; Wed, 16 Dec 2020 08:15:34 -0500 (EST) 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 81Z7r8yB2keQ; Wed, 16 Dec 2020 08:15:34 -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 DA4E5561F8; Wed, 16 Dec 2020 08:15:34 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id D9618A6; Wed, 16 Dec 2020 08:15:34 -0500 (EST) Date: Wed, 16 Dec 2020 08:15:34 -0500 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Piotr Trojanek Subject: [Ada] Reject junk syntax for Contract_Cases/Test_Case/Subprogram_Variant Message-ID: <20201216131534.GA69792@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="NzB8fVQJ5HfG6fxh" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-11.5 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: , X-List-Received-Date: Wed, 16 Dec 2020 13:15:36 -0000 --NzB8fVQJ5HfG6fxh Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Reject contracts Contract_Cases, Test_Case and Subprogram_Variant whose expression is either "null", "(null record)" or has extra parentheses. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_ch13.adb (Analyze_Aspect_Specifications): Add a codefix for extra parentheses around aspect Annotate expression; reject "(null record)" aggregate and extra parentheses around aspect Test_Case expression. * sem_prag.adb (Analyze_Pragma): Reject "null", "(null record)" and extra parentheses around pragma Contract_Cases; likewise for pragma Subprogram_Variant. --NzB8fVQJ5HfG6fxh Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" 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 @@ -4145,7 +4145,8 @@ package body Sem_Ch13 is -- Must not be parenthesized if Paren_Count (Expr) /= 0 then - Error_Msg_F ("extra parentheses ignored", Expr); + Error_Msg -- CODEFIX + ("redundant parentheses", First_Sloc (Expr)); end if; -- List of arguments is list of aggregate expressions @@ -4426,13 +4427,24 @@ package body Sem_Ch13 is goto Continue; end if; - if Nkind (Expr) /= N_Aggregate then + if Nkind (Expr) /= N_Aggregate + or else Null_Record_Present (Expr) + then Error_Msg_Name_1 := Nam; Error_Msg_NE ("wrong syntax for aspect `%` for &", Id, E); goto Continue; end if; + -- Check that the expression is a proper aggregate (no + -- parentheses). + + if Paren_Count (Expr) /= 0 then + Error_Msg -- CODEFIX + ("redundant parentheses", First_Sloc (Expr)); + goto Continue; + end if; + -- Create the list of arguments for building the Test_Case -- pragma. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -545,16 +545,31 @@ package body Sem_Prag is -- Single and multiple contract cases must appear in aggregate form. If -- this is not the case, then either the parser or the analysis of the - -- pragma failed to produce an aggregate. + -- pragma failed to produce an aggregate, e.g. when the contract is + -- "null" or a "(null record)". - pragma Assert (Nkind (CCases) = N_Aggregate); + pragma Assert + (if Nkind (CCases) = N_Aggregate + then Null_Record_Present (CCases) + xor (Present (Component_Associations (CCases)) + or + Present (Expressions (CCases))) + else Nkind (CCases) = N_Null); -- Only CASE_GUARD => CONSEQUENCE clauses are allowed - if Present (Component_Associations (CCases)) + if Nkind (CCases) = N_Aggregate + and then Present (Component_Associations (CCases)) and then No (Expressions (CCases)) then + -- Check that the expression is a proper aggregate (no parentheses) + + if Paren_Count (CCases) /= 0 then + Error_Msg -- CODEFIX + ("redundant parentheses", First_Sloc (CCases)); + end if; + -- Ensure that the formal parameters are visible when analyzing all -- clauses. This falls out of the general rule of aspects pertaining -- to subprogram declarations. @@ -29170,16 +29185,31 @@ package body Sem_Prag is -- Single and multiple contract cases must appear in aggregate form. If -- this is not the case, then either the parser of the analysis of the - -- pragma failed to produce an aggregate. + -- pragma failed to produce an aggregate, e.g. when the contract is + -- "null" or a "(null record)". - pragma Assert (Nkind (Variants) = N_Aggregate); + pragma Assert + (if Nkind (Variants) = N_Aggregate + then Null_Record_Present (Variants) + xor (Present (Component_Associations (Variants)) + or + Present (Expressions (Variants))) + else Nkind (Variants) = N_Null); -- Only "change_direction => discrete_expression" clauses are allowed - if Present (Component_Associations (Variants)) + if Nkind (Variants) = N_Aggregate + and then Present (Component_Associations (Variants)) and then No (Expressions (Variants)) then + -- Check that the expression is a proper aggregate (no parentheses) + + if Paren_Count (Variants) /= 0 then + Error_Msg -- CODEFIX + ("redundant parentheses", First_Sloc (Variants)); + end if; + -- Ensure that the formal parameters are visible when analyzing all -- clauses. This falls out of the general rule of aspects pertaining -- to subprogram declarations. --NzB8fVQJ5HfG6fxh--