diff mbox

[Ada] Fix missing cases for restriction No_Obsolescent_Features

Message ID 20100810135104.GA7996@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Aug. 10, 2010, 1:51 p.m. UTC
The restriction No_Obsolescent_Features missed the following
cases which should be handled:
 Ada 95 mode: J.1 J.2 J.3 J.6 J.9
 Ada 2005 mode: J.10 J.11 J.12 J.13 J.14
this patch corrects all these missing cases

The following test program generates error messages for
all lines marked with --  J.n (the test should be run in
both standard Ada 95 mode and with the -gnat05 switch to
select Ada 2005 mode, the latter will flag the lines
marked --  J.n (Ada 2005)

pragma Restrictions (No_Obsolescent_Features);

pragma Restrictions (No_Asynchronous_Control);        --  J.13 (Ada 2005)
pragma Restrictions (No_Unchecked_Deallocation);      --  J.13 (Ada 2005)
pragma Restrictions (No_Unchecked_Conversion);        --  J.13 (Ada 2005)

with Text_IO;                                         --  J.1

with Ada.Characters.Handling;
with System.Storage_Elements;

procedure Test_Obsolete is
   package SSE renames System.Storage_Elements;

   S : String := %aaa%;                               --  J.2

   type My_Fix is delta 0.001 range -100.0 .. 100.0;
   subtype My_Fix_Subtype is My_Fix delta 0.01;       --  J.3

   package Inner is
      type P is private;
   private
      type P is (A, B, C);
   end Inner;

   B : Boolean := Inner.P'Constrained;                 --  J.4

   C : Character := ASCII.NUL;                         --  J.5

   procedure Raise_Numeric_Error (I : Integer) is
   begin
      if I = 0 then
         raise Numeric_Error;                          --  J.6
      end if;
   end Raise_Numeric_Error;

   I : Integer;
   for I use at SSE.To_Address (16#FFFF_0020#);        --  J.7

   task type Interrupt_Handler is
      entry Done;
      for Done'Address                                 --  J.7.1
        use SSE.To_Address (16#FFFF_0000#);
   end Interrupt_Handler;

   task body Interrupt_Handler is
   begin
      accept Done;
   end Interrupt_Handler;

   type Rec is record
      I : Integer;
   end record;

   for Rec use
      record at mod 8;                                 --  J.8
         I at 0 range 0 .. 32;
      end record;

   I1 : Integer := Interrupt_Handler'Storage_Size;     --  J.9

   pragma Suppress (Index_Check, On => S);             --  J.10 (Ada 2005)

   type Incomplete;

   type Access_Incomplete is access Incomplete'Class;  --  J.11 (Ada 2005)

   type Incomplete is tagged null record;

   function Local (X : Integer) return Integer;
   pragma Interface (C, Local);                        --  J.12 (Ada 2005)

   B1 : Boolean :=
          Ada.Characters.Handling.Is_Character ('a');  --  J.14 (Ada 2005)

   function ISC (Item : Wide_Character) return Boolean
     renames Ada.Characters.Handling.Is_Character;     --  J.14 (Ada 2005)

   type R is access
     function (Item : Wide_Character) return Boolean;  --  J.14 (Ada 2005)

   RV : R :=
          Ada.Characters.Handling.Is_Character'Access;
begin
   null;
end Test_Obsolete;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-08-10  Robert Dewar  <dewar@adacore.com>

	* a-chahan.ads: Add comments on handling of obsolescent entries.
	* opt.ads: Add Ada_2005 and Ada_2012 renamings for versions.
	* restrict.adb (Check_Obsolescent_2005_Entity): New procedure.
	* restrict.ads (Check_Obsolescent_2005_Entity): New procedure.
	* sem_attr.adb (Analyze_Access_Attribute): Call
	Check_Obsolescent_2005_Entity to check for access to obsolescent
	Ada.Characters.Handling subprogram.
	(Analyze_Attribute, case Class): Applying Class to untagged incomplete
	type is obsolescent in Ada 2005.
	(Analyze_Attribute, case Constrained): Better placement of flag when
	flagged as obsolescent feature.
	(Analyze_Attribute, case Storage_Size): Use with tasks is obsolescent
	* sem_ch10.adb (Analyze_With_Clause): With of renamings such as Text_IO
	is an obsolescent feature.
	* sem_ch11.adb (Analyze_Raise_Statement): Numeric_Error is obsolescent
	feature.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): Call
	Check_Obsolescent_2005_Entity to check for renaming obsolete
	Ada.Characters.Handling subprogram.
	* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings): Check
	for obsolescent restrictions in Ada 2005.
	(Analyze_Pragma, case Suppress): Entity arg is obsolescent in Ada 2005
	(Analyze_Pragma, case Interface): Interface is obsolescent in Ada 2005
	* sem_res.adb (Resolve_Call): Call Check_Obsolescent_2005_Entity to
	check for obsolescent references to Ada.Characters.Handling subprograms
diff mbox

Patch

Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 163060)
+++ sem_ch10.adb	(working copy)
@@ -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));
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 163054)
+++ sem_prag.adb	(working copy)
@@ -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 --
          --------------------
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 163054)
+++ sem_res.adb	(working copy)
@@ -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.
Index: sem_attr.adb
===================================================================
--- sem_attr.adb	(revision 163054)
+++ sem_attr.adb	(working copy)
@@ -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
Index: restrict.adb
===================================================================
--- restrict.adb	(revision 163054)
+++ restrict.adb	(working copy)
@@ -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 --
    ---------------------------
Index: restrict.ads
===================================================================
--- restrict.ads	(revision 163054)
+++ restrict.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          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
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 163054)
+++ sem_ch8.adb	(working copy)
@@ -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
Index: sem_ch11.adb
===================================================================
--- sem_ch11.adb	(revision 163054)
+++ sem_ch11.adb	(working copy)
@@ -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;
 
Index: opt.ads
===================================================================
--- opt.ads	(revision 163054)
+++ opt.ads	(working copy)
@@ -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
Index: a-chahan.ads
===================================================================
--- a-chahan.ads	(revision 163054)
+++ a-chahan.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          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;