Natools

Check-in [6e22289101]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:indefinite_holders: new package containing an Ada 2005 implementation of Ada 2012 indefinite holders
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 6e22289101e11c50bb58760886e13d334a987ffd
User & Date: nat on 2013-11-02 13:59:49
Other Links: manifest | tags
Context
2013-11-13
19:48
string_slice_set_tests: new test case showing a bug in Subset check-in: 7b0c5022d4 user: nat tags: trunk
2013-11-02
13:59
indefinite_holders: new package containing an Ada 2005 implementation of Ada 2012 indefinite holders check-in: 6e22289101 user: nat tags: trunk
2013-11-01
13:37
string_slice_set_tests: test Add_Slice with empty range check-in: 127bb5a0ae user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added src/natools-indefinite_holders.adb version [3646d078bc]. 





















































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2013, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Indefinite_Vectors is an implementation of a subset of Ada 2012  --
-- Containers.Indefinite_Holders, compatible with Ada 2005.                 --
------------------------------------------------------------------------------

package body Natools.Indefinite_Holders is

   function "=" (Left, Right : Holder) return Boolean is
   begin
      if Left.Ref = Right.Ref then
         return True;
      elsif Left.Ref = null or Right.Ref = null then
         return False;
      else
         return Left.Ref.all = Right.Ref.all;
      end if;
   end "=";


   function To_Holder (New_Item : Element_Type) return Holder is
   begin
      return Holder'(Ada.Finalization.Controlled with
         Ref => new Element_Type'(New_Item));
   end To_Holder;


   function Is_Empty (Container : Holder) return Boolean is
   begin
      return Container.Ref = null;
   end Is_Empty;


   procedure Clear (Container : in out Holder) is
   begin
      Free (Container.Ref);
   end Clear;


   function Element (Container : Holder) return Element_Type is
   begin
      if Container.Ref = null then
         raise Constraint_Error with "Element called with an empty holder";
      else
         return Container.Ref.all;
      end if;
   end Element;


   procedure Replace_Element (Container : in out Holder;
                              New_Item  : in     Element_Type) is
   begin
      Free (Container.Ref);
      Container.Ref := new Element_Type'(New_Item);
   end Replace_Element;


   procedure Query_Element
     (Container : in Holder;
      Process   : not null access procedure (Element : in Element_Type)) is
   begin
      if Container.Ref = null then
         raise Constraint_Error
           with "Query_Element called with an empty holder";
      else
         Process.all (Container.Ref.all);
      end if;
   end Query_Element;


   procedure Update_Element
     (Container : in out Holder;
      Process   : not null access procedure (Element : in out Element_Type)) is
   begin
      if Container.Ref = null then
         raise Constraint_Error
           with "Update_Element called with an empty holder";
      else
         Process.all (Container.Ref.all);
      end if;
   end Update_Element;


   function Reference (Container : Holder) return access Element_Type is
   begin
      return Container.Ref;
   end Reference;


   procedure Assign (Target : in out Holder; Source : in Holder) is
   begin
      Free (Target.Ref);
      if Source.Ref /= null then
         Target.Ref := new Element_Type'(Source.Ref.all);
      end if;
   end Assign;


   function Copy (Source : Holder) return Holder is
      Result : Holder;
   begin
      if Source.Ref /= null then
         Result.Ref := new Element_Type'(Source.Ref.all);
      end if;

      return Result;
   end Copy;


   procedure Move (Target : in out Holder; Source : in out Holder) is
   begin
      Free (Target.Ref);
      Target.Ref := Source.Ref;
      Source.Ref := null;
   end Move;

   overriding procedure Adjust (Object : in out Holder) is
      New_Ref : Element_Access := null;
   begin
      if Object.Ref /= null then
         New_Ref := new Element_Type'(Object.Ref.all);
         Object.Ref := New_Ref;
      end if;
   end Adjust;


   overriding procedure Finalize (Object : in out Holder) is
   begin
      Free (Object.Ref);
   end Finalize;

end Natools.Indefinite_Holders;








Added src/natools-indefinite_holders.ads version [15040caba0].
























































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2013, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Indefinite_Holders is an implementation of a subset of Ada 2012  --
-- Containers.Indefinite_Holders, compatible with Ada 2005.                 --
--                                                                          --
-- WARNING: tampering checks are not implemented yet.                       --
------------------------------------------------------------------------------

private with Ada.Finalization;
private with Ada.Unchecked_Deallocation;

generic
   type Element_Type (<>) is private;
   with function "=" (Left, Right : Element_Type) return Boolean is <>;

package Natools.Indefinite_Holders is
   pragma Preelaborate (Indefinite_Holders);
   --  pragma Remote_Types (Indefinite_Holders); is not supported yet.

   type Holder is tagged private;
   pragma Preelaborable_Initialization (Holder);

   Empty_Holder : constant Holder;

   function "=" (Left, Right : Holder) return Boolean;

   function To_Holder (New_Item : Element_Type) return Holder;

   function Is_Empty (Container : Holder) return Boolean;

   procedure Clear (Container : in out Holder);
   function Element (Container : Holder) return Element_Type;

   procedure Replace_Element (Container : in out Holder;
                              New_Item  : in     Element_Type);

   procedure Query_Element
     (Container : in Holder;
      Process   : not null access procedure (Element : in Element_Type));

   procedure Update_Element
     (Container : in out Holder;
      Process   : not null access procedure (Element : in out Element_Type));

   function Reference (Container : Holder) return access Element_Type;

   procedure Assign (Target : in out Holder; Source : in Holder);

   function Copy (Source : Holder) return Holder;

   procedure Move (Target : in out Holder; Source : in out Holder);

private

   type Element_Access is access Element_Type;

   procedure Free is new Ada.Unchecked_Deallocation
     (Element_Type, Element_Access);

   type Holder is new Ada.Finalization.Controlled with record
      Ref : Element_Access := null;
   end record;

   overriding procedure Adjust (Object : in out Holder);
   overriding procedure Finalize (Object : in out Holder);

   Empty_Holder : constant Holder := (Ada.Finalization.Controlled with null);

end Natools.Indefinite_Holders;













This page was generated in about
0.004s by
Fossil 2.23 [47362306a7] 2023-11-01 18:56:47