===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1998-2011, 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- --
@@ -261,7 +261,22 @@
-- Lock_Entries --
------------------
- procedure Lock_Entries
+ procedure Lock_Entries (Object : Protection_Entries_Access) is
+ Ceiling_Violation : Boolean;
+
+ begin
+ Lock_Entries_With_Status (Object, Ceiling_Violation);
+
+ if Ceiling_Violation then
+ raise Program_Error with "Ceiling Violation";
+ end if;
+ end Lock_Entries;
+
+ ------------------------------
+ -- Lock_Entries_With_Status --
+ ------------------------------
+
+ procedure Lock_Entries_With_Status
(Object : Protection_Entries_Access;
Ceiling_Violation : out Boolean)
is
@@ -316,20 +331,8 @@
Self_Id.Common.Protected_Action_Nesting + 1;
end;
end if;
+ end Lock_Entries_With_Status;
- end Lock_Entries;
-
- procedure Lock_Entries (Object : Protection_Entries_Access) is
- Ceiling_Violation : Boolean;
-
- begin
- Lock_Entries (Object, Ceiling_Violation);
-
- if Ceiling_Violation then
- raise Program_Error with "Ceiling Violation";
- end if;
- end Lock_Entries;
-
----------------------------
-- Lock_Read_Only_Entries --
----------------------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2011, 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- --
@@ -183,7 +183,7 @@
-- Unlock has been made by the caller. Program_Error is raised in case of
-- ceiling violation.
- procedure Lock_Entries
+ procedure Lock_Entries_With_Status
(Object : Protection_Entries_Access;
Ceiling_Violation : out Boolean);
-- Same as above, but return the ceiling violation status instead of
===================================================================
@@ -628,7 +628,7 @@
-- Requeue to a protected entry
Called_PO := POE.To_Protection (Entry_Call.Called_PO);
- STPE.Lock_Entries (Called_PO, Ceiling_Violation);
+ STPE.Lock_Entries_With_Status (Called_PO, Ceiling_Violation);
if Ceiling_Violation then
pragma Assert (Ex = Ada.Exceptions.Null_Id);
===================================================================
@@ -135,7 +135,7 @@
-- Check entity Eid to ensure that configurable run-time restrictions are
-- met. May generate an error message (if RTE_Available_Call is false) and
-- raise RE_Not_Available if entity E does not exist (e.g. Eid is Empty).
- -- Above documentation not clear ???
+ -- Also check that entity is not overloaded.
procedure Entity_Not_Defined (Id : RE_Id);
-- Outputs error messages for an entity that is not defined in the run-time
@@ -233,6 +233,22 @@
raise RE_Not_Available;
end if;
+ -- Check entity is not overloaded, checking for special exceptions
+
+ if Has_Homonym (Eid)
+ and then E /= RE_Save_Occurrence
+ then
+ Set_Standard_Error;
+ Write_Str ("Run-time configuration error (");
+ Write_Str ("rtsfind entity """);
+ Get_Decoded_Name_String (Chars (Eid));
+ Set_Casing (Mixed_Case);
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Str (""" is overloaded)");
+ Write_Eol;
+ raise Unrecoverable_Error;
+ end if;
+
-- Otherwise entity is accessible
return Eid;
@@ -414,8 +430,8 @@
return E1 = E2;
end if;
- -- If the unit containing E is not loaded, we already know that
- -- the entity we have cannot have come from this unit.
+ -- If the unit containing E is not loaded, we already know that the
+ -- entity we have cannot have come from this unit.
E_Unit_Name := Get_Unit_Name (RE_Unit_Table (E));
===================================================================
@@ -498,6 +498,14 @@
-- value is required syntactically, but no real entry is required or
-- needed. Use of this value will cause a fatal error in an RTE call.
+ -- Note that under no circumstances can any of these entities be defined
+ -- more than once in a given package, i.e. no overloading is allowed for
+ -- any entity that is found using rtsfind. A fatal error is given if this
+ -- rule is violated. The one exception is for Save_Occurrence, where the
+ -- RM mandates the overloading. In this case, the compiler only uses the
+ -- procedure, not the function, and the procedure must come first so that
+ -- the compiler finds it and not the function.
+
type RE_Id is (
RE_Null,
===================================================================
@@ -568,7 +568,7 @@
-- where abort is already deferred.
Initialization.Defer_Abort_Nestable (Self_ID);
- Lock_Entries (Object, Ceiling_Violation);
+ Lock_Entries_With_Status (Object, Ceiling_Violation);
if Ceiling_Violation then
@@ -722,7 +722,7 @@
-- Requeue is to different PO
- Lock_Entries (New_Object, Ceiling_Violation);
+ Lock_Entries_With_Status (New_Object, Ceiling_Violation);
if Ceiling_Violation then
Object.Call_In_Progress := null;
@@ -966,7 +966,7 @@
end if;
Initialization.Defer_Abort_Nestable (Self_Id);
- Lock_Entries (Object, Ceiling_Violation);
+ Lock_Entries_With_Status (Object, Ceiling_Violation);
if Ceiling_Violation then
Initialization.Undefer_Abort (Self_Id);
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2011, 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- --
@@ -216,7 +216,7 @@
STPO.Unlock_RTS;
end if;
- Lock_Entries (Test_PO, Ceiling_Violation);
+ Lock_Entries_With_Status (Test_PO, Ceiling_Violation);
-- ???