Commit 87ace727 by Robert Dewar Committed by Arnaud Charlet

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
parent 7a56c3bc
......@@ -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);
......
......@@ -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");
......
......@@ -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;
......
......@@ -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
......
......@@ -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,
......
......@@ -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
......
......@@ -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;
......
......@@ -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;
......
......@@ -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;
......
......@@ -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.
......
......@@ -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);
......
......@@ -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
......
......@@ -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;
......
......@@ -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;
......@@ -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");
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment