From patchwork Tue Apr 25 09:46:17 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 754671 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3wByzC6x1rz9s3w for ; Tue, 25 Apr 2017 19:46:47 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="xkPS2RHk"; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=p55EjBKCUlabLeUcVYbn+IvFaLd/J7u6CAXR7QHIWxLd7lteQj PgiE3wo6mL06d1K/YHNu+V93cdemQgez/VUxmo+zPXMTrxSs+OAYOpHCTyjY6Sf1 ksTItH6YGUeFCl4NkZETUfS2JYflcPfVGOgLh9TxcieGOH9uZXH3kNNDA= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=DmHaSc5JjuzRYlshJfw4g4VSJk8=; b=xkPS2RHkJSaUwEKnohm+ +BZaBx9UJd+zaSe0W0aQ0w9AGETPKJNoUOH/n3FHS3iN+44GJ3FdLiZbwSqWK81O 6Z+8L96xwOYQpxvJxs8lmvL1Dey9SvasmlKrd/Lk1xtI8wRZ1RP8ZyAdao0utPLD OOaz/RGutvzWAs67FFAOs4A= Received: (qmail 125253 invoked by alias); 25 Apr 2017 09:46:25 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 124480 invoked by uid 89); 25 Apr 2017 09:46:20 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.1 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=Baird, baird X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 25 Apr 2017 09:46:17 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id E9AAF350F; Tue, 25 Apr 2017 05:46:17 -0400 (EDT) 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 FZvqAmSMkIRT; Tue, 25 Apr 2017 05:46:17 -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 D9B6D29DE7; Tue, 25 Apr 2017 05:46:17 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id D6B6F521; Tue, 25 Apr 2017 05:46:17 -0400 (EDT) Date: Tue, 25 Apr 2017 05:46:17 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Stephen Baird Subject: [Ada] For CodePeer, omit some tag checks which confuse gnat2scil Message-ID: <20170425094617.GA8503@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) CodePeer does not do anything useful with the various components of the record type Ada.Tags.Type_Specific_Data. Suppress generation of some checks which reference these components in cases where these checks cause CodePeer to generate unwanted messages. This change has no user-visible effect except when Gnat2scil is running. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Steve Baird * exp_ch6.adb (Expand_Simple_Function_Return): if CodePeer_Mode is True, then don't generate the accessibility check for the tag of a tagged result. * exp_intr.adb (Expand_Dispatching_Constructor_Call): if CodePeer_Mode is True, then don't generate the tag checks for the result of call to an instance of Ada.Tags.Generic_Dispatching_Constructor (i.e., both the "is a descendant of" check and the accessibility check). Index: exp_ch6.adb =================================================================== --- exp_ch6.adb (revision 247136) +++ exp_ch6.adb (working copy) @@ -6635,15 +6635,20 @@ Attribute_Name => Name_Tag); end if; - Insert_Action (Exp, - Make_Raise_Program_Error (Loc, - Condition => - Make_Op_Gt (Loc, - Left_Opnd => Build_Get_Access_Level (Loc, Tag_Node), - Right_Opnd => - Make_Integer_Literal (Loc, - Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))), - Reason => PE_Accessibility_Check_Failed)); + if not CodePeer_Mode then + -- CodePeer doesn't do anything useful with + -- Ada.Tags.Type_Specific_Data components + + Insert_Action (Exp, + Make_Raise_Program_Error (Loc, + Condition => + Make_Op_Gt (Loc, + Left_Opnd => Build_Get_Access_Level (Loc, Tag_Node), + Right_Opnd => + Make_Integer_Literal (Loc, + Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))), + Reason => PE_Accessibility_Check_Failed)); + end if; end; -- AI05-0073: If function has a controlling access result, check that Index: exp_intr.adb =================================================================== --- exp_intr.adb (revision 247150) +++ exp_intr.adb (working copy) @@ -421,20 +421,22 @@ Result_Typ := Class_Wide_Type (Etype (Act_Constr)); -- Check that the accessibility level of the tag is no deeper than that - -- of the constructor function. + -- of the constructor function (unless CodePeer_Mode) - Insert_Action (N, - Make_Implicit_If_Statement (N, - Condition => - Make_Op_Gt (Loc, - Left_Opnd => - Build_Get_Access_Level (Loc, New_Copy_Tree (Tag_Arg)), - Right_Opnd => - Make_Integer_Literal (Loc, Scope_Depth (Act_Constr))), + if not CodePeer_Mode then + Insert_Action (N, + Make_Implicit_If_Statement (N, + Condition => + Make_Op_Gt (Loc, + Left_Opnd => + Build_Get_Access_Level (Loc, New_Copy_Tree (Tag_Arg)), + Right_Opnd => + Make_Integer_Literal (Loc, Scope_Depth (Act_Constr))), - Then_Statements => New_List ( - Make_Raise_Statement (Loc, - New_Occurrence_Of (RTE (RE_Tag_Error), Loc))))); + Then_Statements => New_List ( + Make_Raise_Statement (Loc, + New_Occurrence_Of (RTE (RE_Tag_Error), Loc))))); + end if; if Is_Interface (Etype (Act_Constr)) then @@ -505,10 +507,11 @@ -- Do not generate a run-time check on the built object if tag -- checks are suppressed for the result type or tagged type expansion - -- is disabled. + -- is disabled or if CodePeer_Mode. if Tag_Checks_Suppressed (Etype (Result_Typ)) or else not Tagged_Type_Expansion + or else CodePeer_Mode then null;