[multiple changes]
authorPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Mon, 25 Sep 2017 10:07:11 +0000 (10:07 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Mon, 25 Sep 2017 10:07:11 +0000 (10:07 +0000)
2017-09-25  Justin Squirek  <squirek@adacore.com>

* aspects.adb, bindgen.adb, clean.adb, erroutc.adb, exp_ch13.adb,
exp_dbug.adb, exp_unst.adb, exp_util.adb, frontend.adb, gnat1drv.adb,
gnatdll.adb, gnatlink.adb, gnatls.adb, gnatname.adb, gnatxref.adb,
gnatfind.adb, libgnat/a-cfhama.ads, libgnat/a-exetim__mingw.adb,
libgnat/a-strmap.adb, libgnat/a-teioed.adb, libgnat/g-alvety.ads,
libgnat/g-expect.adb, libgnat/g-regist.adb, libgnat/g-socket.adb,
libgnat/g-socthi__mingw.ads, libgnat/s-stausa.adb,
libgnat/s-tsmona__linux.adb, libgnat/s-tsmona__mingw.adb,
libgnarl/s-taenca.adb, libgnarl/s-tassta.adb, libgnarl/s-tarest.adb,
libgnarl/s-tpobop.adb, make.adb, makeusg.adb, namet.adb, output.ads,
put_scos.adb, repinfo.adb, rtsfind.adb, scn.ads, sem_attr.adb,
sem_aux.ads, sem_warn.ads, targparm.adb, xr_tabls.adb, xref_lib.adb:
Removal of ineffective use-clauses.
* exp_ch9.adb (Is_Simple_Barrier_Name): Check for false positives with
constant folded barriers.
* ghost.adb, sprint.adb, sem_ch10.adb, sem_warn.adb: Change access to
Subtype_Marks and Names list in use-clause nodes to their new singular
counterparts (e.g. Subtype_Mark, Name).
* par.adb, par-ch8.adb (Append_Use_Clause): Created to set
Prev_Ids and More_Ids in use-clause nodes.
(P_Use_Clause): Modify to take a list as a parameter.
(P_Use_Package_Clause, P_Use_Type_Clause): Divide names and
subtype_marks within an aggregate use-clauses into individual clauses.
* par-ch3.adb, par-ch10.adb, par-ch12.adb: Trivally modify call to
P_Use_Clause to match its new behavior.
* sem.adb (Analyze): Mark use clauses for non-overloaded entities.
* sem_ch4.adb (Try_One_Interp): Add sanity check to handle previous
errors.
* sem_ch6.adb (Analyze_Generic_Subprogram_Body,
Analyze_Subprogram_Body_Helper): Update use clause chain at the end of
the declarative region.
* sem_ch7.adb (Analyze_Package_Body_Helper): Update use clause chain
after analysis (Analyze_Package_Specification): Update use clause chain
when there is no body.
* sem_ch8.ads, sem_ch8.adb (Analyze_Use_Package, Analyze_Use_Type): Add
parameter to determine weither the installation of scopes should also
propagate on the use-clause "chain".
(Mark_Use_Clauses): Created to traverse use-clause chains and determine
what constitutes a valid "use" of a clause.
(Update_Use_Clause_Chain): Created to aggregate common machinary used
to clean up use-clause chains (and warn on ineffectiveness) at the end
of declaritive regions.
* sem_ch8.adb (Analyze_Package_Name): Created to perform analysis on a
package name from a use-package clause.
(Analyze_Package_Name_List): Created to perform analysis on a list of
package names (similar to Analyze_Package_Name).
(Find_Most_Prev): Created to traverse to the beginning of a given
use-clause chain.
(Most_Decendant_Use_Clause): Create to identify which clause from a
given set is highest in scope (not always the most prev).
(Use_One_Package, Use_One_Type): Major cleanup and reorganization to
handle the new chaining algorithm, also many changes related to
redundant clauses. A new parameter has also been added to force
installation to handle certain cases.
* sem_ch9.adb (Analyze_Entry_Body, Analyze_Protected_Body,
Analyze_Task_Body): Mark use clauses on relevant entities.
* sem_ch10.adb, sem_ch10.ads (Install_Context_Clauses,
Install_Parents): Add parameter to determine weither the installation
of scopes should also propagate on the use-clause "chain".
* sem_ch12.adb (Inline_Instance_Body): Add flag in call to
Install_Context to avoid redundant chaining of use-clauses.
* sem_ch13.adb: Minor reformatting.
* sem_res.adb (Resolve): Mark use clauses on operators.
(Resolve_Call, Resolve_Entity_Name): Mark use clauses on relevant
entities.
* sinfo.adb, sinfo.ads (Is_Effective_Use_Clause,
Set_Is_Effective_Use_Clause): Add new flag to N_Use_Clause nodes to
represent any given clause's usage/reference/necessity.
(Prev_Use_Clause, Set_Prev_Use_Clause): Add new field to N_Use_Clause
nodes to allow loose chaining of redundant clauses.
(Set_Used_Operations, Set_Subtype_Mark, Set_Prev_Ids, Set_Names,
Set_More_Ids, Set_Name): Modify set procedure calls to reflect
reorganization in node fields.
* types.ads (Source_File_Index): Adjust index bounds.
(No_Access_To_Source_File): New constant.

2017-09-25  Ed Schonberg  <schonberg@adacore.com>

* sem_ch13.adb (Analyze_One_Aspect): In ASIS mode make a full copy of
the expression to be used in the generated attribute specification
(rather than relocating it) to avoid resolving a potentially malformed
tree when the expression is resolved through an ASIS-specific call to
Resolve_Aspect_Expressions.  This manifests itself as a crash on a
function with parameter associations.

From-SVN: r253144

73 files changed:
gcc/ada/ChangeLog
gcc/ada/aspects.adb
gcc/ada/bindgen.adb
gcc/ada/clean.adb
gcc/ada/erroutc.adb
gcc/ada/exp_ch13.adb
gcc/ada/exp_ch9.adb
gcc/ada/exp_dbug.adb
gcc/ada/exp_unst.adb
gcc/ada/exp_util.adb
gcc/ada/frontend.adb
gcc/ada/ghost.adb
gcc/ada/gnat1drv.adb
gcc/ada/gnatdll.adb
gcc/ada/gnatfind.adb
gcc/ada/gnatlink.adb
gcc/ada/gnatls.adb
gcc/ada/gnatname.adb
gcc/ada/gnatxref.adb
gcc/ada/gprep.adb
gcc/ada/libgnarl/a-exetim__mingw.adb
gcc/ada/libgnarl/s-taenca.adb
gcc/ada/libgnarl/s-tarest.adb
gcc/ada/libgnarl/s-tassta.adb
gcc/ada/libgnarl/s-tpobop.adb
gcc/ada/libgnat/a-cfhama.ads
gcc/ada/libgnat/a-strmap.adb
gcc/ada/libgnat/a-teioed.adb
gcc/ada/libgnat/g-alvety.ads
gcc/ada/libgnat/g-expect.adb
gcc/ada/libgnat/g-regist.adb
gcc/ada/libgnat/g-socket.adb
gcc/ada/libgnat/g-socthi__mingw.ads
gcc/ada/libgnat/s-stausa.adb
gcc/ada/libgnat/s-tsmona__linux.adb
gcc/ada/libgnat/s-tsmona__mingw.adb
gcc/ada/make.adb
gcc/ada/makeusg.adb
gcc/ada/namet.adb
gcc/ada/output.ads
gcc/ada/par-ch10.adb
gcc/ada/par-ch12.adb
gcc/ada/par-ch3.adb
gcc/ada/par-ch8.adb
gcc/ada/par.adb
gcc/ada/put_scos.adb
gcc/ada/repinfo.adb
gcc/ada/rtsfind.adb
gcc/ada/scn.ads
gcc/ada/sem.adb
gcc/ada/sem_attr.adb
gcc/ada/sem_aux.ads
gcc/ada/sem_ch10.adb
gcc/ada/sem_ch10.ads
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_ch5.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_ch7.adb
gcc/ada/sem_ch8.adb
gcc/ada/sem_ch8.ads
gcc/ada/sem_ch9.adb
gcc/ada/sem_res.adb
gcc/ada/sem_warn.adb
gcc/ada/sem_warn.ads
gcc/ada/sinfo.adb
gcc/ada/sinfo.ads
gcc/ada/sprint.adb
gcc/ada/targparm.adb
gcc/ada/types.ads
gcc/ada/xr_tabls.adb
gcc/ada/xref_lib.adb

index 28fa8f18e3052c155fe3a086ceafff0a4fec626c..2657531cf36630c6d8f1590426db9c82671519a1 100644 (file)
@@ -1,3 +1,90 @@
+2017-09-25  Justin Squirek  <squirek@adacore.com>
+
+       * aspects.adb, bindgen.adb, clean.adb, erroutc.adb, exp_ch13.adb,
+       exp_dbug.adb, exp_unst.adb, exp_util.adb, frontend.adb, gnat1drv.adb,
+       gnatdll.adb, gnatlink.adb, gnatls.adb, gnatname.adb, gnatxref.adb,
+       gnatfind.adb, libgnat/a-cfhama.ads, libgnat/a-exetim__mingw.adb,
+       libgnat/a-strmap.adb, libgnat/a-teioed.adb, libgnat/g-alvety.ads,
+       libgnat/g-expect.adb, libgnat/g-regist.adb, libgnat/g-socket.adb,
+       libgnat/g-socthi__mingw.ads, libgnat/s-stausa.adb,
+       libgnat/s-tsmona__linux.adb, libgnat/s-tsmona__mingw.adb,
+       libgnarl/s-taenca.adb, libgnarl/s-tassta.adb, libgnarl/s-tarest.adb,
+       libgnarl/s-tpobop.adb, make.adb, makeusg.adb, namet.adb, output.ads,
+       put_scos.adb, repinfo.adb, rtsfind.adb, scn.ads, sem_attr.adb,
+       sem_aux.ads, sem_warn.ads, targparm.adb, xr_tabls.adb, xref_lib.adb:
+       Removal of ineffective use-clauses.
+       * exp_ch9.adb (Is_Simple_Barrier_Name): Check for false positives with
+       constant folded barriers.
+       * ghost.adb, sprint.adb, sem_ch10.adb, sem_warn.adb: Change access to
+       Subtype_Marks and Names list in use-clause nodes to their new singular
+       counterparts (e.g. Subtype_Mark, Name).
+       * par.adb, par-ch8.adb (Append_Use_Clause): Created to set
+       Prev_Ids and More_Ids in use-clause nodes.
+       (P_Use_Clause): Modify to take a list as a parameter.
+       (P_Use_Package_Clause, P_Use_Type_Clause): Divide names and
+       subtype_marks within an aggregate use-clauses into individual clauses.
+       * par-ch3.adb, par-ch10.adb, par-ch12.adb: Trivally modify call to
+       P_Use_Clause to match its new behavior.
+       * sem.adb (Analyze): Mark use clauses for non-overloaded entities.
+       * sem_ch4.adb (Try_One_Interp): Add sanity check to handle previous
+       errors.
+       * sem_ch6.adb (Analyze_Generic_Subprogram_Body,
+       Analyze_Subprogram_Body_Helper): Update use clause chain at the end of
+       the declarative region.
+       * sem_ch7.adb (Analyze_Package_Body_Helper): Update use clause chain
+       after analysis (Analyze_Package_Specification): Update use clause chain
+       when there is no body.
+       * sem_ch8.ads, sem_ch8.adb (Analyze_Use_Package, Analyze_Use_Type): Add
+       parameter to determine weither the installation of scopes should also
+       propagate on the use-clause "chain".
+       (Mark_Use_Clauses): Created to traverse use-clause chains and determine
+       what constitutes a valid "use" of a clause.
+       (Update_Use_Clause_Chain): Created to aggregate common machinary used
+       to clean up use-clause chains (and warn on ineffectiveness) at the end
+       of declaritive regions.
+       * sem_ch8.adb (Analyze_Package_Name): Created to perform analysis on a
+       package name from a use-package clause.
+       (Analyze_Package_Name_List): Created to perform analysis on a list of
+       package names (similar to Analyze_Package_Name).
+       (Find_Most_Prev): Created to traverse to the beginning of a given
+       use-clause chain.
+       (Most_Decendant_Use_Clause): Create to identify which clause from a
+       given set is highest in scope (not always the most prev).
+       (Use_One_Package, Use_One_Type): Major cleanup and reorganization to
+       handle the new chaining algorithm, also many changes related to
+       redundant clauses. A new parameter has also been added to force
+       installation to handle certain cases.
+       * sem_ch9.adb (Analyze_Entry_Body, Analyze_Protected_Body,
+       Analyze_Task_Body): Mark use clauses on relevant entities.
+       * sem_ch10.adb, sem_ch10.ads (Install_Context_Clauses,
+       Install_Parents): Add parameter to determine weither the installation
+       of scopes should also propagate on the use-clause "chain".
+       * sem_ch12.adb (Inline_Instance_Body): Add flag in call to
+       Install_Context to avoid redundant chaining of use-clauses.
+       * sem_ch13.adb: Minor reformatting.
+       * sem_res.adb (Resolve): Mark use clauses on operators.
+       (Resolve_Call, Resolve_Entity_Name): Mark use clauses on relevant
+       entities.
+       * sinfo.adb, sinfo.ads (Is_Effective_Use_Clause,
+       Set_Is_Effective_Use_Clause): Add new flag to N_Use_Clause nodes to
+       represent any given clause's usage/reference/necessity.
+       (Prev_Use_Clause, Set_Prev_Use_Clause): Add new field to N_Use_Clause
+       nodes to allow loose chaining of redundant clauses.
+       (Set_Used_Operations, Set_Subtype_Mark, Set_Prev_Ids, Set_Names,
+       Set_More_Ids, Set_Name): Modify set procedure calls to reflect
+       reorganization in node fields.
+       * types.ads (Source_File_Index): Adjust index bounds.
+       (No_Access_To_Source_File): New constant.
+
+2017-09-25  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch13.adb (Analyze_One_Aspect): In ASIS mode make a full copy of
+       the expression to be used in the generated attribute specification
+       (rather than relocating it) to avoid resolving a potentially malformed
+       tree when the expression is resolved through an ASIS-specific call to
+       Resolve_Aspect_Expressions.  This manifests itself as a crash on a
+       function with parameter associations.
+
 2017-09-25  Yannick Moy  <moy@adacore.com>
 
        * exp_spark.adb (Expand_SPARK_Indexed_Component,
index d5ec072d5e7ca63e46d1f0b2f7ab383111c5bc42..821f4b5598488bd90105fd9066fcc586a8fe9625 100644 (file)
@@ -35,7 +35,7 @@ with Nlists;   use Nlists;
 with Sinfo;    use Sinfo;
 with Tree_IO;  use Tree_IO;
 
-with GNAT.HTable;           use GNAT.HTable;
+with GNAT.HTable;
 
 package body Aspects is
 
index 59b43e0c27ebbda45957a01618e4cccceafb95f7..a9ea20ebd9bd06ac4f62e9b986e300f75a6e177f 100644 (file)
@@ -35,19 +35,17 @@ with Osint.B;  use Osint.B;
 with Output;   use Output;
 with Rident;   use Rident;
 with Stringt;  use Stringt;
-with Table;    use Table;
+with Table;
 with Targparm; use Targparm;
 with Types;    use Types;
 
-with System.OS_Lib;  use System.OS_Lib;
+with System.OS_Lib;
 with System.WCh_Con; use System.WCh_Con;
 
 with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
 with GNAT.HTable;
 
 package body Bindgen is
-   use Binde.Unit_Id_Tables;
-
    Statement_Buffer : String (1 .. 1000);
    --  Buffer used for constructing output statements
 
index 2b3d03324edb278fffc6bb654db547597bb32cfb..891575ea9d39fe402b6565b9b692d7d9f4a498a0 100644 (file)
@@ -31,7 +31,7 @@ with Osint;     use Osint;
 with Osint.M;   use Osint.M;
 with Switch;    use Switch;
 with Table;
-with Targparm;  use Targparm;
+with Targparm;
 with Types;     use Types;
 
 with Ada.Command_Line;          use Ada.Command_Line;
index f81d337a0a789e42cb5499839149343d3851410a..b77d53d7e61abfe08acdfe20dbe6b6363ed34ab4 100644 (file)
@@ -41,7 +41,7 @@ with Output;   use Output;
 with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Stringt;  use Stringt;
-with Targparm; use Targparm;
+with Targparm;
 with Uintp;    use Uintp;
 with Widechar; use Widechar;
 
index 0e0bbca440eb2f2814e2c1afb92fdea417a057a0..4637d04ed9874399e05a3cd8acff8cfef1f96bda 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -27,7 +27,7 @@ with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
 with Exp_Ch3;  use Exp_Ch3;
-with Exp_Ch6;  use Exp_Ch6;
+with Exp_Ch6;
 with Exp_Imgv; use Exp_Imgv;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
index 0cd4fde15b1f40be65fae63181c590ace0e05fdb..37399adf98b9404d0e1efb17792b2a5e3f83de1e 100644 (file)
@@ -6006,6 +6006,14 @@ package body Exp_Ch9 is
          --  reference will have been rewritten.
 
          if Expander_Active then
+            --  The expanded name may have been constant folded in which case
+            --  the original node is not necessarily an entity name (e.g. an
+            --  indexed component).
+
+            if not Is_Entity_Name (Original_Node (N)) then
+               return False;
+            end if;
+
             Renamed := Renamed_Object (Entity (Original_Node (N)));
 
             return
index 1b51d538e3f2d809910d79c7eb1d3edd102a6035..70c21c00a437d72f46907c12e07d3eff93f67626 100644 (file)
@@ -23,7 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Alloc;    use Alloc;
+with Alloc;
 with Atree;    use Atree;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
index 62d9d339f209fe8fe2ce822d7c2c9e2e7a279b42..063b60f93548126b407083dcb5acdce9693e60cb 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2014-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 2014-2017, 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- --
@@ -31,7 +31,7 @@ with Lib;      use Lib;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
-with Opt;      use Opt;
+with Opt;
 with Output;   use Output;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
index b8c528eb52c9568514c43c4ea7bd6eef7fceb6e3..c9650ce10a4a31cbd1bc1bc038eca9634d5f7a6d 100644 (file)
@@ -65,8 +65,7 @@ with Ttypes;   use Ttypes;
 with Urealp;   use Urealp;
 with Validsw;  use Validsw;
 
-with GNAT.HTable; use GNAT.HTable;
-
+with GNAT.HTable;
 package body Exp_Util is
 
    ---------------------------------------------------------
index 378aacdffd1bbbaeaa88374db8011e65d1ffc2ed..c55085856c0456beb0e93aa880e5addb1c6138a0 100644 (file)
@@ -38,7 +38,7 @@ with Ghost;    use Ghost;
 with Inline;   use Inline;
 with Lib;      use Lib;
 with Lib.Load; use Lib.Load;
-with Lib.Xref; use Lib.Xref;
+with Lib.Xref;
 with Live;     use Live;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
@@ -49,21 +49,21 @@ with Prep;
 with Prepcomp;
 with Restrict; use Restrict;
 with Rident;   use Rident;
-with Rtsfind;  use Rtsfind;
+with Rtsfind;
 with Snames;   use Snames;
 with Sprint;
 with Scn;      use Scn;
 with Sem;      use Sem;
 with Sem_Aux;
-with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch8;
 with Sem_SCIL;
 with Sem_Elab; use Sem_Elab;
 with Sem_Prag; use Sem_Prag;
-with Sem_Warn; use Sem_Warn;
+with Sem_Warn;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with Sinput.L; use Sinput.L;
-with SCIL_LL;  use SCIL_LL;
+with SCIL_LL;
 with Tbuild;   use Tbuild;
 with Types;    use Types;
 
@@ -168,7 +168,6 @@ begin
          --  Case of gnat.adc file present
 
          if Source_gnat_adc /= No_Source_File then
-
             --  Parse the gnat.adc file for configuration pragmas
 
             Initialize_Scanner (No_Unit, Source_gnat_adc);
index 6640d6a0f8e846974f4ced99734a31e30b5401d9..e7ca3bfcf374294904171333543d2b103560d464 100644 (file)
@@ -23,7 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Alloc;    use Alloc;
+with Alloc;
 with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Einfo;    use Einfo;
@@ -1477,10 +1477,10 @@ package body Ghost is
 
    begin
       if Nkind (N) = N_Use_Package_Clause then
-         Nam := First (Names (N));
+         Nam := Name (N);
 
       elsif Nkind (N) = N_Use_Type_Clause then
-         Nam := First (Subtype_Marks (N));
+         Nam := Subtype_Mark (N);
 
       elsif Nkind (N) = N_With_Clause then
          Nam := Name (N);
index c3377da48345b42100f4a738fecd7a33cdd417fa..0e3bc27becbc9acea354b9b6ab5afb8dd79192d7 100644 (file)
@@ -27,7 +27,7 @@ with Atree;     use Atree;
 with Back_End;  use Back_End;
 with Checks;
 with Comperr;
-with Csets;     use Csets;
+with Csets;
 with Debug;     use Debug;
 with Elists;
 with Errout;    use Errout;
@@ -76,7 +76,7 @@ with Tree_Gen;
 with Treepr;    use Treepr;
 with Ttypes;
 with Types;     use Types;
-with Uintp;     use Uintp;
+with Uintp;
 with Uname;     use Uname;
 with Urealp;
 with Usage;
index 94b39b8cc7d59a2fc7376e7ddf56ca14d9317d88..736979a2c665a33a68b042007d5e373f77408020 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2017, 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- --
@@ -28,7 +28,7 @@
 
 with Gnatvsn;
 with MDLL.Fil; use MDLL.Fil;
-with MDLL.Utl; use MDLL.Utl;
+with MDLL.Utl;
 with Switch;   use Switch;
 
 with Ada.Text_IO;           use Ada.Text_IO;
@@ -41,8 +41,6 @@ with GNAT.Command_Line; use GNAT.Command_Line;
 
 procedure Gnatdll is
 
-   use type GNAT.OS_Lib.Argument_List;
-
    procedure Syntax;
    --  Print out usage
 
index 0d030be6f00f8a70a091f686770411db2d6b0a4b..9e427baad1b1741979e4f11d757463ad63baba45 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2017, 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- --
@@ -27,7 +27,7 @@ with Opt;
 with Osint;    use Osint;
 with Switch;   use Switch;
 with Types;    use Types;
-with Xr_Tabls; use Xr_Tabls;
+with Xr_Tabls;
 with Xref_Lib; use Xref_Lib;
 
 with Ada.Command_Line;  use Ada.Command_Line;
index 073c2c953157f930ff363b6ca5e14687aee55036..5e290eb639f77274871b3c22cb818af914ace4ac 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2017, 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- --
@@ -37,7 +37,7 @@ with Snames;
 with Switch;   use Switch;
 with System;   use System;
 with Table;
-with Targparm; use Targparm;
+with Targparm;
 with Types;
 
 with Ada.Command_Line; use Ada.Command_Line;
index a120ee46acd4d6a8ee46299ac874ddbc7680bbe6..925ae2c7836b002e9df9d2bdd7a06e9072e009b6 100644 (file)
@@ -29,7 +29,7 @@ with ALI;         use ALI;
 with ALI.Util;    use ALI.Util;
 with Binderr;     use Binderr;
 with Butil;       use Butil;
-with Csets;       use Csets;
+with Csets;
 with Fname;       use Fname;
 with Gnatvsn;     use Gnatvsn;
 with Make_Util;   use Make_Util;
index 7540a1e557b85a1e251263cda8b5e6dccf87f4b2..4a9973f5dfdd4eae2ba1b1ebb9bcfca915142ddc 100644 (file)
@@ -36,7 +36,7 @@ with Make_Util; use Make_Util;
 with Namet;     use Namet;
 with Opt;
 with Osint;     use Osint;
-with Output;    use Output;
+with Output;
 with Switch;    use Switch;
 with Table;
 with Tempdir;
index c24fd49341a7c5a70d0dc5405f48fdf684a38292..e458d035a0d9a8ca5285427e044b4b363481f2fd 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2017, 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- --
@@ -27,11 +27,11 @@ with Opt;
 with Osint;    use Osint;
 with Types;    use Types;
 with Switch;   use Switch;
-with Xr_Tabls; use Xr_Tabls;
+with Xr_Tabls;
 with Xref_Lib; use Xref_Lib;
 
 with Ada.Command_Line;  use Ada.Command_Line;
-with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+with Ada.Strings.Fixed;
 with Ada.Text_IO;       use Ada.Text_IO;
 
 with GNAT.Command_Line; use GNAT.Command_Line;
index cc7e24301bbb9f059c112271c904dfe5040d555d..825a5373ddfe91575414581dbec00b04cc5a2e62 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2017, 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- --
@@ -249,6 +249,10 @@ package body GPrep is
                Fail ("unable to find definition file """
                      & Get_Name_String (Deffile_Name)
                      & """");
+            elsif Deffile = No_Access_To_Source_File then
+               Fail ("unabled to read definition file """
+                     & Get_Name_String (Deffile_Name)
+                     & """");
             end if;
 
             Scanner.Initialize_Scanner (Deffile);
@@ -514,6 +518,10 @@ package body GPrep is
             Fail ("unable to find input file """
                   & Get_Name_String (Infile_Name)
                   & """");
+         elsif Infile = No_Access_To_Source_File then
+            Fail ("unable to read input file """
+                  & Get_Name_String (Infile_Name)
+                  & """");
          end if;
 
          --  Set Main_Source_File to the input file for the benefit of
index 264ba9d5322d6e48638d2d4f262dbd87ad903fc6..7555b16b191d7f67bfd72dd01d2db22df607e9f9 100644 (file)
@@ -153,7 +153,6 @@ is
       SC : out Ada.Real_Time.Seconds_Count;
       TS : out Ada.Real_Time.Time_Span)
    is
-      use type Ada.Real_Time.Time;
    begin
       Ada.Real_Time.Split (Ada.Real_Time.Time (T), SC, TS);
    end Split;
index 1236194441cdac9797f507d83ee9d593da2a10b2..dc5dcf0e8fca9a7c4d8a709cc2597ea70f8869aa 100644 (file)
@@ -42,7 +42,6 @@ package body System.Tasking.Entry_Calls is
    package STPO renames System.Task_Primitives.Operations;
 
    use Parameters;
-   use Task_Primitives;
    use Protected_Objects.Entries;
    use Protected_Objects.Operations;
 
index 4bf2df6da095c562843ecbf8fb955e3e317c8ad3..daff5c1c3ae27a2d86e1f7ed78fa9dd17eae43e1 100644 (file)
@@ -72,7 +72,6 @@ package body System.Tasking.Restricted.Stages is
 
    use Parameters;
    use Task_Primitives.Operations;
-   use Task_Info;
 
    Tasks_Activation_Chain : Task_Id;
    --  Chain of all the tasks to activate
index 346e5bfe14288bd967edfda86e645ae791269e4d..44c054fec3ecfe0e043ad691246d778ff5582359 100644 (file)
@@ -78,7 +78,6 @@ package body System.Tasking.Stages is
    use Parameters;
    use Task_Primitives;
    use Task_Primitives.Operations;
-   use Task_Info;
 
    -----------------------
    -- Local Subprograms --
@@ -1045,7 +1044,6 @@ package body System.Tasking.Stages is
 
       function Secondary_Stack_Size return Storage_Elements.Storage_Offset is
          use System.Storage_Elements;
-         use System.Secondary_Stack;
 
       begin
          if Parameters.Sec_Stack_Dynamic then
@@ -1539,7 +1537,6 @@ package body System.Tasking.Stages is
       pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
 
       use System.Soft_Links;
-      use System.Standard_Library;
 
       function To_Address is new
         Ada.Unchecked_Conversion
index 242fe45f97ec807bf2c602ad67156380572b38d1..251ae87b91d2255bb13f249a654de910c2765c41 100644 (file)
@@ -60,7 +60,6 @@ package body System.Tasking.Protected_Objects.Operations is
    package STPO renames System.Task_Primitives.Operations;
 
    use Parameters;
-   use Task_Primitives;
    use Ada.Exceptions;
    use Entries;
 
index e02accc3f52f96cd149022bde8ec4d0da194ef53..feaa3b141bf13fa8e7a62d955ee4fcebaca4f4e6 100644 (file)
@@ -808,8 +808,6 @@ private
    type Map (Capacity : Count_Type; Modulus : Hash_Type) is
      new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
 
-   use HT_Types;
-
    Empty_Map : constant Map := (Capacity => 0, Modulus => 0, others => <>);
 
 end Ada.Containers.Formal_Hashed_Maps;
index a98556b6dc359a0825c6a38822cf9dcdd18091dd..0f68f183f3bd0eabf259134d99aaed8c5c894432 100644 (file)
@@ -37,8 +37,6 @@
 
 package body Ada.Strings.Maps is
 
-   use Ada.Characters.Latin_1;
-
    ---------
    -- "-" --
    ---------
index 93e69f694e9d9f6a203b92480dc5e4492e1819d2..4260682b69d7f61ed110c6a736cb8035177fe11c 100644 (file)
@@ -1019,7 +1019,6 @@ package body Ada.Text_IO.Editing is
       -------------------
 
       procedure Debug_Integer (Value : Integer; S : String) is
-         use Ada.Text_IO; --  needed for >
 
       begin
          if Debug and then Value > 0 then
index 623a5fc373e1995aab79fcbd743e9c9980ff5e65..a697e627d9979b5caea6e397e855a0c444c80f12 100644 (file)
@@ -36,8 +36,6 @@ with GNAT.Altivec.Low_Level_Vectors;
 
 package GNAT.Altivec.Vector_Types is
 
-   use GNAT.Altivec.Low_Level_Vectors;
-
    ---------------------------------------------------
    -- Vector type declarations [PIM-2.1 Data Types] --
    ---------------------------------------------------
index 4435b6a1f6d95583070af441de22101495513076..554660163b071b0a38b590a0e4a3c44314888a01 100644 (file)
@@ -907,8 +907,6 @@ package body GNAT.Expect is
       Status     : not null access Integer;
       Err_To_Out : Boolean := False) return String
    is
-      use GNAT.Expect;
-
       Process : Process_Descriptor;
 
       Output : String_Access := new String (1 .. 1024);
index 5b097bb1e4e420a9f93b033ef6a55ced2eaff051..02e07fd5f456d5be6831439f08620b46e8071376 100644 (file)
@@ -184,9 +184,6 @@ package body GNAT.Registry is
       Sub_Key  : String;
       Mode     : Key_Mode := Read_Write) return HKEY
    is
-      use type REGSAM;
-      use type DWORD;
-
       REG_OPTION_NON_VOLATILE : constant := 16#0#;
 
       C_Sub_Key : constant String := Sub_Key & ASCII.NUL;
@@ -425,8 +422,6 @@ package body GNAT.Registry is
       Sub_Key  : String;
       Mode     : Key_Mode := Read_Only) return HKEY
    is
-      use type REGSAM;
-
       C_Sub_Key : constant String := Sub_Key & ASCII.NUL;
       C_Mode    : constant REGSAM := To_C_Mode (Mode);
 
@@ -456,7 +451,6 @@ package body GNAT.Registry is
       Expand   : Boolean := False) return String
    is
       use GNAT.Directory_Operations;
-      use type LONG;
       use type ULONG;
 
       Value : String (1 .. Max_Value_Size);
index 9b2ad7f74fb390ae30ef379f1a3817fd8f62252e..519776e0ad3fb89a0913da8f8abfbd37771b5590 100644 (file)
@@ -2175,7 +2175,6 @@ package body GNAT.Sockets is
       Count  : out Ada.Streams.Stream_Element_Count;
       Flags  : Request_Flag_Type := No_Request_Flag)
    is
-      use SOSC;
       use Interfaces.C;
 
       Res            : ssize_t;
index 48f5aeb9befd045ee52de45cfc490b43194ab027..fa7617288a1c83299c1ba8949ebe800dda01e2d6 100644 (file)
@@ -48,8 +48,6 @@ package GNAT.Sockets.Thin is
 
    package C renames Interfaces.C;
 
-   use type System.CRTL.ssize_t;
-
    function Socket_Errno return Integer;
    --  Returns last socket error number
 
index f652e7a47325e3b23e255e28c991bf555a40547d..da5db75552a5a8e4940481957894b1a314bdb5af 100644 (file)
@@ -35,7 +35,6 @@ with System.IO;
 
 package body System.Stack_Usage is
    use System.Storage_Elements;
-   use System;
    use System.IO;
    use Interfaces;
 
index 8c1f8b4ada8b3e5bbc5efaa23a25328a33b68ec6..49b73b680a9e6484d1cae65c27bf2657e5edc09d 100644 (file)
@@ -38,8 +38,6 @@ separate (System.Traceback.Symbolic)
 
 package body Module_Name is
 
-   use System;
-
    pragma Linker_Options ("-ldl");
 
    function Is_Shared_Lib (Base : Address) return Boolean;
index 46c35cd791a53e74ef930ebaf202669b43ba1953..3205c0a83fecdbe5fdda405a0c095606c829da1c 100644 (file)
@@ -37,8 +37,6 @@ separate (System.Traceback.Symbolic)
 
 package body Module_Name is
 
-   use System;
-
    ---------------------------------
    -- Build_Cache_For_All_Modules --
    ---------------------------------
index cbd110dc8f0e2df09546b4c74a07057ac59df762..75048d24e5e6d436f39e40fc648257678144549c 100644 (file)
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with ALI;      use ALI;
-with ALI.Util; use ALI.Util;
+with ALI;       use ALI;
+with ALI.Util;  use ALI.Util;
 with Csets;
 with Debug;
 with Fmap;
 with Fname;     use Fname;
-with Fname.SF;  use Fname.SF;
+with Fname.SF;
 with Fname.UF;  use Fname.UF;
 with Gnatvsn;   use Gnatvsn;
 with Hostparm;  use Hostparm;
 with Makeusg;
 with Make_Util; use Make_Util;
-with Namet;    use Namet;
-with Opt;      use Opt;
-with Osint.M;  use Osint.M;
-with Osint;    use Osint;
-with Output;   use Output;
+with Namet;     use Namet;
+with Opt;       use Opt;
+with Osint.M;   use Osint.M;
+with Osint;     use Osint;
+with Output;    use Output;
 with SFN_Scan;
 with Sinput;
-with Snames;   use Snames;
+with Snames;
 with Stringt;
 
 pragma Warnings (Off);
@@ -52,7 +52,7 @@ pragma Warnings (On);
 with Switch;   use Switch;
 with Switch.M; use Switch.M;
 with Table;
-with Targparm; use Targparm;
+with Targparm;
 with Tempdir;
 with Types;    use Types;
 
index 73361de9658597d92a54d446146b85b716e2556b..e596f32a44eefb9b1e497655327252250d5bc2f6 100644 (file)
@@ -24,7 +24,7 @@
 ------------------------------------------------------------------------------
 
 with Make_Util;
-with Osint;   use Osint;
+with Osint;
 with Output;  use Output;
 with Switch;  use Switch;
 with Usage;
index fd458a3085a91f4cd7b0a32ebf284373a0c6d0c1..2dcbe1a677cfe4da38dd117b11c4506062047944 100644 (file)
@@ -38,7 +38,7 @@ with Opt;      use Opt;
 with Output;   use Output;
 with System;   use System;
 with Tree_IO;  use Tree_IO;
-with Widechar; use Widechar;
+with Widechar;
 
 with Interfaces; use Interfaces;
 
index 5fe0d44a9c29978853da4ce7e6dd7893e1f7293e..21f69dd01be814bb01b88b3b8aa68bd0cc7d5f94 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -33,7 +33,7 @@
 --  writing error messages and informational output. It is also used by the
 --  debug source file output routines (see Sprint.Print_Debug_Line).
 
-with Hostparm; use Hostparm;
+with Hostparm;
 with Types;    use Types;
 
 pragma Warnings (Off);
index eca327b5634fbcc15c6cb0095c49cb0769c5b4c9..1dd3b762564f206aadb8159d01cbe126c84907ec 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -970,7 +970,7 @@ package body Ch10 is
          --  Processing for USE clause
 
          elsif Token = Tok_Use then
-            Append (P_Use_Clause, Item_List);
+            P_Use_Clause (Item_List);
 
          --  Anything else is end of context clause
 
index 52f687ee03dfa0c4f022b64619dee836a403e1ee..e603d9c57fd9a3f6761d3cb6b418be6b192f318b 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -167,7 +167,7 @@ package body Ch12 is
          end if;
 
          if Token = Tok_Use then
-            Append (P_Use_Clause, Decls);
+            P_Use_Clause (Decls);
 
          else
             --  Parse a generic parameter declaration
index 6553a954eb1216d47d62549fce316bbb729a7225..54dd5621fd81cd21ba32900b3f91003d738b6ca4 100644 (file)
@@ -4411,7 +4411,7 @@ package body Ch3 is
 
          when Tok_Use =>
             Check_Bad_Layout;
-            Append (P_Use_Clause, Decls);
+            P_Use_Clause (Decls);
             Done := False;
 
          when Tok_With =>
index b4eaf8c72284eb326ff64526823461b1b57d0fca..456c86358be77750988bf239b262a2ef1da855c7 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -34,8 +34,50 @@ package body Ch8 is
    -- Local Subprograms --
    -----------------------
 
-   function P_Use_Package_Clause                           return Node_Id;
-   function P_Use_Type_Clause                              return Node_Id;
+   procedure Append_Use_Clause
+     (Item_List : List_Id;
+      Use_Node  : Node_Id;
+      Is_First  : in out Boolean;
+      Is_Last   : in out Boolean);
+   --  Append a use_clause to the Item_List, appropriately setting the Prev_Ids
+   --  and More_Ids flags for each split use node. The flags Is_First and
+   --  Is_Last track position of subtype_marks or names within the original
+   --  use_clause.
+
+   procedure P_Use_Package_Clause (Item_List : List_Id);
+   procedure P_Use_Type_Clause    (Item_List : List_Id);
+
+   -----------------------
+   -- Append_Use_Clause --
+   -----------------------
+
+   procedure Append_Use_Clause
+     (Item_List : List_Id;
+      Use_Node  : Node_Id;
+      Is_First  : in out Boolean;
+      Is_Last   : in out Boolean)
+   is
+   begin
+      if Token /= Tok_Comma then
+         if not Is_First then
+            Set_Prev_Ids (Use_Node);
+         end if;
+
+         Append (Use_Node, Item_List);
+         Is_Last := True;
+      else
+         Set_More_Ids (Use_Node);
+
+         if not Is_First then
+            Set_Prev_Ids (Use_Node);
+         else
+            Is_First := False;
+         end if;
+
+         Append (Use_Node, Item_List);
+         Scan; --  Past comma
+      end if;
+   end Append_Use_Clause;
 
    ---------------------
    -- 8.4  Use Clause --
@@ -47,14 +89,14 @@ package body Ch8 is
 
    --  Error recovery: cannot raise Error_Resync
 
-   function P_Use_Clause return Node_Id is
+   procedure P_Use_Clause (Item_List : List_Id) is
    begin
       Scan; -- past USE
 
       if Token = Tok_Type or else Token = Tok_All then
-         return P_Use_Type_Clause;
+         P_Use_Type_Clause (Item_List);
       else
-         return P_Use_Package_Clause;
+         P_Use_Package_Clause (Item_List);
       end if;
    end P_Use_Clause;
 
@@ -68,26 +110,32 @@ package body Ch8 is
 
    --  Error recovery: cannot raise Error_Resync
 
-   function P_Use_Package_Clause return Node_Id is
+   procedure P_Use_Package_Clause (Item_List : List_Id) is
+      Is_First : Boolean := True;
+      Is_Last  : Boolean := False;
       Use_Node : Node_Id;
+      Use_Sloc : constant Source_Ptr := Prev_Token_Ptr;
 
    begin
-      Use_Node := New_Node (N_Use_Package_Clause, Prev_Token_Ptr);
-      Set_Names (Use_Node, New_List);
-
       if Token = Tok_Package then
          Error_Msg_SC ("PACKAGE should not appear here");
-         Scan; -- past PACKAGE
+         Scan; --  Past PACKAGE
       end if;
 
+      --  Loop through names in a single use_package_clause, generating an
+      --  N_Use_Package_Clause node for each name encountered.
+
       loop
-         Append (P_Qualified_Simple_Name, Names (Use_Node));
-         exit when Token /= Tok_Comma;
-         Scan; -- past comma
+         Use_Node := New_Node (N_Use_Package_Clause, Use_Sloc);
+         Set_Name (Use_Node, P_Qualified_Simple_Name);
+
+         --  Locally chain each name's use-package node
+
+         Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last);
+         exit when Is_Last;
       end loop;
 
       TF_Semicolon;
-      return Use_Node;
    end P_Use_Package_Clause;
 
    --------------------------
@@ -103,45 +151,53 @@ package body Ch8 is
 
    --  Error recovery: cannot raise Error_Resync
 
-   function P_Use_Type_Clause return Node_Id is
-      Use_Node    : Node_Id;
+   procedure P_Use_Type_Clause (Item_List : List_Id) is
       All_Present : Boolean;
+      Is_First    : Boolean := True;
+      Is_Last     : Boolean := False;
+      Use_Node    : Node_Id;
       Use_Sloc    : constant Source_Ptr := Prev_Token_Ptr;
 
    begin
       if Token = Tok_All then
          Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr);
          All_Present := True;
-         Scan; -- past ALL
+         Scan; --  Past ALL
 
          if Token /= Tok_Type then
             Error_Msg_SC ("TYPE expected");
          end if;
 
-      else pragma Assert (Token = Tok_Type);
+      else
+         pragma Assert (Token = Tok_Type);
          All_Present := False;
       end if;
 
-      Use_Node := New_Node (N_Use_Type_Clause, Use_Sloc);
-      Set_All_Present (Use_Node, All_Present);
-      Set_Subtype_Marks (Use_Node, New_List);
-      Set_Used_Operations (Use_Node, No_Elist);
-
       if Ada_Version = Ada_83 then
          Error_Msg_SC ("(Ada 83) use type not allowed!");
       end if;
 
-      Scan; -- past TYPE
+      Scan; --  Past TYPE
+
+      --  Loop through subtype_marks in one use_type_clause, generating a
+      --  separate N_Use_Type_Clause node for each subtype_mark encountered.
 
       loop
-         Append (P_Subtype_Mark, Subtype_Marks (Use_Node));
+         Use_Node := New_Node (N_Use_Type_Clause, Use_Sloc);
+         Set_All_Present (Use_Node, All_Present);
+         Set_Used_Operations (Use_Node, No_Elist);
+
+         Set_Subtype_Mark (Use_Node, P_Subtype_Mark);
+
          No_Constraint;
-         exit when Token /= Tok_Comma;
-         Scan; -- past comma
+
+         --  Locally chain each subtype_mark's use-type node
+
+         Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last);
+         exit when Is_Last;
       end loop;
 
       TF_Semicolon;
-      return Use_Node;
    end P_Use_Type_Clause;
 
    -------------------------------
@@ -163,9 +219,9 @@ package body Ch8 is
 
    --  Parsed by P_Identifier_Declarations (3.3.1)
 
-   ----------------------------------------
+   -------------------------------------------
    -- 8.5.2  Exception Renaming Declaration --
-   ----------------------------------------
+   -------------------------------------------
 
    --  Parsed by P_Identifier_Declarations (3.3.1)
 
index 41459078421b196c93cff6877ead868f74c18467..280d8a1d1c0a5c50e8dfc32fdfda2edbd98edbff 100644 (file)
@@ -867,7 +867,7 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
    -------------
 
    package Ch8 is
-      function P_Use_Clause                           return Node_Id;
+      procedure P_Use_Clause (Item_List : List_Id);
    end Ch8;
 
    -------------
index c4200907f20705c2cd05589451dd757b553b61e6..fa8a7a868c81eb809b7280141304d83f635d0f1b 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2009-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2009-2017, 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- --
@@ -23,9 +23,9 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Namet; use Namet;
-with Opt;   use Opt;
-with SCOs;  use SCOs;
+with Namet;
+with Opt;
+with SCOs; use SCOs;
 
 procedure Put_SCOs is
    Current_SCO_Unit : SCO_Unit_Index := 0;
index a62c48b3798ba45fb95e545e030f65e38fba3c91..630d592f2be885e0c246131a1e860a7ca0bb752e 100644 (file)
@@ -29,7 +29,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Alloc;   use Alloc;
+with Alloc;
 with Atree;   use Atree;
 with Casing;  use Casing;
 with Debug;   use Debug;
@@ -45,7 +45,7 @@ with Sinput;  use Sinput;
 with Snames;  use Snames;
 with Stand;   use Stand;
 with Stringt; use Stringt;
-with Table;   use Table;
+with Table;
 with Uname;   use Uname;
 with Urealp;  use Urealp;
 
index 8bedff6c61ca1d05601e37be55c971193261c9d6..e3af27d31f4b61a55e9364469e9d189aad4948c1 100644 (file)
@@ -30,7 +30,7 @@ with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
-with Exp_Dist; use Exp_Dist;
+with Exp_Dist;
 with Fname;    use Fname;
 with Fname.UF; use Fname.UF;
 with Ghost;    use Ghost;
index 77ebadc49a98f7157ed2dc73cb95e71a14d422b5..10e4ad3cc89be13a6198d1b58e6f75bae5e08404 100644 (file)
@@ -29,7 +29,7 @@
 with Casing; use Casing;
 with Errout; use Errout;
 with Scng;
-with Style;  use Style;
+with Style;  --  use Style;
 with Types;  use Types;
 
 package Scn is
index 35d0d482bbe886abe8aa7c5c7121840a90eb53e2..e121e5969130f1b86bf59ab9639d2fb36295190c 100644 (file)
@@ -732,6 +732,18 @@ package body Sem is
 
       Debug_A_Exit ("analyzing  ", N, "  (done)");
 
+      --  Mark relevant use-type and use-package clauses as effective using the
+      --  original node, because constant folding may have occurred and removed
+      --  references that need to be examined. If the node in question is
+      --  overloaded then this is deferred until resolution.
+
+      if Nkind (Original_Node (N)) in N_Op
+        and then Present (Entity (Original_Node (N)))
+        and then not Is_Overloaded (Original_Node (N))
+      then
+         Mark_Use_Clauses (Original_Node (N));
+      end if;
+
       --  Now that we have analyzed the node, we call the expander to perform
       --  possible expansion. We skip this for subexpressions, because we don't
       --  have the type yet, and the expander will need to know the type before
index 0930e8f23cd0c17474ddf2d3b7606a8d96e10f77..5bedc6c8c128ef6b6fd85c9b8f9dba8276b92f9c 100644 (file)
@@ -47,7 +47,7 @@ with Opt;      use Opt;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
-with Sdefault; use Sdefault;
+with Sdefault;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Cat;  use Sem_Cat;
@@ -11797,6 +11797,15 @@ package body Sem_Attr is
             end if;
       end case;
 
+      --  Mark use clauses of the original prefix if the attribute is applied
+      --  to an entity.
+
+      if Nkind (Original_Node (P)) in N_Has_Entity
+        and then Present (Entity (Original_Node (P)))
+      then
+         Mark_Use_Clauses (Original_Node (P));
+      end if;
+
       --  Normally the Freezing is done by Resolve but sometimes the Prefix
       --  is not resolved, in which case the freezing must be done now.
 
index 2ab9ef6199bf346d1dd03a5f6e41e5cc3e29df2b..7da7b41985c121ecb0eebcac757b918596630d5e 100644 (file)
@@ -38,7 +38,7 @@
 --  content of entities in the tree, so this package is used for routines that
 --  require more than minimal semantic knowledge.
 
-with Alloc; use Alloc;
+with Alloc;
 with Namet; use Namet;
 with Table;
 with Types; use Types;
index 6da229cfc590c56064b7df5100380ef7688e6130..b89d8d32008f4880f4e7aada9cb038c66aab9c76 100644 (file)
@@ -138,9 +138,12 @@ package body Sem_Ch10 is
    --  Check that the shadow entity is not already in the homonym chain, for
    --  example through a limited_with clause in a parent unit.
 
-   procedure Install_Context_Clauses (N : Node_Id);
+   procedure Install_Context_Clauses (N : Node_Id; Chain : Boolean := True);
    --  Subsidiary to Install_Context and Install_Parents. Process all with
-   --  and use clauses for current unit and its library unit if any.
+   --  and use clauses for current unit and its library unit if any. The flag
+   --  Chain is used to control the "chaining" or linking together of use-type
+   --  and use-package clauses to avoid circularities with reinstalling
+   --  clauses.
 
    procedure Install_Limited_Context_Clauses (N : Node_Id);
    --  Subsidiary to Install_Context. Process only limited with_clauses for
@@ -159,7 +162,8 @@ package body Sem_Ch10 is
    --  is called when compiling the private part of a package, or installing
    --  the private declarations of a parent unit.
 
-   procedure Install_Parents (Lib_Unit : Node_Id; Is_Private : Boolean);
+   procedure Install_Parents
+     (Lib_Unit : Node_Id; Is_Private : Boolean; Chain : Boolean := True);
    --  This procedure establishes the context for the compilation of a child
    --  unit. If Lib_Unit is a child library spec then the context of the parent
    --  is installed, and the parent itself made immediately visible, so that
@@ -168,7 +172,9 @@ package body Sem_Ch10 is
    --  parents are loaded in the nested case. If Lib_Unit is a library body,
    --  the only effect of Install_Parents is to install the private decls of
    --  the parents, because the visible parent declarations will have been
-   --  installed as part of the context of the corresponding spec.
+   --  installed as part of the context of the corresponding spec. The flag
+   --  Chain is used to control the "chaining" or linking of use-type and
+   --  use-package clauses to avoid circularities when installing context.
 
    procedure Install_Siblings (U_Name : Entity_Id; N : Node_Id);
    --  In the compilation of a child unit, a child of any of the  ancestor
@@ -342,53 +348,45 @@ package body Sem_Ch10 is
                then
                   --  Search through use clauses
 
-                  Use_Item := First (Names (Cont_Item));
-                  while Present (Use_Item) and then not Used loop
+                  Use_Item := Name (Cont_Item);
 
-                     --  Case of a direct use of the one we are looking for
+                  --  Case of a direct use of the one we are looking for
 
-                     if Entity (Use_Item) = Nam_Ent then
-                        Used := True;
+                  if Entity (Use_Item) = Nam_Ent then
+                     Used := True;
 
-                     --  Handle nested case, as in "with P; use P.Q.R"
+                  --  Handle nested case, as in "with P; use P.Q.R"
 
-                     else
-                        declare
-                           UE : Node_Id;
-
-                        begin
-                           --  Loop through prefixes looking for match
+                  else
+                     declare
+                        UE : Node_Id;
 
-                           UE := Use_Item;
-                           while Nkind (UE) = N_Expanded_Name loop
-                              if Same_Unit (Prefix (UE), Nam_Ent) then
-                                 Used := True;
-                                 exit;
-                              end if;
+                     begin
+                        --  Loop through prefixes looking for match
 
-                              UE := Prefix (UE);
-                           end loop;
-                        end;
-                     end if;
+                        UE := Use_Item;
+                        while Nkind (UE) = N_Expanded_Name loop
+                           if Same_Unit (Prefix (UE), Nam_Ent) then
+                              Used := True;
+                              exit;
+                           end if;
 
-                     Next (Use_Item);
-                  end loop;
+                           UE := Prefix (UE);
+                        end loop;
+                     end;
+                  end if;
 
                --  USE TYPE clause
 
                elsif Nkind (Cont_Item) = N_Use_Type_Clause
                  and then not Used_Type_Or_Elab
                then
-                  Subt_Mark := First (Subtype_Marks (Cont_Item));
-                  while Present (Subt_Mark)
-                    and then not Used_Type_Or_Elab
-                  loop
-                     if Same_Unit (Prefix (Subt_Mark), Nam_Ent) then
-                        Used_Type_Or_Elab := True;
-                     end if;
-
-                     Next (Subt_Mark);
-                  end loop;
+                  Subt_Mark := Subtype_Mark (Cont_Item);
+                  if not Used_Type_Or_Elab
+                    and then Same_Unit (Prefix (Subt_Mark), Nam_Ent)
+                  then
+                     Used_Type_Or_Elab := True;
+                  end if;
 
                --  Pragma Elaborate or Elaborate_All
 
@@ -426,7 +424,6 @@ package body Sem_Ch10 is
          is
             Nam_Ent   : constant Entity_Id := Entity (Name (Clause));
             Cont_Item : Node_Id;
-            Use_Item  : Node_Id;
 
          begin
             Used := False;
@@ -450,14 +447,9 @@ package body Sem_Ch10 is
                if Nkind (Cont_Item) = N_Use_Package_Clause
                  and then not Used
                then
-                  Use_Item := First (Names (Cont_Item));
-                  while Present (Use_Item) and then not Used loop
-                     if Entity (Use_Item) = Nam_Ent then
-                        Used := True;
-                     end if;
-
-                     Next (Use_Item);
-                  end loop;
+                  if Entity (Name (Cont_Item)) = Nam_Ent then
+                     Used := True;
+                  end if;
 
                --  Package with clause. Avoid processing self, implicitly
                --  generated with clauses or limited with clauses. Note that
@@ -2103,7 +2095,6 @@ package body Sem_Ch10 is
 
       procedure Analyze_Subunit_Context is
          Item      :  Node_Id;
-         Nam       :  Node_Id;
          Unit_Name : Entity_Id;
 
       begin
@@ -2154,18 +2145,10 @@ package body Sem_Ch10 is
                end if;
 
             elsif Nkind (Item) = N_Use_Package_Clause then
-               Nam := First (Names (Item));
-               while Present (Nam) loop
-                  Analyze (Nam);
-                  Next (Nam);
-               end loop;
+               Analyze (Name (Item));
 
             elsif Nkind (Item) = N_Use_Type_Clause then
-               Nam := First (Subtype_Marks (Item));
-               while Present (Nam) loop
-                  Analyze (Nam);
-                  Next (Nam);
-               end loop;
+               Analyze (Subtype_Mark (Item));
             end if;
 
             Next (Item);
@@ -2212,7 +2195,7 @@ package body Sem_Ch10 is
             Re_Install_Parents (Library_Unit (L), Scope (Scop));
          end if;
 
-         Install_Context (L);
+         Install_Context (L, False);
 
          --  If the subunit occurs within a child unit, we must restore the
          --  immediate visibility of any siblings that may occur in context.
@@ -2259,7 +2242,7 @@ package body Sem_Ch10 is
          for J in reverse 1 .. Num_Scopes loop
             U := Use_Clauses (J);
             Scope_Stack.Table (Scope_Stack.Last - J + 1).First_Use_Clause := U;
-            Install_Use_Clauses (U, Force_Installation => True);
+            Install_Use_Clauses (U);
          end loop;
       end Re_Install_Use_Clauses;
 
@@ -2383,7 +2366,7 @@ package body Sem_Ch10 is
          end if;
 
          Re_Install_Use_Clauses;
-         Install_Context (N);
+         Install_Context (N, Chain => False);
 
          --  Restore state of suppress flags for current body
 
@@ -3399,14 +3382,15 @@ package body Sem_Ch10 is
    -- Install_Context --
    ---------------------
 
-   procedure Install_Context (N : Node_Id) is
+   procedure Install_Context (N : Node_Id; Chain : Boolean := True) is
       Lib_Unit : constant Node_Id := Unit (N);
 
    begin
-      Install_Context_Clauses (N);
+      Install_Context_Clauses (N, Chain);
 
       if Is_Child_Spec (Lib_Unit) then
-         Install_Parents (Lib_Unit, Private_Present (Parent (Lib_Unit)));
+         Install_Parents
+           (Lib_Unit, Private_Present (Parent (Lib_Unit)), Chain);
       end if;
 
       Install_Limited_Context_Clauses (N);
@@ -3416,7 +3400,7 @@ package body Sem_Ch10 is
    -- Install_Context_Clauses --
    -----------------------------
 
-   procedure Install_Context_Clauses (N : Node_Id) is
+   procedure Install_Context_Clauses (N : Node_Id; Chain : Boolean := True) is
       Lib_Unit      : constant Node_Id := Unit (N);
       Item          : Node_Id;
       Uname_Node    : Entity_Id;
@@ -3567,12 +3551,12 @@ package body Sem_Ch10 is
          --  Case of USE PACKAGE clause
 
          elsif Nkind (Item) = N_Use_Package_Clause then
-            Analyze_Use_Package (Item);
+            Analyze_Use_Package (Item, Chain);
 
          --  Case of USE TYPE clause
 
          elsif Nkind (Item) = N_Use_Type_Clause then
-            Analyze_Use_Type (Item);
+            Analyze_Use_Type (Item, Chain);
 
          --  case of PRAGMA
 
@@ -3602,7 +3586,7 @@ package body Sem_Ch10 is
         or else (Nkind (Lib_Unit) = N_Subprogram_Body
                   and then not Acts_As_Spec (N))
       then
-         Install_Context (Library_Unit (N));
+         Install_Context (Library_Unit (N), Chain);
 
          --  Only install private with-clauses of a spec that comes from
          --  source, excluding specs created for a subprogram body that is
@@ -3716,7 +3700,6 @@ package body Sem_Ch10 is
          Item   : Node_Id;
          Spec   : Node_Id;
          WEnt   : Entity_Id;
-         Nam    : Node_Id;
          E      : Entity_Id;
          E2     : Entity_Id;
 
@@ -3749,43 +3732,36 @@ package body Sem_Ch10 is
 
             if Nkind (Item) = N_Use_Package_Clause then
 
-               --  Traverse the list of packages
+               E := Entity (Name (Item));
 
-               Nam := First (Names (Item));
-               while Present (Nam) loop
-                  E := Entity (Nam);
+               pragma Assert (Present (Parent (E)));
 
-                  pragma Assert (Present (Parent (E)));
-
-                  if Nkind (Parent (E)) = N_Package_Renaming_Declaration
-                    and then Renamed_Entity (E) = WEnt
-                  then
-                     --  The unlimited view is visible through use clause and
-                     --  renamings. There is no need to generate the error
-                     --  message here because Is_Visible_Through_Renamings
-                     --  takes care of generating the precise error message.
+               if Nkind (Parent (E)) = N_Package_Renaming_Declaration
+                 and then Renamed_Entity (E) = WEnt
+               then
+                  --  The unlimited view is visible through use clause and
+                  --  renamings. There is no need to generate the error
+                  --  message here because Is_Visible_Through_Renamings
+                  --  takes care of generating the precise error message.
 
-                     return;
+                  return;
 
-                  elsif Nkind (Parent (E)) = N_Package_Specification then
+               elsif Nkind (Parent (E)) = N_Package_Specification then
 
-                     --  The use clause may refer to a local package.
-                     --  Check all the enclosing scopes.
+                  --  The use clause may refer to a local package.
+                  --  Check all the enclosing scopes.
 
-                     E2 := E;
-                     while E2 /= Standard_Standard and then E2 /= WEnt loop
-                        E2 := Scope (E2);
-                     end loop;
+                  E2 := E;
+                  while E2 /= Standard_Standard and then E2 /= WEnt loop
+                     E2 := Scope (E2);
+                  end loop;
 
-                     if E2 = WEnt then
-                        Error_Msg_N
-                          ("unlimited view visible through use clause ", W);
-                        return;
-                     end if;
+                  if E2 = WEnt then
+                     Error_Msg_N
+                       ("unlimited view visible through use clause ", W);
+                     return;
                   end if;
-
-                  Next (Nam);
-               end loop;
+               end if;
             end if;
 
             Next (Item);
@@ -4088,7 +4064,8 @@ package body Sem_Ch10 is
    -- Install_Parents --
    ---------------------
 
-   procedure Install_Parents (Lib_Unit : Node_Id; Is_Private : Boolean) is
+   procedure Install_Parents
+     (Lib_Unit : Node_Id; Is_Private : Boolean; Chain : Boolean := True) is
       P      : Node_Id;
       E_Name : Entity_Id;
       P_Name : Entity_Id;
@@ -4145,12 +4122,12 @@ package body Sem_Ch10 is
 
       if Is_Child_Spec (P) then
          Install_Parents (P,
-           Is_Private or else Private_Present (Parent (Lib_Unit)));
+           Is_Private or else Private_Present (Parent (Lib_Unit)), Chain);
       end if;
 
       --  Now we can install the context for this parent
 
-      Install_Context_Clauses (Parent_Spec (Lib_Unit));
+      Install_Context_Clauses (Parent_Spec (Lib_Unit), Chain);
       Install_Limited_Context_Clauses (Parent_Spec (Lib_Unit));
       Install_Siblings (P_Name, Parent (Lib_Unit));
 
index d4b28cde8af07cb93e136d25d308413f081fd796..2843d9e52fb83b754e3788ff0ede42bc195ce26e 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -34,10 +34,12 @@ package Sem_Ch10 is
    procedure Analyze_Protected_Body_Stub                (N : Node_Id);
    procedure Analyze_Subunit                            (N : Node_Id);
 
-   procedure Install_Context (N : Node_Id);
+   procedure Install_Context (N : Node_Id; Chain : Boolean := True);
    --  Installs the entities from the context clause of the given compilation
    --  unit into the visibility chains. This is done before analyzing a unit.
-   --  For a child unit, install context of parents as well.
+   --  For a child unit, install context of parents as well. The flag Chain is
+   --  used to control the "chaining" or linking of use-type and use-package
+   --  clauses to avoid circularities when reinstalling context clauses.
 
    procedure Install_Private_With_Clauses (P : Entity_Id);
    --  Install the private with_clauses of a compilation unit, when compiling
index 44dc80100ad54169f11e902fa4addb2125505d12..ec270f3ad1925e017011f696cc6f18815a9dba89 100644 (file)
@@ -4840,7 +4840,7 @@ package body Sem_Ch12 is
          end loop;
 
          if Removed then
-            Install_Context (Curr_Comp);
+            Install_Context (Curr_Comp, Chain => False);
 
             if Present (Curr_Scope)
               and then Is_Child_Unit (Curr_Scope)
index 04ed408f45c1845855b6fddea39d9beddab046be..79b22cd54b5d03ec974cad3cee46398386ff5386 100644 (file)
@@ -2264,13 +2264,29 @@ package body Sem_Ch13 is
                      end if;
                   end if;
 
-                  --  Construct the attribute definition clause
-
-                  Aitem :=
-                    Make_Attribute_Definition_Clause (Loc,
-                      Name       => Ent,
-                      Chars      => Chars (Id),
-                      Expression => Relocate_Node (Expr));
+                  --  Construct the attribute_definition_clause. The expression
+                  --  in the aspect specification is simply shared with the
+                  --  constructed attribute, because it will be fully analyzed
+                  --  when the attribute is processed. However, in ASIS mode
+                  --  the aspect expression itself is preanalyzed and resolved
+                  --  to catch visibility errors that are otherwise caught
+                  --  later, and we create a separate copy of the expression
+                  --  to prevent analysis of a malformed tree (e.g. a function
+                  --  call with parameter associations).
+
+                  if ASIS_Mode then
+                     Aitem :=
+                       Make_Attribute_Definition_Clause (Loc,
+                         Name       => Ent,
+                         Chars      => Chars (Id),
+                         Expression => New_Copy_Tree (Expr));
+                  else
+                     Aitem :=
+                       Make_Attribute_Definition_Clause (Loc,
+                         Name       => Ent,
+                         Chars      => Chars (Id),
+                         Expression => Relocate_Node (Expr));
+                  end if;
 
                   --  If the address is specified, then we treat the entity as
                   --  referenced, to avoid spurious warnings. This is analogous
index 28da82303caa3879c650a1df98b9caec4c0da1b6..8801fb750bad15b54eb0600d40686c7b204035d7 100644 (file)
@@ -6477,9 +6477,17 @@ package body Sem_Ch4 is
       --------------------
 
       procedure Try_One_Interp (T1 : Entity_Id) is
-         Bas : constant Entity_Id := Base_Type (T1);
+         Bas : Entity_Id;
 
       begin
+         --  Perform a sanity check in case of previous errors
+
+         if No (T1) then
+            return;
+         end if;
+
+         Bas := Base_Type (T1);
+
          --  If the operator is an expanded name, then the type of the operand
          --  must be defined in the corresponding scope. If the type is
          --  universal, the context will impose the correct type. An anonymous
index d33d59ab8c0b650ccc740925dcaea990693c6558..e3aa50b2ddd2f0aa363bdd10feb77ef03d503039 100644 (file)
@@ -1132,6 +1132,7 @@ package body Sem_Ch5 is
          end if;
 
          Check_References (Ent);
+         Update_Use_Clause_Chain;
          End_Scope;
 
          if Unblocked_Exit_Count = 0 then
index 468c112d01ec6f7d6da43af8d015437ec386d749..9ef0acaaf498229ba7ec4e23e2ca5e42d56dd48d 100644 (file)
@@ -1498,6 +1498,7 @@ package body Sem_Ch6 is
       end;
 
       Process_End_Label (Handled_Statement_Sequence (N), 't', Current_Scope);
+      Update_Use_Clause_Chain;
       End_Scope;
       Check_Subprogram_Order (N);
 
@@ -4357,6 +4358,7 @@ package body Sem_Ch6 is
       --  Deal with end of scope processing for the body
 
       Process_End_Label (HSS, 't', Current_Scope);
+      Update_Use_Clause_Chain;
       End_Scope;
 
       --  If we are compiling an entry wrapper, remove the enclosing
index 030d4f09a7c3f6daafe5fdec412da423fbabfcf9..ba7ff3c848cd3ad1bc4cc05269e54d032a395d87 100644 (file)
@@ -945,6 +945,7 @@ package body Sem_Ch7 is
          Set_Last_Entity  (Spec_Id, Empty);
       end if;
 
+      Update_Use_Clause_Chain;
       End_Package_Scope (Spec_Id);
 
       --  All entities declared in body are not visible
@@ -1796,6 +1797,18 @@ package body Sem_Ch7 is
       then
          Unit_Requires_Body_Info (Id);
       end if;
+
+      --  Nested package specs that do not require bodies are not checked for
+      --  ineffective use clauses due to the possbility of subunits. This is
+      --  because at this stage it is impossible to tell whether there will be
+      --  a separate body.
+
+      if not Unit_Requires_Body (Id)
+        and then Is_Compilation_Unit (Id)
+        and then not Is_Private_Descendant (Id)
+      then
+         Update_Use_Clause_Chain;
+      end if;
    end Analyze_Package_Specification;
 
    --------------------------------------
index 89478415bd417f5b52d4ef2fe63dbefe4860318a..d86818abd490c0adebc794ded8291328a93a2eee 100644 (file)
@@ -65,7 +65,7 @@ with Stand;    use Stand;
 with Sinfo;    use Sinfo;
 with Sinfo.CN; use Sinfo.CN;
 with Snames;   use Snames;
-with Style;    use Style;
+with Style;
 with Table;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
@@ -402,11 +402,6 @@ package body Sem_Ch8 is
    --  The renaming operation is intrinsic because the compiler must in
    --  fact generate a wrapper for it (6.3.1 (10 1/2)).
 
-   function Applicable_Use (Pack_Name : Node_Id) return Boolean;
-   --  Common code to Use_One_Package and Set_Use, to determine whether use
-   --  clause must be processed. Pack_Name is an entity name that references
-   --  the package in question.
-
    procedure Attribute_Renaming (N : Node_Id);
    --  Analyze renaming of attribute as subprogram. The renaming declaration N
    --  is rewritten as a subprogram body that returns the attribute reference
@@ -469,19 +464,21 @@ package body Sem_Ch8 is
    --  but is a reasonable heuristic on the use of nested generics. The
    --  proper solution requires a full renaming model.
 
-   function Has_Implicit_Character_Literal (N : Node_Id) return Boolean;
-   --  Find a type derived from Character or Wide_Character in the prefix of N.
-   --  Used to resolved qualified names whose selector is a character literal.
-
-   function Has_Private_With (E : Entity_Id) return Boolean;
-   --  Ada 2005 (AI-262): Determines if the current compilation unit has a
-   --  private with on E.
+   function Entity_Of_Unit (U : Node_Id) return Entity_Id;
+   --  Return the appropriate entity for determining which unit has a deeper
+   --  scope: the defining entity for U, unless U is a package instance, in
+   --  which case we retrieve the entity of the instance spec.
 
    procedure Find_Expanded_Name (N : Node_Id);
    --  The input is a selected component known to be an expanded name. Verify
    --  legality of selector given the scope denoted by prefix, and change node
    --  N into a expanded name with a properly set Entity field.
 
+   function Find_Most_Prev (Use_Clause : Node_Id) return Node_Id;
+   --  Find the most previous use clause (that is, the first one to appear in
+   --  the source) by traversing the previous clause chain that exists in both
+   --  N_Use_Package_Clause nodes and N_Use_Type_Clause nodes.
+
    function Find_Renamed_Entity
      (N         : Node_Id;
       Nam       : Node_Id;
@@ -493,6 +490,14 @@ package body Sem_Ch8 is
    --  indicates that the renaming is the one generated for an actual subpro-
    --  gram in an instance, for which special visibility checks apply.
 
+   function Has_Implicit_Character_Literal (N : Node_Id) return Boolean;
+   --  Find a type derived from Character or Wide_Character in the prefix of N.
+   --  Used to resolved qualified names whose selector is a character literal.
+
+   function Has_Private_With (E : Entity_Id) return Boolean;
+   --  Ada 2005 (AI-262): Determines if the current compilation unit has a
+   --  private with on E.
+
    function Has_Implicit_Operator (N : Node_Id) return Boolean;
    --  N is an expanded name whose selector is an operator name (e.g. P."+").
    --  declarative part contains an implicit declaration of an operator if it
@@ -507,30 +512,33 @@ package body Sem_Ch8 is
    --  specification are discarded and replaced with those of the renamed
    --  subprogram, which are then used to recheck the default values.
 
-   function Is_Appropriate_For_Record (T : Entity_Id) return Boolean;
-   --  Prefix is appropriate for record if it is of a record type, or an access
-   --  to such.
-
    function Is_Appropriate_For_Entry_Prefix (T : Entity_Id) return Boolean;
    --  True if it is of a task type, a protected type, or else an access to one
    --  of these types.
 
-   procedure Note_Redundant_Use (Clause : Node_Id);
-   --  Mark the name in a use clause as redundant if the corresponding entity
-   --  is already use-visible. Emit a warning if the use clause comes from
-   --  source and the proper warnings are enabled.
+   function Is_Appropriate_For_Record (T : Entity_Id) return Boolean;
+   --  Prefix is appropriate for record if it is of a record type, or an access
+   --  to such.
+
+   function Most_Descendant_Use_Clause
+     (Clause1 : Entity_Id;
+      Clause2 : Entity_Id) return Entity_Id;
+   --  Determine which use clause parameter is the most descendant in terms of
+   --  scope.
 
    procedure Premature_Usage (N : Node_Id);
    --  Diagnose usage of an entity before it is visible
 
-   procedure Use_One_Package (P : Entity_Id; N : Node_Id);
+   procedure Use_One_Package
+     (N : Node_Id; Pack_Name : Entity_Id := Empty; Force : Boolean := False);
    --  Make visible entities declared in package P potentially use-visible
    --  in the current context. Also used in the analysis of subunits, when
    --  re-installing use clauses of parent units. N is the use_clause that
    --  names P (and possibly other packages).
 
-   procedure Use_One_Type (Id : Node_Id; Installed : Boolean := False);
-   --  Id is the subtype mark from a use type clause. This procedure makes
+   procedure Use_One_Type
+     (Id : Node_Id; Installed : Boolean := False; Force : Boolean := False);
+   --  Id is the subtype mark from a use_type_clause. This procedure makes
    --  the primitive operators of the type potentially use-visible. The
    --  boolean flag Installed indicates that the clause is being reinstalled
    --  after previous analysis, and primitive operations are already chained
@@ -3437,7 +3445,7 @@ package body Sem_Ch8 is
          --  addition the renamed entity may depend on the generic formals of
          --  the enclosing generic.
 
-         if Is_Actual and then not Inside_A_Generic then
+         if Is_Actual and not Inside_A_Generic then
             Freeze_Before (N, Old_S);
             Freeze_Actual_Profile;
             Set_Has_Delayed_Freeze (New_S, False);
@@ -3624,6 +3632,25 @@ package body Sem_Ch8 is
             Analyze (N);
          end if;
       end if;
+
+      --  Check if we are looking at an Ada 2012 defaulted formal subprogram
+      --  and mark any use_package_clauses that affect the visibility of the
+      --  implicit generic actual.
+
+      if From_Default (N)
+           and then Is_Generic_Actual_Subprogram (New_S)
+           and then Present (Alias (New_S))
+      then
+         Mark_Use_Clauses (Alias (New_S));
+
+      --  Check intrinsic operators used as generic actuals since they may
+      --  make a use_type_clause effective.
+
+      elsif Is_Generic_Actual_Subprogram (New_S)
+        and then Is_Intrinsic_Subprogram (New_S)
+      then
+         Mark_Use_Clauses (New_S);
+      end if;
    end Analyze_Subprogram_Renaming;
 
    -------------------------
@@ -3637,11 +3664,78 @@ package body Sem_Ch8 is
    --  use. If the package is an open scope, i.e. if the use clause occurs
    --  within the package itself, ignore it.
 
-   procedure Analyze_Use_Package (N : Node_Id) is
+   procedure Analyze_Use_Package (N : Node_Id; Chain : Boolean := True) is
+
+      procedure Analyze_Package_Name (Clause : Node_Id);
+      --  Perform analysis on a package name from a use_package_clause
+
+      procedure Analyze_Package_Name_List (Head_Clause : Node_Id);
+      --  Similar to Analyze_Package_Name but iterates over all the names
+      --  in a use clause.
+
+      --------------------------
+      -- Analyze_Package_Name --
+      --------------------------
+
+      procedure Analyze_Package_Name (Clause : Node_Id) is
+         Pack : constant Node_Id := Name (Clause);
+         Pref : Node_Id;
+
+      begin
+         pragma Assert (Nkind (Clause) = N_Use_Package_Clause);
+         Analyze (Pack);
+
+         --  Verify that the package standard is not directly named in a
+         --  use_package_clause.
+
+         if Nkind (Parent (Clause)) = N_Compilation_Unit
+           and then Nkind (Pack) = N_Expanded_Name
+         then
+            Pref := Prefix (Pack);
+
+            while Nkind (Pref) = N_Expanded_Name loop
+               Pref := Prefix (Pref);
+            end loop;
+
+            if Entity (Pref) = Standard_Standard then
+               Error_Msg_N
+                 ("predefined package Standard cannot appear in a "
+                  & "context clause", Pref);
+            end if;
+         end if;
+      end Analyze_Package_Name;
+
+      -------------------------------
+      -- Analyze_Package_Name_List --
+      -------------------------------
+
+      procedure Analyze_Package_Name_List (Head_Clause : Node_Id) is
+         Curr : Node_Id;
+
+      begin
+         --  Due to the way source use clauses are split during parsing we are
+         --  forced to simply iterate through all entities in scope until the
+         --  clause representing the last name in the list is found.
+
+         Curr := Head_Clause;
+         while Present (Curr) loop
+            Analyze_Package_Name (Curr);
+
+            --  Stop iterating over the names in the use clause when we are at
+            --  the last one.
+
+            exit when not More_Ids (Curr) and then Prev_Ids (Curr);
+            Next (Curr);
+         end loop;
+      end Analyze_Package_Name_List;
+
+      --  Local variables
+
       Ghost_Id  : Entity_Id := Empty;
       Living_Id : Entity_Id := Empty;
       Pack      : Entity_Id;
-      Pack_Name : Node_Id;
+
+   --  Start of processing for Analyze_Use_Package
 
    begin
       Check_SPARK_05_Restriction ("use clause is not allowed", N);
@@ -3661,107 +3755,89 @@ package body Sem_Ch8 is
          Error_Msg_N ("use clause not allowed in predefined spec", N);
       end if;
 
-      --  Chain clause to list of use clauses in current scope
+      --  Loop through all package names from the original use clause in
+      --  order to analyze referenced packages. A use_package_clause with only
+      --  one name does not have More_Ids or Prev_Ids set, while a clause with
+      --  More_Ids only starts the chain produced by the parser.
 
-      if Nkind (Parent (N)) /= N_Compilation_Unit then
-         Chain_Use_Clause (N);
+      if not More_Ids (N) and then not Prev_Ids (N) then
+         Analyze_Package_Name (N);
+      elsif More_Ids (N) and then not Prev_Ids (N) then
+         Analyze_Package_Name_List (N);
       end if;
 
-      --  Loop through package names to identify referenced packages
-
-      Pack_Name := First (Names (N));
-      while Present (Pack_Name) loop
-         Analyze (Pack_Name);
-
-         if Nkind (Parent (N)) = N_Compilation_Unit
-           and then Nkind (Pack_Name) = N_Expanded_Name
-         then
-            declare
-               Pref : Node_Id;
-
-            begin
-               Pref := Prefix (Pack_Name);
-               while Nkind (Pref) = N_Expanded_Name loop
-                  Pref := Prefix (Pref);
-               end loop;
+      if not Is_Entity_Name (Name (N)) then
+         Error_Msg_N ("& is not a package", Name (N));
 
-               if Entity (Pref) = Standard_Standard then
-                  Error_Msg_N
-                    ("predefined package Standard cannot appear in a context "
-                     & "clause", Pref);
-               end if;
-            end;
-         end if;
+         return;
+      end if;
+      Pack := Entity (Name (N));
 
-         Next (Pack_Name);
-      end loop;
+      if Chain then
+         Chain_Use_Clause (N);
+      end if;
 
-      --  Loop through package names to mark all entities as potentially use
-      --  visible.
+      --  There are many cases where scopes are manipulated during analysis, so
+      --  check that Pack's current use clause has not already been chained
+      --  before setting its previous use clause.
 
-      Pack_Name := First (Names (N));
-      while Present (Pack_Name) loop
-         if Is_Entity_Name (Pack_Name) then
-            Pack := Entity (Pack_Name);
+      if Ekind (Pack) = E_Package
+         and then Present (Current_Use_Clause (Pack))
+         and then Current_Use_Clause (Pack) /= N
+         and then No (Prev_Use_Clause (N))
+      then
+         Set_Prev_Use_Clause (N, Current_Use_Clause (Pack));
+      end if;
 
-            if Ekind (Pack) /= E_Package and then Etype (Pack) /= Any_Type then
-               if Ekind (Pack) = E_Generic_Package then
-                  Error_Msg_N  -- CODEFIX
-                    ("a generic package is not allowed in a use clause",
-                     Pack_Name);
+      --  Mark all entities as potentially use visible.
 
-               elsif Ekind_In (Pack, E_Generic_Function, E_Generic_Package)
-               then
-                  Error_Msg_N  -- CODEFIX
-                    ("a generic subprogram is not allowed in a use clause",
-                     Pack_Name);
+      if Ekind (Pack) /= E_Package and then Etype (Pack) /= Any_Type then
+         if Ekind (Pack) = E_Generic_Package then
+            Error_Msg_N  -- CODEFIX
+              ("a generic package is not allowed in a use clause",
+               Name (N));
 
-               elsif Ekind_In (Pack, E_Function, E_Procedure, E_Operator) then
-                  Error_Msg_N  -- CODEFIX
-                    ("a subprogram is not allowed in a use clause",
-                     Pack_Name);
+         elsif Ekind_In (Pack, E_Generic_Function, E_Generic_Package)
+         then
+            Error_Msg_N  -- CODEFIX
+              ("a generic subprogram is not allowed in a use clause",
+               Name (N));
 
-               else
-                  Error_Msg_N ("& is not allowed in a use clause", Pack_Name);
-               end if;
+         elsif Ekind_In (Pack, E_Function, E_Procedure, E_Operator) then
+            Error_Msg_N  -- CODEFIX
+              ("a subprogram is not allowed in a use clause",
+               Name (N));
 
-            else
-               if Nkind (Parent (N)) = N_Compilation_Unit then
-                  Check_In_Previous_With_Clause (N, Pack_Name);
-               end if;
+         else
+            Error_Msg_N ("& is not allowed in a use clause", Name (N));
+         end if;
 
-               if Applicable_Use (Pack_Name) then
-                  Use_One_Package (Pack, N);
-               end if;
+      else
+         if Nkind (Parent (N)) = N_Compilation_Unit then
+            Check_In_Previous_With_Clause (N, Name (N));
+         end if;
 
-               --  Capture the first Ghost package and the first living package
+         Use_One_Package (N, Name (N));
 
-               if Is_Entity_Name (Pack_Name) then
-                  Pack := Entity (Pack_Name);
+         --  Capture the first Ghost package and the first living package
 
-                  if Is_Ghost_Entity (Pack) then
-                     if No (Ghost_Id) then
-                        Ghost_Id := Pack;
-                     end if;
+         if Is_Entity_Name (Name (N)) then
+            Pack := Entity (Name (N));
 
-                  elsif No (Living_Id) then
-                     Living_Id := Pack;
-                  end if;
+            if Is_Ghost_Entity (Pack) then
+               if No (Ghost_Id) then
+                  Ghost_Id := Pack;
                end if;
-            end if;
 
-         --  Report error because name denotes something other than a package
-
-         else
-            Error_Msg_N ("& is not a package", Pack_Name);
+            elsif No (Living_Id) then
+               Living_Id := Pack;
+            end if;
          end if;
-
-         Next (Pack_Name);
-      end loop;
+      end if;
 
       --  Detect a mixture of Ghost packages and living packages within the
-      --  same use package clause. Ideally one would split a use package clause
-      --  with multiple names into multiple use package clauses with a single
+      --  same use_package_clause. Ideally one would split a use_package_clause
+      --  with multiple names into multiple use_package_clauses with a single
       --  name, however clients of the front end would have to adapt to this
       --  change.
 
@@ -3783,21 +3859,39 @@ package body Sem_Ch8 is
    -- Analyze_Use_Type --
    ----------------------
 
-   procedure Analyze_Use_Type (N : Node_Id) is
-      E         : Entity_Id;
-      Ghost_Id  : Entity_Id := Empty;
-      Id        : Node_Id;
-      Living_Id : Entity_Id := Empty;
+   procedure Analyze_Use_Type (N : Node_Id; Chain : Boolean := True) is
+      E  : Entity_Id;
+      Id : Node_Id;
 
    begin
       Set_Hidden_By_Use_Clause (N, No_Elist);
 
-      --  Chain clause to list of use clauses in current scope
+      --  Chain clause to list of use clauses in current scope when flagged
 
-      if Nkind (Parent (N)) /= N_Compilation_Unit then
+      if Chain then
          Chain_Use_Clause (N);
       end if;
 
+      --  Obtain the base type of the type denoted within the use_type_clause's
+      --  subtype mark.
+
+      Id := Subtype_Mark (N);
+      Find_Type (Id);
+      E := Base_Type (Entity (Id));
+
+      --  There are many cases where a use_type_clause may be reanalyzed due to
+      --  manipulation of the scope stack so we much guard against those cases
+      --  here, otherwise, we must add the new use_type_clause to the previous
+      --  use_type_clause chain in order to mark redundant use_type_clauses as
+      --  used.
+
+      if Present (Current_Use_Clause (E))
+        and then Current_Use_Clause (E) /= N
+        and then No (Prev_Use_Clause (N))
+      then
+         Set_Prev_Use_Clause (N, Current_Use_Clause (E));
+      end if;
+
       --  If the Used_Operations list is already initialized, the clause has
       --  been analyzed previously, and it is being reinstalled, for example
       --  when the clause appears in a package spec and we are compiling the
@@ -3806,15 +3900,10 @@ package body Sem_Ch8 is
 
       if Present (Used_Operations (N)) then
          declare
-            Mark : Node_Id;
             Elmt : Elmt_Id;
 
          begin
-            Mark := First (Subtype_Marks (N));
-            while Present (Mark) loop
-               Use_One_Type (Mark, Installed => True);
-               Next (Mark);
-            end loop;
+            Use_One_Type (Subtype_Mark (N), Installed => True);
 
             Elmt := First_Elmt (Used_Operations (N));
             while Present (Elmt) loop
@@ -3830,133 +3919,69 @@ package body Sem_Ch8 is
       --  made use-visible by the clause.
 
       Set_Used_Operations (N, New_Elmt_List);
-      Id := First (Subtype_Marks (N));
-      while Present (Id) loop
-         Find_Type (Id);
-         E := Entity (Id);
-
-         if E /= Any_Type then
-            Use_One_Type (Id);
+      E := Entity (Id);
 
-            if Nkind (Parent (N)) = N_Compilation_Unit then
-               if Nkind (Id) = N_Identifier then
-                  Error_Msg_N ("type is not directly visible", Id);
+      if E /= Any_Type then
+         Use_One_Type (Id);
 
-               elsif Is_Child_Unit (Scope (E))
-                 and then Scope (E) /= System_Aux_Id
-               then
-                  Check_In_Previous_With_Clause (N, Prefix (Id));
-               end if;
-            end if;
-
-         else
-            --  If the use_type_clause appears in a compilation unit context,
-            --  check whether it comes from a unit that may appear in a
-            --  limited_with_clause, for a better error message.
+         if Nkind (Parent (N)) = N_Compilation_Unit then
+            if Nkind (Id) = N_Identifier then
+               Error_Msg_N ("type is not directly visible", Id);
 
-            if Nkind (Parent (N)) = N_Compilation_Unit
-              and then Nkind (Id) /= N_Identifier
+            elsif Is_Child_Unit (Scope (E))
+              and then Scope (E) /= System_Aux_Id
             then
-               declare
-                  Item : Node_Id;
-                  Pref : Node_Id;
-
-                  function Mentioned (Nam : Node_Id) return Boolean;
-                  --  Check whether the prefix of expanded name for the type
-                  --  appears in the prefix of some limited_with_clause.
-
-                  ---------------
-                  -- Mentioned --
-                  ---------------
-
-                  function Mentioned (Nam : Node_Id) return Boolean is
-                  begin
-                     return Nkind (Name (Item)) = N_Selected_Component
-                       and then Chars (Prefix (Name (Item))) = Chars (Nam);
-                  end Mentioned;
-
-               begin
-                  Pref := Prefix (Id);
-                  Item := First (Context_Items (Parent (N)));
-                  while Present (Item) and then Item /= N loop
-                     if Nkind (Item) = N_With_Clause
-                       and then Limited_Present (Item)
-                       and then Mentioned (Pref)
-                     then
-                        Change_Error_Text
-                          (Get_Msg_Id, "premature usage of incomplete type");
-                     end if;
-
-                     Next (Item);
-                  end loop;
-               end;
+               Check_In_Previous_With_Clause (N, Prefix (Id));
             end if;
          end if;
 
-         --  Capture the first Ghost type and the first living type
-
-         if Is_Ghost_Entity (E) then
-            if No (Ghost_Id) then
-               Ghost_Id := E;
-            end if;
+      else
+         --  If the use_type_clause appears in a compilation unit context,
+         --  check whether it comes from a unit that may appear in a
+         --  limited_with_clause, for a better error message.
 
-         elsif No (Living_Id) then
-            Living_Id := E;
-         end if;
+         if Nkind (Parent (N)) = N_Compilation_Unit
+           and then Nkind (Id) /= N_Identifier
+         then
+            declare
+               Item : Node_Id;
+               Pref : Node_Id;
 
-         Next (Id);
-      end loop;
+               function Mentioned (Nam : Node_Id) return Boolean;
+               --  Check whether the prefix of expanded name for the type
+               --  appears in the prefix of some limited_with_clause.
 
-      --  Detect a mixture of Ghost types and living types within the same use
-      --  type clause. Ideally one would split a use type clause with multiple
-      --  marks into multiple use type clauses with a single mark, however
-      --  clients of the front end will have to adapt to this change.
+               ---------------
+               -- Mentioned --
+               ---------------
 
-      if Present (Ghost_Id) and then Present (Living_Id) then
-         Error_Msg_N
-           ("use clause cannot mention ghost and non-ghost ghost types", N);
+               function Mentioned (Nam : Node_Id) return Boolean is
+               begin
+                  return Nkind (Name (Item)) = N_Selected_Component
+                    and then Chars (Prefix (Name (Item))) = Chars (Nam);
+               end Mentioned;
 
-         Error_Msg_Sloc := Sloc (Ghost_Id);
-         Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id);
+            begin
+               Pref := Prefix (Id);
+               Item := First (Context_Items (Parent (N)));
+               while Present (Item) and then Item /= N loop
+                  if Nkind (Item) = N_With_Clause
+                    and then Limited_Present (Item)
+                    and then Mentioned (Pref)
+                  then
+                     Change_Error_Text
+                       (Get_Msg_Id, "premature usage of incomplete type");
+                  end if;
 
-         Error_Msg_Sloc := Sloc (Living_Id);
-         Error_Msg_NE ("\& # declared as non-ghost", N, Living_Id);
+                  Next (Item);
+               end loop;
+            end;
+         end if;
       end if;
 
       Mark_Ghost_Clause (N);
    end Analyze_Use_Type;
 
-   --------------------
-   -- Applicable_Use --
-   --------------------
-
-   function Applicable_Use (Pack_Name : Node_Id) return Boolean is
-      Pack : constant Entity_Id := Entity (Pack_Name);
-
-   begin
-      if In_Open_Scopes (Pack) then
-         if Warn_On_Redundant_Constructs and then Pack = Current_Scope then
-            Error_Msg_NE -- CODEFIX
-              ("& is already use-visible within itself?r?", Pack_Name, Pack);
-         end if;
-
-         return False;
-
-      elsif In_Use (Pack) then
-         Note_Redundant_Use (Pack_Name);
-         return False;
-
-      elsif Present (Renamed_Object (Pack))
-        and then In_Use (Renamed_Object (Pack))
-      then
-         Note_Redundant_Use (Pack_Name);
-         return False;
-
-      else
-         return True;
-      end if;
-   end Applicable_Use;
-
    ------------------------
    -- Attribute_Renaming --
    ------------------------
@@ -4186,21 +4211,27 @@ package body Sem_Ch8 is
       Level : Int := Scope_Stack.Last;
 
    begin
+      --  Common case
+
       if not Is_Compilation_Unit (Current_Scope)
         or else not Is_Child_Unit (Current_Scope)
       then
-         null;   --  Common case
+         null;
 
-      elsif Defining_Entity (Parent (N)) = Current_Scope then
-         null;   --  Common case for compilation unit
+      --  Common case for compilation unit
+
+      elsif Defining_Entity (N               => Parent (N),
+                             Empty_On_Errors => True) = Current_Scope
+      then
+         null;
 
       else
          --  If declaration appears in some other scope, it must be in some
          --  parent unit when compiling a child.
 
-         Pack := Defining_Entity (Parent (N));
+         Pack := Defining_Entity (Parent (N), Empty_On_Errors => True);
          if not In_Open_Scopes (Pack) then
-            null;  --  default as well
+            null;
 
          --  If the use clause appears in an ancestor and we are in the
          --  private part of the immediate parent, the use clauses are
@@ -4547,11 +4578,11 @@ package body Sem_Ch8 is
    ---------------------
 
    procedure End_Use_Clauses (Clause : Node_Id) is
-      U   : Node_Id;
+      U : Node_Id;
 
    begin
-      --  Remove Use_Type clauses first, because they affect the
-      --  visibility of operators in subsequent used packages.
+      --  Remove use_type_clauses first, because they affect the visibility of
+      --  operators in subsequent used packages.
 
       U := Clause;
       while Present (U) loop
@@ -4577,8 +4608,8 @@ package body Sem_Ch8 is
    ---------------------
 
    procedure End_Use_Package (N : Node_Id) is
-      Pack_Name : Node_Id;
       Pack      : Entity_Id;
+      Pack_Name : Node_Id;
       Id        : Entity_Id;
       Elmt      : Elmt_Id;
 
@@ -4603,43 +4634,64 @@ package body Sem_Ch8 is
    --  Start of processing for End_Use_Package
 
    begin
-      Pack_Name := First (Names (N));
-      while Present (Pack_Name) loop
+      Pack_Name := Name (N);
 
-         --  Test that Pack_Name actually denotes a package before processing
+      --  Test that Pack_Name actually denotes a package before processing
 
-         if Is_Entity_Name (Pack_Name)
-           and then Ekind (Entity (Pack_Name)) = E_Package
-         then
-            Pack := Entity (Pack_Name);
+      if Is_Entity_Name (Pack_Name)
+        and then Ekind (Entity (Pack_Name)) = E_Package
+      then
+         Pack := Entity (Pack_Name);
 
-            if In_Open_Scopes (Pack) then
-               null;
+         if In_Open_Scopes (Pack) then
+            null;
 
-            elsif not Redundant_Use (Pack_Name) then
-               Set_In_Use (Pack, False);
-               Set_Current_Use_Clause (Pack, Empty);
+         elsif not Redundant_Use (Pack_Name) then
+            Set_In_Use (Pack, False);
+            Set_Current_Use_Clause (Pack, Empty);
 
-               Id := First_Entity (Pack);
-               while Present (Id) loop
+            Id := First_Entity (Pack);
+            while Present (Id) loop
 
-                  --  Preserve use-visibility of operators that are primitive
-                  --  operators of a type that is use-visible through an active
-                  --  use_type clause.
+               --  Preserve use-visibility of operators that are primitive
+               --  operators of a type that is use-visible through an active
+               --  use_type_clause.
 
-                  if Nkind (Id) = N_Defining_Operator_Symbol
-                    and then
-                      (Is_Primitive_Operator_In_Use (Id, First_Formal (Id))
-                        or else
-                          (Present (Next_Formal (First_Formal (Id)))
-                            and then
-                              Is_Primitive_Operator_In_Use
-                                (Id, Next_Formal (First_Formal (Id)))))
-                  then
-                     null;
-                  else
-                     Set_Is_Potentially_Use_Visible (Id, False);
-                  end if;
+               if Nkind (Id) = N_Defining_Operator_Symbol
+                 and then
+                   (Is_Primitive_Operator_In_Use (Id, First_Formal (Id))
+                     or else
+                       (Present (Next_Formal (First_Formal (Id)))
+                         and then
+                           Is_Primitive_Operator_In_Use
+                             (Id, Next_Formal (First_Formal (Id)))))
+               then
+                  null;
+               else
+                  Set_Is_Potentially_Use_Visible (Id, False);
+               end if;
+
+               if Is_Private_Type (Id)
+                 and then Present (Full_View (Id))
+               then
+                  Set_Is_Potentially_Use_Visible (Full_View (Id), False);
+               end if;
+
+               Next_Entity (Id);
+            end loop;
+
+            if Present (Renamed_Object (Pack)) then
+               Set_In_Use (Renamed_Object (Pack), False);
+               Set_Current_Use_Clause (Renamed_Object (Pack), Empty);
+            end if;
+
+            if Chars (Pack) = Name_System
+              and then Scope (Pack) = Standard_Standard
+              and then Present_System_Aux
+            then
+               Id := First_Entity (System_Aux_Id);
+               while Present (Id) loop
+                  Set_Is_Potentially_Use_Visible (Id, False);
 
                   if Is_Private_Type (Id)
                     and then Present (Full_View (Id))
@@ -4650,38 +4702,12 @@ package body Sem_Ch8 is
                   Next_Entity (Id);
                end loop;
 
-               if Present (Renamed_Object (Pack)) then
-                  Set_In_Use (Renamed_Object (Pack), False);
-                  Set_Current_Use_Clause (Renamed_Object (Pack), Empty);
-               end if;
-
-               if Chars (Pack) = Name_System
-                 and then Scope (Pack) = Standard_Standard
-                 and then Present_System_Aux
-               then
-                  Id := First_Entity (System_Aux_Id);
-                  while Present (Id) loop
-                     Set_Is_Potentially_Use_Visible (Id, False);
-
-                     if Is_Private_Type (Id)
-                       and then Present (Full_View (Id))
-                     then
-                        Set_Is_Potentially_Use_Visible (Full_View (Id), False);
-                     end if;
-
-                     Next_Entity (Id);
-                  end loop;
-
-                  Set_In_Use (System_Aux_Id, False);
-               end if;
-
-            else
-               Set_Redundant_Use (Pack_Name, False);
+               Set_In_Use (System_Aux_Id, False);
             end if;
+         else
+            Set_Redundant_Use (Pack_Name, False);
          end if;
-
-         Next (Pack_Name);
-      end loop;
+      end if;
 
       if Present (Hidden_By_Use_Clause (N)) then
          Elmt := First_Elmt (Hidden_By_Use_Clause (N));
@@ -4714,30 +4740,26 @@ package body Sem_Ch8 is
    ------------------
 
    procedure End_Use_Type (N : Node_Id) is
-      Elmt    : Elmt_Id;
-      Id      : Entity_Id;
-      T       : Entity_Id;
+      Elmt : Elmt_Id;
+      Id   : Entity_Id;
+      T    : Entity_Id;
 
    --  Start of processing for End_Use_Type
 
    begin
-      Id := First (Subtype_Marks (N));
-      while Present (Id) loop
+      Id := Subtype_Mark (N);
 
-         --  A call to Rtsfind may occur while analyzing a use_type clause,
-         --  in which case the type marks are not resolved yet, and there is
-         --  nothing to remove.
-
-         if not Is_Entity_Name (Id) or else No (Entity (Id)) then
-            goto Continue;
-         end if;
+      --  A call to Rtsfind may occur while analyzing a use_type_clause, in
+      --  which case the type marks are not resolved yet, so guard against that
+      --  here.
 
+      if Is_Entity_Name (Id) and then Present (Entity (Id)) then
          T := Entity (Id);
 
          if T = Any_Type or else From_Limited_With (T) then
             null;
 
-         --  Note that the use_type clause may mention a subtype of the type
+         --  Note that the use_type_clause may mention a subtype of the type
          --  whose primitive operations have been made visible. Here as
          --  elsewhere, it is the base type that matters for visibility.
 
@@ -4750,10 +4772,7 @@ package body Sem_Ch8 is
             Set_Current_Use_Clause (T, Empty);
             Set_Current_Use_Clause (Base_Type (T), Empty);
          end if;
-
-         <<Continue>>
-            Next (Id);
-      end loop;
+      end if;
 
       if Is_Empty_Elmt_List (Used_Operations (N)) then
          return;
@@ -4767,6 +4786,21 @@ package body Sem_Ch8 is
       end if;
    end End_Use_Type;
 
+   --------------------
+   -- Entity_Of_Unit --
+   --------------------
+
+   function Entity_Of_Unit (U : Node_Id) return Entity_Id is
+   begin
+      if Nkind (U) = N_Package_Instantiation
+        and then Analyzed (U)
+      then
+         return Defining_Entity (Instance_Spec (U));
+      else
+         return Defining_Entity (U);
+      end if;
+   end Entity_Of_Unit;
+
    ----------------------
    -- Find_Direct_Name --
    ----------------------
@@ -5384,6 +5418,17 @@ package body Sem_Ch8 is
             end;
          end if;
 
+         --  Although the marking of use clauses happens at the end of
+         --  Find_Direct_Name, a certain case where a generic actual satisfies
+         --  a use clause must be checked here due to how the generic machinery
+         --  handles the analysis of said actuals.
+
+         if In_Instance
+           and then Nkind (Parent (N)) = N_Generic_Association
+         then
+            Mark_Use_Clauses (Entity (N));
+         end if;
+
          return;
       end if;
 
@@ -5561,7 +5606,7 @@ package body Sem_Ch8 is
                goto Done;
 
             elsif Is_Predefined_Unit (Current_Sem_Unit) then
-               --  A use-clause in the body of a system file creates conflict
+               --  A use clause in the body of a system file creates conflict
                --  with some entity in a user scope, while rtsfind is active.
                --  Keep only the entity coming from another predefined unit.
 
@@ -5843,6 +5888,20 @@ package body Sem_Ch8 is
          end if;
       end;
 
+      --  Mark relevant use-type and use-package clauses as effective if the
+      --  node in question is not overloaded and therefore does not require
+      --  resolution.
+      --
+      --  Note: Generic actual subprograms do not follow the normal resolution
+      --  path, so ignore the fact that they are overloaded and mark them
+      --  anyway.
+
+      if Nkind (N) not in N_Subexpr
+        or else not Is_Overloaded (N)
+      then
+         Mark_Use_Clauses (N);
+      end if;
+
    --  Come here with entity set
 
    <<Done>>
@@ -6460,9 +6519,34 @@ package body Sem_Ch8 is
          Generate_Reference (Id, N);
       end if;
 
+      --  Mark relevant use-type and use-package clauses as effective if the
+      --  node in question is not overloaded and therefore does not require
+      --  resolution.
+
+      if Nkind (N) not in N_Subexpr or else not Is_Overloaded (N) then
+         Mark_Use_Clauses (N);
+      end if;
+
       Check_Restriction_No_Use_Of_Entity (N);
    end Find_Expanded_Name;
 
+   --------------------
+   -- Find_Most_Prev --
+   --------------------
+
+   function Find_Most_Prev (Use_Clause : Node_Id) return Node_Id is
+      Curr : Node_Id;
+   begin
+      --  Loop through the Prev_Use_Clause chain
+
+      Curr := Use_Clause;
+      while Present (Prev_Use_Clause (Curr)) loop
+         Curr := Prev_Use_Clause (Curr);
+      end loop;
+
+      return Curr;
+   end Find_Most_Prev;
+
    -------------------------
    -- Find_Renamed_Entity --
    -------------------------
@@ -8039,9 +8123,7 @@ package body Sem_Ch8 is
      (Clause             : Node_Id;
       Force_Installation : Boolean := False)
    is
-      U  : Node_Id;
-      P  : Node_Id;
-      Id : Entity_Id;
+      U : Node_Id;
 
    begin
       U := Clause;
@@ -8050,44 +8132,13 @@ package body Sem_Ch8 is
          --  Case of USE package
 
          if Nkind (U) = N_Use_Package_Clause then
-            P := First (Names (U));
-            while Present (P) loop
-               Id := Entity (P);
-
-               if Ekind (Id) = E_Package then
-                  if In_Use (Id) then
-                     Note_Redundant_Use (P);
-
-                  elsif Present (Renamed_Object (Id))
-                    and then In_Use (Renamed_Object (Id))
-                  then
-                     Note_Redundant_Use (P);
-
-                  elsif Force_Installation or else Applicable_Use (P) then
-                     Use_One_Package (Id, U);
-
-                  end if;
-               end if;
-
-               Next (P);
-            end loop;
+            Use_One_Package (U, Name (U), True);
 
          --  Case of USE TYPE
 
          else
-            P := First (Subtype_Marks (U));
-            while Present (P) loop
-               if not Is_Entity_Name (P)
-                 or else No (Entity (P))
-               then
-                  null;
+            Use_One_Type (Subtype_Mark (U), Force => Force_Installation);
 
-               elsif Entity (P) /= Any_Type then
-                  Use_One_Type (P);
-               end if;
-
-               Next (P);
-            end loop;
          end if;
 
          Next_Use_Clause (U);
@@ -8145,196 +8196,268 @@ package body Sem_Ch8 is
                                and then Has_Components (Designated_Type (T))));
    end Is_Appropriate_For_Record;
 
-   ------------------------
-   -- Note_Redundant_Use --
-   ------------------------
+   ----------------------
+   -- Mark_Use_Clauses --
+   ----------------------
 
-   procedure Note_Redundant_Use (Clause : Node_Id) is
-      Pack_Name : constant Entity_Id := Entity (Clause);
-      Cur_Use   : constant Node_Id   := Current_Use_Clause (Pack_Name);
-      Decl      : constant Node_Id   := Parent (Clause);
+   procedure Mark_Use_Clauses (Id : Node_Or_Entity_Id) is
 
-      Prev_Use   : Node_Id := Empty;
-      Redundant  : Node_Id := Empty;
-      --  The Use_Clause which is actually redundant. In the simplest case it
-      --  is Pack itself, but when we compile a body we install its context
-      --  before that of its spec, in which case it is the use_clause in the
-      --  spec that will appear to be redundant, and we want the warning to be
-      --  placed on the body. Similar complications appear when the redundancy
-      --  is between a child unit and one of its ancestors.
+      procedure Mark_Parameters (Call : Entity_Id);
+      --  Perform use_type_clause marking for all parameters in a subprogram
+      --  or operator call.
 
-   begin
-      Set_Redundant_Use (Clause, True);
+      procedure Mark_Use_Package (Pak : Entity_Id);
+      --  Move up the Prev_Use_Clause chain for packages denoted by Pak -
+      --  marking each clause in the chain as effective in the process.
 
-      if not Comes_From_Source (Clause)
-        or else In_Instance
-        or else not Warn_On_Redundant_Constructs
-      then
-         return;
-      end if;
+      procedure Mark_Use_Type (E : Entity_Id);
+      --  Similar to Do_Use_Package_Marking except we move up the
+      --  Prev_Use_Clause chain for the type denoted by E.
 
-      if not Is_Compilation_Unit (Current_Scope) then
+      ---------------------
+      -- Mark_Parameters --
+      ---------------------
 
-         --  If the use_clause is in an inner scope, it is made redundant by
-         --  some clause in the current context, with one exception: If we're
-         --  compiling a nested package body, and the use_clause comes from the
-         --  corresponding spec, the clause is not necessarily fully redundant,
-         --  so we should not warn. If a warning was warranted, it would have
-         --  been given when the spec was processed.
+      procedure Mark_Parameters (Call : Entity_Id) is
+         Curr : Node_Id;
 
-         if Nkind (Parent (Decl)) = N_Package_Specification then
-            declare
-               Package_Spec_Entity : constant Entity_Id :=
-                                       Defining_Unit_Name (Parent (Decl));
-            begin
-               if In_Package_Body (Package_Spec_Entity) then
-                  return;
-               end if;
-            end;
-         end if;
+      begin
+         --  Move through all of the formals
 
-         Redundant := Clause;
-         Prev_Use  := Cur_Use;
+         Curr := First_Formal (Call);
+         while Present (Curr) loop
+            Mark_Use_Type (Curr);
 
-      elsif Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body then
-         declare
-            Cur_Unit : constant Unit_Number_Type := Get_Source_Unit (Cur_Use);
-            New_Unit : constant Unit_Number_Type := Get_Source_Unit (Clause);
-            Scop     : Entity_Id;
+            Curr := Next_Formal (Curr);
+         end loop;
 
-         begin
-            if Cur_Unit = New_Unit then
+         --  Handle the return type
 
-               --  Redundant clause in same body
+         Mark_Use_Type (Call);
+      end Mark_Parameters;
 
-               Redundant := Clause;
-               Prev_Use  := Cur_Use;
+      ----------------------
+      -- Mark_Use_Package --
+      ----------------------
 
-            elsif Cur_Unit = Current_Sem_Unit then
+      procedure Mark_Use_Package (Pak : Entity_Id) is
+         Curr : Node_Id;
 
-               --  If the new clause is not in the current unit it has been
-               --  analyzed first, and it makes the other one redundant.
-               --  However, if the new clause appears in a subunit, Cur_Unit
-               --  is still the parent, and in that case the redundant one
-               --  is the one appearing in the subunit.
+      begin
+         --  Ignore cases where the scope of the type is not a package
+         --  (e.g. Standard_Standard).
 
-               if Nkind (Unit (Cunit (New_Unit))) = N_Subunit then
-                  Redundant := Clause;
-                  Prev_Use  := Cur_Use;
+         if Ekind (Pak) /= E_Package then
+            return;
+         end if;
 
-               --  Most common case: redundant clause in body,
-               --  original clause in spec. Current scope is spec entity.
+         Curr := Current_Use_Clause (Pak);
+         while Present (Curr)
+            and then not Is_Effective_Use_Clause (Curr)
+         loop
+            --  We need to mark the previous use clauses as effective, but each
+            --  use clause may in turn render other use_package_clauses
+            --  effective. Additionally, it is possible to have a parent
+            --  package renamed as a child of itself so we must check the
+            --  prefix entity is not the same as the package we are marking.
+
+            if Nkind (Name (Curr)) /= N_Identifier
+              and then Present (Prefix (Name (Curr)))
+              and then Entity (Prefix (Name (Curr))) /= Pak
+            then
+               Mark_Use_Package (Entity (Prefix (Name (Curr))));
 
-               elsif
-                 Current_Scope =
-                   Defining_Entity (
-                     Unit (Library_Unit (Cunit (Current_Sem_Unit))))
-               then
-                  Redundant := Cur_Use;
-                  Prev_Use  := Clause;
+            --  It is also possible to have a child package without a prefix
+            --  that relies on a previous use_package_clause.
 
-               else
-                  --  The new clause may appear in an unrelated unit, when
-                  --  the parents of a generic are being installed prior to
-                  --  instantiation. In this case there must be no warning.
-                  --  We detect this case by checking whether the current top
-                  --  of the stack is related to the current compilation.
-
-                  Scop := Current_Scope;
-                  while Present (Scop) and then Scop /= Standard_Standard loop
-                     if Is_Compilation_Unit (Scop)
-                       and then not Is_Child_Unit (Scop)
-                     then
-                        return;
+            elsif Nkind (Name (Curr)) = N_Identifier
+              and then Is_Child_Unit (Entity (Name (Curr)))
+            then
+               Mark_Use_Package (Scope (Entity (Name (Curr))));
+            end if;
 
-                     elsif Scop = Cunit_Entity (Current_Sem_Unit) then
-                        exit;
-                     end if;
+            --  Mark the use_package_clause as effective and move up the chain
 
-                     Scop := Scope (Scop);
-                  end loop;
+            Set_Is_Effective_Use_Clause (Curr);
 
-                  Redundant := Cur_Use;
-                  Prev_Use  := Clause;
-               end if;
+            Curr := Prev_Use_Clause (Curr);
+         end loop;
+      end Mark_Use_Package;
 
-            elsif New_Unit = Current_Sem_Unit then
-               Redundant := Clause;
-               Prev_Use  := Cur_Use;
+      -------------------
+      -- Mark_Use_Type --
+      -------------------
 
-            else
-               --  Neither is the current unit, so they appear in parent or
-               --  sibling units. Warning will be emitted elsewhere.
+      procedure Mark_Use_Type (E : Entity_Id) is
+         Curr : Node_Id;
 
-               return;
+      begin
+         --  Ignore void types and unresolved string literals and primitives
+
+         if Nkind (E) = N_String_Literal
+           or else Nkind (Etype (E)) not in N_Entity
+           or else not Is_Type (Etype (E))
+         then
+            return;
+         end if;
+
+         --  The package containing the type or operator function being used
+         --  may be in use as well, so mark any use_package_clauses for it as
+         --  effective. There are also additional sanity checks performed here
+         --  for ignoring previous errors.
+
+         Mark_Use_Package (Scope (Base_Type (Etype (E))));
+         if Nkind (E) in N_Op
+           and then Present (Entity (E))
+           and then Present (Scope (Entity (E)))
+         then
+            Mark_Use_Package (Scope (Entity (E)));
+         end if;
+
+         Curr := Current_Use_Clause (Base_Type (Etype (E)));
+         while Present (Curr)
+            and then not Is_Effective_Use_Clause (Curr)
+         loop
+            --  Current use_type_clause may render other use_package_clauses
+            --  effective.
+
+            if Nkind (Subtype_Mark (Curr)) /= N_Identifier
+              and then Present (Prefix (Subtype_Mark (Curr)))
+            then
+               Mark_Use_Package (Entity (Prefix (Subtype_Mark (Curr))));
             end if;
-         end;
 
-      elsif Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration
-        and then Present (Parent_Spec (Unit (Cunit (Current_Sem_Unit))))
-      then
-         --  Use_clause is in child unit of current unit, and the child unit
-         --  appears in the context of the body of the parent, so it has been
-         --  installed first, even though it is the redundant one. Depending on
-         --  their placement in the context, the visible or the private parts
-         --  of the two units, either might appear as redundant, but the
-         --  message has to be on the current unit.
-
-         if Get_Source_Unit (Cur_Use) = Current_Sem_Unit then
-            Redundant := Cur_Use;
-            Prev_Use  := Clause;
-         else
-            Redundant := Clause;
-            Prev_Use  := Cur_Use;
+            --  Mark the use_type_clause as effective and move up the chain
+
+            Set_Is_Effective_Use_Clause (Curr);
+
+            Curr := Prev_Use_Clause (Curr);
+         end loop;
+      end Mark_Use_Type;
+
+   --  Start of processing for Mark_Use_Clauses
+
+   begin
+      --  Use clauses in and of themselves do not count as a "use" of a
+      --  package.
+
+      if Nkind_In (Parent (Id), N_Use_Type_Clause, N_Use_Package_Clause) then
+         return;
+      end if;
+
+      --  Handle entities
+
+      if Nkind (Id) in N_Entity then
+
+         --  Mark the entity's package
+
+         if Is_Potentially_Use_Visible (Id) then
+            Mark_Use_Package (Scope (Id));
          end if;
 
-         --  If the new use clause appears in the private part of a parent unit
-         --  it may appear to be redundant w.r.t. a use clause in a child unit,
-         --  but the previous use clause was needed in the visible part of the
-         --  child, and no warning should be emitted.
+         --  Mark enumeration literals
 
-         if Nkind (Parent (Decl)) = N_Package_Specification
-           and then
-             List_Containing (Decl) = Private_Declarations (Parent (Decl))
+         if Ekind (Id) = E_Enumeration_Literal then
+            Mark_Use_Type (Id);
+
+         --  Mark primitives
+
+         elsif (Ekind (Id) in Overloadable_Kind
+                 or else Ekind_In
+                   (Ekind (Id), E_Generic_Function, E_Generic_Procedure))
+           and then (Is_Potentially_Use_Visible (Id)
+                      or else Is_Intrinsic_Subprogram (Id))
          then
-            declare
-               Par : constant Entity_Id := Defining_Entity (Parent (Decl));
-               Spec : constant Node_Id  :=
-                        Specification (Unit (Cunit (Current_Sem_Unit)));
+            Mark_Parameters (Id);
+         end if;
 
-            begin
-               if Is_Compilation_Unit (Par)
-                 and then Par /= Cunit_Entity (Current_Sem_Unit)
-                 and then Parent (Cur_Use) = Spec
-                 and then
-                   List_Containing (Cur_Use) = Visible_Declarations (Spec)
-               then
-                  return;
+      --  Handle nodes
+
+      else
+         --  Mark operators
+
+         if Nkind (Id) in N_Op then
+
+            --  At this point the left operand may not be resolved if we are
+            --  encountering multiple operators next to eachother in an
+            --  expression.
+
+            if Nkind (Id) in N_Binary_Op
+               and then not (Nkind (Left_Opnd (Id)) in N_Op)
+            then
+               Mark_Use_Type (Left_Opnd (Id));
+            end if;
+
+            Mark_Use_Type (Right_Opnd (Id));
+            Mark_Use_Type (Id);
+
+         --  Mark entity identifiers
+
+         elsif Nkind (Id) in N_Has_Entity
+           and then (Is_Potentially_Use_Visible (Entity (Id))
+                      or else (Is_Generic_Instance (Entity (Id))
+                                and then Is_Immediately_Visible (Entity (Id))))
+         then
+            --  Ignore fully qualified names as they do not count as a "use" of
+            --  a package.
+
+            if Nkind_In (Id, N_Identifier, N_Operator_Symbol)
+              or else (Present (Prefix (Id))
+                         and then Scope (Entity (Id)) /= Entity (Prefix (Id)))
+            then
+               --  There is a case whereby a unary operator is used within a
+               --  qualified expression, so mark the parameters as well as the
+               --  entity.
+
+               if Nkind (Entity (Id)) = N_Defining_Operator_Symbol then
+                  Mark_Parameters (Entity (Id));
                end if;
-            end;
+
+               Mark_Use_Package (Scope (Entity (Id)));
+            end if;
          end if;
+      end if;
+   end Mark_Use_Clauses;
 
-      --  Finally, if the current use clause is in the context then
-      --  the clause is redundant when it is nested within the unit.
+   --------------------------------
+   -- Most_Descendant_Use_Clause --
+   --------------------------------
 
-      elsif Nkind (Parent (Cur_Use)) = N_Compilation_Unit
-        and then Nkind (Parent (Parent (Clause))) /= N_Compilation_Unit
-        and then Get_Source_Unit (Cur_Use) = Get_Source_Unit (Clause)
-      then
-         Redundant := Clause;
-         Prev_Use  := Cur_Use;
+   function Most_Descendant_Use_Clause
+     (Clause1 : Entity_Id;
+      Clause2 : Entity_Id) return Entity_Id
+   is
+      Scope1, Scope2 : Entity_Id;
 
-      else
-         null;
+   begin
+      if Clause1 = Clause2 then
+         return Clause1;
       end if;
 
-      if Present (Redundant) then
-         Error_Msg_Sloc := Sloc (Prev_Use);
-         Error_Msg_NE -- CODEFIX
-           ("& is already use-visible through previous use clause #??",
-            Redundant, Pack_Name);
+      --  We determine which one is the most descendant by the scope distance
+      --  to the ultimate parent unit.
+
+      Scope1 := Entity_Of_Unit (Unit (Parent (Clause1)));
+      Scope2 := Entity_Of_Unit (Unit (Parent (Clause2)));
+      while Scope1 /= Standard_Standard
+        and then Scope2 /= Standard_Standard
+      loop
+         Scope1 := Scope (Scope1);
+         Scope2 := Scope (Scope2);
+
+         if not Present (Scope1) then
+            return Clause1;
+         elsif not Present (Scope2) then
+            return Clause2;
+         end if;
+      end loop;
+
+      if Scope1 = Standard_Standard then
+         return Clause1;
       end if;
-   end Note_Redundant_Use;
+
+      return Clause2;
+   end Most_Descendant_Use_Clause;
 
    ---------------
    -- Pop_Scope --
@@ -8400,9 +8523,9 @@ package body Sem_Ch8 is
       Scope_Stack.Decrement_Last;
    end Pop_Scope;
 
-   ---------------
+   ----------------
    -- Push_Scope --
-   ---------------
+   ----------------
 
    procedure Push_Scope (S : Entity_Id) is
       E : constant Entity_Id := Scope (S);
@@ -8776,7 +8899,8 @@ package body Sem_Ch8 is
         and then Scope_Stack.Table (SS_Last).Entity /= Standard_Standard
         and then Handle_Use
       then
-         Install_Use_Clauses (Scope_Stack.Table (SS_Last).First_Use_Clause);
+         Install_Use_Clauses (Scope_Stack.Table (SS_Last).First_Use_Clause,
+                               Force_Installation => True);
       end if;
    end Restore_Scope_Stack;
 
@@ -8873,10 +8997,7 @@ package body Sem_Ch8 is
    -------------
 
    procedure Set_Use (L : List_Id) is
-      Decl      : Node_Id;
-      Pack_Name : Node_Id;
-      Pack      : Entity_Id;
-      Id        : Entity_Id;
+      Decl : Node_Id;
 
    begin
       if Present (L) then
@@ -8884,52 +9005,412 @@ package body Sem_Ch8 is
          while Present (Decl) loop
             if Nkind (Decl) = N_Use_Package_Clause then
                Chain_Use_Clause (Decl);
+               Use_One_Package (Decl, Name (Decl));
+
+            elsif Nkind (Decl) = N_Use_Type_Clause then
+               Chain_Use_Clause (Decl);
+               Use_One_Type (Subtype_Mark (Decl));
+
+            end if;
+
+            Next (Decl);
+         end loop;
+      end if;
+   end Set_Use;
+
+   -----------------------------
+   -- Update_Use_Clause_Chain --
+   -----------------------------
+
+   procedure Update_Use_Clause_Chain is
+
+      procedure Update_Chain_In_Scope (Level : Int);
+      --  Iterate through one level in the scope stack verifying each use-type
+      --  clause within said level is used then reset the Current_Use_Clause
+      --  to a redundant use clause outside of the current ending scope if such
+      --  a clause exists.
+
+      ---------------------------
+      -- Update_Chain_In_Scope --
+      ---------------------------
+
+      procedure Update_Chain_In_Scope (Level : Int) is
+         Curr : Node_Id;
+         N    : Node_Id;
+
+      begin
+         --  Loop through all use clauses within the scope dictated by Level
+
+         Curr := Scope_Stack.Table (Level).First_Use_Clause;
+         while Present (Curr) loop
+
+            --  Retrieve the subtype mark or name within the current current
+            --  use clause.
+
+            if Nkind (Curr) = N_Use_Type_Clause then
+               N := Subtype_Mark (Curr);
+            else
+               N := Name (Curr);
+            end if;
+
+            --  If warnings for unreferenced entities are enabled and the
+            --  current use clause has not been marked effective.
 
-               Pack_Name := First (Names (Decl));
-               while Present (Pack_Name) loop
-                  Pack := Entity (Pack_Name);
+            if Check_Unreferenced
+              and then Comes_From_Source (Curr)
+              and then not Is_Effective_Use_Clause (Curr)
+              and then not In_Instance
+            then
+
+               --  We are dealing with a potentially unused use_package_clause
+
+               if Nkind (Curr) = N_Use_Package_Clause then
 
-                  if Ekind (Pack) = E_Package
-                    and then Applicable_Use (Pack_Name)
+                  --  Renamings and formal subprograms may cause the associated
+                  --  to be marked as effective instead of the original.
+
+                  if not (Present (Associated_Node (N))
+                           and then Present
+                             (Current_Use_Clause (Associated_Node (N)))
+                           and then Is_Effective_Use_Clause
+                             (Current_Use_Clause (Associated_Node (N))))
                   then
-                     Use_One_Package (Pack, Decl);
+                     Error_Msg_Node_1 := Entity (N);
+                     Error_Msg_NE ("ineffective use clause for package &?",
+                                   Curr, Entity (N));
                   end if;
 
-                  Next (Pack_Name);
-               end loop;
+               --  We are dealing with an unused use_type_clause
 
-            elsif Nkind (Decl) = N_Use_Type_Clause then
-               Chain_Use_Clause (Decl);
+               else
+                  Error_Msg_Node_1 := Etype (N);
+                  Error_Msg_NE ("ineffective use clause for }?",
+                                 Curr, Etype (N));
+               end if;
+            end if;
 
-               Id := First (Subtype_Marks (Decl));
-               while Present (Id) loop
-                  if Entity (Id) /= Any_Type then
-                     Use_One_Type (Id);
-                  end if;
+            --  Verify that we haven't already processed a redundant
+            --  use_type_clause within the same scope before we move the
+            --  current use clause up to a previous one for type T.
 
-                  Next (Id);
-               end loop;
+            if Present (Prev_Use_Clause (Curr)) then
+               Set_Current_Use_Clause (Entity (N), Prev_Use_Clause (Curr));
             end if;
 
-            Next (Decl);
+            Curr := Next_Use_Clause (Curr);
          end loop;
+      end Update_Chain_In_Scope;
+
+   --  Start of processing for Update_Use_Clause_Chain
+
+   begin
+      Update_Chain_In_Scope (Scope_Stack.Last);
+
+      --  Deal with use clauses within the context area if the current
+      --  scope is a compilation unit.
+
+      if Is_Compilation_Unit (Current_Scope) then
+
+         pragma Assert (Scope_Stack.Last /= Scope_Stack.First);
+
+         Update_Chain_In_Scope (Scope_Stack.Last - 1);
       end if;
-   end Set_Use;
+   end Update_Use_Clause_Chain;
 
    ---------------------
    -- Use_One_Package --
    ---------------------
 
-   procedure Use_One_Package (P : Entity_Id; N : Node_Id) is
+   procedure Use_One_Package
+     (N         : Node_Id;
+      Pack_Name : Entity_Id := Empty;
+      Force     : Boolean   := False)
+   is
+
+      procedure Note_Redundant_Use (Clause : Node_Id);
+      --  Mark the name in a use clause as redundant if the corresponding
+      --  entity is already use-visible. Emit a warning if the use clause comes
+      --  from source and the proper warnings are enabled.
+
+      ------------------------
+      -- Note_Redundant_Use --
+      ------------------------
+
+      procedure Note_Redundant_Use (Clause : Node_Id) is
+         Pack_Name : constant Entity_Id := Entity (Clause);
+         Decl      : constant Node_Id   := Parent (Clause);
+
+         Cur_Use    : Node_Id := Current_Use_Clause (Pack_Name);
+         Prev_Use   : Node_Id := Empty;
+         Redundant  : Node_Id := Empty;
+         --  The Use_Clause which is actually redundant. In the simplest case
+         --  it is Pack itself, but when we compile a body we install its
+         --  context before that of its spec, in which case it is the
+         --  use_clause in the spec that will appear to be redundant, and we
+         --  want the warning to be placed on the body. Similar complications
+         --  appear when the redundancy is between a child unit and one of its
+         --  ancestors.
+
+      begin
+         --  Could be renamed...
+
+         if No (Cur_Use) then
+            Cur_Use := Current_Use_Clause (Renamed_Entity (Pack_Name));
+         end if;
+
+         Set_Redundant_Use (Clause, True);
+
+         if not Comes_From_Source (Clause)
+           or else In_Instance
+           or else not Warn_On_Redundant_Constructs
+         then
+            return;
+         end if;
+
+         if not Is_Compilation_Unit (Current_Scope) then
+
+            --  If the use_clause is in an inner scope, it is made redundant by
+            --  some clause in the current context, with one exception: If we
+            --  are compiling a nested package body, and the use_clause comes
+            --  from then corresponding spec, the clause is not necessarily
+            --  fully redundant, so we should not warn. If a warning was
+            --  warranted, it would have been given when the spec was
+            --  processed.
+
+            if Nkind (Parent (Decl)) = N_Package_Specification then
+               declare
+                  Package_Spec_Entity : constant Entity_Id :=
+                                          Defining_Unit_Name (Parent (Decl));
+               begin
+                  if In_Package_Body (Package_Spec_Entity) then
+                     return;
+                  end if;
+               end;
+            end if;
+
+            Redundant := Clause;
+            Prev_Use  := Cur_Use;
+
+         elsif Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body then
+            declare
+               Cur_Unit : constant Unit_Number_Type :=
+                 Get_Source_Unit (Cur_Use);
+               New_Unit : constant Unit_Number_Type :=
+                 Get_Source_Unit (Clause);
+               Scop     : Entity_Id;
+
+            begin
+               if Cur_Unit = New_Unit then
+
+                  --  Redundant clause in same body
+
+                  Redundant := Clause;
+                  Prev_Use  := Cur_Use;
+
+               elsif Cur_Unit = Current_Sem_Unit then
+
+                  --  If the new clause is not in the current unit it has been
+                  --  analyzed first, and it makes the other one redundant.
+                  --  However, if the new clause appears in a subunit, Cur_Unit
+                  --  is still the parent, and in that case the redundant one
+                  --  is the one appearing in the subunit.
+
+                  if Nkind (Unit (Cunit (New_Unit))) = N_Subunit then
+                     Redundant := Clause;
+                     Prev_Use  := Cur_Use;
+
+                  --  Most common case: redundant clause in body,
+                  --  original clause in spec. Current scope is spec entity.
+
+                  elsif Current_Scope = Cunit_Entity (Current_Sem_Unit) then
+                     Redundant := Cur_Use;
+                     Prev_Use  := Clause;
+
+                  else
+                     --  The new clause may appear in an unrelated unit, when
+                     --  the parents of a generic are being installed prior to
+                     --  instantiation. In this case there must be no warning.
+                     --  We detect this case by checking whether the current
+                     --  top of the stack is related to the current
+                     --  compilation.
+
+                     Scop := Current_Scope;
+                     while Present (Scop)
+                       and then Scop /= Standard_Standard
+                     loop
+                        if Is_Compilation_Unit (Scop)
+                          and then not Is_Child_Unit (Scop)
+                        then
+                           return;
+
+                        elsif Scop = Cunit_Entity (Current_Sem_Unit) then
+                           exit;
+                        end if;
+
+                        Scop := Scope (Scop);
+                     end loop;
+
+                     Redundant := Cur_Use;
+                     Prev_Use  := Clause;
+                  end if;
+
+               elsif New_Unit = Current_Sem_Unit then
+                  Redundant := Clause;
+                  Prev_Use  := Cur_Use;
+
+               else
+                  --  Neither is the current unit, so they appear in parent or
+                  --  sibling units. Warning will be emitted elsewhere.
+
+                  return;
+               end if;
+            end;
+
+         elsif Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration
+           and then Present (Parent_Spec (Unit (Cunit (Current_Sem_Unit))))
+         then
+            --  Use_clause is in child unit of current unit, and the child unit
+            --  appears in the context of the body of the parent, so it has
+            --  been installed first, even though it is the redundant one.
+            --  Depending on their placement in the context, the visible or the
+            --  private parts of the two units, either might appear as
+            --  redundant, but the message has to be on the current unit.
+
+            if Get_Source_Unit (Cur_Use) = Current_Sem_Unit then
+               Redundant := Cur_Use;
+               Prev_Use  := Clause;
+            else
+               Redundant := Clause;
+               Prev_Use  := Cur_Use;
+            end if;
+
+            --  If the new use clause appears in the private part of a parent
+            --  unit it may appear to be redundant w.r.t. a use clause in a
+            --  child unit, but the previous use clause was needed in the
+            --  visible part of the child, and no warning should be emitted.
+
+            if Nkind (Parent (Decl)) = N_Package_Specification
+              and then
+                List_Containing (Decl) = Private_Declarations (Parent (Decl))
+            then
+               declare
+                  Par : constant Entity_Id := Defining_Entity (Parent (Decl));
+                  Spec : constant Node_Id  :=
+                           Specification (Unit (Cunit (Current_Sem_Unit)));
+
+               begin
+                  if Is_Compilation_Unit (Par)
+                    and then Par /= Cunit_Entity (Current_Sem_Unit)
+                    and then Parent (Cur_Use) = Spec
+                    and then
+                      List_Containing (Cur_Use) = Visible_Declarations (Spec)
+                  then
+                     return;
+                  end if;
+               end;
+            end if;
+
+         --  Finally, if the current use clause is in the context then
+         --  the clause is redundant when it is nested within the unit.
+
+         elsif Nkind (Parent (Cur_Use)) = N_Compilation_Unit
+           and then Nkind (Parent (Parent (Clause))) /= N_Compilation_Unit
+           and then Get_Source_Unit (Cur_Use) = Get_Source_Unit (Clause)
+         then
+            Redundant := Clause;
+            Prev_Use  := Cur_Use;
+
+         end if;
+
+         if Present (Redundant) then
+            --  Make sure we are looking at most-descendant use_package_clause
+            --  by traversing the chain with Find_Most_Prev and then verifying
+            --  there is no scope manipulation via Most_Descendant_Use_Clause.
+
+            if Nkind (Prev_Use) = N_Use_Package_Clause
+              and then
+                (Nkind (Parent (Prev_Use)) /= N_Compilation_Unit
+                  or else Most_Descendant_Use_Clause
+                    (Prev_Use, Find_Most_Prev (Prev_Use)) /= Prev_Use)
+            then
+               Prev_Use := Find_Most_Prev (Prev_Use);
+            end if;
+
+            Error_Msg_Sloc := Sloc (Prev_Use);
+            Error_Msg_NE -- CODEFIX
+              ("& is already use-visible through previous use clause #??",
+               Redundant, Pack_Name);
+         end if;
+      end Note_Redundant_Use;
+
+      --  Local variables
+
       Id               : Entity_Id;
       Prev             : Entity_Id;
       Current_Instance : Entity_Id := Empty;
       Real_P           : Entity_Id;
       Private_With_OK  : Boolean   := False;
+      P                : Entity_Id;
+
+   --  Start of processing for Use_One_Package
 
    begin
-      if Ekind (P) /= E_Package then
-         return;
+      --  Use_One_Package may have been called recursively to handle an
+      --  implicit use for a auxiliary system package, so set P accordingly
+      --  and skip redundancy checks.
+
+      if No (Pack_Name) and then Present_System_Aux (N) then
+         P := System_Aux_Id;
+
+      --  Check for redundant use_package_clauses
+
+      else
+         --  Ignore cases where we are dealing with a non user defined package
+         --  like Standard_Standard or something other than a valid package.
+
+         if not Is_Entity_Name (Pack_Name)
+           or else No (Entity (Pack_Name))
+           or else Ekind (Entity (Pack_Name)) /= E_Package
+         then
+            return;
+         end if;
+
+         --  When a renaming exists we must check it for redundancy. The
+         --  original package would have already been seen at this point.
+
+         if Present (Renamed_Object (Entity (Pack_Name))) then
+            P := Renamed_Object (Entity (Pack_Name));
+         else
+            P := Entity (Pack_Name);
+         end if;
+
+         --  Check for redundant clauses then set the current use clause for
+         --  P if were are not "forcing" an installation from a scope
+         --  reinstallation that is done throughout analysis for various
+         --  reasons.
+
+         if In_Use (P) then
+            Note_Redundant_Use (Pack_Name);
+            if not Force then
+               Set_Current_Use_Clause (P, N);
+            end if;
+            return;
+
+         --  Warn about detected redundant clauses
+
+         elsif In_Open_Scopes (P) and not Force then
+            if Warn_On_Redundant_Constructs and then P = Current_Scope then
+               Error_Msg_NE -- CODEFIX
+                 ("& is already use-visible within itself?r?",
+                   Pack_Name, P);
+            end if;
+            return;
+         end if;
+
+         --  Set P back to the non-renamed package so that visiblilty of the
+         --  entities within the package can be properly set below.
+
+         P := Entity (Pack_Name);
       end if;
 
       Set_In_Use (P);
@@ -9113,16 +9594,17 @@ package body Sem_Ch8 is
         and then Scope (Real_P) = Standard_Standard
         and then Present_System_Aux (N)
       then
-         Use_One_Package (System_Aux_Id, N);
+         Use_One_Package (N);
       end if;
-
    end Use_One_Package;
 
    ------------------
    -- Use_One_Type --
    ------------------
 
-   procedure Use_One_Type (Id : Node_Id; Installed : Boolean := False) is
+   procedure Use_One_Type
+     (Id : Node_Id; Installed : Boolean := False; Force : Boolean := False)
+   is
       Elmt          : Elmt_Id;
       Is_Known_Used : Boolean;
       Op_List       : Elist_Id;
@@ -9174,8 +9656,8 @@ package body Sem_Ch8 is
          Ent  : Entity_Id;
 
          function Is_Class_Wide_Operation_Of
-        (Op  : Entity_Id;
-           : Entity_Id) return Boolean;
+           (Op : Entity_Id;
+            T  : Entity_Id) return Boolean;
          --  Determine whether a subprogram has a class-wide parameter or
          --  result that is T'Class.
 
@@ -9232,19 +9714,26 @@ package body Sem_Ch8 is
    --  Start of processing for Use_One_Type
 
    begin
+      if Entity (Id) = Any_Type then
+         return;
+      end if;
+
       --  It is the type determined by the subtype mark (8.4(8)) whose
       --  operations become potentially use-visible.
 
       T := Base_Type (Entity (Id));
 
-      --  Either the type itself is used, the package where it is declared
-      --  is in use or the entity is declared in the current package, thus
+      --  Either the type itself is used, the package where it is declared is
+      --  in use or the entity is declared in the current package, thus
       --  use-visible.
 
-      Is_Known_Used :=
-        In_Use (T)
-          or else In_Use (Scope (T))
-          or else Scope (T) = Current_Scope;
+      Is_Known_Used := (In_Use (T)
+                         and then ((Present (Current_Use_Clause (T))
+                                     and then All_Present
+                                                (Current_Use_Clause (T)))
+                                    or else not All_Present (Parent (Id))))
+                         or else In_Use (Scope (T))
+                         or else Scope (T) = Current_Scope;
 
       Set_Redundant_Use (Id,
         Is_Known_Used or else Is_Potentially_Use_Visible (T));
@@ -9255,7 +9744,7 @@ package body Sem_Ch8 is
       elsif In_Open_Scopes (Scope (T)) then
          null;
 
-      --  A limited view cannot appear in a use_type clause. However, an access
+      --  A limited view cannot appear in a use_type_clause. However, an access
       --  type whose designated type is limited has the flag but is not itself
       --  a limited view unless we only have a limited view of its enclosing
       --  package.
@@ -9274,13 +9763,28 @@ package body Sem_Ch8 is
       --  even if it is redundant at the place of the instantiation.
 
       elsif Redundant_Use (Id) then
+
+         --  We must avoid incorrectly setting the Current_Use_Clause when we
+         --  are working with a redundant clause that has already been linked
+         --  in the Prev_Use_Clause chain, otherwise the chain will break.
+
+         if Present (Current_Use_Clause (T))
+           and then Present (Prev_Use_Clause (Current_Use_Clause (T)))
+           and then Parent (Id) = Prev_Use_Clause (Current_Use_Clause (T))
+         then
+            null;
+         else
+            Set_Current_Use_Clause (T, Parent (Id));
+         end if;
+
          Set_Used_Operations (Parent (Id), New_Elmt_List);
 
       --  If the subtype mark designates a subtype in a different package,
       --  we have to check that the parent type is visible, otherwise the
-      --  use type clause is a noop. Not clear how to do that???
+      --  use_type_clause is a no-op. Not clear how to do that???
 
       else
+         Set_Current_Use_Clause (T, Parent (Id));
          Set_In_Use (T);
 
          --  If T is tagged, primitive operators on class-wide operands
@@ -9290,8 +9794,6 @@ package body Sem_Ch8 is
             Set_In_Use (Class_Wide_Type (T));
          end if;
 
-         Set_Current_Use_Clause (T, Parent (Id));
-
          --  Iterate over primitive operations of the type. If an operation is
          --  already use_visible, it is the result of a previous use_clause,
          --  and already appears on the corresponding entity chain. If the
@@ -9335,7 +9837,8 @@ package body Sem_Ch8 is
 
       --  If warning on redundant constructs, check for unnecessary WITH
 
-      if Warn_On_Redundant_Constructs
+      if not Force
+        and then Warn_On_Redundant_Constructs
         and then Is_Known_Used
 
         --                     with P;         with P; use P;
@@ -9362,39 +9865,19 @@ package body Sem_Ch8 is
 
             if Present (Current_Use_Clause (T)) then
                Use_Clause_Known : declare
-                  Clause1 : constant Node_Id := Parent (Id);
-                  Clause2 : constant Node_Id := Current_Use_Clause (T);
+                  Clause1 : constant Node_Id := Find_Most_Prev
+                                                  (Current_Use_Clause (T));
+                  Clause2 : constant Node_Id := Parent (Id);
                   Ent1    : Entity_Id;
                   Ent2    : Entity_Id;
                   Err_No  : Node_Id;
                   Unit1   : Node_Id;
                   Unit2   : Node_Id;
 
-                  function Entity_Of_Unit (U : Node_Id) return Entity_Id;
-                  --  Return the appropriate entity for determining which unit
-                  --  has a deeper scope: the defining entity for U, unless U
-                  --  is a package instance, in which case we retrieve the
-                  --  entity of the instance spec.
-
-                  --------------------
-                  -- Entity_Of_Unit --
-                  --------------------
-
-                  function Entity_Of_Unit (U : Node_Id) return Entity_Id is
-                  begin
-                     if Nkind (U) = N_Package_Instantiation
-                       and then Analyzed (U)
-                     then
-                        return Defining_Entity (Instance_Spec (U));
-                     else
-                        return Defining_Entity (U);
-                     end if;
-                  end Entity_Of_Unit;
-
                --  Start of processing for Use_Clause_Known
 
                begin
-                  --  If both current use type clause and the use type clause
+                  --  If both current use_type_clause and the use_type_clause
                   --  for the type are at the compilation unit level, one of
                   --  the units must be an ancestor of the other, and the
                   --  warning belongs on the descendant.
@@ -9418,14 +9901,7 @@ package body Sem_Ch8 is
                      --  of the other, or one of them is in a subunit, report
                      --  redundancy on the later one.
 
-                     if Unit1 = Unit2 then
-                        Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
-                        Error_Msg_NE -- CODEFIX
-                          ("& is already use-visible through previous "
-                           & "use_type_clause #??", Clause1, T);
-                        return;
-
-                     elsif Nkind (Unit1) = N_Subunit then
+                     if Unit1 = Unit2 or else Nkind (Unit1) = N_Subunit then
                         Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
                         Error_Msg_NE -- CODEFIX
                           ("& is already use-visible through previous "
@@ -9443,7 +9919,7 @@ package body Sem_Ch8 is
                         return;
                      end if;
 
-                     --  There is a redundant use type clause in a child unit.
+                     --  There is a redundant use_type_clause in a child unit.
                      --  Determine which of the units is more deeply nested.
                      --  If a unit is a package instance, retrieve the entity
                      --  and its scope from the instance spec.
@@ -9489,13 +9965,22 @@ package body Sem_Ch8 is
                         end;
                      end if;
 
-                     Error_Msg_NE -- CODEFIX
-                       ("& is already use-visible through previous "
-                        & "use_type_clause #??", Err_No, Id);
+                     if Parent (Id) /= Err_No then
+                        if Most_Descendant_Use_Clause
+                             (Err_No, Parent (Id)) = Parent (Id)
+                        then
+                           Error_Msg_Sloc := Sloc (Err_No);
+                           Err_No := Parent (Id);
+                        end if;
+
+                        Error_Msg_NE -- CODEFIX
+                          ("& is already use-visible through previous "
+                           & "use_type_clause #??", Err_No, Id);
+                     end if;
 
-                  --  Case where current use type clause and the use type
-                  --  clause for the type are not both at the compilation unit
-                  --  level. In this case we don't have location information.
+                  --  Case where current use_type_clause and use_type_clause
+                  --  for the type are not both at the compilation unit level.
+                  --  In this case we don't have location information.
 
                   else
                      Error_Msg_NE -- CODEFIX
@@ -9516,7 +10001,8 @@ package body Sem_Ch8 is
          --  The package where T is declared is already used
 
          elsif In_Use (Scope (T)) then
-            Error_Msg_Sloc := Sloc (Current_Use_Clause (Scope (T)));
+            Error_Msg_Sloc := Sloc (Find_Most_Prev
+                                     (Current_Use_Clause (Scope (T))));
             Error_Msg_NE -- CODEFIX
               ("& is already use-visible through package use clause #??",
                Id, T);
index ae63e172ceeba61deb7854b866e01154cb866c29..e87f5aafd5162113a86a689345cd4cbf866cb1b6 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -52,8 +52,18 @@ package Sem_Ch8 is
    procedure Analyze_Object_Renaming            (N : Node_Id);
    procedure Analyze_Package_Renaming           (N : Node_Id);
    procedure Analyze_Subprogram_Renaming        (N : Node_Id);
-   procedure Analyze_Use_Package                (N : Node_Id);
-   procedure Analyze_Use_Type                   (N : Node_Id);
+
+   procedure Analyze_Use_Package (N     : Node_Id;
+                                  Chain : Boolean := True);
+   --  Analyze a use package clause and control (through the Chain
+   --  parameter) whether to add N to the use clause chain for the name
+   --  denoted within use clause N in case we are reanalyzing a use clause
+   --  because of stack manipulation.
+
+   procedure Analyze_Use_Type (N     : Node_Id;
+                               Chain : Boolean := True);
+   --  Similar to Analyze_Use_Package except the Chain parameter applies
+   --  to the type within N's subtype mark Current_Use_Clause.
 
    procedure End_Scope;
    --  Called at end of scope. On exit from blocks and bodies (subprogram,
@@ -131,6 +141,10 @@ package Sem_Ch8 is
    --  Analyze_Subunit.Re_Install_Use_Clauses to insure that, after the
    --  analysis of the subunit, the parent's environment is again identical.
 
+   procedure Mark_Use_Clauses (Id : Node_Or_Entity_Id);
+   --  Mark a given entity or node Id's relevant use clauses as effective,
+   --  including redundant ones and ones outside of the current scope.
+
    procedure Push_Scope (S : Entity_Id);
    --  Make new scope stack entry, pushing S, the entity for a scope onto the
    --  top of the scope table. The current setting of the scope suppress flags
@@ -174,6 +188,10 @@ package Sem_Ch8 is
    --  and set the potentially use-visible flags of imported entities before
    --  analyzing the corresponding package body.
 
+   procedure Update_Use_Clause_Chain;
+   --  Called at the end of a declarative region to detect unused use type
+   --  clauses and maintain the Current_Use_Clause for type entities.
+
    procedure ws;
    --  Debugging routine for use in gdb: dump all entities on scope stack
 
index 2fb8ebdc942b9e91737fde36a61ed52d6fd2ca55..cbebe2601d2bbf714cfe9ea0e978dfa3730be1b3 100644 (file)
@@ -1447,6 +1447,7 @@ package body Sem_Ch9 is
       --  Process the end label, and terminate the scope
 
       Process_End_Label (Handled_Statement_Sequence (N), 't', Entry_Name);
+      Update_Use_Clause_Chain;
       End_Scope;
 
       --  If this is an entry family, remove the loop created to provide
@@ -1851,6 +1852,7 @@ package body Sem_Ch9 is
       Check_Completion (Body_Id);
       Check_References (Spec_Id);
       Process_End_Label (N, 't', Ref_Id);
+      Update_Use_Clause_Chain;
       End_Scope;
 
       --  When a Lock_Free aspect specification/pragma forces the lock-free
@@ -2991,6 +2993,7 @@ package body Sem_Ch9 is
       end;
 
       Process_End_Label (HSS, 't', Ref_Id);
+      Update_Use_Clause_Chain;
       End_Scope;
    end Analyze_Task_Body;
 
index 5087fe62f67c519edc806ab2e5e9da21c4024403..803ad0eb0aeb72bc27bfe2ce804977fcddf07e6f 100644 (file)
@@ -3010,6 +3010,14 @@ package body Sem_Res is
                Resolve_Unchecked_Type_Conversion (N, Ctx_Type);
          end case;
 
+         --  Mark relevant use-type and use-package clauses as effective using
+         --  the original node because constant folding may have occured and
+         --  removed references that need to be examined.
+
+         if Nkind (Original_Node (N)) in N_Op then
+            Mark_Use_Clauses (Original_Node (N));
+         end if;
+
          --  Ada 2012 (AI05-0149): Apply an (implicit) conversion to an
          --  expression of an anonymous access type that occurs in the context
          --  of a named general access type, except when the expression is that
@@ -6724,6 +6732,8 @@ package body Sem_Res is
          end if;
       end if;
 
+      Mark_Use_Clauses (Subp);
+
       Warn_On_Overlapping_Actuals (Nam, N);
    end Resolve_Call;
 
@@ -7279,6 +7289,8 @@ package body Sem_Res is
             Check_Ghost_Context (E, N);
          end if;
       end if;
+
+      Mark_Use_Clauses (E);
    end Resolve_Entity_Name;
 
    -------------------
index 278d6b6bd214b1c1571fa782b420648b5e38088c..f20d9df5a9dad0b7c78042d84250383ee4f28483 100644 (file)
@@ -2225,29 +2225,21 @@ package body Sem_Warn is
             ----------------------
 
             function Check_Use_Clause (N : Node_Id) return Traverse_Result is
-               Nam  : Node_Id;
-
             begin
-               if Nkind (N) = N_Use_Package_Clause then
-                  Nam := First (Names (N));
-                  while Present (Nam) loop
-                     if Entity (Nam) = Pack then
-
-                        --  Suppress message if any serious errors detected
-                        --  that turn off expansion, and thus result in false
-                        --  positives for this warning.
-
-                        if Serious_Errors_Detected = 0 then
-                           Error_Msg_Qual_Level := 1;
-                           Error_Msg_NE -- CODEFIX
-                             ("?u?no entities of package& are referenced!",
-                                Nam, Pack);
-                           Error_Msg_Qual_Level := 0;
-                        end if;
-                     end if;
-
-                     Next (Nam);
-                  end loop;
+               if Nkind (N) = N_Use_Package_Clause
+                 and then Entity (Name (N)) = Pack
+               then
+                  --  Suppress message if any serious errors detected that turn
+                  --  off expansion, and thus result in false positives for
+                  --  this warning.
+
+                  if Serious_Errors_Detected = 0 then
+                     Error_Msg_Qual_Level := 1;
+                     Error_Msg_NE -- CODEFIX
+                       ("?u?no entities of package& are referenced!",
+                          Name (N), Pack);
+                     Error_Msg_Qual_Level := 0;
+                  end if;
                end if;
 
                return OK;
index e19c1c76c06f9a88e62823ed6dc748f9f68d9e66..de43c2907b1ae13331a29a3f785ca93c51523065 100644 (file)
@@ -27,7 +27,7 @@
 --  about uses of uninitialized variables and unused with's. It also has
 --  some unrelated routines related to the generation of warnings.
 
-with Alloc; use Alloc;
+with Alloc;
 with Table;
 with Types; use Types;
 
index 4a902e82e4ff9f37347bcb8aa98925f0ba0e84f1..4eb1c8c6f476a888b520bf674b81e48401856082 100644 (file)
@@ -298,7 +298,8 @@ package body Sinfo is
         or else NT (N).Nkind in N_Has_Entity
         or else NT (N).Nkind = N_Aggregate
         or else NT (N).Nkind = N_Extension_Aggregate
-        or else NT (N).Nkind = N_Selected_Component);
+        or else NT (N).Nkind = N_Selected_Component
+        or else NT (N).Nkind = N_Use_Package_Clause);
       return Node4 (N);
    end Associated_Node;
 
@@ -1646,7 +1647,7 @@ package body Sinfo is
       pragma Assert (False
         or else NT (N).Nkind = N_Use_Package_Clause
         or else NT (N).Nkind = N_Use_Type_Clause);
-      return Elist4 (N);
+      return Elist5 (N);
    end Hidden_By_Use_Clause;
 
    function High_Bound
@@ -1882,6 +1883,15 @@ package body Sinfo is
       return Flag18 (N);
    end Is_Dynamic_Coextension;
 
+   function Is_Effective_Use_Clause
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Use_Package_Clause
+        or else NT (N).Nkind = N_Use_Type_Clause);
+      return Flag1 (N);
+   end Is_Effective_Use_Clause;
+
    function Is_Elsif
      (N : Node_Id) return Boolean is
    begin
@@ -2254,7 +2264,9 @@ package body Sinfo is
         or else NT (N).Nkind = N_Formal_Object_Declaration
         or else NT (N).Nkind = N_Number_Declaration
         or else NT (N).Nkind = N_Object_Declaration
-        or else NT (N).Nkind = N_Parameter_Specification);
+        or else NT (N).Nkind = N_Parameter_Specification
+        or else NT (N).Nkind = N_Use_Package_Clause
+        or else NT (N).Nkind = N_Use_Type_Clause);
       return Flag5 (N);
    end More_Ids;
 
@@ -2328,6 +2340,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Requeue_Statement
         or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
         or else NT (N).Nkind = N_Subunit
+        or else NT (N).Nkind = N_Use_Package_Clause
         or else NT (N).Nkind = N_Variant_Part
         or else NT (N).Nkind = N_With_Clause);
       return Node2 (N);
@@ -2337,8 +2350,7 @@ package body Sinfo is
       (N : Node_Id) return List_Id is
    begin
       pragma Assert (False
-        or else NT (N).Nkind = N_Abort_Statement
-        or else NT (N).Nkind = N_Use_Package_Clause);
+        or else NT (N).Nkind = N_Abort_Statement);
       return List2 (N);
    end Names;
 
@@ -2723,10 +2735,21 @@ package body Sinfo is
         or else NT (N).Nkind = N_Formal_Object_Declaration
         or else NT (N).Nkind = N_Number_Declaration
         or else NT (N).Nkind = N_Object_Declaration
-        or else NT (N).Nkind = N_Parameter_Specification);
+        or else NT (N).Nkind = N_Parameter_Specification
+        or else NT (N).Nkind = N_Use_Package_Clause
+        or else NT (N).Nkind = N_Use_Type_Clause);
       return Flag6 (N);
    end Prev_Ids;
 
+   function Prev_Use_Clause
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Use_Package_Clause
+        or else NT (N).Nkind = N_Use_Type_Clause);
+      return Node1 (N);
+   end Prev_Use_Clause;
+
    function Print_In_Hex
       (N : Node_Id) return Boolean is
    begin
@@ -3133,7 +3156,8 @@ package body Sinfo is
         or else NT (N).Nkind = N_Qualified_Expression
         or else NT (N).Nkind = N_Subtype_Indication
         or else NT (N).Nkind = N_Type_Conversion
-        or else NT (N).Nkind = N_Unchecked_Type_Conversion);
+        or else NT (N).Nkind = N_Unchecked_Type_Conversion
+        or else NT (N).Nkind = N_Use_Type_Clause);
       return Node4 (N);
    end Subtype_Mark;
 
@@ -3141,8 +3165,7 @@ package body Sinfo is
       (N : Node_Id) return List_Id is
    begin
       pragma Assert (False
-        or else NT (N).Nkind = N_Unconstrained_Array_Definition
-        or else NT (N).Nkind = N_Use_Type_Clause);
+        or else NT (N).Nkind = N_Unconstrained_Array_Definition);
       return List2 (N);
    end Subtype_Marks;
 
@@ -3338,7 +3361,7 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Use_Type_Clause);
-      return Elist5 (N);
+      return Elist2 (N);
    end Used_Operations;
 
    function Was_Expression_Function
@@ -3609,7 +3632,8 @@ package body Sinfo is
         or else NT (N).Nkind in N_Has_Entity
         or else NT (N).Nkind = N_Aggregate
         or else NT (N).Nkind = N_Extension_Aggregate
-        or else NT (N).Nkind = N_Selected_Component);
+        or else NT (N).Nkind = N_Selected_Component
+        or else NT (N).Nkind = N_Use_Package_Clause);
       Set_Node4 (N, Val); -- semantic field, no parent set
    end Set_Associated_Node;
 
@@ -4948,7 +4972,7 @@ package body Sinfo is
       pragma Assert (False
         or else NT (N).Nkind = N_Use_Package_Clause
         or else NT (N).Nkind = N_Use_Type_Clause);
-      Set_Elist4 (N, Val);
+      Set_Elist5 (N, Val);
    end Set_Hidden_By_Use_Clause;
 
    procedure Set_High_Bound
@@ -5184,6 +5208,15 @@ package body Sinfo is
       Set_Flag18 (N, Val);
    end Set_Is_Dynamic_Coextension;
 
+   procedure Set_Is_Effective_Use_Clause
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Use_Package_Clause
+        or else NT (N).Nkind = N_Use_Type_Clause);
+      Set_Flag1 (N, Val);
+   end Set_Is_Effective_Use_Clause;
+
    procedure Set_Is_Elsif
      (N : Node_Id; Val : Boolean := True) is
    begin
@@ -5556,7 +5589,9 @@ package body Sinfo is
         or else NT (N).Nkind = N_Formal_Object_Declaration
         or else NT (N).Nkind = N_Number_Declaration
         or else NT (N).Nkind = N_Object_Declaration
-        or else NT (N).Nkind = N_Parameter_Specification);
+        or else NT (N).Nkind = N_Parameter_Specification
+        or else NT (N).Nkind = N_Use_Package_Clause
+        or else NT (N).Nkind = N_Use_Type_Clause);
       Set_Flag5 (N, Val);
    end Set_More_Ids;
 
@@ -5630,6 +5665,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Requeue_Statement
         or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
         or else NT (N).Nkind = N_Subunit
+        or else NT (N).Nkind = N_Use_Package_Clause
         or else NT (N).Nkind = N_Variant_Part
         or else NT (N).Nkind = N_With_Clause);
       Set_Node2_With_Parent (N, Val);
@@ -5639,8 +5675,7 @@ package body Sinfo is
       (N : Node_Id; Val : List_Id) is
    begin
       pragma Assert (False
-        or else NT (N).Nkind = N_Abort_Statement
-        or else NT (N).Nkind = N_Use_Package_Clause);
+        or else NT (N).Nkind = N_Abort_Statement);
       Set_List2_With_Parent (N, Val);
    end Set_Names;
 
@@ -6025,10 +6060,21 @@ package body Sinfo is
         or else NT (N).Nkind = N_Formal_Object_Declaration
         or else NT (N).Nkind = N_Number_Declaration
         or else NT (N).Nkind = N_Object_Declaration
-        or else NT (N).Nkind = N_Parameter_Specification);
+        or else NT (N).Nkind = N_Parameter_Specification
+        or else NT (N).Nkind = N_Use_Package_Clause
+        or else NT (N).Nkind = N_Use_Type_Clause);
       Set_Flag6 (N, Val);
    end Set_Prev_Ids;
 
+   procedure Set_Prev_Use_Clause
+      (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Use_Package_Clause
+        or else NT (N).Nkind = N_Use_Type_Clause);
+      Set_Node1 (N, Val); -- semantic field, no parent set
+   end Set_Prev_Use_Clause;
+
    procedure Set_Print_In_Hex
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -6418,7 +6464,8 @@ package body Sinfo is
         or else NT (N).Nkind = N_Qualified_Expression
         or else NT (N).Nkind = N_Subtype_Indication
         or else NT (N).Nkind = N_Type_Conversion
-        or else NT (N).Nkind = N_Unchecked_Type_Conversion);
+        or else NT (N).Nkind = N_Unchecked_Type_Conversion
+        or else NT (N).Nkind = N_Use_Type_Clause);
       Set_Node4_With_Parent (N, Val);
    end Set_Subtype_Mark;
 
@@ -6426,8 +6473,7 @@ package body Sinfo is
       (N : Node_Id; Val : List_Id) is
    begin
       pragma Assert (False
-        or else NT (N).Nkind = N_Unconstrained_Array_Definition
-        or else NT (N).Nkind = N_Use_Type_Clause);
+        or else NT (N).Nkind = N_Unconstrained_Array_Definition);
       Set_List2_With_Parent (N, Val);
    end Set_Subtype_Marks;
 
@@ -6640,7 +6686,7 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Use_Type_Clause);
-      Set_Elist5 (N, Val);
+      Set_Elist2 (N, Val);
    end Set_Used_Operations;
 
    procedure Set_Was_Expression_Function
index a5a6413200b819998d345937e9fd4013238a4e3b..87b65424f4d26692b367233e0ea246308f248288 100644 (file)
@@ -1596,7 +1596,7 @@ package Sinfo is
    --    added to the size of the prefix. The flag also prevents the infinite
    --    expansion of the same attribute in the said context.
 
-   --  Hidden_By_Use_Clause (Elist4-Sem)
+   --  Hidden_By_Use_Clause (Elist5-Sem)
    --     An entity list present in use clauses that appear within
    --     instantiations. For the resolution of local entities, entities
    --     introduced by these use clauses have priority over global ones, and
@@ -1721,6 +1721,10 @@ package Sinfo is
    --    coextension must be deallocated and finalized at the same time as
    --    the enclosing object.
 
+   --  Is_Effective_Use_Clause (Flag1-Sem)
+   --    Present in both N_Use_Type_Clause and N_Use_Package_Clause to indicate
+   --    a use clause is "used" in the current source.
+
    --  Is_Entry_Barrier_Function (Flag8-Sem)
    --    This flag is set on N_Subprogram_Declaration and N_Subprogram_Body
    --    nodes which emulate the barrier function of a protected entry body.
@@ -2137,6 +2141,11 @@ package Sinfo is
    --    ASIS processing (data decomposition annex) to determine if a field is
    --    present or not.
 
+   --  Prev_Use_Clause (Node1-Sem)
+   --    Present in both N_Use_Package_Clause and N_Use_Type_Clause. Used in
+   --    detection of ineffective use clauses by allowing a chain of related
+   --    clauses together to avoid traversing the current scope stack.
+
    --  Print_In_Hex (Flag13-Sem)
    --    Set on an N_Integer_Literal node to indicate that the value should be
    --    printed in hexadecimal in the sprint listing. Has no effect on
@@ -2338,7 +2347,7 @@ package Sinfo is
    --    initialized. Used to warn if the corresponding actual type is not
    --    a fully initialized type.
 
-   --  Used_Operations (Elist5-Sem)
+   --  Used_Operations (Elist2-Sem)
    --    Present in N_Use_Type_Clause nodes. Holds the list of operations that
    --    are made potentially use-visible by the clause. Simplifies processing
    --    on exit from the scope of the use_type_clause, in particular in the
@@ -5687,9 +5696,14 @@ package Sinfo is
 
       --  N_Use_Package_Clause
       --  Sloc points to USE
-      --  Names (List2)
+      --  Prev_Use_Clause (Node1-Sem)
+      --  Name (Node2)
       --  Next_Use_Clause (Node3-Sem)
-      --  Hidden_By_Use_Clause (Elist4-Sem)
+      --  Associated_Node (Node4-Sem)
+      --  Hidden_By_Use_Clause (Elist5-Sem)
+      --  Is_Effective_Use_Clause (Flag1)
+      --  More_Ids (Flag5) (set to False if no more identifiers in list)
+      --  Prev_Ids (Flag6) (set to False if no previous identifiers in list)
 
       --------------------------
       -- 8.4  Use Type Clause --
@@ -5703,10 +5717,14 @@ package Sinfo is
 
       --  N_Use_Type_Clause
       --  Sloc points to USE
-      --  Subtype_Marks (List2)
+      --  Prev_Use_Clause (Node1-Sem)
+      --  Used_Operations (Elist2-Sem)
       --  Next_Use_Clause (Node3-Sem)
-      --  Hidden_By_Use_Clause (Elist4-Sem)
-      --  Used_Operations (Elist5-Sem)
+      --  Subtype_Mark (Node4)
+      --  Hidden_By_Use_Clause (Elist5-Sem)
+      --  Is_Effective_Use_Clause (Flag1)
+      --  More_Ids (Flag5) (set to False if no more identifiers in list)
+      --  Prev_Ids (Flag6) (set to False if no previous identifiers in list)
       --  All_Present (Flag15)
 
       -------------------------------
@@ -9455,7 +9473,7 @@ package Sinfo is
      (N : Node_Id) return Boolean;    -- Flag11
 
    function Hidden_By_Use_Clause
-     (N : Node_Id) return Elist_Id;   -- Elist4
+     (N : Node_Id) return Elist_Id;   -- Elist5
 
    function High_Bound
      (N : Node_Id) return Node_Id;    -- Node2
@@ -9535,6 +9553,9 @@ package Sinfo is
    function Is_Dynamic_Coextension
      (N : Node_Id) return Boolean;    -- Flag18
 
+   function Is_Effective_Use_Clause
+     (N : Node_Id) return Boolean;    -- Flag1
+
    function Is_Elsif
      (N : Node_Id) return Boolean;    -- Flag13
 
@@ -9802,6 +9823,9 @@ package Sinfo is
    function Prev_Ids
      (N : Node_Id) return Boolean;    -- Flag6
 
+   function Prev_Use_Clause
+     (N : Node_Id) return Node_Id;    -- Node1
+
    function Print_In_Hex
      (N : Node_Id) return Boolean;    -- Flag13
 
@@ -9995,7 +10019,7 @@ package Sinfo is
      (N : Node_Id) return Node_Id;    -- Node3
 
    function Used_Operations
-     (N : Node_Id) return Elist_Id;   -- Elist5
+     (N : Node_Id) return Elist_Id;   -- Elist2
 
    function Was_Expression_Function
      (N : Node_Id) return Boolean;    -- Flag18
@@ -10511,7 +10535,7 @@ package Sinfo is
      (N : Node_Id; Val : Boolean := True);    -- Flag11
 
    procedure Set_Hidden_By_Use_Clause
-     (N : Node_Id; Val : Elist_Id);           -- Elist4
+     (N : Node_Id; Val : Elist_Id);           -- Elist5
 
    procedure Set_High_Bound
      (N : Node_Id; Val : Node_Id);            -- Node2
@@ -10591,6 +10615,9 @@ package Sinfo is
    procedure Set_Is_Dynamic_Coextension
      (N : Node_Id; Val : Boolean := True);    -- Flag18
 
+   procedure Set_Is_Effective_Use_Clause
+     (N : Node_Id; Val : Boolean := True);    -- Flag1
+
    procedure Set_Is_Elsif
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
@@ -10858,6 +10885,9 @@ package Sinfo is
    procedure Set_Prev_Ids
      (N : Node_Id; Val : Boolean := True);    -- Flag6
 
+   procedure Set_Prev_Use_Clause
+     (N : Node_Id; Val : Node_Id);            -- Node1
+
    procedure Set_Print_In_Hex
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
@@ -11051,7 +11081,7 @@ package Sinfo is
      (N : Node_Id; Val : Node_Id);            -- Node3
 
    procedure Set_Used_Operations
-     (N : Node_Id; Val : Elist_Id);           -- Elist5
+     (N : Node_Id; Val : Elist_Id);           -- Elist2
 
    procedure Set_Was_Expression_Function
      (N : Node_Id; Val : Boolean := True);    -- Flag18
@@ -12053,18 +12083,18 @@ package Sinfo is
         5 => True),   --  Subtype_Indication (Node5)
 
      N_Use_Package_Clause =>
-       (1 => False,   --  unused
-        2 => True,    --  Names (List2)
+       (1 => False,   --  Prev_Use_Clause (Node1-Sem)
+        2 => True,    --  Name (Node2)
         3 => False,   --  Next_Use_Clause (Node3-Sem)
-        4 => False,   --  Hidden_By_Use_Clause (Elist4-Sem)
-        5 => False),  --  unused
+        4 => False,   --  Associated_Node (Node4-Sem)
+        5 => False),  --  Hidden_By_Use_Clause (Elist5-Sem)
 
      N_Use_Type_Clause =>
-       (1 => False,   --  unused
-        2 => True,    --  Subtype_Marks (List2)
+       (1 => False,   --  Prev_Use_Clause (Node1-Sem)
+        2 => False,   --  Used_Operations (Elist2-Sem)
         3 => False,   --  Next_Use_Clause (Node3-Sem)
-        4 => False,   --  Hidden_By_Use_Clause (Elist4-Sem)
-        5 => False),  --  unused
+        4 => True,    --  Subtype_Mark (Node4)
+        5 => False),  --  Hidden_By_Use_Clause (Elist5-Sem)
 
      N_Object_Renaming_Declaration =>
        (1 => True,    --  Defining_Identifier (Node1)
@@ -13053,6 +13083,7 @@ package Sinfo is
    pragma Inline (Is_Delayed_Aspect);
    pragma Inline (Is_Disabled);
    pragma Inline (Is_Dynamic_Coextension);
+   pragma Inline (Is_Effective_Use_Clause);
    pragma Inline (Is_Elsif);
    pragma Inline (Is_Entry_Barrier_Function);
    pragma Inline (Is_Expanded_Build_In_Place_Call);
@@ -13141,6 +13172,7 @@ package Sinfo is
    pragma Inline (Premature_Use);
    pragma Inline (Present_Expr);
    pragma Inline (Prev_Ids);
+   pragma Inline (Prev_Use_Clause);
    pragma Inline (Print_In_Hex);
    pragma Inline (Private_Declarations);
    pragma Inline (Private_Present);
@@ -13400,6 +13432,7 @@ package Sinfo is
    pragma Inline (Set_Is_Delayed_Aspect);
    pragma Inline (Set_Is_Disabled);
    pragma Inline (Set_Is_Dynamic_Coextension);
+   pragma Inline (Set_Is_Effective_Use_Clause);
    pragma Inline (Set_Is_Elsif);
    pragma Inline (Set_Is_Entry_Barrier_Function);
    pragma Inline (Set_Is_Expanded_Build_In_Place_Call);
@@ -13489,6 +13522,7 @@ package Sinfo is
    pragma Inline (Set_Premature_Use);
    pragma Inline (Set_Present_Expr);
    pragma Inline (Set_Prev_Ids);
+   pragma Inline (Set_Prev_Use_Clause);
    pragma Inline (Set_Print_In_Hex);
    pragma Inline (Set_Private_Declarations);
    pragma Inline (Set_Private_Present);
index d97a1f78dd7701eb1cef189881699964289e83fc..6e2931093791521b62993e63115c781f8c60d0c6 100644 (file)
@@ -3435,12 +3435,12 @@ package body Sprint is
 
          when N_Use_Package_Clause =>
             Write_Indent_Str_Sloc ("use ");
-            Sprint_Comma_List (Names (Node));
+            Sprint_Node_Sloc (Name (Node));
             Write_Char (';');
 
          when N_Use_Type_Clause =>
             Write_Indent_Str_Sloc ("use type ");
-            Sprint_Comma_List (Subtype_Marks (Node));
+            Sprint_Node_Sloc (Subtype_Mark (Node));
             Write_Char (';');
 
          when N_Validate_Unchecked_Conversion =>
index 2ee9245268add52ec2ca1e34fcfe664f5ca4c1cc..4855db50b15f4dab6e420fab9b3fd22a2f51f77e 100644 (file)
@@ -24,7 +24,7 @@
 ------------------------------------------------------------------------------
 
 with Csets;    use Csets;
-with Opt;      use Opt;
+with Opt;
 with Osint;    use Osint;
 with Output;   use Output;
 
index e0809f27037242c9ebf9b4358c1cdf13d50ff556..0d8eb06c715ef80a2f62380b269eb6c16376a214 100644 (file)
@@ -572,12 +572,15 @@ package Types is
    No_Unit : constant Unit_Number_Type := -1;
    --  Special value used to signal no unit
 
-   type Source_File_Index is new Int range 0 .. Int'Last;
+   type Source_File_Index is new Int range -1 .. Int'Last;
    --  Type used to index the source file table (see package Sinput)
 
    No_Source_File : constant Source_File_Index := 0;
    --  Value used to indicate no source file present
 
+   No_Access_To_Source_File : constant Source_File_Index := -1;
+   --  Value used to indicate a source file is present but unreadable
+
    -----------------------------------
    -- Representation of Time Stamps --
    -----------------------------------
index 8a6411c75e39f0ab36c5adedaed11b573a8d3cdc..8ae9e6d1b32662e5121c3d6387e83a7525cc3487 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2017, 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- --
@@ -36,7 +36,7 @@ with Ada.Strings.Unbounded;     use Ada.Strings.Unbounded;
 
 with GNAT.OS_Lib;               use GNAT.OS_Lib;
 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with GNAT.HTable;               use GNAT.HTable;
+with GNAT.HTable;
 with GNAT.Heap_Sort_G;
 
 package body Xr_Tabls is
index 92508414a03e516da5c461c411a53b5377de43da..b860978d774e879d5532929d5c5ed6fe9ac2f7c9 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2017, 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- --
@@ -30,7 +30,7 @@ with Types;  use Types;
 with Unchecked_Deallocation;
 
 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
-with Ada.Text_IO;       use Ada.Text_IO;
+with Ada.Text_IO;
 
 with GNAT.Command_Line; use GNAT.Command_Line;
 with GNAT.IO_Aux;       use GNAT.IO_Aux;