From 6534852011f3e72090c690ffc53b990feb709b9f Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 11 Jun 2018 09:19:12 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/libgnat/a-ciorma.adb | 7 +++++++ gcc/ada/libgnat/a-ciormu.adb | 7 +++++++ gcc/ada/libgnat/a-ciorse.adb | 7 +++++++ gcc/ada/libgnat/a-coorma.adb | 7 +++++++ gcc/ada/libgnat/a-coormu.adb | 7 +++++++ gcc/ada/libgnat/a-coorse.adb | 7 +++++++ 7 files changed, 48 insertions(+) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 84dd18b7767..e032be37062 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-06-11 Bob Duff + + * 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 * 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 a981f7219f7..000851a8cac 100644 --- 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 2420788cc4f..5c3e9f75bb2 100644 --- 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 e6565136aa1..7394a4aedc5 100644 --- 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 05eea5bc494..5fd3ec68a50 100644 --- 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 0fc1063bd40..c114cf9f48a 100644 --- 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 606938ec3c0..1f96d39499a 100644 --- 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"); -- 2.11.4.GIT