[multiple changes]
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. From-SVN: r202466
This commit is contained in:
parent
ac40189179
commit
fb620b37de
|
@ -1,3 +1,29 @@
|
|||
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.
|
||||
|
|
|
@ -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 --
|
||||
------------------
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 (
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
-----------
|
||||
|
|
|
@ -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));
|
||||
|
|
|
@ -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;
|
||||
|
||||
--------------------------------
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
--------------
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in New Issue