Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/cd/cd72a01.a @ 111:04ced10e8804
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 -- CD72A01.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 the package System.Address_To_Access_Conversions may be | |
29 -- instantiated for various simple types. | |
30 -- | |
31 -- Check that To_Pointer and To_Address are inverse operations. | |
32 -- | |
33 -- Check that To_Pointer(X'Address) equals X'Unchecked_Access for an | |
34 -- X that allows Unchecked_Access. | |
35 -- | |
36 -- Check that To_Pointer(Null_Address) returns null. | |
37 -- | |
38 -- TEST DESCRIPTION: | |
39 -- This test checks that the semantics provided in | |
40 -- Address_To_Access_Conversions are present and operate | |
41 -- within expectations (to the best extent possible in a portable | |
42 -- implementation independent fashion). | |
43 -- | |
44 -- The functions Address_To_Hex and Hex_To_Address test the invertability | |
45 -- of the To_Integer and To_Address functions, along with a great deal | |
46 -- of optimizer chaff and protection from the fact that type | |
47 -- Storage_Elements.Integer_Address may be either a modular or a signed | |
48 -- integer type. | |
49 -- | |
50 -- This test has some interesting usage paradigms in that users | |
51 -- occasionally want to store address information in a transportable | |
52 -- fashion, and often resort to some textual representation of values. | |
53 -- | |
54 -- APPLICABILITY CRITERIA: | |
55 -- All implementations must attempt to compile this test. | |
56 -- | |
57 -- For implementations validating against Systems Programming Annex (C): | |
58 -- this test must execute and report PASSED. | |
59 -- | |
60 -- For implementations not validating against Annex C: | |
61 -- this test may report compile time errors at one or more points | |
62 -- indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable. | |
63 -- Otherwise, the test must execute and report PASSED. | |
64 -- | |
65 -- CHANGE HISTORY: | |
66 -- 13 JUL 95 SAIC Initial version (CD72001) | |
67 -- 08 FEB 96 SAIC Revised (split) version for 2.1 | |
68 -- 07 MAY 96 SAIC Additional subtest added for 2.1 | |
69 -- 16 FEB 98 EDS Modified documentation. | |
70 --! | |
71 | |
72 with Report; | |
73 with Impdef; | |
74 with FD72A00; | |
75 with System.Storage_Elements; | |
76 with System.Address_To_Access_Conversions; | |
77 procedure CD72A01 is | |
78 use System; | |
79 use FD72A00; | |
80 | |
81 package Number_ATAC is | |
82 new System.Address_To_Access_Conversions(Number); -- ANX-C RQMT | |
83 | |
84 use type Number_ATAC.Object_Pointer; | |
85 | |
86 type Data is record | |
87 One, Two: aliased Number; | |
88 end record; | |
89 | |
90 package Data_ATAC is | |
91 new System.Address_To_Access_Conversions(Data); -- ANX-C RQMT | |
92 | |
93 use type Data_ATAC.Object_Pointer; | |
94 | |
95 type Test_Cases is ( Addr_Type, Record_Type ); | |
96 | |
97 type Naive_Dynamic_String is access String; | |
98 | |
99 type String_Store is array(Test_Cases) of Naive_Dynamic_String; | |
100 | |
101 The_Strings : String_Store; | |
102 | |
103 -- create several aliased objects with distinct values | |
104 | |
105 My_Number : aliased Number := Number'First; | |
106 My_Data : aliased Data := (Number'First,Number'Last); | |
107 | |
108 use type System.Storage_Elements.Integer_Address; | |
109 | |
110 begin -- Main test procedure. | |
111 | |
112 Report.Test ("CD72A01", "Check package " & | |
113 "System.Address_To_Access_Conversions " & | |
114 "for simple types" ); | |
115 | |
116 -- take several pointer objects, convert them to addresses, and store | |
117 -- the address as a hexadecimal representation for later reconversion | |
118 | |
119 The_Strings(Addr_Type) := new String'( | |
120 Address_To_Hex(Number_ATAC.To_Address(My_Number'Access)) ); | |
121 | |
122 The_Strings(Record_Type) := new String'( | |
123 Address_To_Hex(Data_ATAC.To_Address(My_Data'Access)) ); | |
124 | |
125 -- now, reconvert the hexadecimal address values back to pointers, | |
126 -- and check that the dereferenced pointer still designates the | |
127 -- value placed at that location. The use of the intermediate | |
128 -- string representation should foil even the cleverest of optimizers | |
129 | |
130 if Number_ATAC.To_Pointer( | |
131 Hex_To_Address(The_Strings(Addr_Type))).all | |
132 /= Number'First then | |
133 Report.Failed("Number reconversion"); | |
134 end if; | |
135 | |
136 if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type))).all | |
137 /= (Number'First,Number'Last) then | |
138 Report.Failed("Data reconversion"); | |
139 end if; | |
140 | |
141 -- check that the resulting values are equal to the 'Unchecked_Access | |
142 -- of the value | |
143 | |
144 if Number_ATAC.To_Pointer( | |
145 Hex_To_Address(The_Strings(Addr_Type))) | |
146 /= My_Number'Unchecked_Access then | |
147 Report.Failed("Number Unchecked_Access"); | |
148 end if; | |
149 | |
150 if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type))) | |
151 /= My_Data'Unchecked_Access then | |
152 Report.Failed("Data Unchecked_Access"); | |
153 end if; | |
154 | |
155 if Number_ATAC.To_Pointer(System.Null_Address) /= null then | |
156 Report.Failed("To_Pointer(Null_Address) /= null"); | |
157 end if; | |
158 | |
159 if Number_ATAC.To_Address(null) /= System.Null_Address then | |
160 Report.Failed("To_Address(null) /= Null_Address"); | |
161 end if; | |
162 | |
163 Report.Result; | |
164 | |
165 end CD72A01; |