From patchwork Tue Jul 7 09:27:36 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: 1324231 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 4B1HFF0Z0fz9sSn for ; Tue, 7 Jul 2020 19:29:05 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 3114538618D9; Tue, 7 Jul 2020 09:27:49 +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 [IPv6:2620:20:4000:0:a9e:1ff:fe9b:1d1]) by sourceware.org (Postfix) with ESMTP id 94EDB3861010 for ; Tue, 7 Jul 2020 09:27:39 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 94EDB3861010 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 0A33256103; Tue, 7 Jul 2020 05:27:37 -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 7zdsViopnomf; Tue, 7 Jul 2020 05:27:36 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id BE8C056107; Tue, 7 Jul 2020 05:27:36 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id BDBDC156; Tue, 7 Jul 2020 05:27:36 -0400 (EDT) Date: Tue, 7 Jul 2020 05:27:36 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] ACATS 4.1J - B854003 - Subtype conformance check missed #2 Message-ID: <20200707092736.GA41663@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-7.3 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_ASCII_DIVIDERS, KAM_DMARC_STATUS, KAM_NUMSUBJECT, 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" This is a follow up of previous change, which didn't handle the case of Errmsg = False in Check_Conformance properly. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_ch6.adb (Check_Formal_Subprogram_Conformance): New subprogram to handle checking without systematically emitting an error. (Check_Conformance): Update call to Check_Formal_Subprogram_Conformance and fix handling of Conforms and Errmsg parameters. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -152,6 +152,16 @@ package body Sem_Ch6 is -- against a formal access-to-subprogram type so Get_Instance_Of must -- be called. + procedure Check_Formal_Subprogram_Conformance + (New_Id : Entity_Id; + Old_Id : Entity_Id; + Err_Loc : Node_Id; + Errmsg : Boolean; + Conforms : out Boolean); + -- Core implementation of Check_Formal_Subprogram_Conformance from spec. + -- Errmsg can be set to False to not emit error messages. + -- Conforms is set to True if there is conformance, False otherwise. + procedure Check_Limited_Return (N : Node_Id; Expr : Node_Id; @@ -5759,14 +5769,19 @@ package body Sem_Ch6 is Error_Msg_Name_2 := Name_Ada + Convention_Id'Pos (Convention (New_Id)); Conformance_Error ("\prior declaration for% has convention %!"); + return; else Conformance_Error ("\calling conventions do not match!"); + return; end if; - - return; else - Check_Formal_Subprogram_Conformance (New_Id, Old_Id, Err_Loc); + Check_Formal_Subprogram_Conformance + (New_Id, Old_Id, Err_Loc, Errmsg, Conforms); + + if not Conforms then + return; + end if; end if; end if; @@ -5932,7 +5947,11 @@ package body Sem_Ch6 is begin if Is_Protected_Type (Corresponding_Concurrent_Type (T)) then - Error_Msg_PT (New_Id, Ultimate_Alias (Old_Id)); + Conforms := False; + + if Errmsg then + Error_Msg_PT (New_Id, Ultimate_Alias (Old_Id)); + end if; else Conformance_Error ("\mode of & does not match!", New_Formal); @@ -6489,12 +6508,16 @@ package body Sem_Ch6 is ----------------------------------------- procedure Check_Formal_Subprogram_Conformance - (New_Id : Entity_Id; - Old_Id : Entity_Id; - Err_Loc : Node_Id := Empty) + (New_Id : Entity_Id; + Old_Id : Entity_Id; + Err_Loc : Node_Id; + Errmsg : Boolean; + Conforms : out Boolean) is N : Node_Id; begin + Conforms := True; + if Is_Formal_Subprogram (Old_Id) or else Is_Formal_Subprogram (New_Id) or else (Is_Subprogram (New_Id) @@ -6507,14 +6530,29 @@ package body Sem_Ch6 is N := New_Id; end if; - Error_Msg_Sloc := Sloc (Old_Id); - Error_Msg_N ("not subtype conformant with declaration#!", N); - Error_Msg_NE - ("\formal subprograms are not subtype conformant " - & "(RM 6.3.1 (17/3))", N, New_Id); + Conforms := False; + + if Errmsg then + Error_Msg_Sloc := Sloc (Old_Id); + Error_Msg_N ("not subtype conformant with declaration#!", N); + Error_Msg_NE + ("\formal subprograms are not subtype conformant " + & "(RM 6.3.1 (17/3))", N, New_Id); + end if; end if; end Check_Formal_Subprogram_Conformance; + procedure Check_Formal_Subprogram_Conformance + (New_Id : Entity_Id; + Old_Id : Entity_Id; + Err_Loc : Node_Id := Empty) + is + Ignore : Boolean; + begin + Check_Formal_Subprogram_Conformance + (New_Id, Old_Id, Err_Loc, True, Ignore); + end Check_Formal_Subprogram_Conformance; + ---------------------------- -- Check_Fully_Conformant -- ---------------------------- @@ -8848,7 +8886,7 @@ package body Sem_Ch6 is -- Warn unless genuine overloading. Do not emit warning on -- hiding predefined operators in Standard (these are either an - -- (artifact of our implicit declarations, or simple noise) but + -- artifact of our implicit declarations, or simple noise) but -- keep warning on a operator defined on a local subtype, because -- of the real danger that different operators may be applied in -- various parts of the program.