OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxh/] [cxh1001.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CXH1001.A
2
--
3
--                             Grant of Unlimited Rights
4
--
5
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7
--     unlimited rights in the software and documentation contained herein.
8
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9
--     this public release, the Government intends to confer upon all
10
--     recipients unlimited rights  equal to those held by the Government.
11
--     These rights include rights to use, duplicate, release or disclose the
12
--     released technical data and computer software in whole or in part, in
13
--     any manner and for any purpose whatsoever, and to have or permit others
14
--     to do so.
15
--
16
--                                    DISCLAIMER
17
--
18
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23
--     PARTICULAR PURPOSE OF SAID MATERIAL.
24
--*
25
--
26
-- OBJECTIVE
27
--     Check pragma Normalize_Scalars.
28
--     Check that this configuration pragma causes uninitialized scalar
29
--     objects to be set to a predictable value.  Check that multiple
30
--     compilation units are affected.  Check for uninitialized scalar
31
--     objects that are subcomponents of composite objects, unassigned
32
--     out parameters, objects that have been allocated without an initial
33
--     value, and objects that are stand alone.
34
--
35
-- TEST DESCRIPTION
36
--     The test requires that the configuration pragma Normalize_Scalars
37
--     be processed.  It then defines a few scalar types (some enumeration,
38
--     some integer) in a few packages.  The scalar types are designed such
39
--     that the representation will easily allow for an out of range value.
40
--     Unchecked_Conversion and the 'Valid attribute are both used to verify
41
--     that the default values of the various kinds of objects are indeed
42
--     invalid for the type.
43
--
44
--     Note that this test relies on having uninitialized objects, compilers
45
--     may generate several warnings to this effect.
46
--
47
-- SPECIAL REQUIREMENTS
48
--      The implementation must process configuration pragmas which
49
--      are not part of any Compilation Unit;  the method employed
50
--      is implementation defined.
51
--
52
-- APPLICABILITY CRITERIA:
53
--      This test is only applicable for a compiler attempting validation
54
--      for the Safety and Security Annex.
55
--
56
--
57
-- CHANGE HISTORY:
58
--      26 OCT 95   SAIC   Initial version
59
--      04 NOV 96   SAIC   Added cases, upgraded commentary
60
--
61
--!
62
 
63
---------------------------- CONFIGURATION PRAGMAS -----------------------
64
 
65
pragma Normalize_Scalars;                                         -- OK
66
                                                -- configuration pragma
67
 
68
------------------------ END OF CONFIGURATION PRAGMAS --------------------
69
 
70
 
71
----------------------------------------------------------------- CXH1001_0
72
 
73
with Impdef.Annex_H;
74
with Unchecked_Conversion;
75
package CXH1001_0 is
76
 
77
  package Imp_H renames Impdef.Annex_H;
78
  use type Imp_H.Small_Number;
79
  use type Imp_H.Scalar_To_Normalize;
80
 
81
  Global_Object : Imp_H.Scalar_To_Normalize;
82
  -- if the pragma is in effect, this should come up with the predictable
83
  -- value
84
 
85
  Global_Number : Imp_H.Small_Number;
86
  -- if the pragma is in effect, this should come up with the predictable
87
  -- value
88
 
89
  procedure Package_Check;
90
 
91
  type Num is range 0..2**Imp_H.Scalar_To_Normalize'Size-1;
92
  for Num'Size use Imp_H.Scalar_To_Normalize'Size;
93
 
94
  function STN_2_Num is
95
     new Unchecked_Conversion( Imp_H.Scalar_To_Normalize, Num );
96
 
97
  Small_Last : constant Integer := Integer(Imp_H.Small_Number'Last);
98
 
99
end CXH1001_0;
100
 
101
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
102
 
103
with Report;
104
package body CXH1001_0 is
105
 
106
  procedure Heap_Check( A_Value  : access Imp_H.Scalar_To_Normalize;
107
                        A_Number : access Imp_H.Small_Number ) is
108
    Value  : Num;
109
    Number : Integer;
110
  begin
111
 
112
    if A_Value.all'Valid then
113
      Value := STN_2_Num ( A_Value.all );
114
      if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then
115
        if Imp_H.Scalar_To_Normalize'Val(Value)
116
           /= Imp_H.Default_For_Scalar_To_Normalize then
117
          Report.Failed("Implicit initial value for local variable is not "
118
                         & "the predicted value");
119
        end if;
120
      else
121
        if Value in 0 ..
122
            Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then
123
          Report.Failed("Implicit initial value for local variable is a "
124
                         & "value of the type");
125
        end if;
126
      end if;
127
    end if;
128
 
129
    if A_Number.all'Valid then
130
      Number := Integer( A_Number.all );
131
      if Imp_H.Default_For_Small_Number_Is_In_Range then
132
        if Global_Number /= Imp_H.Default_For_Small_Number then
133
          Report.Failed("Implicit initial value for number is not "
134
                         & "the predicted value");
135
        end if;
136
      else
137
        if Integer( Global_Number ) in 0 .. Report.Ident_Int(Small_Last) then
138
          Report.Failed("Implicit initial value for number is a "
139
                         & "value of the type");
140
        end if;
141
      end if;
142
    end if;
143
 
144
  end Heap_Check;
145
 
146
  procedure Package_Check is
147
    Value  : Num;
148
    Number : Integer;
149
  begin
150
 
151
    if Global_Object'Valid then
152
      Value := STN_2_Num ( Global_Object );
153
      if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then
154
        if Imp_H.Scalar_To_Normalize'Val(Value)
155
           /= Imp_H.Default_For_Scalar_To_Normalize then
156
          Report.Failed("Implicit initial value for local variable is not "
157
                         & "the predicted value");
158
        end if;
159
      else
160
        if Value in 0 ..
161
            Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then
162
          Report.Failed("Implicit initial value for local variable is a "
163
                         & "value of the type");
164
        end if;
165
      end if;
166
    end if;
167
 
168
    if Global_Number'Valid then
169
      Number := Integer( Global_Number );
170
      if Imp_H.Default_For_Small_Number_Is_In_Range then
171
        if Global_Number /= Imp_H.Default_For_Small_Number then
172
          Report.Failed("Implicit initial value for number is not "
173
                         & "the predicted value");
174
        end if;
175
      else
176
        if Integer( Global_Number ) in 0 .. Report.Ident_Int(Small_Last) then
177
          Report.Failed("Implicit initial value for number is a "
178
                         & "value of the type");
179
        end if;
180
      end if;
181
    end if;
182
 
183
    Heap_Check( new Imp_H.Scalar_To_Normalize, new Imp_H.Small_Number );
184
 
185
  end Package_Check;
186
 
187
end CXH1001_0;
188
 
189
----------------------------------------------------------------- CXH1001_1
190
 
191
with Unchecked_Conversion;
192
package CXH1001_0.CXH1001_1 is
193
 
194
  -- kill as many birds as possible with a single stone:
195
  --   embed a protected object in the body of a child package,
196
  -- checks the multiple compilation unit case,
197
  -- and part of the subcomponent case.
198
 
199
  protected Thingy is
200
    procedure Check_Embedded_Values;
201
  private
202
    Hidden_Object : Imp_H.Scalar_To_Normalize;  -- not initialized
203
    Hidden_Number : Imp_H.Small_Number;         -- not initialized
204
  end Thingy;
205
 
206
end CXH1001_0.CXH1001_1;
207
 
208
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
209
 
210
with Report;
211
package body CXH1001_0.CXH1001_1 is
212
 
213
  Childs_Object : Imp_H.Scalar_To_Normalize;  -- not initialized
214
 
215
  protected body Thingy is
216
 
217
    procedure Check_Embedded_Values is
218
    begin
219
 
220
      if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then
221
        if Childs_Object /= Imp_H.Default_For_Scalar_To_Normalize then
222
          Report.Failed("Implicit initial value for child object is not "
223
                         & "the predicted value");
224
        end if;
225
      elsif Childs_Object'Valid and then STN_2_Num( Childs_Object ) in 0 ..
226
            Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then
227
          Report.Failed("Implicit initial value for child object is a "
228
                         & "value of the type");
229
      end if;
230
 
231
      if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then
232
        if Hidden_Object /= Imp_H.Default_For_Scalar_To_Normalize then
233
          Report.Failed("Implicit initial value for protected package object "
234
                         & "is not the predicted value");
235
        end if;
236
      elsif Hidden_Object'Valid and then STN_2_Num( Hidden_Object ) in 0 ..
237
            Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then
238
          Report.Failed("Implicit initial value for protected component "
239
                         & "is a value of the type");
240
      end if;
241
 
242
      if Imp_H.Default_For_Small_Number_Is_In_Range then
243
        if Hidden_Number /= Imp_H.Default_For_Small_Number then
244
          Report.Failed("Implicit initial value for protected number "
245
                         & "is not the predicted value");
246
        end if;
247
      elsif Hidden_Number'Valid and then Hidden_Number in
248
 
249
          Report.Failed("Implicit initial value for protected number "
250
                         & "is a value of the type");
251
      end if;
252
 
253
    end Check_Embedded_Values;
254
 
255
 end Thingy;
256
 
257
end CXH1001_0.CXH1001_1;
258
 
259
------------------------------------------------------------------- CXH1001
260
 
261
with Impdef.Annex_H;
262
with Report;
263
with CXH1001_0.CXH1001_1;
264
procedure CXH1001 is
265
 
266
  package Imp_H renames Impdef.Annex_H;
267
  use type CXH1001_0.Num;
268
 
269
  My_Object : Imp_H.Scalar_To_Normalize;  -- not initialized
270
 
271
  Value     : CXH1001_0.Num := CXH1001_0.STN_2_Num ( My_Object );
272
                               -- My_Object is not initialized
273
 
274
  Parameter_Value : Imp_H.Scalar_To_Normalize
275
                  := Imp_H.Scalar_To_Normalize'Last;
276
 
277
  type Structure is record  -- not initialized
278
    Std_Int : Integer;
279
    Scalar  : Imp_H.Scalar_To_Normalize;
280
    Num     : CXH1001_0.Num;
281
  end record;
282
 
283
  S : Structure;  -- not initialized
284
 
285
  procedure Bad_Code( Unassigned : out Imp_H.Scalar_To_Normalize ) is
286
    -- returns uninitialized OUT parameter
287
  begin
288
 
289
    if Report.Ident_Int( 0 ) = 1 then
290
      Report.Failed( "Nothing is something" );
291
      Unassigned := Imp_H.Scalar_To_Normalize'First;
292
    end if;
293
 
294
  end Bad_Code;
295
 
296
  procedure Check( V : CXH1001_0.Num; Message : String ) is
297
  begin
298
 
299
 
300
    if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then
301
      if V /= Imp_H.Scalar_To_Normalize'Pos(
302
                                  Imp_H.Default_For_Scalar_To_Normalize) then
303
        Report.Failed(Message & ": Implicit initial value for object "
304
                       & "is not the predicted value");
305
      end if;
306
    elsif V'Valid and then V in
307
 
308
      Report.Failed(Message & ": Implicit initial value for object "
309
                     & "is a value of the type");
310
    end if;
311
 
312
  end Check;
313
 
314
begin  -- Main test procedure.
315
 
316
  Report.Test ("CXH1001", "Check that the configuration pragma " &
317
                          "Normalize_Scalars causes uninitialized scalar " &
318
                          "objects to be set to a predictable value. " &
319
                          "Check that multiple compilation units are " &
320
                          "affected.  Check for uninitialized scalar " &
321
                          "objects that are subcomponents of composite " &
322
                          "objects, unassigned out parameters, have been " &
323
                          "allocated without an initial value, and are " &
324
                          "stand alone." );
325
 
326
  CXH1001_0.Package_Check;
327
 
328
  if My_Object'Valid then
329
    Value := CXH1001_0.STN_2_Num ( My_Object ); -- My_Object not initialized
330
  end if;
331
  -- otherwise, we just leave Value uninitialized
332
 
333
  Check( Value, "main procedure variable" );
334
 
335
  Bad_Code( Parameter_Value );
336
 
337
  if Parameter_Value'Valid then
338
    Check( CXH1001_0.STN_2_Num ( Parameter_Value ), "Out parameter return" );
339
  end if;
340
 
341
  if S.Scalar'Valid then
342
    Check( CXH1001_0.STN_2_Num ( S.Scalar ), "Record component" );
343
  end if;
344
 
345
  CXH1001_0.CXH1001_1.Thingy.Check_Embedded_Values;
346
 
347
  Report.Result;
348
 
349
end CXH1001;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.