• R/O
  • SSH

PAF: 提交

New main repository


Commit MetaInfo

修订版36a147b87f3f202af761be75bab2da5bbffd22a9 (tree)
时间2023-01-08 19:22:23
作者Ivan Levashev 卜根 <bu_ <gen@octa...>
CommiterIvan Levashev 卜根 <bu_

Log Message

Type information: initialization

更改概述

差异

diff -r 6a2f7c9bd27b -r 36a147b87f3f Source/PAF.Storage_Pools.Default.ads
--- a/Source/PAF.Storage_Pools.Default.ads Sun Jan 08 10:29:12 2023 +0300
+++ b/Source/PAF.Storage_Pools.Default.ads Sun Jan 08 13:22:23 2023 +0300
@@ -15,7 +15,7 @@
1515 ------------------------------------------------------------------------------
1616
1717 with PAF.Storage_Pools.Reallocatable;
18-with PAF.Storage_Pools.Default_Instance;
18+with PAF.Storage_Pools.Default_Internal;
1919
2020 package PAF.Storage_Pools.Default is
2121 pragma Preelaborate (PAF.Storage_Pools.Default);
@@ -23,6 +23,6 @@
2323 -- Classwide reference to the default pool
2424
2525 Pool : Reallocatable.Reallocatable_Pool'Class
26- renames Default_Instance.Pool_Access.all;
26+ renames Default_Internal.Pool_Access.all;
2727
2828 end PAF.Storage_Pools.Default;
diff -r 6a2f7c9bd27b -r 36a147b87f3f Source/PAF.Storage_Pools.Default_Instance.ads
--- a/Source/PAF.Storage_Pools.Default_Instance.ads Sun Jan 08 10:29:12 2023 +0300
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,34 +0,0 @@
1-------------------------------------------------------------------------------
2--- Copyright 2023 Levashev Ivan Aleksandrovich --
3--- --
4--- Licensed under the Apache License, Version 2.0 (the "License"); --
5--- you may not use this file except in compliance with the License. --
6--- You may obtain a copy of the License at --
7--- --
8--- http://www.apache.org/licenses/LICENSE-2.0 --
9--- --
10--- Unless required by applicable law or agreed to in writing, software --
11--- distributed under the License is distributed on an "AS IS" BASIS, --
12--- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --
13--- See the License for the specific language governing permissions and --
14--- limitations under the License. --
15-------------------------------------------------------------------------------
16-
17-with PAF.Storage_Pools.Reallocatable;
18-with PAF.Storage_Pools.Default_Types;
19-
20-package PAF.Storage_Pools.Default_Instance is
21- pragma Preelaborate (PAF.Storage_Pools.Default_Instance);
22-
23- -- Moved to separate package to workaround error in renaming declaration:
24- -- deferred constant is frozen before completion
25-
26- Pool_Access : constant Reallocatable.Reallocatable_Pool_Access;
27-
28-private
29-
30- Pool_Instance : aliased Default_Types.Default_Pool;
31- Pool_Access : constant Reallocatable.Reallocatable_Pool_Access :=
32- Pool_Instance'Access;
33-
34-end PAF.Storage_Pools.Default_Instance;
diff -r 6a2f7c9bd27b -r 36a147b87f3f Source/PAF.Storage_Pools.Default_Internal.ads
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Source/PAF.Storage_Pools.Default_Internal.ads Sun Jan 08 13:22:23 2023 +0300
@@ -0,0 +1,34 @@
1+------------------------------------------------------------------------------
2+-- Copyright 2023 Levashev Ivan Aleksandrovich --
3+-- --
4+-- Licensed under the Apache License, Version 2.0 (the "License"); --
5+-- you may not use this file except in compliance with the License. --
6+-- You may obtain a copy of the License at --
7+-- --
8+-- http://www.apache.org/licenses/LICENSE-2.0 --
9+-- --
10+-- Unless required by applicable law or agreed to in writing, software --
11+-- distributed under the License is distributed on an "AS IS" BASIS, --
12+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --
13+-- See the License for the specific language governing permissions and --
14+-- limitations under the License. --
15+------------------------------------------------------------------------------
16+
17+with PAF.Storage_Pools.Reallocatable;
18+with PAF.Storage_Pools.Default_Types;
19+
20+package PAF.Storage_Pools.Default_Internal is
21+ pragma Preelaborate (PAF.Storage_Pools.Default_Internal);
22+
23+ -- Moved to separate package to workaround error in renaming declaration:
24+ -- deferred constant is frozen before completion
25+
26+ Pool_Access : constant Reallocatable.Reallocatable_Pool_Access;
27+
28+private
29+
30+ Pool_Instance : aliased Default_Types.Default_Pool;
31+ Pool_Access : constant Reallocatable.Reallocatable_Pool_Access :=
32+ Pool_Instance'Access;
33+
34+end PAF.Storage_Pools.Default_Internal;
diff -r 6a2f7c9bd27b -r 36a147b87f3f Source/PAF.Type_Information.Default.ads
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Source/PAF.Type_Information.Default.ads Sun Jan 08 13:22:23 2023 +0300
@@ -0,0 +1,57 @@
1+------------------------------------------------------------------------------
2+-- Copyright 2023 Levashev Ivan Aleksandrovich --
3+-- --
4+-- Licensed under the Apache License, Version 2.0 (the "License"); --
5+-- you may not use this file except in compliance with the License. --
6+-- You may obtain a copy of the License at --
7+-- --
8+-- http://www.apache.org/licenses/LICENSE-2.0 --
9+-- --
10+-- Unless required by applicable law or agreed to in writing, software --
11+-- distributed under the License is distributed on an "AS IS" BASIS, --
12+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --
13+-- See the License for the specific language governing permissions and --
14+-- limitations under the License. --
15+------------------------------------------------------------------------------
16+
17+package PAF.Type_Information.Default is
18+ pragma Preelaborate (PAF.Type_Information.Default);
19+
20+ -- It may make sense to have additional support for character, integral,
21+ -- enumeration and Boolean types. But not yet
22+
23+ package Boolean_Type_Information is
24+ new Default_Ordinal_Type_Information (Boolean);
25+
26+ package Character_8_Type_Information is new Default_Ordinal_Type_Information
27+ (Character_8,
28+ Default_Value => Character_8'Val (16#20#));
29+ package Character_16_Type_Information is new Default_Ordinal_Type_Information
30+ (Character_16,
31+ Default_Value => Character_16'Val (16#20#));
32+ package Character_32_Type_Information is new Default_Ordinal_Type_Information
33+ (Character_32,
34+ Default_Value => Character_32'Val (16#20#));
35+
36+ package Integer_Type_Information is
37+ new Default_Ordinal_Type_Information (Integer);
38+ package Natural_Type_Information is
39+ new Default_Ordinal_Type_Information (Natural);
40+ package Positive_Type_Information is
41+ new Default_Ordinal_Type_Information (Positive);
42+
43+ package Integer_32_Type_Information is
44+ new Default_Ordinal_Type_Information (Integer_32);
45+ package Natural_32_Type_Information is
46+ new Default_Ordinal_Type_Information (Natural_32);
47+ package Positive_32_Type_Information is
48+ new Default_Ordinal_Type_Information (Positive_32);
49+
50+ package Integer_64_Type_Information is
51+ new Default_Ordinal_Type_Information (Integer_64);
52+ package Natural_64_Type_Information is
53+ new Default_Ordinal_Type_Information (Natural_64);
54+ package Positive_64_Type_Information is
55+ new Default_Ordinal_Type_Information (Positive_64);
56+
57+end PAF.Type_Information.Default;
diff -r 6a2f7c9bd27b -r 36a147b87f3f Source/PAF.Type_Information.adb
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Source/PAF.Type_Information.adb Sun Jan 08 13:22:23 2023 +0300
@@ -0,0 +1,65 @@
1+------------------------------------------------------------------------------
2+-- Copyright 2023 Levashev Ivan Aleksandrovich --
3+-- --
4+-- Licensed under the Apache License, Version 2.0 (the "License"); --
5+-- you may not use this file except in compliance with the License. --
6+-- You may obtain a copy of the License at --
7+-- --
8+-- http://www.apache.org/licenses/LICENSE-2.0 --
9+-- --
10+-- Unless required by applicable law or agreed to in writing, software --
11+-- distributed under the License is distributed on an "AS IS" BASIS, --
12+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --
13+-- See the License for the specific language governing permissions and --
14+-- limitations under the License. --
15+------------------------------------------------------------------------------
16+
17+with System.Storage_Elements;
18+with PAF.Memory_Operations;
19+
20+package body PAF.Type_Information is
21+
22+ --------------------------------------
23+ -- Default_Ordinal_Type_Information --
24+ --------------------------------------
25+
26+ package body Default_Ordinal_Type_Information is
27+
28+ use System.Storage_Elements;
29+
30+ ----------------------
31+ -- Initialize_Array --
32+ ----------------------
33+
34+ procedure Initialize_Array
35+ (Array_Address : System.Address; Count : Natural)
36+ is
37+ Elements : array (Positive range 1 .. Count) of Element_Type;
38+ pragma Import (Ada, Elements);
39+ for Elements'Address use Array_Address;
40+ begin
41+ if Default_Is_Zeroed_Memory then
42+ Memory_Operations.Fill
43+ (Target => Array_Address, Item => 0,
44+ Count => (Elements'Size + System.Storage_Unit - 1) / System.Storage_Unit);
45+ else
46+ for Index in Elements'Range loop
47+ Elements (Index) := Default_Value;
48+ end loop;
49+ end if;
50+ end Initialize_Array;
51+
52+ --------------------
53+ -- Finalize_Array --
54+ --------------------
55+
56+ procedure Finalize_Array
57+ (Array_Address : System.Address; Count : Natural) is
58+ begin
59+ null;
60+ end Finalize_Array;
61+
62+ end Default_Ordinal_Type_Information;
63+
64+
65+end PAF.Type_Information;
diff -r 6a2f7c9bd27b -r 36a147b87f3f Source/PAF.Type_Information.ads
--- a/Source/PAF.Type_Information.ads Sun Jan 08 10:29:12 2023 +0300
+++ b/Source/PAF.Type_Information.ads Sun Jan 08 13:22:23 2023 +0300
@@ -14,8 +14,10 @@
1414 -- limitations under the License. --
1515 ------------------------------------------------------------------------------
1616
17+with System;
18+
1719 package PAF.Type_Information is
18- pragma Pure (PAF.Type_Information);
20+ pragma Preelaborate (PAF.Type_Information);
1921
2022 -- Element type is nonlimited and definite
2123 -- Is_Controlled means some RAII is required
@@ -28,61 +30,36 @@
2830 Default_Is_Zeroed_Memory : Boolean := False;
2931 Is_Controlled : Boolean := True;
3032 Is_Tracked : Boolean := Is_Controlled;
33+ with procedure Initialize_Array (Array_Address : System.Address; Count : Natural);
34+ with procedure Finalize_Array (Array_Address : System.Address; Count : Natural);
3135 package Element_Type_Information is
3236 pragma Assert (Is_Controlled >= Is_Tracked);
37+ end Element_Type_Information;
3338
34- end Element_Type_Information;
39+ -- There can be formal package Ordinal_Type_Information, but not yet
3540
3641 generic
3742 type Element_Type is (<>);
43+ Default_Value : Element_Type :=
44+ Element_Type'Val (Integer_64'Max
45+ (0, Element_Type'Pos (Element_Type'First)));
3846 Default_Is_Zeroed_Memory : Boolean :=
39- Element_Type'Pos (Element_Type'First) <= 0;
40- package Ordinal_Type_Information is
47+ Element_Type'Pos (Default_Value) = 0;
48+ package Default_Ordinal_Type_Information is
49+
50+ procedure Initialize_Array (Array_Address : System.Address; Count : Natural);
51+ procedure Finalize_Array (Array_Address : System.Address; Count : Natural);
4152
4253 package As_Element is new Element_Type_Information
43- (Element_Type => Ordinal_Type_Information.Element_Type,
54+ (Element_Type => Default_Ordinal_Type_Information.Element_Type,
4455 Default_Is_Zeroed_Memory => Default_Is_Zeroed_Memory,
45- Is_Controlled => False,
46- Is_Tracked => False);
47- end Ordinal_Type_Information;
48-
49- -- It may make sense to have additional support for character, integral,
50- -- enumeration and Boolean types. But not yet
51-
52- package Boolean_Type_Information is
53- new Ordinal_Type_Information (Boolean);
54-
55- -- Default character is space
56-
57- package Character_8_Type_Information is new Ordinal_Type_Information
58- (Character_8,
59- Default_Is_Zeroed_Memory => False);
60- package Character_16_Type_Information is new Ordinal_Type_Information
61- (Character_16,
62- Default_Is_Zeroed_Memory => False);
63- package Character_32_Type_Information is new Ordinal_Type_Information
64- (Character_32,
65- Default_Is_Zeroed_Memory => False);
66-
67- package Integer_Type_Information is
68- new Ordinal_Type_Information (Integer);
69- package Natural_Type_Information is
70- new Ordinal_Type_Information (Natural);
71- package Positive_Type_Information is
72- new Ordinal_Type_Information (Positive);
73-
74- package Integer_32_Type_Information is
75- new Ordinal_Type_Information (Integer_32);
76- package Natural_32_Type_Information is
77- new Ordinal_Type_Information (Natural_32);
78- package Positive_32_Type_Information is
79- new Ordinal_Type_Information (Positive_32);
80-
81- package Integer_64_Type_Information is
82- new Ordinal_Type_Information (Integer_64);
83- package Natural_64_Type_Information is
84- new Ordinal_Type_Information (Natural_64);
85- package Positive_64_Type_Information is
86- new Ordinal_Type_Information (Positive_64);
56+ Is_Controlled => False,
57+ Is_Tracked => False,
58+ Initialize_Array => Initialize_Array,
59+ Finalize_Array => Finalize_Array);
60+ private
61+ pragma Inline (Initialize_Array);
62+ pragma Inline (Finalize_Array);
63+ end Default_Ordinal_Type_Information;
8764
8865 end PAF.Type_Information;
diff -r 6a2f7c9bd27b -r 36a147b87f3f Test/PAF.Type_Information.Test.adb
--- a/Test/PAF.Type_Information.Test.adb Sun Jan 08 10:29:12 2023 +0300
+++ b/Test/PAF.Type_Information.Test.adb Sun Jan 08 13:22:23 2023 +0300
@@ -14,6 +14,9 @@
1414 -- limitations under the License. --
1515 ------------------------------------------------------------------------------
1616
17+with System;
18+with PAF.Type_Information.Default;
19+
1720 package body PAF.Type_Information.Test is
1821
1922 procedure Test_Boolean;
@@ -21,6 +24,7 @@
2124 procedure Test_Characters_Zeroed_Memory;
2225 procedure Test_Integers;
2326 procedure Test_Integers_Zeroed_Memory;
27+ procedure Test_Initialize;
2428
2529 --------------------------------------
2630 -- Type_Information_Test.Initialize --
@@ -43,6 +47,8 @@
4347 (Object, Test_Integers'Access, "Test_Integers");
4448 Ahven.Framework.Add_Test_Routine
4549 (Object, Test_Integers_Zeroed_Memory'Access, "Test_Integers_Zeroed_Memory");
50+ Ahven.Framework.Add_Test_Routine
51+ (Object, Test_Initialize'Access, "Test_Initialize");
4652 end Initialize;
4753
4854 ----------------------------------
@@ -82,10 +88,14 @@
8288 Default_Is_Zeroed_Memory : Boolean renames Element_Information.Default_Is_Zeroed_Memory;
8389 Is_Controlled : Boolean renames Element_Information.Is_Controlled;
8490 Is_Tracked : Boolean renames Element_Information.Is_Tracked;
91+ procedure Initialize_Array (Array_Address : System.Address; Count : Natural)
92+ renames Element_Information.Initialize_Array;
93+ procedure Finalize_Array (Array_Address : System.Address; Count : Natural)
94+ renames Element_Information.Finalize_Array;
8595 end Extract_Information;
8696
8797 package Extract_Boolean is new Extract_Information
88- (Boolean_Type_Information.As_Element);
98+ (Default.Boolean_Type_Information.As_Element);
8999
90100 ------------------
91101 -- Test_Boolean --
@@ -102,11 +112,11 @@
102112 end Test_Boolean;
103113
104114 package Extract_Character_8 is new Extract_Information
105- (Character_8_Type_Information.As_Element);
115+ (Default.Character_8_Type_Information.As_Element);
106116 package Extract_Character_16 is new Extract_Information
107- (Character_16_Type_Information.As_Element);
117+ (Default.Character_16_Type_Information.As_Element);
108118 package Extract_Character_32 is new Extract_Information
109- (Character_32_Type_Information.As_Element);
119+ (Default.Character_32_Type_Information.As_Element);
110120
111121 ---------------------
112122 -- Test_Characters --
@@ -147,25 +157,25 @@
147157 end Test_Characters_Zeroed_Memory;
148158
149159 package Extract_Integer is new Extract_Information
150- (Integer_Type_Information.As_Element);
160+ (Default.Integer_Type_Information.As_Element);
151161 package Extract_Natural is new Extract_Information
152- (Natural_Type_Information.As_Element);
162+ (Default.Natural_Type_Information.As_Element);
153163 package Extract_Positive is new Extract_Information
154- (Positive_Type_Information.As_Element);
164+ (Default.Positive_Type_Information.As_Element);
155165
156166 package Extract_Integer_32 is new Extract_Information
157- (Integer_32_Type_Information.As_Element);
167+ (Default.Integer_32_Type_Information.As_Element);
158168 package Extract_Natural_32 is new Extract_Information
159- (Natural_32_Type_Information.As_Element);
169+ (Default.Natural_32_Type_Information.As_Element);
160170 package Extract_Positive_32 is new Extract_Information
161- (Positive_32_Type_Information.As_Element);
171+ (Default.Positive_32_Type_Information.As_Element);
162172
163173 package Extract_Integer_64 is new Extract_Information
164- (Integer_64_Type_Information.As_Element);
174+ (Default.Integer_64_Type_Information.As_Element);
165175 package Extract_Natural_64 is new Extract_Information
166- (Natural_64_Type_Information.As_Element);
176+ (Default.Natural_64_Type_Information.As_Element);
167177 package Extract_Positive_64 is new Extract_Information
168- (Positive_64_Type_Information.As_Element);
178+ (Default.Positive_64_Type_Information.As_Element);
169179
170180 -------------------
171181 -- Test_Integers --
@@ -241,4 +251,29 @@
241251 "not Extract_Positive_64.Default_Is_Zeroed_Memory");
242252 end Test_Integers_Zeroed_Memory;
243253
254+ ---------------------
255+ -- Test_Initialize --
256+ ---------------------
257+
258+ procedure Test_Initialize is
259+ Default_Integer : aliased Integer := -6768;
260+ Default_Natural : aliased Natural := 995;
261+ Default_Positive : aliased Positive := 547;
262+ Default_Character_32 : aliased Character_32 := Character_32'Val (81134);
263+ Default_Boolean : aliased Boolean := True;
264+ begin
265+ Extract_Integer.Initialize_Array (Default_Integer'Address, 1);
266+ Extract_Natural.Initialize_Array (Default_Natural'Address, 1);
267+ Extract_Positive.Initialize_Array (Default_Positive'Address, 1);
268+ Extract_Character_32.Initialize_Array (Default_Character_32'Address, 1);
269+ Extract_Boolean.Initialize_Array (Default_Boolean'Address, 1);
270+
271+ Ahven.Assert (Default_Integer = 0, "Default_Integer = 0");
272+ Ahven.Assert (Default_Natural = 0, "Default_Natural = 0");
273+ Ahven.Assert (Default_Positive = 1, "Default_Positive = 1");
274+ Ahven.Assert (Default_Character_32 = Character_32'Val (16#20#),
275+ "Default_Character_32 = Character_32'Val (16#20#)");
276+ Ahven.Assert (not Default_Boolean, "not Default_Boolean");
277+ end Test_Initialize;
278+
244279 end PAF.Type_Information.Test;
Show on old repository browser