Patchwork [Ada] Fix handling of local Restrictions pragmas

login
register
mail settings
Submitter Arnaud Charlet
Date Nov. 21, 2011, 11:46 a.m.
Message ID <20111121114627.GA23176@adacore.com>
Download mbox | patch
Permalink /patch/126760/
State New
Headers show

Comments

Arnaud Charlet - Nov. 21, 2011, 11:46 a.m.
This patch completely redoes the handling of Restrictions pragmas that
occur locally to a unit as a configuration pragma (rather than as an
entrhy in a configuration pragma file).

The new handling is much more consistent, and fixes a number of problems
with inheriting restrictions from with'ed units and from package specs
in package bodies etc.

The new handling is as follows. For restrictions that are partition-wide,
there is no change, such restrictions are recognized wherever they appear
and can be freely inherited, e.g. from a with'ed unit to the with'ing
unit. This makes sense since the binder will in any case insist on seeing
consistent use, so any unit not conforming to any restrictions that are
anywhere in the partition will be rejected, and you might as well find
that out at compile time rather than at bind time.

For restrictions that do not require partition-wide consistency, e.g.
SPARK or No_Implementation_Attributes, in general the restriction applies
only to the unit in which the pragma appears, and not to any other units.

The exception is No_Elaboration_Code which always applies to the entire
object file from a compilation, i.e. to the body, spec, and all subunits.
This restriction can be specified in a configuration pragma file, or it
can be on the body and/or the spec (in eithe case it applies to all the
relevant units). It can appear on a subunit only if it has previously
appeared in the body of spec.

The following tests for improper inheriting of restrictions from spec
to body, and from with'ed units:

     1. pragma Restrictions (SPARK);
     2. pragma Restrictions (No_Wide_Characters);
     3. with RFHeader;
     4. package RFPkg is
     5.    procedure Proc;
     6. end;
           |
        >>> violation of restriction "SPARK" at rfheader.ads:1
        >>>  "end Rfpkg" required

     1. package body RFPkg is
     2.    procedure Proc is
     3.       W : Wide_Character := ' ';
     4.    begin
     5.       RFHeader.G := 0;
     6.    end;
     7. end;

     1. pragma Restrictions (SPARK);
     2. pragma Restrictions (No_Wide_Characters);
     3. package RFHeader is
     4.    G : Integer;
     5. end RFHeader;

before this patch, the above program flagged the end of the body (a
case of improperly inheriting the pragma from the spec), and the
use of Wide_Character (improperly inheriting from a with'ed unit).

The following tests the new diagnostic for using an isolated pragma
Restrictions (No_Elaboration_Code) in a subunit (compiled with
-gnatld7 -gnatj60).

     1. package NoElabSub is
     2.    procedure q;
     3. end;

     1. package body NoElabSub is
     2.    procedure q is separate;
     3. end;

     1. pragma Restrictions (No_Elaboration_Code);
        |
        >>> invalid specification of "No_Elaboration_Code",
            restriction cannot be specified in a subunit,
            unless also specified in body or spec

     2. separate (NoElabSub)
     3. procedure q is begin null; end;

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

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* frontend.adb (Frontend): Capture restrictions from config files
	* lib-load.adb (Load_Unit): Save/set/restore restriction pragma
	information
	* lib-xref.adb (Generate_Reference): Fix handling of obsolescent
	references. This was noticed during debugging, but it is not
	known if it causes real bugs.
	* restrict.ads, restrict.adb: New routines to save/set/restore
	non-partition-wide restrictions.
	* s-rident.ads: Comment changes for new handling of
	No_Elaboration_Code
	* sem.adb (Sem): Save/Set/Restore non-partition-wide restrictions
	* sem_ch10.adb (Analyze_Compilation_Unit): Remove incomplete
	attempt to save/restore non-partition-wide restrictions (now
	this work is all done in Sem).
	* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
	Special handling for restriction No_Elaboration_Code.

Patch

Index: frontend.adb
===================================================================
--- frontend.adb	(revision 181556)
+++ frontend.adb	(working copy)
@@ -226,6 +226,12 @@ 
       Opt.Suppress_Options := Scope_Suppress;
    end;
 
+   --  This is where we can capture the value of the compilation unit specific
+   --  restrictions that have been set by the config pragma files (or from
+   --  Targparm), for later restoration when processing e.g. subunits.
+
+   Save_Config_Cunit_Boolean_Restrictions;
+
    --  If there was a -gnatem switch, initialize the mappings of unit names to
    --  file names and of file names to path names from the mapping file.
 
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 181556)
+++ sem_ch10.adb	(working copy)
@@ -467,7 +467,6 @@ 
                --  generated with clauses or limited with clauses. Note that
                --  we examine with clauses having pragmas Elaborate or
                --  Elaborate_All applied to them due to cases such as:
-               --
 
                --     with Pack;
                --     with Pack;
@@ -725,7 +724,12 @@ 
             return;
 
          else
+            --  Analyze the package spec
+
             Semantics (Lib_Unit);
+
+            --  Check for unused with's
+
             Check_Unused_Withs (Get_Cunit_Unit_Number (Lib_Unit));
 
             --  Verify that the library unit is a package declaration
@@ -857,8 +861,6 @@ 
 
          declare
             Save_Style_Check : constant Boolean := Style_Check;
-            Save_C_Restrict  : constant Save_Cunit_Boolean_Restrictions :=
-                                 Cunit_Boolean_Restrictions_Save;
 
          begin
             if not GNAT_Mode then
@@ -867,8 +869,10 @@ 
 
             Semantics (Parent_Spec (Unit_Node));
             Version_Update (N, Parent_Spec (Unit_Node));
+
+            --  Restore style check settings
+
             Style_Check := Save_Style_Check;
-            Cunit_Boolean_Restrictions_Restore (Save_C_Restrict);
          end;
       end if;
 
@@ -1052,8 +1056,6 @@ 
             Un    : Unit_Number_Type;
 
             Save_Style_Check : constant Boolean := Style_Check;
-            Save_C_Restrict  : constant Save_Cunit_Boolean_Restrictions :=
-                                 Cunit_Boolean_Restrictions_Save;
 
          begin
             Item := First (Context_Items (N));
@@ -1122,8 +1124,9 @@ 
                Next (Item);
             end loop;
 
+            --  Restore style checks settings
+
             Style_Check := Save_Style_Check;
-            Cunit_Boolean_Restrictions_Restore (Save_C_Restrict);
          end;
       end if;
 
@@ -1641,7 +1644,7 @@ 
       --  subunit, and that the current unit is one of its parents which was
       --  being analyzed to provide the needed context for the analysis of the
       --  subunit. In this case we analyze the subunit and continue with the
-      --  parent, without looking a subsequent subunits.
+      --  parent, without looking at subsequent subunits.
 
       if Is_Loaded (Subunit_Name) then
 
@@ -2351,7 +2354,6 @@ 
       --  warnings if we have this definite error.
 
       Save_Style_Check : constant Boolean := Opt.Style_Check;
-      Save_C_Restrict  : Save_Cunit_Boolean_Restrictions;
 
    begin
       U := Unit (Library_Unit (N));
@@ -2388,10 +2390,6 @@ 
          end if;
       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.
@@ -2591,10 +2589,9 @@ 
          end if;
       end if;
 
-      --  Restore style checks and restrictions
+      --  Restore style checks
 
       Style_Check := Save_Style_Check;
-      Cunit_Boolean_Restrictions_Restore (Save_C_Restrict);
 
       --  Record the reference, but do NOT set the unit as referenced, we want
       --  to consider the unit as unreferenced if this is the only reference
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 181565)
+++ sem_prag.adb	(working copy)
@@ -5350,6 +5350,46 @@ 
                   Check_Restriction (No_Implementation_Restrictions, Arg);
                end if;
 
+               --  Special processing for No_Elaboration_Code restriction
+
+               if R_Id = No_Elaboration_Code then
+
+                  --  Restriction is only recognized within a configuration
+                  --  pragma file, or within a unit of the main extended
+                  --  program. Note: the test for Main_Unit is needed to
+                  --  properly include the case of configuration pragma files.
+
+                  if not (Current_Sem_Unit = Main_Unit
+                           or else In_Extended_Main_Source_Unit (N))
+                  then
+                     return;
+
+                  --  Don't allow in a subunit unless already specified in
+                  --  body or spec.
+
+                  elsif Nkind (Parent (N)) = N_Compilation_Unit
+                    and then Nkind (Unit (Parent (N))) = N_Subunit
+                    and then not Restriction_Active (No_Elaboration_Code)
+                  then
+                     Error_Msg_N
+                       ("invalid specification of ""No_Elaboration_Code""",
+                        N);
+                     Error_Msg_N
+                       ("\restriction cannot be specified in a subunit", N);
+                     Error_Msg_N
+                       ("\unless also specified in body or spec", N);
+                     return;
+
+                  --  If we have a No_Elaboration_Code pragma that we
+                  --  accept, then it needs to be added to the configuration
+                  --  restrcition set so that we get proper application to
+                  --  other units in the main extended source as required.
+
+                  else
+                     Add_To_Config_Boolean_Restrictions (No_Elaboration_Code);
+                  end if;
+               end if;
+
                --  If this is a warning, then set the warning unless we already
                --  have a real restriction active (we never want a warning to
                --  override a real restriction).
Index: sem.adb
===================================================================
--- sem.adb	(revision 181556)
+++ sem.adb	(working copy)
@@ -35,6 +35,7 @@ 
 with Lib.Load; use Lib.Load;
 with Nlists;   use Nlists;
 with Output;   use Output;
+with Restrict; use Restrict;
 with Sem_Attr; use Sem_Attr;
 with Sem_Ch2;  use Sem_Ch2;
 with Sem_Ch3;  use Sem_Ch3;
@@ -1361,6 +1362,11 @@ 
       --  Variable used to save values of config switches while we analyze the
       --  new unit, to be restored on exit for proper recursive behavior.
 
+      Save_Cunit_Restrictions : Save_Cunit_Boolean_Restrictions;
+      --  Used to save non-partition wide restrictions before processing new
+      --  unit. All with'ed units are analyzed with config restrictions reset
+      --  and we need to restore these saved values at the end.
+
       procedure Do_Analyze;
       --  Procedure to analyze the compilation unit. This is called more than
       --  once when the high level optimizer is activated.
@@ -1442,11 +1448,27 @@ 
       In_Spec_Expression := False;
 
       Set_Comes_From_Source_Default (False);
+
+      --  Save current config switches and reset then appropriately
+
       Save_Opt_Config_Switches (Save_Config_Switches);
       Set_Opt_Config_Switches
         (Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)),
          Current_Sem_Unit = Main_Unit);
 
+      --  Save current non-partition-wide restrictions
+
+      Save_Cunit_Restrictions := Cunit_Boolean_Restrictions_Save;
+
+      --  For unit in main extended unit, we reset the configuration values
+      --  for the non-partition-wide restrictions. For other units reset them.
+
+      if In_Extended_Main_Source_Unit (Comp_Unit) then
+         Restore_Config_Cunit_Boolean_Restrictions;
+      else
+         Reset_Cunit_Boolean_Restrictions;
+      end if;
+
       --  Only do analysis of unit that has not already been analyzed
 
       if not Analyzed (Comp_Unit) then
@@ -1511,6 +1533,11 @@ 
       Outer_Generic_Scope  := S_Outer_Gen_Scope;
 
       Restore_Opt_Config_Switches (Save_Config_Switches);
+
+      --  Deal with restore of restrictions
+
+      Cunit_Boolean_Restrictions_Restore (Save_Cunit_Restrictions);
+
       Expander_Mode_Restore;
 
       if Debug_Unit_Walk then
Index: restrict.adb
===================================================================
--- restrict.adb	(revision 181563)
+++ restrict.adb	(working copy)
@@ -41,6 +41,9 @@ 
 
 package body Restrict is
 
+   Config_Cunit_Boolean_Restrictions : Save_Cunit_Boolean_Restrictions;
+   --  Save compilation unit restrictions set by config pragma files
+
    Restricted_Profile_Result : Boolean := False;
    --  This switch memoizes the result of Restricted_Profile function calls for
    --  improved efficiency. Valid only if Restricted_Profile_Cached is True.
@@ -100,6 +103,17 @@ 
       end if;
    end Abort_Allowed;
 
+   ----------------------------------------
+   -- Add_To_Config_Boolean_Restrictions --
+   ----------------------------------------
+
+   procedure Add_To_Config_Boolean_Restrictions (R : Restriction_Id) is
+   begin
+      Config_Cunit_Boolean_Restrictions (R) := True;
+   end Add_To_Config_Boolean_Restrictions;
+   --  Add specified restriction to stored configuration boolean restrictions.
+   --  This is used for handling the special case of No_Elaboration_Code.
+
    -------------------------
    -- Check_Compiler_Unit --
    -------------------------
@@ -498,7 +512,9 @@ 
 
       Update_Restrictions (Restrictions);
 
-      --  If in main extended unit, update main restrictions as well
+      --  If in main extended unit, update main restrictions as well. Note
+      --  that as usual we check for Main_Unit explicitly to deal with the
+      --  case of configuration pragma files.
 
       if Current_Sem_Unit = Main_Unit
         or else In_Extended_Main_Source_Unit (N)
@@ -642,6 +658,16 @@ 
       for J in Cunit_Boolean_Restrictions loop
          Restrictions.Set (J) := R (J);
       end loop;
+
+      --  If No_Elaboration_Code set in configuration restrictions, and we
+      --  in the main extended source, then set it here now. This is part of
+      --  the special processing for No_Elaboration_Code.
+
+      if In_Extended_Main_Source_Unit (Cunit_Entity (Current_Sem_Unit))
+        and then Config_Cunit_Boolean_Restrictions (No_Elaboration_Code)
+      then
+         Restrictions.Set (No_Elaboration_Code) := True;
+      end if;
    end Cunit_Boolean_Restrictions_Restore;
 
    -------------------------------------
@@ -656,7 +682,6 @@ 
    begin
       for J in Cunit_Boolean_Restrictions loop
          R (J) := Restrictions.Set (J);
-         Restrictions.Set (J) := False;
       end loop;
 
       return R;
@@ -772,6 +797,26 @@ 
       return New_Name;
    end Process_Restriction_Synonyms;
 
+   --------------------------------------
+   -- Reset_Cunit_Boolean_Restrictions --
+   --------------------------------------
+
+   procedure Reset_Cunit_Boolean_Restrictions is
+   begin
+      for J in Cunit_Boolean_Restrictions loop
+         Restrictions.Set (J) := False;
+      end loop;
+   end Reset_Cunit_Boolean_Restrictions;
+
+   -----------------------------------------------
+   -- Restore_Config_Cunit_Boolean_Restrictions --
+   -----------------------------------------------
+
+   procedure Restore_Config_Cunit_Boolean_Restrictions is
+   begin
+      Cunit_Boolean_Restrictions_Restore (Config_Cunit_Boolean_Restrictions);
+   end Restore_Config_Cunit_Boolean_Restrictions;
+
    ------------------------
    -- Restricted_Profile --
    ------------------------
@@ -1004,6 +1049,15 @@ 
       end if;
    end Same_Unit;
 
+   --------------------------------------------
+   -- Save_Config_Cunit_Boolean_Restrictions --
+   --------------------------------------------
+
+   procedure Save_Config_Cunit_Boolean_Restrictions is
+   begin
+      Config_Cunit_Boolean_Restrictions := Cunit_Boolean_Restrictions_Save;
+   end Save_Config_Cunit_Boolean_Restrictions;
+
    ------------------------------
    -- Set_Hidden_Part_In_SPARK --
    ------------------------------
@@ -1070,23 +1124,6 @@ 
       N : Node_Id)
    is
    begin
-      --  Restriction No_Elaboration_Code must be enforced on a unit by unit
-      --  basis. Hence, we avoid setting the restriction when processing an
-      --  unit which is not the main one being compiled (or its corresponding
-      --  spec). It can happen, for example, when processing an inlined body
-      --  (the package containing the inlined subprogram is analyzed,
-      --  including its pragma Restrictions).
-
-      --  This seems like a very nasty kludge??? This is not the only per unit
-      --  restriction why is this treated specially ???
-
-      if R = No_Elaboration_Code
-        and then Current_Sem_Unit /= Main_Unit
-        and then Cunit (Current_Sem_Unit) /= Library_Unit (Cunit (Main_Unit))
-      then
-         return;
-      end if;
-
       Restrictions.Set (R) := True;
 
       if Restricted_Profile_Cached and Restricted_Profile_Result then
Index: restrict.ads
===================================================================
--- restrict.ads	(revision 181563)
+++ restrict.ads	(working copy)
@@ -71,10 +71,6 @@ 
    --  set if Restriction_Warnings is set, so this does not look like a
    --  restriction to the binder.
 
-   type Save_Cunit_Boolean_Restrictions is private;
-   --  Type used for saving and restoring compilation unit restrictions.
-   --  See Cunit_Boolean_Restrictions_[Save|Restore] subprograms.
-
    --  The following declarations establish a mapping between restriction
    --  identifiers, and the names of corresponding restriction library units.
 
@@ -312,22 +308,6 @@ 
    --  [Wide_]Wide_Character or [Wide_]Wide_String, then the restriction
    --  violation is recorded, and an appropriate message given.
 
-   function Cunit_Boolean_Restrictions_Save
-     return Save_Cunit_Boolean_Restrictions;
-   --  This function saves the compilation unit restriction settings, and
-   --  resets them to False. This is used e.g. when compiling a with'ed
-   --  unit to avoid incorrectly propagating restrictions. Note that it
-   --  would not be wrong to also save and reset the partition restrictions,
-   --  since the binder would catch inconsistencies, but actually it is a
-   --  good thing to acquire restrictions from with'ed units if they are
-   --  required to be partition wide, because it allows the restriction
-   --  violation message to be given at compile time instead of link time.
-
-   procedure Cunit_Boolean_Restrictions_Restore
-     (R : Save_Cunit_Boolean_Restrictions);
-   --  This is the corresponding restore procedure to restore restrictions
-   --  previously saved by Cunit_Boolean_Restrictions_Save.
-
    function Get_Restriction_Id
      (N : Name_Id) return Restriction_Id;
    --  Given an identifier name, determines if it is a valid restriction
@@ -435,6 +415,71 @@ 
    --  Tests if tasking operations are allowed by the current restrictions
    --  settings. For tasking to be allowed Max_Tasks must be non-zero.
 
+   ----------------------------------------------
+   -- Handling of Boolean Compilation Switches --
+   ----------------------------------------------
+
+   --  The following declarations are used for proper saving and restoring of
+   --  restrictions for separate compilation units. There are two cases:
+
+   --    For partition-wide restrictions, we just let the restrictions pragmas
+   --    pile up, and we never reset them. We might as well detect what we can
+   --    at compile time. If e.g. a with'ed unit has a restriction for one of
+   --    the partition-wide restrictions, then the binder will enforce it on
+   --    all units in the partition, including the unit with the WITH. Although
+   --    it would not be wrong to leave this till bind time, we might as well
+   --    flag it earlier at compile time.
+
+   --    For non-partition-wide restrictions, we have quite a different state
+   --    of affairs. Here it would be quite wrong to carry a restriction from
+   --    a with'ed unit to another with'ed unit, or from a package spec to the
+   --    package body. This means that we have to reset these non-partition
+   --    wide restrictions at the start of each separate compilation unit. For
+   --    units in the extended main program, we need to reset them all to the
+   --    values set by the configuration pragma file(s). For units not in the
+   --    extended main program, e.g. with'ed units, we might as well reset all
+   --    of these restrictions to off (False). The actual initial values will
+   --    be taken from the config files active when those units are compiled
+   --    as main units.
+
+   type Save_Cunit_Boolean_Restrictions is private;
+   --  Type used for saving and restoring compilation unit restrictions.
+
+   function Cunit_Boolean_Restrictions_Save
+     return Save_Cunit_Boolean_Restrictions;
+   --  This function saves the compilation unit restriction settings, leaving
+   --  then unchanged. This is used e.g. at the start of processing a context
+   --  clause, so that the main unit restrictions can be restored after all
+   --  the with'ed units have been processed.
+
+   procedure Cunit_Boolean_Restrictions_Restore
+     (R : Save_Cunit_Boolean_Restrictions);
+   --  This is the corresponding restore procedure to restore restrictions
+   --  previously saved by Cunit_Boolean_Restrictions_Save. However it does
+   --  not reset No_Elaboration_Code, this stays set if it was set before
+   --  the call, and also if it is set before the call, then the Config
+   --  setting is also updated to include this restriction. This is what
+   --  implements the special handling of No_Elaboration_Code.
+
+   procedure Save_Config_Cunit_Boolean_Restrictions;
+   --  This saves the current compilation unit restrictions in an internal
+   --  variable, and leaves them unchanged. This is called immediately after
+   --  processing the configuration file pragmas, to record the restrictions
+   --  set by these configuration file pragmas.
+
+   procedure Restore_Config_Cunit_Boolean_Restrictions;
+   --  This restores the value saved by the previous call to save config values
+   --  saved by Save_Config_Cunit_Boolean_Restrictions. It is called at the
+   --  start of processing a new unit that is part of the main sources (e.g.
+   --  a package spec when the main unit is a package body).
+
+   procedure Reset_Cunit_Boolean_Restrictions;
+   --  Turns off all non-partition-wide boolean restrictions
+
+   procedure Add_To_Config_Boolean_Restrictions (R : Restriction_Id);
+   --  Add specified restriction to stored configuration boolean restrictions.
+   --  This is used for handling the special case of No_Elaboration_Code.
+
 private
    type Save_Cunit_Boolean_Restrictions is
      array (Cunit_Boolean_Restrictions) of Boolean;
Index: lib-load.adb
===================================================================
--- lib-load.adb	(revision 181556)
+++ lib-load.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -359,9 +359,25 @@ 
       Src_Ind      : Source_File_Index;
       Save_PMES    : constant Boolean := Parsing_Main_Extended_Source;
 
+      Save_Cunit_Restrictions : constant Save_Cunit_Boolean_Restrictions :=
+                                  Cunit_Boolean_Restrictions_Save;
+      --  Save current restrictions for restore at end
+
    begin
       Parsing_Main_Extended_Source := PMES;
 
+      --  Initialize restrictions to config restrictions for unit to load if
+      --  it is part of the main extended source, otherwise reset them.
+
+      --  Note: it's a bit odd but PMES is False for subunits, which is why
+      --  we have the OR here. Should be investigated some time???
+
+      if PMES or Subunit then
+         Restore_Config_Cunit_Boolean_Restrictions;
+      else
+         Reset_Cunit_Boolean_Restrictions;
+      end if;
+
       --  If renamings are allowed and we have a child unit name, then we
       --  must first load the parent to deal with finding the real name.
       --  Retain the with_clause that names the child, so that if it is
@@ -782,6 +798,7 @@ 
 
       <<Done>>
       Parsing_Main_Extended_Source := Save_PMES;
+      Cunit_Boolean_Restrictions_Restore (Save_Cunit_Restrictions);
       return Unum;
    end Load_Unit;
 
Index: s-rident.ads
===================================================================
--- s-rident.ads	(revision 181556)
+++ s-rident.ads	(working copy)
@@ -124,8 +124,16 @@ 
 
       No_Default_Initialization,               -- GNAT
 
-      --  The following cases do not require consistency checking
+      --  The following cases do not require consistency checking and if used
+      --  as a configuration pragma within a specific unit, apply only to that
+      --  unit (e.g. if used in the package spec, do not apply to the body)
 
+      --  Note: No_Elaboration_Code is handled specially. Like the other
+      --  non-partition-wide restrictions, it can only be set in a unit that
+      --  is part of the extended main source unit (body/spec/subunits). But
+      --  it is sticky, in that if it is found anywhere within any of these
+      --  units, it applies to all units in this extended main source.
+
       Immediate_Reclamation,                   -- (RM H.4(10))
       No_Implementation_Aspect_Specifications, -- Ada 2012 AI-241
       No_Implementation_Attributes,            -- Ada 2005 AI-257
@@ -202,7 +210,7 @@ 
    --  Boolean restrictions that are not checked for partition consistency
    --  and that thus apply only to the current unit. Note that for these
    --  restrictions, the compiler does not apply restrictions found in
-   --  with'ed units, parent specs etc. to the main unit.
+   --  with'ed units, parent specs etc. to the main unit, and vice versa.
 
    subtype All_Parameter_Restrictions is
      Restriction_Id range
Index: lib-xref.adb
===================================================================
--- lib-xref.adb	(revision 181556)
+++ lib-xref.adb	(working copy)
@@ -577,14 +577,16 @@ 
       --  doing in such cases. For example the calls in Ada.Characters.Handling
       --  to its own obsolescent subprograms are just fine.
 
-      --  In any case we do not generate warnings within the extended source
-      --  unit of the entity in question, since we assume the source unit
-      --  itself knows what is going on (and for sure we do not want silly
-      --  warnings, e.g. on the end line of an obsolescent procedure body).
+      --  In any case we only generate warnings if we are in the extended main
+      --  source unit, and the entity itself is not in the extended main source
+      --  unit, since we assume the source unit itself knows what is going on
+      --  (and for sure we do not want silly warnings, e.g. on the end line of
+      --  an obsolescent procedure body).
 
       if Is_Obsolescent (E)
         and then not GNAT_Mode
         and then not In_Extended_Main_Source_Unit (E)
+        and then In_Extended_Main_Source_Unit (N)
       then
          Check_Restriction (No_Obsolescent_Features, N);