From patchwork Fri Aug 30 15:22:51 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 1155963 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-508051-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="Q7TO5B/9"; dkim-atps=neutral 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 46KjsR6PG0z9sML for ; Sat, 31 Aug 2019 01:22:51 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=H8u/zHOrYbUiwOKK 5ziLdpvdMx2uLeOE5Dfdc3ry0neRyMIzsvo+zOR9ZTWBMSQ/W7OQdhhPXNsI5vtq P2KiVnfWO1iFYtOFUjM9jPw58R6TIIjIDyxNM6Odm7BLSsrHvSPqqfhfKFfYEkhD 5zJaZYxn43W+40LAi58F+fankiw= 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:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; s=default; bh=Hz1BeuK/SRoa1XjZxOxpfC EvFXU=; b=Q7TO5B/9A9n/D2jNU+8P60ATy4Evx349ANwcptTg0qoEUUUyc+myAE dwvrNmpbeVyJUGBvNlH6SPmpmC32AIB5K1/cCwEUrFtB4WoGi9dU7rBXjcb3rAZt ckcW0kicjJ6gnsVpeswS5zk94CgB2XvEgIlyUTt3SWbNlf09UgEJA= Received: (qmail 125670 invoked by alias); 30 Aug 2019 15:22:44 -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 125661 invoked by uid 89); 30 Aug 2019 15:22:44 -0000 Authentication-Results: sourceware.org; auth=none 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.1 spammy=misaligned X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 30 Aug 2019 15:22:43 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id B541C81392 for ; Fri, 30 Aug 2019 17:22:40 +0200 (CEST) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id V27nYckxtTeI for ; Fri, 30 Aug 2019 17:22:40 +0200 (CEST) Received: from arcturus.home (unknown [IPv6:2a01:e35:8a16:3850:36e6:d7ff:fe66:317b]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 8B53481369 for ; Fri, 30 Aug 2019 17:22:40 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Add warning for explicit by-reference mechanism Date: Fri, 30 Aug 2019 17:22:51 +0200 Message-ID: <4585906.kV5GvoEGmf@arcturus.home> MIME-Version: 1.0 This instructs gigi to issue a warning when an explicit by-reference mechanism specified by means of pragma Export_Function cannot be honored. Tested on x86_64-suse-linux, applied on the mainline. 2019-08-30 Eric Botcazou * gcc-interface/ada-tree.h (DECL_FORCED_BY_REF_P): New macro. * gcc-interface/decl.c (gnat_to_gnu_param): Set it on parameters whose mechanism was forced to by-reference. * gcc-interface/trans.c (Call_to_gnu): Do not issue a warning about a misaligned actual parameter if it is based on a CONSTRUCTOR. Remove obsolete warning for users of Starlet. Issue a warning if a temporary is make around the call for a parameter with DECL_FORCED_BY_REF_P set. (addressable_p): Return true for REAL_CST and ADDR_EXPR. Index: gcc-interface/ada-tree.h =================================================================== --- gcc-interface/ada-tree.h (revision 275062) +++ gcc-interface/ada-tree.h (working copy) @@ -482,6 +482,9 @@ do { \ value of a function call or 'reference to a function call. */ #define DECL_RETURN_VALUE_P(NODE) DECL_LANG_FLAG_5 (VAR_DECL_CHECK (NODE)) +/* Nonzero in a PARM_DECL if its mechanism was forced to by-reference. */ +#define DECL_FORCED_BY_REF_P(NODE) DECL_LANG_FLAG_5 (PARM_DECL_CHECK (NODE)) + /* In a FIELD_DECL corresponding to a discriminant, contains the discriminant number. */ #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE)) Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 275196) +++ gcc-interface/decl.c (working copy) @@ -5208,6 +5208,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_ bool ro_param = in_param && !Address_Taken (gnat_param); bool by_return = false, by_component_ptr = false; bool by_ref = false; + bool forced_by_ref = false; bool restricted_aliasing_p = false; location_t saved_location = input_location; tree gnu_param; @@ -5235,7 +5236,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_ /* Or else, see if a Mechanism was supplied that forced this parameter to be passed one way or another. */ else if (mech == Default || mech == By_Copy || mech == By_Reference) - ; + forced_by_ref + = (mech == By_Reference + && !foreign + && !TYPE_IS_BY_REFERENCE_P (gnu_param_type) + && !Is_Aliased (gnat_param)); /* Positive mechanism means by copy for sufficiently small parameters. */ else if (mech > 0) @@ -5368,6 +5373,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_ gnu_param = create_param_decl (gnu_param_name, gnu_param_type); TREE_READONLY (gnu_param) = ro_param || by_ref || by_component_ptr; DECL_BY_REF_P (gnu_param) = by_ref; + DECL_FORCED_BY_REF_P (gnu_param) = forced_by_ref; DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr; DECL_POINTS_TO_READONLY_P (gnu_param) = (ro_param && (by_ref || by_component_ptr)); Index: gcc-interface/trans.c =================================================================== --- gcc-interface/trans.c (revision 275197) +++ gcc-interface/trans.c (working copy) @@ -5257,30 +5257,20 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_t /* Do not issue warnings for CONSTRUCTORs since this is not a copy but sort of an instantiation for them. */ - if (TREE_CODE (gnu_name) == CONSTRUCTOR) + if (TREE_CODE (remove_conversions (gnu_name, true)) == CONSTRUCTOR) ; - /* If the type is passed by reference, a copy is not allowed. */ - else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type)) + /* If the formal is passed by reference, a copy is not allowed. */ + else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type) + || Is_Aliased (gnat_formal)) post_error ("misaligned actual cannot be passed by reference", gnat_actual); - /* For users of Starlet we issue a warning because the interface - apparently assumes that by-ref parameters outlive the procedure - invocation. The code still will not work as intended, but we - cannot do much better since low-level parts of the back-end - would allocate temporaries at will because of the misalignment - if we did not do so here. */ - else if (Is_Valued_Procedure (Entity (Name (gnat_node)))) - { - post_error - ("?possible violation of implicit assumption", gnat_actual); - post_error_ne - ("?made by pragma Import_Valued_Procedure on &", gnat_actual, - Entity (Name (gnat_node))); - post_error_ne ("?because of misalignment of &", gnat_actual, - gnat_formal); - } + /* If the mechanism was forced to by-ref, a copy is not allowed but + we issue only a warning because this case is not strict Ada. */ + else if (DECL_FORCED_BY_REF_P (gnu_formal)) + post_error ("misaligned actual cannot be passed by reference??", + gnat_actual); /* If the actual type of the object is already the nominal type, we have nothing to do, except if the size is self-referential @@ -10394,6 +10384,7 @@ addressable_p (tree gnu_expr, tree gnu_type) case STRING_CST: case INTEGER_CST: + case REAL_CST: /* Taking the address yields a pointer to the constant pool. */ return true; @@ -10403,6 +10394,7 @@ addressable_p (tree gnu_expr, tree gnu_type) return TREE_STATIC (gnu_expr) ? true : false; case NULL_EXPR: + case ADDR_EXPR: case SAVE_EXPR: case CALL_EXPR: case PLUS_EXPR: