From patchwork Tue Sep 10 15:21:46 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 273916 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 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client did not present a certificate) by ozlabs.org (Postfix) with ESMTPS id 499F82C011D for ; Wed, 11 Sep 2013 01:22:02 +1000 (EST) 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=Ustm7hrFRi4XoMyOkaMt/fSDoDgWFkX55FJGYpSPklKsAdpgvJ wDuLinFK2WZNnqdVBDDJbkzfZWgOkmRpSZ96ijVcP/fY7g1ksNhu1+W5jD8CdQUN 7dc8fZSyXN9HcNHpz3wAJT1OjdGs9bl2w/IpdyhQm3ZuTOSMCkwchkgFE= 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=caAEbbsBFl+U39lLpXuwz78pnyo=; b=oNuRuWNCJNwAo8dQ+RsH h+yitzhgMIKPGo7SI6NaMCwk16nOccLkBhGAi7AULtUuwH+kD9mvWLKAk254YTQx vfacucf0q6eR9baluHSc2I+EmM9/1lI2cW8t9p4mSaB/2hLhfTDzFS/gMBOlb+5z /vMCZczEeR0hGhmZIBB5zJ4= Received: (qmail 29180 invoked by alias); 10 Sep 2013 15:21:50 -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 29145 invoked by uid 89); 10 Sep 2013 15:21:50 -0000 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; Tue, 10 Sep 2013 15:21:50 +0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=2.3 required=5.0 tests=BAYES_60, RDNS_NONE autolearn=no version=3.3.2 X-HELO: rock.gnat.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5177B116670; Tue, 10 Sep 2013 11:21:58 -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 PQORN9b6-QZl; Tue, 10 Sep 2013 11:21:58 -0400 (EDT) Received: from kwai.gnat.com (unknown [IPv6:2620:20:4000:0:a6ba:dbff:fe26:1f63]) by rock.gnat.com (Postfix) with ESMTP id 3E29C116649; Tue, 10 Sep 2013 11:21:58 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 77BB33FB31; Tue, 10 Sep 2013 11:21:46 -0400 (EDT) Date: Tue, 10 Sep 2013 11:21:46 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Improve error msgs for Ada 2012 feature not in Ada 2012 mode Message-ID: <20130910152146.GA27770@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Previously if an Ada 2012 feature was used in an earlier Ada mode, the error message always advised the use of the -gnat2012 switch. But that is not helpful if the mode was set by an explicit use of pragma Ada_xx. This patch improves the error message in this case by pointing to the relevant pragma. 1. pragma Ada_2005; 2. package Pr0512 is 3. x : integer := (if true then 1 else 2); | >>> if expression is an Ada 2012 feature >>> incompatible with Ada version set at line 1 4. end Pr0512; The following is compiled with pragma Ada_95 in gnat.adc 1. package Pr0512a is 2. x : integer := (if true then 1 else 2); | >>> if expression is an Ada 2012 feature >>> incompatible with Ada version set at gnat.adc:1 3. end Pr0512a; If this same program is compiled without a gnat.adc file, but using the switch -gnat2005, we get: 1. package Pr0512a is 2. x : integer := (if true then 1 else 2); | >>> if expression is an Ada 2012 feature >>> unit must be compiled with -gnat2012 switch 3. end Pr0512a; Tested on x86_64-pc-linux-gnu, committed on trunk 2013-09-10 Robert Dewar * errout.adb (Error_Msg_Ada_2012_Feature): New procedure. * errout.ads (Error_Msg_Ada_2012_Feature): New procedure. * inline.ads: Save/Restore Ada_Version_Pragma. * opt.adb: Save/Restore Ada_Version_Pragma. * opt.ads (Ada_Version_Pragma): New variable. * par-ch11.adb, par-ch12.adb, par-ch13.adb, par-ch4.adb, par-ch5.adb, par-ch6.adb, par-ch8.adb, par-prag.adb: Use Error_Msg_Ada_2012_Feature. * prj.adb: Initialize Ada_Version_Pragma. * sem_attr.adb: Use Error_Msg_Ada_2012_Feature. * sem_ch12.adb, sem_ch8.adb: Save/restore Ada_Version_Pragma. * sem_prag.adb (Analyze_Pragma, cases Ada_xx): Set Ada_Version_Pragma. * switch-c.adb: Initialize Ada_Version_Pragma. * sem_ch12.adb: Minor reformatting. Index: errout.adb =================================================================== --- errout.adb (revision 202456) +++ errout.adb (working copy) @@ -476,6 +476,24 @@ end; end Error_Msg; + -------------------------------- + -- Error_Msg_Ada_2012_Feature -- + -------------------------------- + + procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr) is + begin + if Ada_Version < Ada_2012 then + Error_Msg (Feature & " is an Ada 2012 feature", Loc); + + if No (Ada_Version_Pragma) then + Error_Msg ("\unit must be compiled with -gnat2012 switch", Loc); + else + Error_Msg_Sloc := Sloc (Ada_Version_Pragma); + Error_Msg ("\incompatible with Ada version set#", Loc); + end if; + end if; + end Error_Msg_Ada_2012_Feature; + ------------------ -- Error_Msg_AP -- ------------------ Index: errout.ads =================================================================== --- errout.ads (revision 202451) +++ errout.ads (working copy) @@ -343,7 +343,8 @@ -- generation of code in the presence of the -gnatQ switch. If the -- insertion character | appears, the message is considered to be -- non-serious, and does not cause Serious_Errors_Detected to be - -- incremented (so expansion is not prevented by such a msg). + -- incremented (so expansion is not prevented by such a msg). This + -- insertion character is ignored in continuation messages. -- Insertion character ~ (Tilde: insert string) -- Indicates that Error_Msg_String (1 .. Error_Msg_Strlen) is to be @@ -820,6 +821,14 @@ -- Posts an error on the protected type declaration Typ indicating wrong -- mode of the first formal of protected type primitive Subp. + procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr); + -- If not operating in Ada 2012 mode, posts errors complaining that Feature + -- is only supported in Ada 2012, with appropriate suggestions to fix this. + -- Loc is the location at which the flag is to be posted. Feature, which + -- appears at the start of the first generated message, may contain error + -- message insertion characters in the normal manner, and in particular + -- may start with | to flag a non-serious error. + procedure dmsg (Id : Error_Msg_Id) renames Erroutc.dmsg; -- Debugging routine to dump an error message Index: inline.ads =================================================================== --- inline.ads (revision 202451) +++ inline.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -89,6 +89,9 @@ -- The body must be compiled with the same language version as the -- spec. The version may be set by a configuration pragma in a separate -- file or in the current file, and may differ from body to body. + + Version_Pragma : Node_Id; + -- This is linked with the Version value end record; package Pending_Instantiations is new Table.Table ( Index: opt.adb =================================================================== --- opt.adb (revision 202451) +++ opt.adb (working copy) @@ -54,6 +54,7 @@ procedure Register_Opt_Config_Switches is begin Ada_Version_Config := Ada_Version; + Ada_Version_Pragma_Config := Ada_Version_Pragma; Ada_Version_Explicit_Config := Ada_Version_Explicit; Assertions_Enabled_Config := Assertions_Enabled; Assume_No_Invalid_Values_Config := Assume_No_Invalid_Values; @@ -87,6 +88,7 @@ procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is begin Ada_Version := Save.Ada_Version; + Ada_Version_Pragma := Save.Ada_Version_Pragma; Ada_Version_Explicit := Save.Ada_Version_Explicit; Assertions_Enabled := Save.Assertions_Enabled; Assume_No_Invalid_Values := Save.Assume_No_Invalid_Values; @@ -122,6 +124,7 @@ procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is begin Save.Ada_Version := Ada_Version; + Save.Ada_Version_Pragma := Ada_Version_Pragma; Save.Ada_Version_Explicit := Ada_Version_Explicit; Save.Assertions_Enabled := Assertions_Enabled; Save.Assume_No_Invalid_Values := Assume_No_Invalid_Values; @@ -161,6 +164,7 @@ -- the configuration setting even in a run time unit. Ada_Version := Ada_Version_Runtime; + Ada_Version_Pragma := Empty; Dynamic_Elaboration_Checks := False; Extensions_Allowed := True; External_Name_Exp_Casing := As_Is; @@ -188,6 +192,7 @@ else Ada_Version := Ada_Version_Config; + Ada_Version_Pragma := Ada_Version_Pragma_Config; Ada_Version_Explicit := Ada_Version_Explicit_Config; Assertions_Enabled := Assertions_Enabled_Config; Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config; Index: opt.ads =================================================================== --- opt.ads (revision 202461) +++ opt.ads (working copy) @@ -131,6 +131,10 @@ -- compiler switches, or implicitly (to Ada_Version_Runtime) when a -- predefined or internal file is compiled. + Ada_Version_Pragma : Node_Id := Empty; + -- Reflects the Ada_xxx pragma that resulted in setting Ada_Version. Used + -- to specialize error messages complaining about the Ada version in use. + Ada_Version_Explicit : Ada_Version_Type := Ada_Version_Default; -- GNAT -- Like Ada_Version, but does not get set implicitly for predefined @@ -1737,6 +1741,9 @@ -- predefined units (which are always compiled in the most up to date -- version of Ada). + Ada_Version_Pragma_Config : Node_Id; + -- This will be set non empty if it is set by a configuration pragma + Ada_Version_Explicit_Config : Ada_Version_Type; -- GNAT -- This is set in the same manner as Ada_Version_Config. The difference is @@ -2019,6 +2026,7 @@ type Config_Switches_Type is record Ada_Version : Ada_Version_Type; Ada_Version_Explicit : Ada_Version_Type; + Ada_Version_Pragma : Node_Id; Assertions_Enabled : Boolean; Assume_No_Invalid_Values : Boolean; Check_Float_Overflow : Boolean; Index: par-ch11.adb =================================================================== --- par-ch11.adb (revision 202451) +++ par-ch11.adb (working copy) @@ -213,11 +213,7 @@ Raise_Node : Node_Id; begin - if Ada_Version < Ada_2012 then - Error_Msg_SC ("raise expression is an Ada 2012 feature"); - Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); - end if; - + Error_Msg_Ada_2012_Feature ("raise expression", Token_Ptr); Raise_Node := New_Node (N_Raise_Expression, Token_Ptr); Scan; -- past RAISE Index: par-ch12.adb =================================================================== --- par-ch12.adb (revision 202460) +++ par-ch12.adb (working copy) @@ -546,12 +546,8 @@ Scan; -- past semicolon - if Ada_Version < Ada_2012 then - Error_Msg_N - ("`formal incomplete type` is an Ada 2012 feature", Decl_Node); - Error_Msg_N - ("\unit must be compiled with -gnat2012 switch", Decl_Node); - end if; + Error_Msg_Ada_2012_Feature + ("formal incomplete type", Sloc (Decl_Node)); Set_Formal_Type_Definition (Decl_Node, @@ -564,13 +560,9 @@ Def_Node := P_Formal_Type_Definition; - if Nkind (Def_Node) = N_Formal_Incomplete_Type_Definition - and then Ada_Version < Ada_2012 - then - Error_Msg_N - ("`formal incomplete type` is an Ada 2012 feature", Decl_Node); - Error_Msg_N - ("\unit must be compiled with -gnat2012 switch", Decl_Node); + if Nkind (Def_Node) = N_Formal_Incomplete_Type_Definition then + Error_Msg_Ada_2012_Feature + ("formal incomplete type", Sloc (Decl_Node)); end if; if Def_Node /= Error then Index: par-ch13.adb =================================================================== --- par-ch13.adb (revision 202462) +++ par-ch13.adb (working copy) @@ -128,8 +128,7 @@ if Result then Restore_Scan_State (Scan_State); - Error_Msg_SC ("|aspect specification is an Ada 2012 feature"); - Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); + Error_Msg_Ada_2012_Feature ("|aspect specification", Token_Ptr); return True; end if; end if; Index: par-ch4.adb =================================================================== --- par-ch4.adb (revision 202451) +++ par-ch4.adb (working copy) @@ -2672,18 +2672,12 @@ Node1 : Node_Id; begin - if Ada_Version < Ada_2012 then - Error_Msg_SC ("quantified expression is an Ada 2012 feature"); - Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); - end if; - + Error_Msg_Ada_2012_Feature ("quantified expression", Token_Ptr); Scan; -- past FOR - Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr); if Token = Tok_All then Set_All_Present (Node1); - elsif Token /= Tok_Some then Error_Msg_AP ("missing quantifier"); raise Error_Resync; @@ -2960,14 +2954,9 @@ Set_Subpool_Handle_Name (Alloc_Node, P_Name); T_Right_Paren; - if Ada_Version < Ada_2012 then - Error_Msg_N - ("|subpool specification is an Ada 2012 feature", - Subpool_Handle_Name (Alloc_Node)); - Error_Msg_N - ("\|unit must be compiled with -gnat2012 switch", - Subpool_Handle_Name (Alloc_Node)); - end if; + Error_Msg_Ada_2012_Feature + ("|subpool specification", + Sloc (Subpool_Handle_Name (Alloc_Node))); end if; Null_Exclusion_Present := P_Null_Exclusion; @@ -3006,11 +2995,7 @@ Save_State : Saved_Scan_State; begin - if Ada_Version < Ada_2012 then - Error_Msg_SC ("|case expression is an Ada 2012 feature"); - Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); - end if; - + Error_Msg_Ada_2012_Feature ("|case expression", Token_Ptr); Scan; -- past CASE Case_Node := Make_Case_Expression (Loc, @@ -3096,12 +3081,7 @@ begin Inside_If_Expression := Inside_If_Expression + 1; - - if Token = Tok_If and then Ada_Version < Ada_2012 then - Error_Msg_SC ("|if expression is an Ada 2012 feature"); - Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); - end if; - + Error_Msg_Ada_2012_Feature ("|if expression", Token_Ptr); Scan; -- past IF or ELSIF Append_To (Exprs, P_Condition); TF_Then; @@ -3182,11 +3162,7 @@ -- Set case if Token = Tok_Vertical_Bar then - if Ada_Version < Ada_2012 then - Error_Msg_SC ("set notation is an Ada 2012 feature"); - Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); - end if; - + Error_Msg_Ada_2012_Feature ("set notation", Token_Ptr); Set_Alternatives (N, New_List (Alt)); Set_Right_Opnd (N, Empty); Index: par-ch5.adb =================================================================== --- par-ch5.adb (revision 202451) +++ par-ch5.adb (working copy) @@ -1656,10 +1656,7 @@ -- during analysis of the loop parameter specification. if Token = Tok_Of or else Token = Tok_Colon then - if Ada_Version < Ada_2012 then - Error_Msg_SC ("iterator is an Ada 2012 feature"); - end if; - + Error_Msg_Ada_2012_Feature ("iterator", Token_Ptr); return P_Iterator_Specification (ID_Node); end if; Index: par-ch6.adb =================================================================== --- par-ch6.adb (revision 202460) +++ par-ch6.adb (working copy) @@ -834,12 +834,8 @@ -- Check we are in Ada 2012 mode - if Ada_Version < Ada_2012 then - Error_Msg_SC - ("expression function is an Ada 2012 feature!"); - Error_Msg_SC - ("\unit must be compiled with -gnat2012 switch!"); - end if; + Error_Msg_Ada_2012_Feature + ("!expression function", Token_Ptr); -- Catch an illegal placement of the aspect specification -- list: @@ -1467,7 +1463,8 @@ if Token = Tok_Aliased then if Ada_Version < Ada_2012 then - Error_Msg_SC ("ALIASED parameter is an Ada 2012 feature"); + Error_Msg_Ada_2012_Feature + ("ALIASED parameter", Token_Ptr); else Set_Aliased_Present (Specification_Node); end if; Index: par-ch8.adb =================================================================== --- par-ch8.adb (revision 202451) +++ par-ch8.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -110,14 +110,9 @@ begin if Token = Tok_All then - if Ada_Version < Ada_2012 then - Error_Msg_SC ("|`USE ALL TYPE` is an Ada 2012 feature"); - Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); - end if; - + Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr); All_Present := True; Scan; -- past ALL - else All_Present := False; end if; Index: par-prag.adb =================================================================== --- par-prag.adb (revision 202451) +++ par-prag.adb (working copy) @@ -307,6 +307,7 @@ when Pragma_Ada_83 => Ada_Version := Ada_83; Ada_Version_Explicit := Ada_83; + Ada_Version_Pragma := Pragma_Node; ------------ -- Ada_95 -- @@ -319,6 +320,7 @@ when Pragma_Ada_95 => Ada_Version := Ada_95; Ada_Version_Explicit := Ada_95; + Ada_Version_Pragma := Pragma_Node; --------------------- -- Ada_05/Ada_2005 -- @@ -333,6 +335,7 @@ if Arg_Count = 0 then Ada_Version := Ada_2005; Ada_Version_Explicit := Ada_2005; + Ada_Version_Pragma := Pragma_Node; end if; --------------------- @@ -348,6 +351,7 @@ if Arg_Count = 0 then Ada_Version := Ada_2012; Ada_Version_Explicit := Ada_2012; + Ada_Version_Pragma := Pragma_Node; end if; ----------- Index: prj.adb =================================================================== --- prj.adb (revision 202451) +++ prj.adb (working copy) @@ -959,6 +959,7 @@ -- identifiers. Opt.Ada_Version := Opt.Ada_95; + Opt.Ada_Version_Pragma := Empty; Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends)); Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 202451) +++ sem_attr.adb (working copy) @@ -890,13 +890,8 @@ procedure Check_Ada_2012_Attribute is begin - if Ada_Version < Ada_2012 then - Error_Msg_Name_1 := Aname; - Error_Msg_N - ("attribute % is an Ada 2012 feature", N); - Error_Msg_N - ("\unit must be compiled with -gnat2012 switch", N); - end if; + Error_Msg_Name_1 := Aname; + Error_Msg_Ada_2012_Feature ("attribute %", Sloc (N)); end Check_Ada_2012_Attribute; -------------------------------- Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 202455) +++ sem_ch12.adb (working copy) @@ -3592,8 +3592,8 @@ Append (Unit_Renaming, Renaming_List); - -- The renaming declarations are the first local declarations of - -- the new unit. + -- The renaming declarations are the first local declarations of the + -- new unit. if Is_Non_Empty_List (Visible_Declarations (Act_Spec)) then Insert_List_Before @@ -3894,7 +3894,8 @@ Current_Sem_Unit => Current_Sem_Unit, Scope_Suppress => Scope_Suppress, Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, - Version => Ada_Version)); + Version => Ada_Version, + Version_Pragma => Ada_Version_Pragma)); end if; end if; @@ -4238,7 +4239,8 @@ Current_Sem_Unit => Current_Sem_Unit, Scope_Suppress => Scope_Suppress, Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, - Version => Ada_Version)), + Version => Ada_Version, + Version_Pragma => Ada_Version_Pragma)), Inlined_Body => True); Pop_Scope; @@ -4318,8 +4320,8 @@ end loop; end if; - -- Restore status of instances. If one of them is a body, make - -- its local entities visible again. + -- Restore status of instances. If one of them is a body, make its + -- local entities visible again. declare E : Entity_Id; @@ -4354,7 +4356,8 @@ Current_Sem_Unit => Current_Sem_Unit, Scope_Suppress => Scope_Suppress, Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, - Version => Ada_Version)), + Version => Ada_Version, + Version_Pragma => Ada_Version_Pragma)), Inlined_Body => True); end if; end Inline_Instance_Body; @@ -4410,7 +4413,8 @@ Current_Sem_Unit => Current_Sem_Unit, Scope_Suppress => Scope_Suppress, Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, - Version => Ada_Version)); + Version => Ada_Version, + Version_Pragma => Ada_Version_Pragma)); return True; -- Here if not inlined, or we ignore the inlining @@ -4864,7 +4868,6 @@ -- subsequent construction of the body. if Need_Subprogram_Instance_Body (N, Act_Decl_Id) then - Check_Forward_Instantiation (Gen_Decl); -- The wrapper package is always delayed, because it does not @@ -9910,6 +9913,7 @@ Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top; Scope_Suppress := Body_Info.Scope_Suppress; Opt.Ada_Version := Body_Info.Version; + Opt.Ada_Version_Pragma := Body_Info.Version_Pragma; if No (Gen_Body_Id) then Load_Parent_Of_Generic @@ -10196,6 +10200,7 @@ Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top; Scope_Suppress := Body_Info.Scope_Suppress; Opt.Ada_Version := Body_Info.Version; + Opt.Ada_Version_Pragma := Body_Info.Version_Pragma; if No (Gen_Body_Id) then @@ -10926,9 +10931,7 @@ -- Ada 2005 (AI-251) - if Ada_Version >= Ada_2005 - and then Is_Interface (Ancestor) - then + if Ada_Version >= Ada_2005 and then Is_Interface (Ancestor) then if not Interface_Present_In_Ancestor (Act_T, Ancestor) then Error_Msg_NE ("(Ada 2005) expected type implementing & in instantiation", @@ -12092,7 +12095,8 @@ Scope_Suppress => Scope_Suppress, Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, - Version => Ada_Version); + Version => Ada_Version, + Version_Pragma => Ada_Version_Pragma); -- Package instance @@ -12128,12 +12132,12 @@ ((Inst_Node => Inst_Node, Act_Decl => True_Parent, Expander_Status => Exp_Status, - Current_Sem_Unit => - Get_Code_Unit (Sloc (Inst_Node)), + Current_Sem_Unit => Get_Code_Unit + (Sloc (Inst_Node)), Scope_Suppress => Scope_Suppress, - Local_Suppress_Stack_Top => - Local_Suppress_Stack_Top, - Version => Ada_Version)), + Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, + Version => Ada_Version, + Version_Pragma => Ada_Version_Pragma)), Body_Optional => Body_Optional); end; end if; Index: sem_ch8.adb =================================================================== --- sem_ch8.adb (revision 202451) +++ sem_ch8.adb (working copy) @@ -1773,6 +1773,7 @@ Old_S : Entity_Id := Empty; Rename_Spec : Entity_Id; Save_AV : constant Ada_Version_Type := Ada_Version; + Save_AVP : constant Node_Id := Ada_Version_Pragma; Save_AV_Exp : constant Ada_Version_Type := Ada_Version_Explicit; Spec : constant Node_Id := Specification (N); @@ -2582,6 +2583,7 @@ -- ??? Ada_Version := Ada_Version_Type'Max (Ada_Version, Ada_95); + Ada_Version_Pragma := Empty; Ada_Version_Explicit := Ada_Version; if No (Old_S) then @@ -3039,6 +3041,7 @@ end if; Ada_Version := Save_AV; + Ada_Version_Pragma := Save_AVP; Ada_Version_Explicit := Save_AV_Exp; end Analyze_Subprogram_Renaming; Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 202463) +++ sem_prag.adb (working copy) @@ -8600,8 +8600,9 @@ -- Now set Ada 83 mode - Ada_Version := Ada_83; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_83; + Ada_Version_Explicit := Ada_83; + Ada_Version_Pragma := N; ------------ -- Ada_95 -- @@ -8631,8 +8632,9 @@ -- Now set Ada 95 mode - Ada_Version := Ada_95; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_95; + Ada_Version_Explicit := Ada_95; + Ada_Version_Pragma := N; --------------------- -- Ada_05/Ada_2005 -- @@ -8679,6 +8681,7 @@ Ada_Version := Ada_2005; Ada_Version_Explicit := Ada_2005; + Ada_Version_Pragma := N; end if; end; @@ -8728,6 +8731,7 @@ Ada_Version := Ada_2012; Ada_Version_Explicit := Ada_2012; + Ada_Version_Pragma := N; end if; end; @@ -11602,6 +11606,7 @@ else Extensions_Allowed := False; Ada_Version := Ada_Version_Explicit; + Ada_Version_Pragma := Empty; end if; -------------- Index: switch-c.adb =================================================================== --- switch-c.adb (revision 202464) +++ switch-c.adb (working copy) @@ -781,8 +781,9 @@ -- implicit setting here, since for example, we want -- Preelaborate_05 treated as Preelaborate - Ada_Version := Ada_2012; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_2012; + Ada_Version_Explicit := Ada_2012; + Ada_Version_Pragma := Empty; -- Set default warnings and style checks for -gnatg @@ -1214,6 +1215,7 @@ Extensions_Allowed := True; Ada_Version := Ada_Version_Type'Last; Ada_Version_Explicit := Ada_Version_Type'Last; + Ada_Version_Pragma := Empty; -- -gnaty (style checks) @@ -1326,8 +1328,9 @@ Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; - Ada_Version := Ada_83; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_83; + Ada_Version_Explicit := Ada_83; + Ada_Version_Pragma := Empty; end if; -- -gnat95 @@ -1343,8 +1346,9 @@ Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; - Ada_Version := Ada_95; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_95; + Ada_Version_Explicit := Ada_95; + Ada_Version_Pragma := Empty; end if; -- -gnat05 @@ -1360,8 +1364,9 @@ Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; - Ada_Version := Ada_2005; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_2005; + Ada_Version_Explicit := Ada_2005; + Ada_Version_Pragma := Empty; end if; -- -gnat12 @@ -1377,8 +1382,9 @@ Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; - Ada_Version := Ada_2012; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_2012; + Ada_Version_Explicit := Ada_2012; + Ada_Version_Pragma := Empty; end if; -- -gnat2005 and -gnat2012 @@ -1398,6 +1404,7 @@ end if; Ada_Version_Explicit := Ada_Version; + Ada_Version_Pragma := Empty; Ptr := Ptr + 4; -- Switch cancellation, currently only -gnat-p is allowed.