a-diroro.ads: Inserted the pragma Unimplemented_Unit

2007-04-06  Robert Dewar  <dewar@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>

	* a-diroro.ads: Inserted the pragma Unimplemented_Unit

	* bindgen.adb (Gen_Output_File_Ada): Generate pragma Ada_95 at start
	of files
	Add mention of -Sev (set initialize_scalars option from environment
	variable at run time) in gnatbind usage message.

	* elists.ads, elists.adb: (Append_Unique_Elmt): New procedure

	* fname-uf.ads: Minor comment fix

	* osint.ads: Change pragma Elaborate to Elaborate_All

	* par-load.adb: Add documentation.

	* sem_cat.ads, sem_cat.adb: Minor code reorganization

	* s-parint.ads (RCI_Locator) : Add 'Version' generic formal

	* s-secsta.ads: Extra comments

	* s-soflin.ads: Minor comment fixes

	* s-stratt.ads (Block_Stream_Ops_OK): Removed.

	* s-wchcon.ads: Minor comment addition

	* treepr.adb: Minor change in message
	(Print_Name,Print_Node): Make these debug printouts more robust: print
	"no such..." instead of crashing on bad input.

From-SVN: r123606

gcc/ada/a-diroro.ads

@@ -6,9 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2006, Free Software Foundation, Inc.            --
---                                                                          --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT.  In accordance with the copyright of that document, you can freely --
 -- copy and modify this specification,  provided that if you redistribute a --
 -- modified version,  any changes that you have made are clearly indicated. --
@@ -20,6 +18,8 @@ with Ada.Real_Time;
 
 package Ada.Dispatching.Round_Robin is
 
+   pragma Unimplemented_Unit;
+
    Default_Quantum : constant Ada.Real_Time.Time_Span :=
                        Ada.Real_Time.Milliseconds (10);
 

gcc/ada/bindgen.adb

@@ -1964,6 +1964,12 @@ package body Bindgen is
 
       Create_Binder_Output (Filename, 's', Bfiles);
 
+      --  We always compile the binder file in Ada 95 mode so that we properly
+      --  handle use of Ada 2005 keywords as identifiers in Ada 95 mode. None
+      --  of the Ada 2005 constructs are needed by the binder file.
+
+      WBI ("pragma Ada_95;");
+
       --  If we are operating in Restrictions (No_Exception_Handlers) mode,
       --  then we need to make sure that the binder program is compiled with
       --  the same restriction, so that no exception tables are generated.
@@ -2153,6 +2159,12 @@ package body Bindgen is
 
       Create_Binder_Output (Filename, 'b', Bfileb);
 
+      --  We always compile the binder file in Ada 95 mode so that we properly
+      --  handle use of Ada 2005 keywords as identifiers in Ada 95 mode. None
+      --  of the Ada 2005 constructs are needed by the binder file.
+
+      WBI ("pragma Ada_95;");
+
       --  Output Source_File_Name pragmas which look like
 
       --    pragma Source_File_Name (Ada_Main, Spec_File_Name => "sss");

gcc/ada/elists.adb

@@ -97,7 +97,7 @@ package body Elists is
      Table_Name           => "Elists");
 
    type Elmt_Item is record
-      Node : Node_Id;
+      Node : Node_Or_Entity_Id;
       Next : Union_Id;
    end record;
 
@@ -113,12 +113,12 @@ package body Elists is
    -- Append_Elmt --
    -----------------
 
-   procedure Append_Elmt (Node : Node_Id; To : Elist_Id) is
+   procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
       L : constant Elmt_Id := Elists.Table (To).Last;
 
    begin
       Elmts.Increment_Last;
-      Elmts.Table (Elmts.Last).Node := Node;
+      Elmts.Table (Elmts.Last).Node := N;
       Elmts.Table (Elmts.Last).Next := Union_Id (To);
 
       if L = No_Elmt then
@@ -134,12 +134,32 @@ package body Elists is
          Write_Int (Int (Elmts.Last));
          Write_Str (" to list Elist_Id = ");
          Write_Int (Int (To));
-         Write_Str (" referencing Node_Id = ");
-         Write_Int (Int (Node));
+         Write_Str (" referencing Node_Or_Entity_Id = ");
+         Write_Int (Int (N));
          Write_Eol;
       end if;
    end Append_Elmt;
 
+   ------------------------
+   -- Append_Unique_Elmt --
+   ------------------------
+
+   procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
+      Elmt : Elmt_Id;
+   begin
+      Elmt := First_Elmt (To);
+      loop
+         if No (Elmt) then
+            Append_Elmt (N, To);
+            return;
+         elsif Node (Elmt) = N then
+            return;
+         else
+            Next_Elmt (Elmt);
+         end if;
+      end loop;
+   end Append_Unique_Elmt;
+
    --------------------
    -- Elists_Address --
    --------------------
@@ -182,20 +202,20 @@ package body Elists is
    -- Insert_Elmt_After --
    -----------------------
 
-   procedure Insert_Elmt_After (Node : Node_Id; Elmt : Elmt_Id) is
-      N : constant Union_Id := Elmts.Table (Elmt).Next;
+   procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is
+      Nxt : constant Union_Id := Elmts.Table (Elmt).Next;
 
    begin
       pragma Assert (Elmt /= No_Elmt);
 
       Elmts.Increment_Last;
-      Elmts.Table (Elmts.Last).Node := Node;
-      Elmts.Table (Elmts.Last).Next := N;
+      Elmts.Table (Elmts.Last).Node := N;
+      Elmts.Table (Elmts.Last).Next := Nxt;
 
       Elmts.Table (Elmt).Next := Union_Id (Elmts.Last);
 
-      if N in Elist_Range then
-         Elists.Table (Elist_Id (N)).Last := Elmts.Last;
+      if Nxt in Elist_Range then
+         Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last;
       end if;
    end Insert_Elmt_After;
 
@@ -326,12 +346,12 @@ package body Elists is
    -- Prepend_Elmt --
    ------------------
 
-   procedure Prepend_Elmt (Node : Node_Id; To : Elist_Id) is
+   procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
       F : constant Elmt_Id := Elists.Table (To).First;
 
    begin
       Elmts.Increment_Last;
-      Elmts.Table (Elmts.Last).Node := Node;
+      Elmts.Table (Elmts.Last).Node := N;
 
       if F = No_Elmt then
          Elists.Table (To).Last := Elmts.Last;
@@ -341,7 +361,6 @@ package body Elists is
       end if;
 
       Elists.Table (To).First  := Elmts.Last;
-
    end Prepend_Elmt;
 
    -------------
@@ -438,7 +457,7 @@ package body Elists is
    -- Replace_Elmt --
    ------------------
 
-   procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Id) is
+   procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is
    begin
       Elmts.Table (Elmt).Node := New_Node;
    end Replace_Elmt;

gcc/ada/elists.ads

@@ -121,17 +121,22 @@ package Elists is
    --  This function determines if a given tree id references an element list
    --  that contains no items.
 
-   procedure Append_Elmt (Node : Node_Id; To : Elist_Id);
-   --  Appends Node at the end of To, allocating a new element
+   procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
+   --  Appends N at the end of To, allocating a new element. N must be a
+   --  non-empty node or entity Id, and To must be an Elist (not No_Elist).
 
-   procedure Prepend_Elmt (Node : Node_Id; To : Elist_Id);
-   --  Appends Node at the beginning of To, allocating a new element
+   procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
+   --  Like Append_Elmt, except that a check is made to see if To already
+   --  contains N and if so the call has no effect.
 
-   procedure Insert_Elmt_After (Node : Node_Id; Elmt : Elmt_Id);
-   --  Add a new element (Node) right after the pre-existing element Elmt
+   procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
+   --  Appends N at the beginning of To, allocating a new element
+
+   procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id);
+   --  Add a new element (N) right after the pre-existing element Elmt
    --  It is invalid to call this subprogram with Elmt = No_Elmt.
 
-   procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Id);
+   procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id);
    pragma Inline (Replace_Elmt);
    --  Causes the given element of the list to refer to New_Node, the node
    --  which was previously referred to by Elmt is effectively removed from

gcc/ada/fname-uf.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2006, 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- --
@@ -58,10 +58,9 @@ package Fname.UF is
       Subunit  : Boolean;
       May_Fail : Boolean := False) return File_Name_Type;
    --  This function returns the file name that corresponds to a given unit
-   --  name, Uname. The Subunit parameter is set True for subunits, and
-   --  false for all other kinds of units. The caller is responsible for
-   --  ensuring that the unit name meets the requirements given in package
-   --  Uname and described above.
+   --  name, Uname. The Subunit parameter is set True for subunits, and false
+   --  for all other kinds of units. The caller must ensure that the unit name
+   --  meets the requirements given in package Uname.
    --
    --  When May_Fail is True, if the file cannot be found, this function
    --  returns No_File. When it is False, if the file cannot be found,

gcc/ada/osint.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2006, 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,8 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
 with System;      use System;
 with Types;       use Types;
 
-pragma Elaborate (GNAT.OS_Lib);
+pragma Elaborate_All (GNAT.OS_Lib);
+--  For the call to function Get_Target_Object_Suffix in the private part
 
 package Osint is
 

gcc/ada/par-load.adb

@@ -84,7 +84,12 @@ procedure Load is
    --  Unit number of loaded unit
 
    Limited_With_Found : Boolean := False;
-   --  Set True if a limited WITH is found, used to ???
+   --  We load the context items in two rounds: the first round handles normal
+   --  withed units and the second round handles Ada 2005 limited-withed units.
+   --  This is required to allow the low-level circuitry that detects circular
+   --  dependencies of units the correct notification of errors (see comment
+   --  bellow). This variable is used to indicate that the second round is
+   --  required.
 
    function Same_File_Name_Except_For_Case
      (Expected_File_Name : File_Name_Type;

gcc/ada/s-parint.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1995-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2006, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -112,8 +112,8 @@ package System.Partition_Interface is
    --  unit has has the same version than the caller's one.
 
    function Same_Partition
-      (Left  : access RACW_Stub_Type;
-       Right : access RACW_Stub_Type) return Boolean;
+      (Left  : not null access RACW_Stub_Type;
+       Right : not null access RACW_Stub_Type) return Boolean;
    --  Determine whether Left and Right correspond to objects instantiated
    --  on the same partition, for enforcement of E.4(19).
 
@@ -171,7 +171,10 @@ package System.Partition_Interface is
 
    generic
       RCI_Name : String;
+      Version  : String;
    package RCI_Locator is
+      pragma Unreferenced (Version);
+
       function Get_RCI_Package_Receiver return Interfaces.Unsigned_64;
       function Get_Active_Partition_ID return RPC.Partition_ID;
    end RCI_Locator;

gcc/ada/s-secsta.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -39,6 +39,8 @@ package System.Secondary_Stack is
 
    Default_Secondary_Stack_Size : Natural := 10 * 1024;
    --  Default size of a secondary stack. May be modified by binder -D switch
+   --  which causes the binder to generate an appropriate assignment in the
+   --  binder generated file.
 
    procedure SS_Init
      (Stk  : in out Address;

gcc/ada/s-soflin.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -32,12 +32,12 @@
 ------------------------------------------------------------------------------
 
 --  This package contains a set of subprogram access variables that access
---  some low-level primitives that are called different depending whether
---  tasking is involved or not (e.g. the Get/Set_Jmpbuf_Address that needs
---  to provide a different value for each task). To avoid dragging in the
---  tasking all the time, we use a system of soft links where the links are
---  initialized to non-tasking versions, and then if the tasking is
---  initialized, they are reset to the real tasking versions.
+--  some low-level primitives that are different depending whether tasking is
+--  involved or not (e.g. the Get/Set_Jmpbuf_Address that needs to provide a
+--  different value for each task). To avoid dragging in the tasking runtimes
+--  all the time, we use a system of soft links where the links are
+--  initialized to non-tasking versions, and then if the tasking support is
+--  initialized, they are set to the real tasking versions.
 
 with Ada.Exceptions;
 with System.Stack_Checking;
@@ -58,7 +58,7 @@ package System.Soft_Links is
 
    --  First we have the access subprogram types used to establish the links.
    --  The approach is to establish variables containing access subprogram
-   --  values which by default point to dummy no tasking versions of routines.
+   --  values, which by default point to dummy no tasking versions of routines.
 
    type No_Param_Proc     is access procedure;
    type Addr_Param_Proc   is access procedure (Addr : Address);
@@ -88,7 +88,7 @@ package System.Soft_Links is
    type Task_Name_Call is access
      function return String;
 
-   --  Suppress checks on all these types, since we know corrresponding
+   --  Suppress checks on all these types, since we know the corrresponding
    --  values can never be null (the soft links are always initialized).
 
    pragma Suppress (Access_Check, No_Param_Proc);
@@ -126,7 +126,7 @@ package System.Soft_Links is
    --  uses this.
 
    procedure Update_Exception_NT (X : EO := Current_Target_Exception);
-   --  Handle exception setting. This routine is provided for targets which
+   --  Handle exception setting. This routine is provided for targets that
    --  have built-in exception handling such as the Java Virtual Machine.
    --  Currently, only JGNAT uses this. See 4jexcept.ads for an explanation on
    --  how this routine is used.
@@ -241,7 +241,7 @@ package System.Soft_Links is
    -- Master_Id Soft-Links --
    --------------------------
 
-   --  Soft-Links are used for procedures that manipulate  Master_Ids because
+   --  Soft-Links are used for procedures that manipulate Master_Ids because
    --  a Master_Id must be generated for access to limited class-wide types,
    --  whose root may be extended with task components.
 

gcc/ada/s-stratt.ads

@@ -155,28 +155,6 @@ package System.Stream_Attributes is
    procedure W_U   (Stream : not null access RST; Item : UST.Unsigned);
    procedure W_WC  (Stream : not null access RST; Item : Wide_Character);
 
-   ----------------------------
-   -- Composite Input/Output --
-   ----------------------------
-
-   --  The following Boolean constant is defined and set to True only if the
-   --  stream representation of a series of elementary items of the same
-   --  type (one of the types handled by the above procedures) has the same
-   --  representation as an array of such items in memory. This allows such
-   --  a series of items to be read or written as a block, instead of
-   --  element by element.
-
-   --  If the stream representation does not have this property for all the
-   --  above types, then this constant can be omitted or set to False,
-   --  and the front end will generate element-by-element operations.
-
-   --  This interface assumes that a Stream_Element has the same size as
-   --  a Storage_Unit. If that is not the case, then this flag should
-   --  also be omitted (or set to False).
-
-   Block_Stream_Ops_OK : constant Boolean := True;
-   --  Set to False if block stream operations not permitted
-
 private
    pragma Inline (I_AD);
    pragma Inline (I_AS);

gcc/ada/s-wchcon.ads

@@ -81,6 +81,7 @@ package System.WCh_Con is
    --     4.  Adjust definition of WC_Longest_Sequence if necessary
    --     5.  Add an entry in WC_Encoding_Letters for the new method
    --     6.  Add proper code to s-wchstw.adb, s-wchwts.adb, s-widwch.adb
+   --     7.  Update documentation (remember section on form strings)
 
    --  Note that the WC_Encoding_Method values must be kept ordered so that
    --  the definitions of the subtypes WC_Upper_Half_Encoding_Method and

gcc/ada/sem_cat.adb

@@ -663,9 +663,9 @@ package body Sem_Cat is
          if Ekind (E) in Subprogram_Kind then
             Declaration := Unit_Declaration_Node (E);
 
-            if False
-              or else Nkind (Declaration) = N_Subprogram_Body
-              or else Nkind (Declaration) = N_Subprogram_Renaming_Declaration
+            if Nkind (Declaration) = N_Subprogram_Body
+                 or else
+               Nkind (Declaration) = N_Subprogram_Renaming_Declaration
             then
                Specification := Corresponding_Spec (Declaration);
             end if;

gcc/ada/sem_cat.ads

@@ -152,6 +152,6 @@ package Sem_Cat is
    --  Enforce constraints on primitive operations of the designated type of
    --  an RACW. Note that since the complete set of primitive operations of the
    --  designated type needs to be known, we must defer these checks until the
-   --  desgianted type is frozen.
+   --  designated type is frozen.
 
 end Sem_Cat;

gcc/ada/treepr.adb

@@ -744,11 +744,14 @@ package body Treepr is
          elsif N = Error_Name then
             Print_Str ("<Error_Name>");
 
-         else
+         elsif Is_Valid_Name (N) then
             Get_Name_String (N);
             Print_Char ('"');
             Write_Name (N);
             Print_Char ('"');
+
+         else
+            Print_Str ("<invalid name ???>");
          end if;
       end if;
    end Print_Name;
@@ -793,6 +796,13 @@ package body Treepr is
 
       Notes := False;
 
+      if N not in
+        Atree_Private_Part.Nodes.First .. Atree_Private_Part.Nodes.Last then
+         Print_Str (" (no such node)");
+         Print_Eol;
+         return;
+      end if;
+
       if Comes_From_Source (N) then
          Notes := True;
          Print_Str (" (source");