1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S --
9 -- Copyright (C) 2011, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 ------------------------------------------------------------------------------
28 with Ada.Unchecked_Deallocation;
30 package body Ada.Containers.Indefinite_Holders is
33 new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
39 function "=" (Left, Right : Holder) return Boolean is
41 if Left.Element = null and Right.Element = null then
44 elsif Left.Element /= null and Right.Element /= null then
45 return Left.Element.all = Right.Element.all;
56 overriding procedure Adjust (Container : in out Holder) is
58 if Container.Element /= null then
59 Container.Element := new Element_Type'(Container.Element.all);
69 procedure Assign (Target : in out Holder; Source : Holder) is
71 if Target.Busy /= 0 then
72 raise Program_Error with "attempt to tamper with elements";
75 if Target.Element /= Source.Element then
76 Free (Target.Element);
78 if Source.Element /= null then
79 Target.Element := new Element_Type'(Source.Element.all);
88 procedure Clear (Container : in out Holder) is
90 if Container.Busy /= 0 then
91 raise Program_Error with "attempt to tamper with elements";
94 Free (Container.Element);
101 function Copy (Source : Holder) return Holder is
103 if Source.Element = null then
104 return (AF.Controlled with null, 0);
106 return (AF.Controlled with new Element_Type'(Source.Element.all), 0);
114 function Element (Container : Holder) return Element_Type is
116 if Container.Element = null then
117 raise Constraint_Error with "container is empty";
119 return Container.Element.all;
127 overriding procedure Finalize (Container : in out Holder) is
129 if Container.Busy /= 0 then
130 raise Program_Error with "attempt to tamper with elements";
133 Free (Container.Element);
140 function Is_Empty (Container : Holder) return Boolean is
142 return Container.Element = null;
149 procedure Move (Target : in out Holder; Source : in out Holder) is
151 if Target.Busy /= 0 then
152 raise Program_Error with "attempt to tamper with elements";
155 if Source.Busy /= 0 then
156 raise Program_Error with "attempt to tamper with elements";
159 if Target.Element /= Source.Element then
160 Free (Target.Element);
161 Target.Element := Source.Element;
162 Source.Element := null;
170 procedure Query_Element
172 Process : not null access procedure (Element : Element_Type))
174 B : Natural renames Container'Unrestricted_Access.Busy;
177 if Container.Element = null then
178 raise Constraint_Error with "container is empty";
184 Process (Container.Element.all);
199 (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
200 Container : out Holder)
205 if not Boolean'Input (Stream) then
206 Container.Element := new Element_Type'(Element_Type'Input (Stream));
210 ---------------------
211 -- Replace_Element --
212 ---------------------
214 procedure Replace_Element
215 (Container : in out Holder;
216 New_Item : Element_Type)
219 if Container.Busy /= 0 then
220 raise Program_Error with "attempt to tamper with elements";
223 Free (Container.Element);
224 Container.Element := new Element_Type'(New_Item);
231 function To_Holder (New_Item : Element_Type) return Holder is
233 return (AF.Controlled with new Element_Type'(New_Item), 0);
240 procedure Update_Element
242 Process : not null access procedure (Element : in out Element_Type))
244 B : Natural renames Container'Unrestricted_Access.Busy;
247 if Container.Element = null then
248 raise Constraint_Error with "container is empty";
254 Process (Container.Element.all);
269 (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
273 Boolean'Output (Stream, Container.Element = null);
275 if Container.Element /= null then
276 Element_Type'Output (Stream, Container.Element.all);
280 end Ada.Containers.Indefinite_Holders;