* [Ada] Check that rtsfind entities are not overloaded
@ 2011-09-05 14:31 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2011-09-05 14:31 UTC (permalink / raw)
To: gcc-patches; +Cc: Robert Dewar
[-- Attachment #1: Type: text/plain, Size: 698 bytes --]
This patch properly documents the rule that rtsfind entities may not
be overloaded, and adds a check that this rule is met. This found
one violation of the rule in the run time which has been fixed. No
test is required, since this clean up has no external effect.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-05 Robert Dewar <dewar@adacore.com>
* rtsfind.adb (Check_CRT): Check for overloaded entity
* rtsfind.ads: Document that entities to be found by rtsfind
cannot be overloaded
* s-taenca.adb, s-tasren.adb, s-tpobop.adb, s-tpoben.ads, s-tpoben.adb
(Lock_Entries_With_Status): New name for Lock_Entries with two
arguments (changed to meet rtsfind no overloading rule).
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 8435 bytes --]
Index: s-tpoben.adb
===================================================================
--- s-tpoben.adb (revision 178381)
+++ s-tpoben.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2010, Free Software Foundation, Inc. --
+-- 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 --
----------------------------
Index: s-tpoben.ads
===================================================================
--- s-tpoben.ads (revision 178381)
+++ s-tpoben.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- 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
Index: s-tasren.adb
===================================================================
--- s-tasren.adb (revision 178381)
+++ s-tasren.adb (working copy)
@@ -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);
Index: rtsfind.adb
===================================================================
--- rtsfind.adb (revision 178381)
+++ rtsfind.adb (working copy)
@@ -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));
Index: rtsfind.ads
===================================================================
--- rtsfind.ads (revision 178381)
+++ rtsfind.ads (working copy)
@@ -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,
Index: s-tpobop.adb
===================================================================
--- s-tpobop.adb (revision 178381)
+++ s-tpobop.adb (working copy)
@@ -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);
Index: s-taenca.adb
===================================================================
--- s-taenca.adb (revision 178381)
+++ s-taenca.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- 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);
-- ???
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2011-09-05 14:31 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-09-05 14:31 [Ada] Check that rtsfind entities are not overloaded Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).