diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-09-10 15:21:28 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-09-10 15:21:28 +0000 |
commit | 8b6fb1f0cf8175ad979dd7cf1b884700bd3b7a0d (patch) | |
tree | 2aa1248d70e80464bb18ab1104c8321f79d18735 /gcc/ada | |
parent | 39aa587b61c8163166c1ca91e8dd1aba2076276f (diff) | |
download | gcc-8b6fb1f0cf8175ad979dd7cf1b884700bd3b7a0d.tar.gz |
2013-09-10 Robert Dewar <dewar@adacore.com>
* sinput.adb (Check_For_BOM): Avoid reading past end of file.
2013-09-10 Robert Dewar <dewar@adacore.com>
* 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.
2013-09-10 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Process_Subtype): Discard constraint on access
to class-wide type. Such constraints are not supported and are
considered a language pathology.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@202466 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 26 | ||||
-rw-r--r-- | gcc/ada/errout.adb | 18 | ||||
-rw-r--r-- | gcc/ada/errout.ads | 11 | ||||
-rw-r--r-- | gcc/ada/inline.ads | 5 | ||||
-rw-r--r-- | gcc/ada/opt.adb | 5 | ||||
-rw-r--r-- | gcc/ada/opt.ads | 8 | ||||
-rw-r--r-- | gcc/ada/par-ch11.adb | 6 | ||||
-rw-r--r-- | gcc/ada/par-ch12.adb | 18 | ||||
-rw-r--r-- | gcc/ada/par-ch13.adb | 3 | ||||
-rw-r--r-- | gcc/ada/par-ch4.adb | 38 | ||||
-rw-r--r-- | gcc/ada/par-ch5.adb | 5 | ||||
-rw-r--r-- | gcc/ada/par-ch6.adb | 11 | ||||
-rw-r--r-- | gcc/ada/par-ch8.adb | 9 | ||||
-rw-r--r-- | gcc/ada/par-prag.adb | 4 | ||||
-rw-r--r-- | gcc/ada/prj.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem_attr.adb | 9 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 40 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 21 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 3 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 13 | ||||
-rw-r--r-- | gcc/ada/sinput.adb | 14 | ||||
-rw-r--r-- | gcc/ada/switch-c.adb | 27 |
22 files changed, 183 insertions, 112 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b040b31e4c9..1ebe97ca451 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,31 @@ 2013-09-10 Robert Dewar <dewar@adacore.com> + * sinput.adb (Check_For_BOM): Avoid reading past end of file. + +2013-09-10 Robert Dewar <dewar@adacore.com> + + * 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. + +2013-09-10 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Process_Subtype): Discard constraint on access + to class-wide type. Such constraints are not supported and are + considered a language pathology. + +2013-09-10 Robert Dewar <dewar@adacore.com> + * gnatbind.adb: Correct starting date in --version string. * gnatdll.adb: Use Check_Version_And_Help_G to implement --help and --version. diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index b32f6a146f6..a1e271469ff 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -476,6 +476,24 @@ package body Errout is 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 -- ------------------ diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 9afc4dfd34a..e2673023274 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -343,7 +343,8 @@ package Errout is -- 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 @@ package Errout is -- 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 diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index f3750a83aa2..d34a7f17302 100644 --- a/gcc/ada/inline.ads +++ b/gcc/ada/inline.ads @@ -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 @@ package Inline is -- 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 ( diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index 1fc43cc203e..9f1f2d84a80 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -54,6 +54,7 @@ package body Opt is 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 @@ package body Opt is 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 @@ package body Opt is 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 @@ package body Opt is -- 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 @@ package body Opt is 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; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index f515dc78605..605dc89e839 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -131,6 +131,10 @@ package Opt is -- 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 @@ package Opt is -- 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 @@ private 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; diff --git a/gcc/ada/par-ch11.adb b/gcc/ada/par-ch11.adb index f0537f27cd1..61df3ee2512 100644 --- a/gcc/ada/par-ch11.adb +++ b/gcc/ada/par-ch11.adb @@ -213,11 +213,7 @@ package body Ch11 is 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 diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index ed6e314dca0..cf75f04fa15 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -546,12 +546,8 @@ package body Ch12 is 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 @@ package body Ch12 is 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 diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index 952064440e1..26b8056f80f 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -128,8 +128,7 @@ package body Ch13 is 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; diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 38fd00e1fbb..5766639816a 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -2672,18 +2672,12 @@ package body Ch4 is 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 @@ package body Ch4 is 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 @@ package body Ch4 is 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 @@ package body Ch4 is 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 @@ package body Ch4 is -- 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); diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index e9b0a2c8e95..94c5bd4d073 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -1656,10 +1656,7 @@ package body Ch5 is -- 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; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index f6aacd14057..f060b3f2822 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -834,12 +834,8 @@ package body Ch6 is -- 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 @@ package body Ch6 is 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; diff --git a/gcc/ada/par-ch8.adb b/gcc/ada/par-ch8.adb index fb2bf17c44d..89a2bb4a22b 100644 --- a/gcc/ada/par-ch8.adb +++ b/gcc/ada/par-ch8.adb @@ -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 @@ package body Ch8 is 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; diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 4d01db09d12..5de6ecc0081 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -307,6 +307,7 @@ begin when Pragma_Ada_83 => Ada_Version := Ada_83; Ada_Version_Explicit := Ada_83; + Ada_Version_Pragma := Pragma_Node; ------------ -- Ada_95 -- @@ -319,6 +320,7 @@ begin 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 @@ begin 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 @@ begin if Arg_Count = 0 then Ada_Version := Ada_2012; Ada_Version_Explicit := Ada_2012; + Ada_Version_Pragma := Pragma_Node; end if; ----------- diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 9e0e0aa38d1..b98f711c5e7 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -959,6 +959,7 @@ package body Prj is -- 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)); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f5d12ed1c7b..ae58c9d2504 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -890,13 +890,8 @@ package body Sem_Attr is 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; -------------------------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index b9c41fa4dc8..819f57361e3 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3592,8 +3592,8 @@ package body Sem_Ch12 is 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 @@ package body Sem_Ch12 is 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 @@ package body Sem_Ch12 is 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 @@ package body Sem_Ch12 is 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 @@ package body Sem_Ch12 is 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 @@ package body Sem_Ch12 is 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 @@ package body Sem_Ch12 is -- 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 @@ package body Sem_Ch12 is 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 @@ package body Sem_Ch12 is 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 @@ package body Sem_Ch12 is -- 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 @@ package body Sem_Ch12 is 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 @@ package body Sem_Ch12 is ((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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index b3f99c4aeb6..2d8d5f798cc 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -19043,6 +19043,27 @@ package body Sem_Ch3 is case Ekind (Base_Type (Subtype_Mark_Id)) is when Access_Kind => + + -- If this is a constraint on a class-wide type, discard it. + -- There is currently no way to express a partial discriminant + -- constraint on a type with unknown discriminants. This is + -- a pathology that the ACATS wisely decides not to test. + + if Is_Class_Wide_Type (Designated_Type (Subtype_Mark_Id)) then + if Comes_From_Source (S) then + Error_Msg_N + ("constraint on class-wide type ignored?", + Constraint (S)); + end if; + + if Nkind (P) = N_Subtype_Declaration then + Set_Subtype_Indication (P, + New_Occurrence_Of (Subtype_Mark_Id, Sloc (S))); + end if; + + return Subtype_Mark_Id; + end if; + Constrain_Access (Def_Id, S, Related_Nod); if Expander_Active diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 27ccc2d3d1e..1e6470bf223 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1773,6 +1773,7 @@ package body Sem_Ch8 is 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 @@ package body Sem_Ch8 is -- ??? 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 @@ package body Sem_Ch8 is end if; Ada_Version := Save_AV; + Ada_Version_Pragma := Save_AVP; Ada_Version_Explicit := Save_AV_Exp; end Analyze_Subprogram_Renaming; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0cf4fc73791..8d716aa8454 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -8600,8 +8600,9 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is -- 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 @@ package body Sem_Prag is Ada_Version := Ada_2005; Ada_Version_Explicit := Ada_2005; + Ada_Version_Pragma := N; end if; end; @@ -8728,6 +8731,7 @@ package body Sem_Prag is Ada_Version := Ada_2012; Ada_Version_Explicit := Ada_2012; + Ada_Version_Pragma := N; end if; end; @@ -11602,6 +11606,7 @@ package body Sem_Prag is else Extensions_Allowed := False; Ada_Version := Ada_Version_Explicit; + Ada_Version_Pragma := Empty; end if; -------------- diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 29be59ac688..a01c045d91f 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -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- -- @@ -258,10 +258,20 @@ package body Sinput is BOM : BOM_Kind; Len : Natural; Tst : String (1 .. 5); + C : Character; begin for J in 1 .. 5 loop - Tst (J) := Source (Scan_Ptr + Source_Ptr (J) - 1); + C := Source (Scan_Ptr + Source_Ptr (J) - 1); + + -- Definitely no BOM if EOF character marks either end of file, or + -- an illegal non-BOM character if not at the end of file. + + if C = EOF then + return; + end if; + + Tst (J) := C; end loop; Read_BOM (Tst, Len, BOM, False); diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 2cca5d114f6..197be06a19e 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -781,8 +781,9 @@ package body Switch.C is -- 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 @@ package body Switch.C is 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 @@ package body Switch.C is 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 @@ package body Switch.C is 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 @@ package body Switch.C is 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 @@ package body Switch.C is 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 @@ package body Switch.C is end if; Ada_Version_Explicit := Ada_Version; + Ada_Version_Pragma := Empty; Ptr := Ptr + 4; -- Switch cancellation, currently only -gnat-p is allowed. |