[Ada] Avoid duplication for Sets functions

gcc/ada/

	* libgnat/a-cbhase.adb, libgnat/a-cborse.adb,
	libgnat/a-cihase.adb, libgnat/a-ciorse.adb,
	libgnat/a-cohase.adb, libgnat/a-coorse.adb
	(Constant_Reference,Reference_Preserving_Key): Refactor using
	the equivalence stated in the RM.
This commit is contained in:
Etienne Servais 2021-11-05 14:25:50 +01:00 committed by Pierre-Marie de Rodat
parent 659e775a17
commit ab59968427
6 changed files with 36 additions and 208 deletions

View File

@ -1629,26 +1629,14 @@ is
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Count_Type :=
Key_Keys.Find (Container'Unrestricted_Access.all, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = 0 then
if Checks and then Position = No_Element then
raise Constraint_Error with "key not in set";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
TC : constant Tamper_Counts_Access :=
Container.TC'Unrestricted_Access;
begin
return R : constant Constant_Reference_Type :=
(Element => N.Element'Unchecked_Access,
Control => (Controlled with TC))
do
Busy (TC.all);
end return;
end;
return Constant_Reference (Container, Position);
end Constant_Reference;
--------------
@ -1836,29 +1824,14 @@ is
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Count_Type := Key_Keys.Find (Container, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = 0 then
if Checks and then Position = No_Element then
raise Constraint_Error with "key not in set";
end if;
declare
P : constant Cursor := Find (Container, Key);
begin
return R : constant Reference_Type :=
(Element => Container.Nodes (Node).Element'Unrestricted_Access,
Control =>
(Controlled with
Container.TC'Unrestricted_Access,
Container'Unrestricted_Access,
Index => Key_Keys.Index (Container, Key),
Old_Pos => P,
Old_Hash => Hash (Key)))
do
Busy (Container.TC);
end return;
end;
return Reference_Preserving_Key (Container, Position);
end Reference_Preserving_Key;
-------------

View File

@ -739,25 +739,14 @@ is
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Count_Type := Key_Keys.Find (Container, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = 0 then
if Checks and then Position = No_Element then
raise Constraint_Error with "key not in set";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
TC : constant Tamper_Counts_Access :=
Container.TC'Unrestricted_Access;
begin
return R : constant Constant_Reference_Type :=
(Element => N.Element'Unchecked_Access,
Control => (Controlled with TC))
do
Busy (TC.all);
end return;
end;
return Constant_Reference (Container, Position);
end Constant_Reference;
--------------
@ -960,28 +949,14 @@ is
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Count_Type := Key_Keys.Find (Container, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = 0 then
if Checks and then Position = No_Element then
raise Constraint_Error with "key not in set";
end if;
declare
N : Node_Type renames Container.Nodes (Node);
begin
return R : constant Reference_Type :=
(Element => N.Element'Unchecked_Access,
Control =>
(Controlled with
Container.TC'Unrestricted_Access,
Container => Container'Unchecked_Access,
Pos => Find (Container, Key),
Old_Key => new Key_Type'(Key)))
do
Busy (Container.TC);
end return;
end;
return Reference_Preserving_Key (Container, Position);
end Reference_Preserving_Key;
-------------

View File

@ -2063,29 +2063,14 @@ is
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
HT : Hash_Table_Type renames Container'Unrestricted_Access.HT;
Node : constant Node_Access := Key_Keys.Find (HT, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = null then
if Checks and then Position = No_Element then
raise Constraint_Error with "Key not in set";
end if;
if Checks and then Node.Element = null then
raise Program_Error with "Node has no element";
end if;
declare
TC : constant Tamper_Counts_Access :=
HT.TC'Unrestricted_Access;
begin
return R : constant Constant_Reference_Type :=
(Element => Node.Element.all'Access,
Control => (Controlled with TC))
do
Busy (TC.all);
end return;
end;
return Constant_Reference (Container, Position);
end Constant_Reference;
--------------
@ -2280,34 +2265,14 @@ is
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = null then
if Checks and then Position = No_Element then
raise Constraint_Error with "Key not in set";
end if;
if Checks and then Node.Element = null then
raise Program_Error with "Node has no element";
end if;
declare
HT : Hash_Table_Type renames Container.HT;
P : constant Cursor := Find (Container, Key);
begin
return R : constant Reference_Type :=
(Element => Node.Element.all'Access,
Control =>
(Controlled with
HT.TC'Unrestricted_Access,
Container => Container'Unchecked_Access,
Index => HT_Ops.Index (HT, P.Node),
Old_Pos => P,
Old_Hash => Hash (Key)))
do
Busy (HT.TC);
end return;
end;
return Reference_Preserving_Key (Container, Position);
end Reference_Preserving_Key;
-------------

View File

@ -771,29 +771,14 @@ is
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = null then
if Checks and then Position = No_Element then
raise Constraint_Error with "Key not in set";
end if;
if Checks and then Node.Element = null then
raise Program_Error with "Node has no element";
end if;
declare
Tree : Tree_Type renames Container'Unrestricted_Access.all.Tree;
TC : constant Tamper_Counts_Access :=
Tree.TC'Unrestricted_Access;
begin
return R : constant Constant_Reference_Type :=
(Element => Node.Element.all'Access,
Control => (Controlled with TC))
do
Busy (TC.all);
end return;
end;
return Constant_Reference (Container, Position);
end Constant_Reference;
--------------
@ -1029,32 +1014,14 @@ is
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = null then
if Checks and then Position = No_Element then
raise Constraint_Error with "Key not in set";
end if;
if Checks and then Node.Element = null then
raise Program_Error with "Node has no element";
end if;
declare
Tree : Tree_Type renames Container.Tree;
begin
return R : constant Reference_Type :=
(Element => Node.Element.all'Unchecked_Access,
Control =>
(Controlled with
Tree.TC'Unrestricted_Access,
Container => Container'Unchecked_Access,
Pos => Find (Container, Key),
Old_Key => new Key_Type'(Key)))
do
Busy (Tree.TC);
end return;
end;
return Reference_Preserving_Key (Container, Position);
end Reference_Preserving_Key;
-----------------------------------

View File

@ -1876,25 +1876,14 @@ is
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
HT : Hash_Table_Type renames Container'Unrestricted_Access.HT;
Node : constant Node_Access := Key_Keys.Find (HT, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = null then
if Checks and then Position = No_Element then
raise Constraint_Error with "Key not in set";
end if;
declare
TC : constant Tamper_Counts_Access :=
HT.TC'Unrestricted_Access;
begin
return R : constant Constant_Reference_Type :=
(Element => Node.Element'Access,
Control => (Controlled with TC))
do
Busy (TC.all);
end return;
end;
return Constant_Reference (Container, Position);
end Constant_Reference;
--------------
@ -2087,30 +2076,14 @@ is
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = null then
if Checks and then Position = No_Element then
raise Constraint_Error with "key not in set";
end if;
declare
HT : Hash_Table_Type renames Container.HT;
P : constant Cursor := Find (Container, Key);
begin
return R : constant Reference_Type :=
(Element => Node.Element'Access,
Control =>
(Controlled with
HT.TC'Unrestricted_Access,
Container'Unrestricted_Access,
Index => HT_Ops.Index (HT, P.Node),
Old_Pos => P,
Old_Hash => Hash (Key)))
do
Busy (HT.TC);
end return;
end;
return Reference_Preserving_Key (Container, Position);
end Reference_Preserving_Key;
-------------

View File

@ -693,25 +693,14 @@ is
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = null then
if Checks and then Position = No_Element then
raise Constraint_Error with "key not in set";
end if;
declare
Tree : Tree_Type renames Container'Unrestricted_Access.all.Tree;
TC : constant Tamper_Counts_Access :=
Tree.TC'Unrestricted_Access;
begin
return R : constant Constant_Reference_Type :=
(Element => Node.Element'Access,
Control => (Controlled with TC))
do
Busy (TC.all);
end return;
end;
return Constant_Reference (Container, Position);
end Constant_Reference;
--------------
@ -915,28 +904,14 @@ is
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
Position : constant Cursor := Find (Container, Key);
begin
if Checks and then Node = null then
if Checks and then Position = No_Element then
raise Constraint_Error with "Key not in set";
end if;
declare
Tree : Tree_Type renames Container.Tree;
begin
return R : constant Reference_Type :=
(Element => Node.Element'Access,
Control =>
(Controlled with
Tree.TC'Unrestricted_Access,
Container => Container'Unchecked_Access,
Pos => Find (Container, Key),
Old_Key => new Key_Type'(Key)))
do
Busy (Tree.TC);
end return;
end;
return Reference_Preserving_Key (Container, Position);
end Reference_Preserving_Key;
-------------