From patchwork Mon May 2 10:05:17 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 617451 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 3qz0LQ6FXnz9sRZ for ; Mon, 2 May 2016 20:05:50 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=ux5FqVUU; 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=m7CB1uJh+YYSdfDy7xBgXmmuQ3G51Ln2SNIBpn8Ln/3H4ZnUgL Ah88t+zQIAnaHnUp4JxGXl89CqkUdXI24/ex8IotjZPkSxARFlI+NzpJeGpOXMnc w+R/UJvAlDeKOyzC/JTGg5thZBomuxzP1zp5aNyHg68Utp0M+xg9C4CUg= 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=xMA6gxOVcDTiAcfMnrbuFlMSlmc=; b=ux5FqVUUjIxCw6l6+Zhu X+EYwG7pFh43rfE5iygpKNwCxLwmXlcmQh0lX2q4xVADc0ObYTS3mndasv2ipTcd KTV8j83nRpbebwNkMZMo1zlk/CSmSa0r81St9vZZq4EcsHdewJz2Cv84HT77dEpu 24VfXb8guyHMGKlckWGqJxI= Received: (qmail 119971 invoked by alias); 2 May 2016 10:05: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 119937 invoked by uid 89); 2 May 2016 10:05:24 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=2.2 required=5.0 tests=AWL, BAYES_50, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_NONE autolearn=no version=3.3.2 spammy=nam, transformations, elsif, biased 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 (AES256-SHA encrypted) ESMTPS; Mon, 02 May 2016 10:05:19 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id E2EE1116754; Mon, 2 May 2016 06:05: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 l0V+FnmvI9px; Mon, 2 May 2016 06:05:17 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id CF62A11674F; Mon, 2 May 2016 06:05:17 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id CE48741B; Mon, 2 May 2016 06:05:17 -0400 (EDT) Date: Mon, 2 May 2016 06:05:17 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Handling of attribute definition clauses for ASIS with GNSA Message-ID: <20160502100517.GA1895@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch introduces new switch -gnatd.H to enabled ASIS_GNSA mode. When active, this mode disabled the call to gigi. In addition, the patch suppresses various error checks with respect to attribute definition clauses in ASIS mode. ------------ -- Source -- ------------ -- clauses.ads package Clauses is -- Alignment type Align_T is tagged record Comp : Integer := 1; end record; for Align_T'Alignment use 7; Align_Obj : Align_T; for Align_Obj'Alignment use 7; -- Component_Size type Comp_Siz_T is array (1 .. 5) of Integer; for Comp_Siz_T'Component_Size use -1; -- Machine_Radix type Mach_Rad_T is delta 0.01 digits 15; for Mach_Rad_T'Machine_Radix use -1; -- Object_Size type Obj_Siz_T is record Comp : Integer := 1; end record; for Obj_Siz_T'Object_Size use -1; -- Size type Siz_Elem_T is new Integer; for Siz_Elem_T'Size use -1; type Siz_Rec_T is record Comp : Integer := 1; end record; for Siz_Rec_T'Size use -1; Siz_Elem_Obj : Siz_Elem_T; for Siz_Elem_Obj'Size use -1; Siz_Rec_Obj : Siz_Rec_T; for Siz_Rec_Obj'Size use -1; -- Storage_Size task type Stor_Siz_T; for Stor_Siz_T'Storage_Size use -1; -- Stream_Size type Str_Siz_Elem_T is new Integer; for Str_Siz_Elem_T'Stream_Size use -1; -- Value_Size type Val_Siz_T is array (1 .. 5) of Integer; for Val_Siz_T'Value_Size use -1; end Clauses; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c clauses.ads $ gcc -c clauses.ads -gnatct -gnatd.H clauses.ads:9:30: alignment value must be positive clauses.ads:13:32: alignment value must be positive clauses.ads:19:38: size for "Integer" too small, minimum allowed is 32 clauses.ads:25:37: machine radix value must be 2 or 10 clauses.ads:33:34: Object_Size must be a multiple of 8 clauses.ads:39:28: size for "Siz_Elem_T" too small, minimum allowed is 32 clauses.ads:49:30: size for "Siz_Elem_T" too small, minimum allowed is 32 clauses.ads:65:04: stream size for elementary type must be a power of 2 and at least 8 Tested on x86_64-pc-linux-gnu, committed on trunk 2016-05-02 Hristian Kirtchev * debug.adb: Document the use of switch -gnatd.H. * gnat1drv.adb (Adjust_Global_Switches): Set ASIS_GNSA mode when -gnatd.H is present. (Gnat1drv): Suppress the call to gigi when ASIS_GNSA mode is active. * opt.ads: Add new option ASIS_GNSA_Mode. * sem_ch13.adb (Alignment_Error): New routine. (Analyze_Attribute_Definition_Clause): Suppress certain errors in ASIS mode for attribute clause Alignment, Machine_Radix, Size, and Stream_Size. (Check_Size): Use routine Size_Too_Small_Error to suppress certain errors in ASIS mode. (Get_Alignment_Value): Use routine Alignment_Error to suppress certain errors in ASIS mode. (Size_Too_Small_Error): New routine. Index: debug.adb =================================================================== --- debug.adb (revision 235710) +++ debug.adb (working copy) @@ -125,7 +125,7 @@ -- d.E Turn selected errors into warnings -- d.F Debug mode for GNATprove -- d.G Ignore calls through generic formal parameters for elaboration - -- d.H + -- d.H GNSA mode for ASIS -- d.I Do not ignore enum representation clauses in CodePeer mode -- d.J Disable parallel SCIL generation mode -- d.K @@ -630,6 +630,9 @@ -- now fixed, but we provide this debug flag to revert to the previous -- situation of ignoring such calls to aid in transition. + -- d.H Sets ASIS_GNSA_Mode to True. This signals the front end to suppress + -- the call to gigi in ASIS_Mode. + -- d.I Do not ignore enum representation clauses in CodePeer mode. -- The default of ignoring representation clauses for enumeration -- types in CodePeer is good for the majority of Ada code, but in some Index: gnat1drv.adb =================================================================== --- gnat1drv.adb (revision 235706) +++ gnat1drv.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -180,6 +180,12 @@ if Operating_Mode = Check_Semantics and then Tree_Output then ASIS_Mode := True; + -- Set ASIS GNSA mode if -gnatd.H is set + + if Debug_Flag_Dot_HH then + ASIS_GNSA_Mode := True; + end if; + -- Turn off inlining in ASIS mode, since ASIS cannot handle the extra -- information in the trees caused by inlining being active. @@ -1054,7 +1060,7 @@ if GNATprove_Mode then declare Unused_E : constant Entity_Id := - Rtsfind.RTE (Rtsfind.RE_Interrupt_Priority); + Rtsfind.RTE (Rtsfind.RE_Interrupt_Priority); begin null; end; @@ -1176,13 +1182,11 @@ -- We can generate code for a package declaration or a subprogram -- declaration only if it does not required a body. - elsif Nkind_In (Main_Kind, - N_Package_Declaration, - N_Subprogram_Declaration) + elsif Nkind_In (Main_Kind, N_Package_Declaration, + N_Subprogram_Declaration) and then (not Body_Required (Main_Unit_Node) - or else - Distribution_Stub_Mode = Generate_Caller_Stub_Body) + or else Distribution_Stub_Mode = Generate_Caller_Stub_Body) then Back_End_Mode := Generate_Object; @@ -1247,8 +1251,7 @@ if Back_End_Mode = Skip then Set_Standard_Error; - Write_Str ("cannot generate code for "); - Write_Str ("file "); + Write_Str ("cannot generate code for file "); Write_Name (Unit_File_Name (Main_Unit)); if Subunits_Missing then @@ -1320,11 +1323,16 @@ -- Annotation is suppressed for targets where front-end layout is -- enabled, because the front end determines representations. + -- The back-end is not invoked in ASIS mode with GNSA because all type + -- representation information will be provided by the GNSA back-end, not + -- gigi. + if Back_End_Mode = Declarations_Only and then (not (Back_Annotate_Rep_Info or Generate_SCIL or GNATprove_Mode) or else Main_Kind = N_Subunit - or else Frontend_Layout_On_Target) + or else Frontend_Layout_On_Target + or else ASIS_GNSA_Mode) then Post_Compilation_Validation_Checks; Errout.Finalize (Last_Call => True); Index: opt.ads =================================================================== --- opt.ads (revision 235713) +++ opt.ads (working copy) @@ -208,6 +208,11 @@ -- Set to non-null when Bind_Alternate_Main_Name is True. This value -- is modified as needed by Gnatbind.Scan_Bind_Arg. + ASIS_GNSA_Mode : Boolean := False; + -- GNAT + -- Enable GNSA back-end processing assuming ASIS_Mode is already set to + -- True. ASIS_GNSA mode suppresses the call to gigi. + ASIS_Mode : Boolean := False; -- GNAT -- Enable semantic checks and tree transformations that are important Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 235711) +++ sem_ch13.adb (working copy) @@ -4758,9 +4758,8 @@ elsif Is_Subprogram (U_Ent) then if Has_Homonym (U_Ent) then Error_Msg_N - ("address clause cannot be given " & - "for overloaded subprogram", - Nam); + ("address clause cannot be given for overloaded " + & "subprogram", Nam); return; end if; @@ -4802,8 +4801,8 @@ if Warn_On_Obsolescent_Feature then Error_Msg_N - ("?j?attaching interrupt to task entry is an " & - "obsolescent feature (RM J.7.1)", N); + ("?j?attaching interrupt to task entry is an obsolescent " + & "feature (RM J.7.1)", N); Error_Msg_N ("\?j?use interrupt procedure instead", N); end if; @@ -5022,12 +5021,17 @@ Set_Has_Alignment_Clause (U_Ent); -- Tagged type case, check for attempt to set alignment to a - -- value greater than Max_Align, and reset if so. + -- value greater than Max_Align, and reset if so. This error + -- is suppressed in ASIS mode to allow for different ASIS + -- back-ends or ASIS-based tools to query the illegal clause. - if Is_Tagged_Type (U_Ent) and then Align > Max_Align then + if Is_Tagged_Type (U_Ent) + and then Align > Max_Align + and then not ASIS_Mode + then Error_Msg_N ("alignment for & set to Maximum_Aligment??", Nam); - Set_Alignment (U_Ent, Max_Align); + Set_Alignment (U_Ent, Max_Align); -- All other cases @@ -5100,7 +5104,7 @@ end if; Btype := Base_Type (U_Ent); - Ctyp := Component_Type (Btype); + Ctyp := Component_Type (Btype); if Duplicate_Clause then null; @@ -5324,8 +5328,8 @@ Error_Msg_NE ("??non-unique external tag supplied for &", N, U_Ent); Error_Msg_N - ("\??same external tag applies to all " - & "subprogram calls", N); + ("\??same external tag applies to all subprogram calls", + N); Error_Msg_N ("\??corresponding internal tag cannot be obtained", N); end if; @@ -5363,8 +5367,8 @@ if From_Aspect_Specification (N) then if not Is_Concurrent_Type (U_Ent) then Error_Msg_N - ("Interrupt_Priority can only be defined for task " - & "and protected object", Nam); + ("Interrupt_Priority can only be defined for task and " + & "protected object", Nam); elsif Duplicate_Clause then null; @@ -5456,9 +5460,15 @@ if Radix = 2 then null; + elsif Radix = 10 then Set_Machine_Radix_10 (U_Ent); - else + + -- The following error is suppressed in ASIS mode to allow for + -- different ASIS back-ends or ASIS-based tools to query the + -- illegal clause. + + elsif not ASIS_Mode then Error_Msg_N ("machine radix value must be 2 or 10", Expr); end if; end if; @@ -5486,7 +5496,14 @@ else Check_Size (Expr, U_Ent, Size, Biased); - if Is_Scalar_Type (U_Ent) then + -- The following errors are suppressed in ASIS mode to allow + -- for different ASIS back-ends or ASIS-based tools to query + -- the illegal clause. + + if ASIS_Mode then + null; + + elsif Is_Scalar_Type (U_Ent) then if Size /= 8 and then Size /= 16 and then Size /= 32 and then UI_Mod (Size, 64) /= 0 then @@ -5573,8 +5590,8 @@ begin if not (Is_Record_Type (U_Ent) or else Is_Array_Type (U_Ent)) then Error_Msg_N - ("Scalar_Storage_Order can only be defined for " - & "record or array type", Nam); + ("Scalar_Storage_Order can only be defined for record or " + & "array type", Nam); elsif Duplicate_Clause then null; @@ -5598,8 +5615,8 @@ Set_Reverse_Storage_Order (Base_Type (U_Ent), True); else Error_Msg_N - ("non-default Scalar_Storage_Order " - & "not supported on target", Expr); + ("non-default Scalar_Storage_Order not supported on " + & "target", Expr); end if; end if; @@ -5696,21 +5713,22 @@ -- For objects, set Esize only else - if Is_Elementary_Type (Etyp) then - if Size /= System_Storage_Unit - and then - Size /= System_Storage_Unit * 2 - and then - Size /= System_Storage_Unit * 4 - and then - Size /= System_Storage_Unit * 8 - then - Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit); - Error_Msg_Uint_2 := Error_Msg_Uint_1 * 8; - Error_Msg_N - ("size for primitive object must be a power of 2" - & " in the range ^-^", N); - end if; + -- The following error is suppressed in ASIS mode to allow + -- for different ASIS back-ends or ASIS-based tools to query + -- the illegal clause. + + if Is_Elementary_Type (Etyp) + and then Size /= System_Storage_Unit + and then Size /= System_Storage_Unit * 2 + and then Size /= System_Storage_Unit * 4 + and then Size /= System_Storage_Unit * 8 + and then not ASIS_Mode + then + Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit); + Error_Msg_Uint_2 := Error_Msg_Uint_1 * 8; + Error_Msg_N + ("size for primitive object must be a power of 2 in " + & "the range ^-^", N); end if; Set_Esize (U_Ent, Size); @@ -5955,8 +5973,8 @@ if Warn_On_Obsolescent_Feature then Error_Msg_N - ("?j?storage size clause for task is an " & - "obsolescent feature (RM J.9)", N); + ("?j?storage size clause for task is an obsolescent " + & "feature (RM J.9)", N); Error_Msg_N ("\?j?use Storage_Size pragma instead", N); end if; end if; @@ -6024,24 +6042,29 @@ null; elsif Is_Elementary_Type (U_Ent) then - if Size /= System_Storage_Unit - and then - Size /= System_Storage_Unit * 2 - and then - Size /= System_Storage_Unit * 4 - and then - Size /= System_Storage_Unit * 8 + + -- The following errors are suppressed in ASIS mode to allow + -- for different ASIS back-ends or ASIS-based tools to query + -- the illegal clause. + + if ASIS_Mode then + null; + + elsif Size /= System_Storage_Unit + and then Size /= System_Storage_Unit * 2 + and then Size /= System_Storage_Unit * 4 + and then Size /= System_Storage_Unit * 8 then Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit); Error_Msg_N - ("stream size for elementary type must be a" - & " power of 2 and at least ^", N); + ("stream size for elementary type must be a power of 2 " + & "and at least ^", N); elsif RM_Size (U_Ent) > Size then Error_Msg_Uint_1 := RM_Size (U_Ent); Error_Msg_N - ("stream size for elementary type must be a" - & " power of 2 and at least ^", N); + ("stream size for elementary type must be a power of 2 " + & "and at least ^", N); end if; Set_Has_Stream_Size_Clause (U_Ent); @@ -6787,12 +6810,10 @@ and then Lbit /= No_Uint then if Posit < 0 then - Error_Msg_N - ("position cannot be negative", Position (CC)); + Error_Msg_N ("position cannot be negative", Position (CC)); elsif Fbit < 0 then - Error_Msg_N - ("first bit cannot be negative", First_Bit (CC)); + Error_Msg_N ("first bit cannot be negative", First_Bit (CC)); -- The Last_Bit specified in a component clause must not be -- less than the First_Bit minus one (RM-13.5.1(10)). @@ -6885,8 +6906,8 @@ Intval (Last_Bit (CC)) then Error_Msg_N - ("component clause inconsistent " - & "with representation of ancestor", CC); + ("component clause inconsistent with " + & "representation of ancestor", CC); elsif Warn_On_Redundant_Constructs then Error_Msg_N @@ -10870,13 +10891,36 @@ Siz : Uint; Biased : out Boolean) is + procedure Size_Too_Small_Error (Min_Siz : Uint); + -- Emit an error concerning illegal size Siz. Min_Siz denotes the + -- minimum size. + + -------------------------- + -- Size_Too_Small_Error -- + -------------------------- + + procedure Size_Too_Small_Error (Min_Siz : Uint) is + begin + -- This error is suppressed in ASIS mode to allow for different ASIS + -- back-ends or ASIS-based tools to query the illegal clause. + + if not ASIS_Mode then + Error_Msg_Uint_1 := Min_Siz; + Error_Msg_NE ("size for & too small, minimum allowed is ^", N, T); + end if; + end Size_Too_Small_Error; + + -- Local variables + UT : constant Entity_Id := Underlying_Type (T); M : Uint; + -- Start of processing for Check_Size + begin Biased := False; - -- Reject patently improper size values. + -- Reject patently improper size values if Is_Elementary_Type (T) and then Siz > UI_From_Int (Int'Last) @@ -10945,9 +10989,7 @@ return; else - Error_Msg_Uint_1 := Asiz; - Error_Msg_NE - ("size for& too small, minimum allowed is ^", N, T); + Size_Too_Small_Error (Asiz); Set_Esize (T, Asiz); Set_RM_Size (T, Asiz); end if; @@ -10962,9 +11004,7 @@ -- since we don't know all the characteristics of the type that can -- affect the size (e.g. a specified small) till freeze time. - elsif Is_Fixed_Point_Type (UT) - and then not Is_Frozen (UT) - then + elsif Is_Fixed_Point_Type (UT) and then not Is_Frozen (UT) then null; -- Cases for which a minimum check is required @@ -10988,10 +11028,8 @@ M := UI_From_Int (Minimum_Size (UT, Biased => True)); if Siz < M then - Error_Msg_Uint_1 := M; - Error_Msg_NE - ("size for& too small, minimum allowed is ^", N, T); - Set_Esize (T, M); + Size_Too_Small_Error (M); + Set_Esize (T, M); Set_RM_Size (T, M); else Biased := True; @@ -11513,14 +11551,36 @@ ------------------------- function Get_Alignment_Value (Expr : Node_Id) return Uint is + procedure Alignment_Error; + -- Issue an error concerning a negatize or zero alignment represented by + -- expression Expr. + + --------------------- + -- Alignment_Error -- + --------------------- + + procedure Alignment_Error is + begin + -- This error is suppressed in ASIS mode to allow for different ASIS + -- back-ends or ASIS-based tools to query the illegal clause. + + if not ASIS_Mode then + Error_Msg_N ("alignment value must be positive", Expr); + end if; + end Alignment_Error; + + -- Local variables + Align : constant Uint := Static_Integer (Expr); + -- Start of processing for Get_Alignment_Value + begin if Align = No_Uint then return No_Uint; elsif Align <= 0 then - Error_Msg_N ("alignment value must be positive", Expr); + Alignment_Error; return No_Uint; else @@ -11532,8 +11592,7 @@ exit when M = Align; if M > Align then - Error_Msg_N - ("alignment value must be power of 2", Expr); + Alignment_Error; return No_Uint; end if; end;