Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cd/cd70001.a @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 --
2 -- CD70001.A
3 --
4 -- Grant of Unlimited Rights
5 --
6 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
7 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
8 -- unlimited rights in the software and documentation contained herein.
9 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
10 -- this public release, the Government intends to confer upon all
11 -- recipients unlimited rights equal to those held by the Government.
12 -- These rights include rights to use, duplicate, release or disclose the
13 -- released technical data and computer software in whole or in part, in
14 -- any manner and for any purpose whatsoever, and to have or permit others
15 -- to do so.
16 --
17 -- DISCLAIMER
18 --
19 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
20 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
21 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
22 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
23 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
24 -- PARTICULAR PURPOSE OF SAID MATERIAL.
25 --*
26 --
27 -- OBJECTIVE:
28 -- Check that package System includes Max_Base_Digits, Address,
29 -- Null_Address, Word_Size, functions "<", "<=", ">", ">=", "="
30 -- (with Address parameters and Boolean results), Bit_Order,
31 -- Default_Bit_Order, Any_Priority, Interrupt_Priority,
32 -- and Default_Priority.
33 --
34 -- Check that package System.Storage_Elements includes all required
35 -- types and operations.
36 --
37 -- TEST DESCRIPTION:
38 -- The test checks for the existence of the names additional
39 -- to package system above those names tested for in 9Xbasic.
40 --
41 -- This test checks that the semantics provided in Storage_Elements
42 -- are present and operate marginally within expectations (to the best
43 -- extent possible in a portable implementation independent fashion).
44 --
45 --
46 -- CHANGE HISTORY:
47 -- 09 MAY 95 SAIC Initial version
48 -- 27 JAN 96 SAIC Revised for 2.1; Allow negative address delta
49 --
50 --!
51
52 with Report;
53 with Ada.Text_IO;
54 with System.Storage_Elements;
55 with System.Address_To_Access_Conversions;
56 procedure CD70001 is
57 use System;
58
59 procedure CD70 is
60
61 type Int_Max is range Min_Int .. Max_Int;
62
63 My_Int : Int_Max := System.Max_Base_Digits + System.Word_Size;
64
65 An_Address : Address;
66 An_Other_Address : Address := An_Address'Address;
67
68 begin -- 7.0
69
70
71 if Default_Bit_Order not in High_Order_First..Low_Order_First then
72 Report.Failed ("Default_Bit_Order invalid");
73 end if;
74
75 if Bit_Order'Pos(High_Order_First) /= 0 then
76 Report.Failed ("Bit_Order'Pos(High_Order_First) /= 0");
77 end if;
78
79 if Bit_Order'Pos(Low_Order_First) /= 1 then
80 Report.Failed ("Bit_Order'Pos(Low_Order_First) /= 1");
81 end if;
82
83 An_Address := My_Int'Address;
84
85 if An_Address = Null_Address then
86 Report.Failed ("Null_Address matched a real address");
87 end if;
88
89
90 if An_Address'Address /= An_Other_Address then
91 Report.Failed("Value set at elaboration not equal to itself");
92 end if;
93
94 if An_Address'Address > An_Other_Address
95 and An_Address'Address < An_Other_Address then
96 Report.Failed("Address is both greater and less!");
97 end if;
98
99 if not (An_Address'Address >= An_Other_Address
100 and An_Address'Address <= An_Other_Address) then
101 Report.Failed("Address comparisons wrong");
102 end if;
103
104
105 if Priority'First /= Any_Priority'First then
106 Report.Failed ("Priority'First /= Any_Priority'First");
107 end if;
108
109 if Interrupt_Priority'First /= Priority'Last+1 then
110 Report.Failed ("Interrupt_Priority'First /= Priority'Last+1");
111 end if;
112
113 if Interrupt_Priority'Last /= Any_Priority'Last then
114 Report.Failed ("Interrupt_Priority'Last /= Any_Priority'Last");
115 end if;
116
117 if Default_Priority /= ((Priority'First + Priority'Last)/2) then
118 Report.Failed ("Default_Priority wrong value");
119 end if;
120
121 end CD70;
122
123 procedure CD71 is
124 use System.Storage_Elements;
125
126 Storehouse_1 : Storage_Array(0..127);
127 Storehouse_2 : Storage_Array(0..127);
128
129 House_Offset : Storage_Offset;
130
131 begin -- 7.1
132
133
134 if Storage_Count'First /= 0 then
135 Report.Failed ("Storage_Count'First /= 0");
136 end if;
137
138 if Storage_Count'Last /= Storage_Offset'Last then
139 Report.Failed ("Storage_Count'Last /= Storage_Offset'Last");
140 end if;
141
142
143 if Storage_Element'Size /= Storage_Unit then
144 Report.Failed ("Storage_Element'Size /= Storage_Unit");
145 end if;
146
147 if Storage_Array'Component_Size /= Storage_Unit then
148 Report.Failed ("Storage_Array'Element_Size /= Storage_Unit");
149 end if;
150
151 if Storage_Element'Last+1 /= 0 then
152 Report.Failed ("Storage_Element not modular");
153 end if;
154
155
156 -- "+", "-"( Address, Storage_Offset) and inverse
157
158 House_Offset := Storehouse_2'Address - Storehouse_1'Address;
159 -- Address - Address = Offset
160 -- Note that House_Offset may be a negative value
161
162 if House_Offset + Storehouse_1'Address /= Storehouse_2'Address then
163 -- Offset + Address = Address
164 Report.Failed ("Storage arithmetic non-linear O+A");
165 end if;
166
167 if Storehouse_1'Address + House_Offset /= Storehouse_2'Address then
168 -- Address + Offset = Address
169 Report.Failed ("Storage arithmetic non-linear A+O");
170 end if;
171
172 if Storehouse_2'Address - House_Offset /= Storehouse_1'Address then
173 -- Address - Offset = Address
174 Report.Failed ("Storage arithmetic non-linear A-O");
175 end if;
176
177 if (Storehouse_2'Address mod abs(House_Offset) > abs(House_Offset)) then
178 -- "mod"( Address, Storage_Offset)
179 Report.Failed("Mod arithmetic");
180 end if;
181
182
183 if Storehouse_1'Address
184 /= To_Address(To_Integer(Storehouse_1'Address)) then
185 Report.Failed("To_Address, To_Integer not symmetric");
186 end if;
187
188 end CD71;
189
190
191 begin -- Main test procedure.
192
193 Report.Test ("CD70001", "Check package System" );
194
195 CD70;
196
197 CD71;
198
199 Report.Result;
200
201 end CD70001;