[Ada] Dangling cursor checks in Element function

In Ada.Containers.Ordered_Maps, if a dangling cursor is passed to the Element
function, execution is erroneous. Therefore, the compiler is not obligated to
detect this error. However, this patch inserts code that will detect this error
in some cases, and raise Program_Error. The same applies to Ordered_Sets,
Ordered_Multisets, Indefinite_Ordered_Maps, Indefinite_Ordered_Sets, and
Indefinite_Ordered_Multisets. No test available for erroneous execution.

2018-06-11  Bob Duff  <duff@adacore.com>

gcc/ada/

	* libgnat/a-ciorma.adb, libgnat/a-ciormu.adb, libgnat/a-ciorse.adb,
	libgnat/a-coorma.adb, libgnat/a-coormu.adb, libgnat/a-coorse.adb:
	(Element): Add code to detect dangling cursors in some cases.

From-SVN: r261424
This commit is contained in:
Bob Duff 2018-06-11 09:19:12 +00:00 committed by Pierre-Marie de Rodat
parent 90265b9343
commit 6534852011
7 changed files with 48 additions and 0 deletions

View File

@ -1,3 +1,9 @@
2018-06-11 Bob Duff <duff@adacore.com>
* libgnat/a-ciorma.adb, libgnat/a-ciormu.adb, libgnat/a-ciorse.adb,
libgnat/a-coorma.adb, libgnat/a-coormu.adb, libgnat/a-coorse.adb:
(Element): Add code to detect dangling cursors in some cases.
2018-06-11 Yannick Moy <moy@adacore.com>
* sem_ch6.adb (Build_Subprogram_Declaration): Mark parameters as coming

View File

@ -541,6 +541,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
"Position cursor of function Element is bad";
end if;
if Checks and then
(Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node)
then
raise Program_Error with "dangling cursor";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"Position cursor of function Element is bad");

View File

@ -545,6 +545,13 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
raise Program_Error with "Position cursor is bad";
end if;
if Checks and then
(Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node)
then
raise Program_Error with "dangling cursor";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Element");

View File

@ -534,6 +534,13 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
raise Program_Error with "Position cursor is bad";
end if;
if Checks and then
(Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node)
then
raise Program_Error with "dangling cursor";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Element");

View File

@ -481,6 +481,13 @@ package body Ada.Containers.Ordered_Maps is
"Position cursor of function Element equals No_Element";
end if;
if Checks and then
(Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node)
then
raise Program_Error with "dangling cursor";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"Position cursor of function Element is bad");

View File

@ -502,6 +502,13 @@ package body Ada.Containers.Ordered_Multisets is
raise Constraint_Error with "Position cursor equals No_Element";
end if;
if Checks and then
(Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node)
then
raise Program_Error with "dangling cursor";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Element");

View File

@ -480,6 +480,13 @@ package body Ada.Containers.Ordered_Sets is
raise Constraint_Error with "Position cursor equals No_Element";
end if;
if Checks and then
(Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node)
then
raise Program_Error with "dangling cursor";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Element");