From 498f964b79d6a5830bb41125423df37900fd0f81 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 6 Apr 2007 09:29:20 +0000 Subject: [PATCH] 2007-04-06 Robert Dewar Arnaud Charlet * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123606 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/a-diroro.ads | 6 +++--- gcc/ada/bindgen.adb | 12 ++++++++++++ gcc/ada/elists.adb | 49 ++++++++++++++++++++++++++++++++++--------------- gcc/ada/elists.ads | 19 ++++++++++++------- gcc/ada/fname-uf.ads | 9 ++++----- gcc/ada/osint.ads | 5 +++-- gcc/ada/par-load.adb | 7 ++++++- gcc/ada/s-parint.ads | 9 ++++++--- gcc/ada/s-secsta.ads | 4 +++- gcc/ada/s-soflin.ads | 22 +++++++++++----------- gcc/ada/s-stratt.ads | 22 ---------------------- gcc/ada/s-wchcon.ads | 1 + gcc/ada/sem_cat.adb | 6 +++--- gcc/ada/sem_cat.ads | 2 +- gcc/ada/treepr.adb | 12 +++++++++++- 15 files changed, 110 insertions(+), 75 deletions(-) diff --git a/gcc/ada/a-diroro.ads b/gcc/ada/a-diroro.ads index 379d0430072..2cdaeb1f2b1 100644 --- a/gcc/ada/a-diroro.ads +++ b/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); diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index b8718a69756..65e952ad406 100644 --- a/gcc/ada/bindgen.adb +++ b/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"); diff --git a/gcc/ada/elists.adb b/gcc/ada/elists.adb index 0fb616e5cac..831f95242ca 100644 --- a/gcc/ada/elists.adb +++ b/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; diff --git a/gcc/ada/elists.ads b/gcc/ada/elists.ads index d68d66d2f2e..6ddb45871a0 100644 --- a/gcc/ada/elists.ads +++ b/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 diff --git a/gcc/ada/fname-uf.ads b/gcc/ada/fname-uf.ads index ded1b8fa77f..bf047704231 100644 --- a/gcc/ada/fname-uf.ads +++ b/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, diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index cda8e828573..8af2ef64608 100644 --- a/gcc/ada/osint.ads +++ b/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 diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb index b69bbbb49a7..d73546843bb 100644 --- a/gcc/ada/par-load.adb +++ b/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; diff --git a/gcc/ada/s-parint.ads b/gcc/ada/s-parint.ads index 4eeb67109a2..07d7d7c11d3 100644 --- a/gcc/ada/s-parint.ads +++ b/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; diff --git a/gcc/ada/s-secsta.ads b/gcc/ada/s-secsta.ads index ad4a98decf2..c5a2fadf502 100644 --- a/gcc/ada/s-secsta.ads +++ b/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; diff --git a/gcc/ada/s-soflin.ads b/gcc/ada/s-soflin.ads index 2abe631a418..6da5c586a9c 100644 --- a/gcc/ada/s-soflin.ads +++ b/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. diff --git a/gcc/ada/s-stratt.ads b/gcc/ada/s-stratt.ads index e0e9b0f5c6d..e1b5960d84e 100644 --- a/gcc/ada/s-stratt.ads +++ b/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); diff --git a/gcc/ada/s-wchcon.ads b/gcc/ada/s-wchcon.ads index 6ae05afd4d0..38b952f3c10 100644 --- a/gcc/ada/s-wchcon.ads +++ b/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 diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index dc7350a2101..581aad7080e 100644 --- a/gcc/ada/sem_cat.adb +++ b/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; diff --git a/gcc/ada/sem_cat.ads b/gcc/ada/sem_cat.ads index 481a52af923..fb583789014 100644 --- a/gcc/ada/sem_cat.ads +++ b/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; diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 492451c60c8..4c26fd6ca81 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -744,11 +744,14 @@ package body Treepr is elsif N = Error_Name then Print_Str (""); - else + elsif Is_Valid_Name (N) then Get_Name_String (N); Print_Char ('"'); Write_Name (N); Print_Char ('"'); + + else + Print_Str (""); 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"); -- 2.11.0