This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
committed: Ada updates
- From: Arnaud Charlet <charlet at ACT-Europe dot FR>
- To: gcc-patches at gcc dot gnu dot org
- Date: Tue, 13 Jan 2004 12:52:06 +0100
- Subject: committed: Ada updates
Tested on x86-linux
--
2004-01-13 Ed Schonberg <schonberg@gnat.com>
* exp_ch3.adb (Build_Assignment): Fix bug in handling of controlled
components that are initialized with aggregates.
2004-01-13 Vincent Celier <celier@gnat.com>
* gnatlink.adb (Process_Binder_File): To find directory of shared
libgcc, if "gcc-lib" is not a subdirectory, look for the last
subdirectory "lib" in the path of the shared libgnat or libgnarl.
* make.adb (Gnatmake): If GCC version is at least 3, link with
-shared-libgcc, when there is at least one shared library project.
* opt.ads (GCC_Version): New integer constant.
* adaint.c (get_gcc_version): New function.
2004-01-13 Robert Dewar <dewar@gnat.com>
* sem_dist.adb, sem_res.adb, sem_util.adb,
sprint.adb, 3zsocthi.adb, einfo.adb, cstand.adb,
exp_ch4.adb, exp_ch9.adb, exp_dist.adb: Minor reformatting
2004-01-13 Thomas Quinot <quinot@act-europe.fr>
* s-interr.adb, s-stache.adb, s-taenca.adb, g-regpat.adb,
g-spitbo.adb, 5itaprop.adb: Add missing 'constant' keywords in object
declarations.
--
Index: 3zsocthi.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/3zsocthi.adb,v
retrieving revision 1.3
diff -u -p -r1.3 3zsocthi.adb
--- 3zsocthi.adb 12 Jan 2004 11:45:23 -0000 1.3
+++ 3zsocthi.adb 13 Jan 2004 10:29:02 -0000
@@ -64,7 +64,7 @@ package body GNAT.Sockets.Thin is
Thread_Blocking_IO : Boolean := True;
Unknown_System_Error : constant C.Strings.chars_ptr :=
- C.Strings.New_String ("Unknown system error");
+ C.Strings.New_String ("Unknown system error");
-- The following types and variables are required to create a Hostent
-- record "by hand".
Index: 5itaprop.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5itaprop.adb,v
retrieving revision 1.8
diff -u -p -r1.8 5itaprop.adb
--- 5itaprop.adb 5 Jan 2004 15:20:42 -0000 1.8
+++ 5itaprop.adb 13 Jan 2004 10:29:02 -0000
@@ -201,7 +201,7 @@ package body System.Task_Primitives.Oper
procedure Abort_Handler (signo : Signal) is
pragma Unreferenced (signo);
- Self_Id : Task_ID := Self;
+ Self_Id : constant Task_ID := Self;
Result : Interfaces.C.int;
Old_Set : aliased sigset_t;
Index: adaint.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/adaint.c,v
retrieving revision 1.25
diff -u -p -r1.25 adaint.c
--- adaint.c 3 Dec 2003 11:47:52 -0000 1.25
+++ adaint.c 13 Jan 2004 10:29:03 -0000
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 1992-2003, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2004, 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- *
@@ -2487,3 +2487,11 @@ __gnat_lseek (int fd, long offset, int w
{
return (int) lseek (fd, offset, whence);
}
+
+/* This function returns the version of GCC being used. Here it's GCC 3. */
+int
+get_gcc_version (void)
+{
+ return 3;
+}
+
Index: cstand.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/cstand.adb,v
retrieving revision 1.15
diff -u -p -r1.15 cstand.adb
--- cstand.adb 12 Jan 2004 11:45:23 -0000 1.15
+++ cstand.adb 13 Jan 2004 10:29:03 -0000
@@ -559,6 +559,7 @@ package body CStand is
-- Create type definition node for type String
Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
+
declare
CompDef_Node : Node_Id;
begin
@@ -567,6 +568,7 @@ package body CStand is
Set_Subtype_Indication (CompDef_Node, Identifier_For (S_Character));
Set_Component_Definition (Tdef_Node, CompDef_Node);
end;
+
Set_Subtype_Marks (Tdef_Node, New_List);
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_String), Tdef_Node);
Index: einfo.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/einfo.adb,v
retrieving revision 1.12
diff -u -p -r1.12 einfo.adb
--- einfo.adb 5 Jan 2004 15:20:43 -0000 1.12
+++ einfo.adb 13 Jan 2004 10:29:03 -0000
@@ -6,14 +6,14 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A CPARTICULAR PURPOSE. See the GNU General Public License --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
Index: exp_ch3.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch3.adb,v
retrieving revision 1.13
diff -u -p -r1.13 exp_ch3.adb
--- exp_ch3.adb 12 Jan 2004 11:45:23 -0000 1.13
+++ exp_ch3.adb 13 Jan 2004 10:29:03 -0000
@@ -1527,7 +1527,7 @@ package body Exp_Ch3 is
-- aggregate that will be expanded inline
if Kind = N_Qualified_Expression then
- Kind := Nkind (Parent (N));
+ Kind := Nkind (Expression (N));
end if;
if Controlled_Type (Typ)
Index: exp_ch4.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch4.adb,v
retrieving revision 1.14
diff -u -p -r1.14 exp_ch4.adb
--- exp_ch4.adb 5 Jan 2004 15:20:43 -0000 1.14
+++ exp_ch4.adb 13 Jan 2004 10:29:03 -0000
@@ -654,7 +654,8 @@ package body Exp_Ch4 is
Comp : RE_Id;
- Stg_Unit_Is_Byte : constant Boolean := System_Storage_Unit = Byte'Size;
+ Byte_Addressable : constant Boolean := System_Storage_Unit = Byte'Size;
+ -- True for byte addressable target
function Length_Less_Than_4 (Opnd : Node_Id) return Boolean;
-- Returns True if the length of the given operand is known to be
@@ -707,7 +708,7 @@ package body Exp_Ch4 is
-- addressing of array components.
if not Is_Bit_Packed_Array (Typ1)
- and then Stg_Unit_Is_Byte
+ and then Byte_Addressable
and then not Java_VM
then
-- The call we generate is:
Index: exp_ch9.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch9.adb,v
retrieving revision 1.11
diff -u -p -r1.11 exp_ch9.adb
--- exp_ch9.adb 12 Jan 2004 11:45:23 -0000 1.11
+++ exp_ch9.adb 13 Jan 2004 10:29:04 -0000
@@ -2612,10 +2612,10 @@ package body Exp_Ch9 is
(Parent (Efam)))), Loc))),
Component_Definition =>
- Make_Component_Definition (Loc,
- Aliased_Present => False,
- Subtype_Indication =>
- New_Reference_To (Standard_Character, Loc))));
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (Standard_Character, Loc))));
Insert_After (Current_Node, Efam_Decl);
Current_Node := Efam_Decl;
@@ -2629,10 +2629,12 @@ package body Exp_Ch9 is
Component_Definition =>
Make_Component_Definition (Loc,
Aliased_Present => False,
+
Subtype_Indication =>
Make_Subtype_Indication (Loc,
Subtype_Mark =>
New_Occurrence_Of (Efam_Type, Loc),
+
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
@@ -7283,11 +7285,13 @@ package body Exp_Ch9 is
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uTask_Info),
+
Component_Definition =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
New_Reference_To (RTE (RE_Task_Info_Type), Loc)),
+
Expression => New_Copy (
Expression (First (
Pragma_Argument_Associations (
Index: exp_dist.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_dist.adb,v
retrieving revision 1.7
diff -u -p -r1.7 exp_dist.adb
--- exp_dist.adb 12 Jan 2004 11:45:23 -0000 1.7
+++ exp_dist.adb 13 Jan 2004 10:29:04 -0000
@@ -55,17 +55,19 @@ package body Exp_Dist is
-- The following model has been used to implement distributed objects:
-- given a designated type D and a RACW type R, then a record of the
-- form:
+
-- type Stub is tagged record
-- [...declaration similar to s-parint.ads RACW_Stub_Type...]
-- end record;
+
-- is built. This type has two properties:
- --
+
-- 1) Since it has the same structure than RACW_Stub_Type, it can be
-- converted to and from this type to make it suitable for
-- System.Partition_Interface.Get_Unique_Remote_Pointer in order
-- to avoid memory leaks when the same remote object arrive on the
-- same partition by following different pathes
- --
+
-- 2) It also has the same dispatching table as the designated type D,
-- and thus can be used as an object designated by a value of type
-- R on any partition other than the one on which the object has
Index: gnatlink.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gnatlink.adb,v
retrieving revision 1.12
diff -u -p -r1.12 gnatlink.adb
--- gnatlink.adb 5 Jan 2004 15:20:44 -0000 1.12
+++ gnatlink.adb 13 Jan 2004 10:29:04 -0000
@@ -678,7 +678,7 @@ procedure Gnatlink is
-- terminator.
function Index (S, Pattern : String) return Natural;
- -- Return the first occurrence of Pattern in S, or 0 if none.
+ -- Return the last occurrence of Pattern in S, or 0 if none.
function Is_Option_Present (Opt : in String) return Boolean;
-- Return true if the option Opt is already present in
@@ -727,8 +727,9 @@ procedure Gnatlink is
function Index (S, Pattern : String) return Natural is
Len : constant Natural := Pattern'Length;
+
begin
- for J in S'First .. S'Last - Len + 1 loop
+ for J in reverse S'First .. S'Last - Len + 1 loop
if Pattern = S (J .. J + Len - 1) then
return J;
end if;
@@ -1061,7 +1062,42 @@ procedure Gnatlink is
-- Also add path to find libgcc_s.so, if
-- relevant.
- GCC_Index := Index (File_Path.all, "gcc-lib");
+ -- To find the location of the shared version
+ -- of libgcc, we look for "gcc-lib" in the
+ -- path of the library. However, this
+ -- subdirectory is no longer present in
+ -- in recent version of GCC. So, we look for
+ -- the last subdirectory "lib" in the path.
+
+ GCC_Index :=
+ Index (File_Path.all, "gcc-lib");
+
+ if GCC_Index /= 0 then
+ -- The shared version of libgcc is
+ -- located in the parent directory.
+
+ GCC_Index := GCC_Index - 1;
+
+ else
+ GCC_Index :=
+ Index (File_Path.all, "/lib/");
+
+ if GCC_Index = 0 then
+ GCC_Index :=
+ Index (File_Path.all,
+ Directory_Separator &
+ "lib" &
+ Directory_Separator);
+ end if;
+
+ -- We have found a subdirectory "lib",
+ -- this is where the shared version of
+ -- libgcc should be located.
+
+ if GCC_Index /= 0 then
+ GCC_Index := GCC_Index + 3;
+ end if;
+ end if;
-- Look for an eventual run_path_option in
-- the linker switches.
@@ -1124,7 +1160,7 @@ procedure Gnatlink is
(1 .. File_Path'Length
- File_Name'Length)
& Path_Separator
- & File_Path (1 .. GCC_Index - 1));
+ & File_Path (1 .. GCC_Index));
else
Linker_Options.Table
@@ -1137,7 +1173,7 @@ procedure Gnatlink is
(1 .. File_Path'Length
- File_Name'Length)
& Path_Separator
- & File_Path (1 .. GCC_Index - 1));
+ & File_Path (1 .. GCC_Index));
end if;
end if;
end if;
Index: g-regpat.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/g-regpat.adb,v
retrieving revision 1.9
diff -u -p -r1.9 g-regpat.adb
--- g-regpat.adb 23 Oct 2003 11:57:52 -0000 1.9
+++ g-regpat.adb 13 Jan 2004 10:29:04 -0000
@@ -2997,9 +2997,9 @@ package body GNAT.Regpat is
function Match_Whilem (IP : Pointer) return Boolean is
pragma Unreferenced (IP);
- Cc : Current_Curly_Access := Current_Curly;
- N : constant Natural := Cc.Cur + 1;
- Ln : Natural := 0;
+ Cc : constant Current_Curly_Access := Current_Curly;
+ N : constant Natural := Cc.Cur + 1;
+ Ln : Natural := 0;
Lastloc : constant Natural := Cc.Lastloc;
-- Detection of 0-len.
Index: g-spitbo.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/g-spitbo.adb,v
retrieving revision 1.4
diff -u -p -r1.4 g-spitbo.adb
--- g-spitbo.adb 21 Oct 2003 13:42:05 -0000 1.4
+++ g-spitbo.adb 13 Jan 2004 10:29:04 -0000
@@ -169,7 +169,7 @@ package body GNAT.Spitbol is
procedure Reverse_String (Str : in out VString) is
Len : constant Natural := Length (Str);
- Chars : String_Access := Get_String (Str);
+ Chars : constant String_Access := Get_String (Str);
Temp : Character;
begin
Index: make.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/make.adb,v
retrieving revision 1.28
diff -u -p -r1.28 make.adb
--- make.adb 5 Jan 2004 15:20:44 -0000 1.28
+++ make.adb 13 Jan 2004 10:29:04 -0000
@@ -393,6 +393,14 @@ package body Make is
Bind_Shared_Known : Boolean := False;
-- Set to True after the first time Bind_Shared is computed
+ Shared_Libgcc : aliased String := "-shared-libgcc";
+
+ No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
+ Shared_Libgcc_Switch : aliased Argument_List :=
+ (1 => Shared_Libgcc'Access);
+ Link_With_Shared_Libgcc : Argument_List_Access :=
+ No_Shared_Libgcc_Switch'Access;
+
procedure Make_Failed (S1 : String; S2 : String := ""; S3 : String := "");
-- Delete all temp files created by Gnatmake and call Osint.Fail,
-- with the parameter S1, S2 and S3 (see osint.ads).
@@ -3383,6 +3391,7 @@ package body Make is
Make.Initialize;
Bind_Shared := No_Shared_Switch'Access;
+ Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
Bind_Shared_Known := False;
Failed_Links.Set_Last (0);
@@ -4769,6 +4778,12 @@ package body Make is
Projects.Table (Proj).Library_Kind /= Static
then
Bind_Shared := Shared_Switch'Access;
+
+ if GCC_Version >= 3 then
+ Link_With_Shared_Libgcc :=
+ Shared_Libgcc_Switch'Access;
+ end if;
+
exit;
end if;
end loop;
@@ -5276,7 +5291,9 @@ package body Make is
-- And invoke the linker
begin
- Link (Main_ALI_File, Args (Args'First .. Last_Arg));
+ Link (Main_ALI_File,
+ Link_With_Shared_Libgcc.all &
+ Args (Args'First .. Last_Arg));
Successful_Links.Increment_Last;
Successful_Links.Table (Successful_Links.Last) :=
Main_ALI_File;
Index: opt.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/opt.ads,v
retrieving revision 1.11
diff -u -p -r1.11 opt.ads
--- opt.ads 5 Jan 2004 15:20:45 -0000 1.11
+++ opt.ads 13 Jan 2004 10:29:04 -0000
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
@@ -443,6 +443,15 @@ package Opt is
Full_List : Boolean := False;
-- GNAT
-- Set True to generate full source listing with embedded errors
+
+ function get_gcc_version return Int;
+ pragma Import (C, get_gcc_version, "get_gcc_version");
+
+ GCC_Version : constant Nat := get_gcc_version;
+ -- GNATMAKE
+ -- Indicates which version of gcc is in use (2 = 2.8.1, 3 = 3.x).
+ -- Used in particular to decide if gcc switch -shared-libgcc should be
+ -- used (it cannot be used for 2.8.1).
Global_Discard_Names : Boolean := False;
-- GNAT, GNATBIND
Index: sem_dist.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_dist.adb,v
retrieving revision 1.7
diff -u -p -r1.7 sem_dist.adb
--- sem_dist.adb 12 Jan 2004 11:45:25 -0000 1.7
+++ sem_dist.adb 13 Jan 2004 10:29:04 -0000
@@ -441,8 +441,7 @@ package body Sem_Dist is
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
- New_Reference_To
- (Standard_Integer, Loc))),
+ New_Reference_To (Standard_Integer, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
@@ -452,8 +451,7 @@ package body Sem_Dist is
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
- New_Reference_To
- (RTE (RE_Unsigned_64), Loc))),
+ New_Reference_To (RTE (RE_Unsigned_64), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
@@ -463,8 +461,7 @@ package body Sem_Dist is
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
- New_Reference_To
- (Standard_Natural, Loc))),
+ New_Reference_To (Standard_Natural, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
@@ -474,8 +471,7 @@ package body Sem_Dist is
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
- New_Reference_To
- (Standard_Boolean, Loc)))))));
+ New_Reference_To (Standard_Boolean, Loc)))))));
Insert_After (N, New_Type_Decl);
Set_Equivalent_Type (User_Type, Fat_Type);
Index: sem_res.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_res.adb,v
retrieving revision 1.18
diff -u -p -r1.18 sem_res.adb
--- sem_res.adb 12 Jan 2004 11:45:25 -0000 1.18
+++ sem_res.adb 13 Jan 2004 10:29:04 -0000
@@ -408,9 +408,10 @@ package body Sem_Res is
and then Scope (Disc) = Current_Scope
and then not
(Nkind (Parent (P)) = N_Subtype_Indication
- and then
- (Nkind (Parent (Parent (P))) = N_Component_Definition
- or else Nkind (Parent (Parent (P))) = N_Subtype_Declaration)
+ and then
+ (Nkind (Parent (Parent (P))) = N_Component_Definition
+ or else
+ Nkind (Parent (Parent (P))) = N_Subtype_Declaration)
and then Paren_Count (N) = 0)
then
Error_Msg_N
@@ -419,8 +420,9 @@ package body Sem_Res is
end if;
-- Detect a common beginner error:
+
-- type R (D : Positive := 100) is record
- -- Name: String (1 .. D);
+ -- Name : String (1 .. D);
-- end record;
-- The default value causes an object of type R to be
Index: sem_util.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_util.adb,v
retrieving revision 1.19
diff -u -p -r1.19 sem_util.adb
--- sem_util.adb 12 Jan 2004 11:45:25 -0000 1.19
+++ sem_util.adb 13 Jan 2004 10:29:05 -0000
@@ -3221,7 +3221,7 @@ package body Sem_Util is
function Has_Dependent_Constraint (Comp : Entity_Id) return Boolean is
Comp_Decl : constant Node_Id := Parent (Comp);
Subt_Indic : constant Node_Id :=
- Subtype_Indication (Component_Definition (Comp_Decl));
+ Subtype_Indication (Component_Definition (Comp_Decl));
Constr : Node_Id;
Assn : Node_Id;
Index: s-interr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/s-interr.adb,v
retrieving revision 1.9
diff -u -p -r1.9 s-interr.adb
--- s-interr.adb 5 Jan 2004 15:20:46 -0000 1.9
+++ s-interr.adb 13 Jan 2004 10:29:05 -0000
@@ -1249,7 +1249,7 @@ package body System.Interrupts is
task body Server_Task is
Intwait_Mask : aliased IMNG.Interrupt_Mask;
Ret_Interrupt : Interrupt_ID;
- Self_ID : Task_ID := Self;
+ Self_ID : constant Task_ID := Self;
Tmp_Handler : Parameterless_Handler;
Tmp_ID : Task_ID;
Tmp_Entry_Index : Task_Entry_Index;
Index: sprint.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sprint.adb,v
retrieving revision 1.14
diff -u -p -r1.14 sprint.adb
--- sprint.adb 12 Jan 2004 11:45:25 -0000 1.14
+++ sprint.adb 13 Jan 2004 10:29:05 -0000
@@ -951,9 +951,11 @@ package body Sprint is
when N_Component_Definition =>
Set_Debug_Sloc;
+
if Aliased_Present (Node) then
Write_Str_With_Col_Check ("aliased ");
end if;
+
Sprint_Node (Subtype_Indication (Node));
when N_Component_Declaration =>
Index: s-stache.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/s-stache.adb,v
retrieving revision 1.8
diff -u -p -r1.8 s-stache.adb
--- s-stache.adb 15 Dec 2003 11:51:00 -0000 1.8
+++ s-stache.adb 13 Jan 2004 10:29:05 -0000
@@ -214,7 +214,7 @@ package body System.Stack_Checking is
Full_Check :
declare
- My_Stack : Stack_Access := Set_Stack_Info (Cache'Access);
+ My_Stack : constant Stack_Access := Set_Stack_Info (Cache'Access);
-- At this point Stack.all might already be invalid, so
-- it is essential to use our local copy of Stack!
Index: s-taenca.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/s-taenca.adb,v
retrieving revision 1.5
diff -u -p -r1.5 s-taenca.adb
--- s-taenca.adb 21 Oct 2003 13:42:15 -0000 1.5
+++ s-taenca.adb 13 Jan 2004 10:29:05 -0000
@@ -262,7 +262,7 @@ package body System.Tasking.Entry_Calls
if Ceiling_Violation then
declare
- Current_Task : Task_ID := STPO.Self;
+ Current_Task : constant Task_ID := STPO.Self;
Old_Base_Priority : System.Any_Priority;
begin