===================================================================
@@ -2314,12 +2314,35 @@ package body Sem_Ch10 is
-- Set True if the unit currently being compiled is an internal unit
Save_Style_Check : constant Boolean := Opt.Style_Check;
- Save_C_Restrict : constant Save_Cunit_Boolean_Restrictions :=
- Cunit_Boolean_Restrictions_Save;
+ Save_C_Restrict : Save_Cunit_Boolean_Restrictions;
begin
U := Unit (Library_Unit (N));
+ -- If this is an internal unit which is a renaming, then this is a
+ -- violation of No_Obsolescent_Features.
+
+ -- Note: this is not quite right if the user defines one of these units
+ -- himself, but that's a marginal case, and fixing it is hard ???
+
+ if Restriction_Active (No_Obsolescent_Features) then
+ declare
+ F : constant File_Name_Type :=
+ Unit_File_Name (Get_Source_Unit (U));
+ begin
+ if Is_Predefined_File_Name (F, Renamings_Included => True)
+ and then not
+ Is_Predefined_File_Name (F, Renamings_Included => False)
+ then
+ Check_Restriction (No_Obsolescent_Features, N);
+ end if;
+ end;
+ end if;
+
+ -- Save current restriction set, does not apply to with'ed unit
+
+ Save_C_Restrict := Cunit_Boolean_Restrictions_Save;
+
-- Several actions are skipped for dummy packages (those supplied for
-- with's where no matching file could be found). Such packages are
-- identified by the Sloc value being set to No_Location.
@@ -2350,9 +2373,7 @@ package body Sem_Ch10 is
-- explicit with'ing of run-time units.
if Configurable_Run_Time_Mode
- and then
- Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Unit (Library_Unit (N)))))
+ and then Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (U)))
then
Configurable_Run_Time_Mode := False;
Semantics (Library_Unit (N));
===================================================================
@@ -4430,6 +4430,19 @@ package body Sem_Prag is
Restriction_Warnings (R_Id) := False;
end if;
+ -- Check for obsolescent restrictions in Ada 2005 mode
+
+ if not Warn
+ and then Ada_Version >= Ada_2005
+ and then (R_Id = No_Asynchronous_Control
+ or else
+ R_Id = No_Unchecked_Deallocation
+ or else
+ R_Id = No_Unchecked_Conversion)
+ then
+ Check_Restriction (No_Obsolescent_Features, N);
+ end if;
+
-- A very special case that must be processed here: pragma
-- Restrictions (No_Exceptions) turns off all run-time
-- checking. This is a bit dubious in terms of the formal
@@ -4621,6 +4634,12 @@ package body Sem_Prag is
-- a specified entity (given as the second argument of the pragma)
else
+ -- This is obsolescent in Ada 2005 mode
+
+ if Ada_Version >= Ada_2005 then
+ Check_Restriction (No_Obsolescent_Features, Arg2);
+ end if;
+
Check_Optional_Identifier (Arg2, Name_On);
E_Id := Expression (Arg2);
Analyze (E_Id);
@@ -8308,6 +8327,14 @@ package body Sem_Prag is
Check_At_Most_N_Arguments (4);
Process_Import_Or_Interface;
+ -- In Ada 2005, the permission to use Interface (a reserved word)
+ -- as a pragma name is considered an obsolescent feature.
+
+ if Ada_Version >= Ada_2005 then
+ Check_Restriction
+ (No_Obsolescent_Features, Pragma_Identifier (N));
+ end if;
+
--------------------
-- Interface_Name --
--------------------
===================================================================
@@ -5250,7 +5250,7 @@ package body Sem_Res is
K : constant Node_Kind := Nkind (Parent (N));
begin
if (K = N_Loop_Statement
- and then Present (Iteration_Scheme (Parent (N))))
+ and then Present (Iteration_Scheme (Parent (N))))
or else K = N_If_Statement
or else K = N_Elsif_Part
or else K = N_Case_Statement_Alternative
@@ -5276,6 +5276,10 @@ package body Sem_Res is
end if;
end if;
+ -- Check obsolescent reference to Ada.Characters.Handling subprogram
+
+ Check_Obsolescent_2005_Entity (Nam, Subp);
+
-- If subprogram name is a predefined operator, it was given in
-- functional notation. Replace call node with operator node, so
-- that actuals can be resolved appropriately.
===================================================================
@@ -584,6 +584,10 @@ package body Sem_Attr is
Check_For_Eliminated_Subprogram (P, Entity (P));
+ -- Check for obsolescent subprogram reference
+
+ Check_Obsolescent_2005_Entity (Entity (P), P);
+
-- Build the appropriate subprogram type
Build_Access_Subprogram_Type (P);
@@ -2535,6 +2539,25 @@ package body Sem_Attr is
Check_E0;
Find_Type (N);
+ -- Applying Class to untagged incomplete type is obsolescent in Ada
+ -- 2005. Note that we can't test Is_Tagged_Type here on P_Type, since
+ -- this flag gets set by Find_Type in this situation.
+
+ if Restriction_Active (No_Obsolescent_Features)
+ and then Ada_Version >= Ada_2005
+ and then Ekind (P_Type) = E_Incomplete_Type
+ then
+ declare
+ DN : constant Node_Id := Declaration_Node (P_Type);
+ begin
+ if Nkind (DN) = N_Incomplete_Type_Declaration
+ and then not Tagged_Present (DN)
+ then
+ Check_Restriction (No_Obsolescent_Features, P);
+ end if;
+ end;
+ end if;
+
------------------
-- Code_Address --
------------------
@@ -2612,7 +2635,7 @@ package body Sem_Attr is
-- Case from RM J.4(2) of constrained applied to private type
if Is_Entity_Name (P) and then Is_Type (Entity (P)) then
- Check_Restriction (No_Obsolescent_Features, N);
+ Check_Restriction (No_Obsolescent_Features, P);
if Warn_On_Obsolescent_Feature then
Error_Msg_N
@@ -4197,6 +4220,10 @@ package body Sem_Attr is
if Is_Task_Type (P_Type) then
Set_Etype (N, Universal_Integer);
+ -- Use with tasks is an obsolescent feature
+
+ Check_Restriction (No_Obsolescent_Features, P);
+
elsif Is_Access_Type (P_Type) then
if Ekind (P_Type) = E_Access_Subprogram_Type then
Error_Attr_P
===================================================================
@@ -34,6 +34,7 @@ with Opt; use Opt;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Snames; use Snames;
+with Stand; use Stand;
with Uname; use Uname;
package body Restrict is
@@ -121,6 +122,46 @@ package body Restrict is
Check_Restriction (No_Implicit_Heap_Allocations, N);
end Check_No_Implicit_Heap_Alloc;
+ -----------------------------------
+ -- Check_Obsolescent_2005_Entity --
+ -----------------------------------
+
+ procedure Check_Obsolescent_2005_Entity (E : Entity_Id; N : Node_Id) is
+ function Chars_Is (E : Entity_Id; S : String) return Boolean;
+ -- Return True iff Chars (E) matches S (given in lower case)
+
+ function Chars_Is (E : Entity_Id; S : String) return Boolean is
+ Nam : constant Name_Id := Chars (E);
+ begin
+ if Length_Of_Name (Nam) /= S'Length then
+ return False;
+ else
+ return Get_Name_String (Nam) = S;
+ end if;
+ end Chars_Is;
+
+ -- Start of processing for Check_Obsolescent_2005_Entity
+
+ begin
+ if Ada_Version >= Ada_2005
+ and then Restriction_Active (No_Obsolescent_Features)
+ and then Chars_Is (Scope (E), "handling")
+ and then Chars_Is (Scope (Scope (E)), "characters")
+ and then Chars_Is (Scope (Scope (Scope (E))), "ada")
+ and then Scope (Scope (Scope (Scope (E)))) = Standard_Standard
+ then
+ if Chars_Is (E, "is_character") or else
+ Chars_Is (E, "is_string") or else
+ Chars_Is (E, "to_character") or else
+ Chars_Is (E, "to_string") or else
+ Chars_Is (E, "to_wide_character") or else
+ Chars_Is (E, "to_wide_string")
+ then
+ Check_Restriction (No_Obsolescent_Features, N);
+ end if;
+ end if;
+ end Check_Obsolescent_2005_Entity;
+
---------------------------
-- Check_Restricted_Unit --
---------------------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2010, 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- --
@@ -230,6 +230,15 @@ package Restrict is
-- Equivalent to Check_Restriction (No_Implicit_Heap_Allocations, N).
-- Provided for easy use by back end, which has to check this restriction.
+ procedure Check_Obsolescent_2005_Entity (E : Entity_Id; N : Node_Id);
+ -- This routine checks if the entity E is one of the obsolescent entries
+ -- in Ada.Characters.Handling in Ada 2005 and No_Obsolescent_Features
+ -- restriction is active. If so an appropriate message is given. N is
+ -- the node on which the message is to be placed. It's a bit kludgy to
+ -- have this highly specialized routine rather than some wonderful general
+ -- mechanism (e.g. a special pragma) to handle this case, but there are
+ -- only six cases, and it is not worth the effort to do something general.
+
function Cunit_Boolean_Restrictions_Save
return Save_Cunit_Boolean_Restrictions;
-- This function saves the compilation unit restriction settings, and
===================================================================
@@ -2467,6 +2467,7 @@ package body Sem_Ch8 is
end if;
-- A useful warning, suggested by Ada Bug Finder (Ada-Europe 2005)
+ -- is to warn if an operator is being renamed as a different operator.
if Comes_From_Source (N)
and then Present (Old_S)
@@ -2479,6 +2480,10 @@ package body Sem_Ch8 is
New_S, Old_S);
end if;
+ -- Check for renaming of obsolescent subprogram
+
+ Check_Obsolescent_2005_Entity (Entity (Nam), Nam);
+
-- Another warning or some utility: if the new subprogram as the same
-- name as the old one, the old one is not hidden by an outer homograph,
-- the new one is not a public symbol, and the old one is otherwise
===================================================================
@@ -538,6 +538,14 @@ package body Sem_Ch11 is
end if;
end if;
+ -- Check obsolescent use of Numeric_Error
+
+ if Exception_Name = Standard_Numeric_Error then
+ Check_Restriction (No_Obsolescent_Features, Exception_Id);
+ end if;
+
+ -- Kill last assignment indication
+
Kill_Current_Values (Last_Assignment_Only => True);
end Analyze_Raise_Statement;
===================================================================
@@ -68,6 +68,10 @@ package Opt is
-- Versions of Ada for Ada_Version below. Note that these are ordered,
-- so that tests like Ada_Version >= Ada_95 are legitimate and useful.
+ Ada_2005 : Ada_Version_Type renames Ada_05;
+ Ada_2012 : Ada_Version_Type renames Ada_12;
+ -- Renamings with full names (preferred usage)
+
Ada_Version_Default : constant Ada_Version_Type := Ada_05;
pragma Warnings (Off, Ada_Version_Default);
-- GNAT
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@@ -95,6 +95,9 @@ package Ada.Characters.Handling is
-- to use these routines when creating code that is intended to run in
-- either Ada 95 or Ada 2005 mode.
+ -- We do however have to flag these if the pragma No_Obsolescent_Features
+ -- restriction is active (see Restrict.Check_Obsolescent_2005_Entity).
+
function Is_Character (Item : Wide_Character) return Boolean;
function Is_String (Item : Wide_String) return Boolean;
@@ -108,6 +111,9 @@ package Ada.Characters.Handling is
-- to use these routines when creating code that is intended to run in
-- either Ada 95 or Ada 2005 mode.
+ -- We do however have to flag these if the pragma No_Obsolescent_Features
+ -- restriction is active (see Restrict.Check_Obsolescent_2005_Entity).
+
function To_Character
(Item : Wide_Character;
Substitute : Character := ' ') return Character;