From patchwork Thu Sep 19 13:28:19 2019 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: 1164624 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-509285-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="JxeWAHG4"; 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 46YyRs4xHnz9s4Y for ; Thu, 19 Sep 2019 23:31:37 +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:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=RG9Vvj/oF4vBAQsUfbJt+yJcYnzRDkG1C5z2st45Eho8JN9igk zJf41VC2dxArWufv6KCyLKwVePqZ7aXXxF2nvxgViL2Nef/P51NC55RCDy85IgBz pAKQ1Qb8cTGI72E3FpefkfVY0KLzsD6EOScf3XSRD5CX60Ekb5EJWEnkM= 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=wl+f3A5DVwT5fedw0pEx84MEhFs=; b=JxeWAHG4Zk4YGvQylJOf mksuCwdW8oquv+vn84DXxf2XltIdw7qAmlVR2MW6DkYXZTqK/iuIeuWnRlbXD7Vs KBGSvkWAkY9kLfE1lzRM9OjneQjxDQdStZoCKYiE9fD1+yz7uJOhrfk51efaoDwf ZsB055dbnrnLTb1ZoOPC7UI= Received: (qmail 3293 invoked by alias); 19 Sep 2019 13:28:39 -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 2438 invoked by uid 89); 19 Sep 2019 13:28:32 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-10.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, SPF_NEUTRAL autolearn=ham version=3.3.1 spammy=Accept, sk:baird@a, Baird, baird X-HELO: eggs.gnu.org Received: from eggs.gnu.org (HELO eggs.gnu.org) (209.51.188.92) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 19 Sep 2019 13:28:30 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iAwTy-0001QB-Pv for gcc-patches@gcc.gnu.org; Thu, 19 Sep 2019 09:28:29 -0400 Received: from rock.gnat.com ([205.232.38.15]:48704) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1iAwTy-0001P2-6V for gcc-patches@gcc.gnu.org; Thu, 19 Sep 2019 09:28:26 -0400 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 343E05602B; Thu, 19 Sep 2019 09:28:20 -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 x05K0xoMzeYI; Thu, 19 Sep 2019 09:28:20 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id EC99C5602C; Thu, 19 Sep 2019 09:28:19 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id EB77D6B4; Thu, 19 Sep 2019 09:28:19 -0400 (EDT) Date: Thu, 19 Sep 2019 09:28:19 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Steve Baird Subject: [Ada] Accept concatentation arguments to pragma Annotate Message-ID: <20190919132819.GA41915@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 205.232.38.15 X-IsSubscribed: yes In cases where pragma Annotate accepts a string literal as an argument, we now also accept a concatenation of string literals. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-09-19 Steve Baird gcc/ada/ * sem_prag.adb (Preferred_String_Type): A new function. Given an expression, determines whether the preference rules defined for the third-and-later arguments of pragma Annotate suffice to determine the type of the expression. If so, then the preferred type is returned; if not then Empty is returned. Handles concatenations. (Analyze_Pragma): Replace previous code, which dealt only with string literals, with calls to the new Preferred_String_Type function, which also handles concatenations. * doc/gnat_rm/implementation_defined_pragmas.rst: Update documentation for pragma Annotate. * gnat_rm.texi: Regenerate. gcc/testsuite/ * gnat.dg/annotation1.adb: New testcase. --- gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -455,7 +455,8 @@ not otherwise analyze it. The second optional identifier is also left unanalyzed, and by convention is used to control the action of the tool to which the annotation is addressed. The remaining ARG arguments can be either string literals or more generally expressions. -String literals are assumed to be either of type +String literals (and concatenations of string literals) are assumed to be +either of type ``Standard.String`` or else ``Wide_String`` or ``Wide_Wide_String`` depending on the character literals they contain. All other kinds of arguments are analyzed as expressions, and must be --- gcc/ada/gnat_rm.texi +++ gcc/ada/gnat_rm.texi @@ -1836,7 +1836,8 @@ not otherwise analyze it. The second optional identifier is also left unanalyzed, and by convention is used to control the action of the tool to which the annotation is addressed. The remaining ARG arguments can be either string literals or more generally expressions. -String literals are assumed to be either of type +String literals (and concatenations of string literals) are assumed to be +either of type @code{Standard.String} or else @code{Wide_String} or @code{Wide_Wide_String} depending on the character literals they contain. All other kinds of arguments are analyzed as expressions, and must be @@ -7706,7 +7707,8 @@ usually supplied automatically by the project manager. A pragma Source_File_Name cannot appear after a @ref{ec,,Pragma Source_File_Name_Project}. For more details on the use of the @code{Source_File_Name} pragma, see the -sections on @code{Using Other File Names} and @cite{Alternative File Naming Schemes' in the :title:`GNAT User's Guide}. +sections on @cite{Using Other File Names} and @cite{Alternative File Naming Schemes} +in the @cite{GNAT User's Guide}. @node Pragma Source_File_Name_Project,Pragma Source_Reference,Pragma Source_File_Name,Implementation Defined Pragmas @anchor{gnat_rm/implementation_defined_pragmas pragma-source-file-name-project}@anchor{ec}@anchor{gnat_rm/implementation_defined_pragmas id41}@anchor{ed} --- gcc/ada/sem_prag.adb +++ gcc/ada/sem_prag.adb @@ -13085,6 +13085,56 @@ package body Sem_Prag is Expr : Node_Id; Nam_Arg : Node_Id; + -------------------------- + -- Inferred_String_Type -- + -------------------------- + + function Preferred_String_Type (Expr : Node_Id) return Entity_Id; + -- Infer the type to use for a string literal or a concatentation + -- of operands whose types can be inferred. For such expressions, + -- returns the "narrowest" of the three predefined string types + -- that can represent the characters occuring in the expression. + -- For other expressions, returns Empty. + + function Preferred_String_Type (Expr : Node_Id) return Entity_Id is + begin + case Nkind (Expr) is + when N_String_Literal => + if Has_Wide_Wide_Character (Expr) then + return Standard_Wide_Wide_String; + elsif Has_Wide_Character (Expr) then + return Standard_Wide_String; + else + return Standard_String; + end if; + + when N_Op_Concat => + declare + L_Type : constant Entity_Id + := Preferred_String_Type (Left_Opnd (Expr)); + R_Type : constant Entity_Id + := Preferred_String_Type (Right_Opnd (Expr)); + + Type_Table : constant array (1 .. 4) of Entity_Id + := (Empty, + Standard_Wide_Wide_String, + Standard_Wide_String, + Standard_String); + begin + for Idx in Type_Table'Range loop + if (L_Type = Type_Table (Idx)) or + (R_Type = Type_Table (Idx)) + then + return Type_Table (Idx); + end if; + end loop; + raise Program_Error; + end; + + when others => + return Empty; + end case; + end Preferred_String_Type; begin GNAT_Pragma; Check_At_Least_N_Arguments (1); @@ -13144,18 +13194,12 @@ package body Sem_Prag is if Is_Entity_Name (Expr) then null; - -- For string literals, we assume Standard_String as the - -- type, unless the string contains wide or wide_wide - -- characters. + -- For string literals and concatenations of string literals + -- we assume Standard_String as the type, unless the string + -- contains wide or wide_wide characters. - elsif Nkind (Expr) = N_String_Literal then - if Has_Wide_Wide_Character (Expr) then - Resolve (Expr, Standard_Wide_Wide_String); - elsif Has_Wide_Character (Expr) then - Resolve (Expr, Standard_Wide_String); - else - Resolve (Expr, Standard_String); - end if; + elsif Present (Preferred_String_Type (Expr)) then + Resolve (Expr, Preferred_String_Type (Expr)); elsif Is_Overloaded (Expr) then Error_Pragma_Arg ("ambiguous argument for pragma%", Expr); --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/annotation1.adb @@ -0,0 +1,7 @@ +-- { dg-do compile } + +procedure Annotation1 is + pragma Annotate (Some_Tool, Some_Action, "abc" & "def"); +begin + null; +end Annotation1; \ No newline at end of file