[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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@261424 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 84dd18b7767a61382a5ecbaecd07d129ebf353f3..e032be370624a5fe394e60aeafd0514ad2497320 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/libgnat/a-ciorma.adb b/gcc/ada/libgnat/a-ciorma.adb
index a981f7219f7d417f9a3a1df126d99dc4e70adc2c..000851a8cac68f1541239ca64659c7210beeff9c 100644 (file)
--- a/gcc/ada/libgnat/a-ciorma.adb
+++ b/gcc/ada/libgnat/a-ciorma.adb
@@ -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");
 

diff --git a/gcc/ada/libgnat/a-ciormu.adb b/gcc/ada/libgnat/a-ciormu.adb
index 2420788cc4f74d73df7423383481158b538de27a..5c3e9f75bb2f718dbe7fe315d64fb3b62b81240c 100644 (file)
--- a/gcc/ada/libgnat/a-ciormu.adb
+++ b/gcc/ada/libgnat/a-ciormu.adb
@@ -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");
 

diff --git a/gcc/ada/libgnat/a-ciorse.adb b/gcc/ada/libgnat/a-ciorse.adb
index e6565136aa1a8bc82f0a749db10e18ca0c3b2409..7394a4aedc5a60da7291b93d4508895642eb64a8 100644 (file)
--- a/gcc/ada/libgnat/a-ciorse.adb
+++ b/gcc/ada/libgnat/a-ciorse.adb
@@ -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");
 

diff --git a/gcc/ada/libgnat/a-coorma.adb b/gcc/ada/libgnat/a-coorma.adb
index 05eea5bc4944e8e63923242c223b3ee9e67bfa53..5fd3ec68a504486b1e598ee9f28afe9293c76364 100644 (file)
--- a/gcc/ada/libgnat/a-coorma.adb
+++ b/gcc/ada/libgnat/a-coorma.adb
@@ -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");
 

diff --git a/gcc/ada/libgnat/a-coormu.adb b/gcc/ada/libgnat/a-coormu.adb
index 0fc1063bd40c8bc98b6ccb9d98ba99c5088ebef0..c114cf9f48a94438872bc88577f05fa1fbd052d0 100644 (file)
--- a/gcc/ada/libgnat/a-coormu.adb
+++ b/gcc/ada/libgnat/a-coormu.adb
@@ -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");
 

diff --git a/gcc/ada/libgnat/a-coorse.adb b/gcc/ada/libgnat/a-coorse.adb
index 606938ec3c03e71ac933b22178cd39a88126ceff..1f96d39499a3b24fd5b56b1c3da2751cb946123b 100644 (file)
--- a/gcc/ada/libgnat/a-coorse.adb
+++ b/gcc/ada/libgnat/a-coorse.adb
@@ -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");