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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxh/] [cxh30031.am] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CXH30031.AM
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 Reviewable.
28
--     Check that pragma Reviewable is accepted as a configuration pragma.
29
--
30
-- TEST DESCRIPTION
31
--     This test checks that pragma Reviewable is processed as a
32
--     configuration pragma.  See CXH3001 for testing pragma Reviewable as
33
--     other than a configuration pragma.
34
--
35
-- TEST FILES:
36
--      The following files comprise this test:
37
--
38
--         CXH30030.A
39
--      => CXH30031.AM
40
--
41
-- APPLICABILITY CRITERIA:
42
--      This test is only applicable for a compiler attempting validation
43
--      for the Safety and Security Annex.
44
--
45
-- SPECIAL REQUIREMENTS
46
--      The implementation must process a configuration pragma which is not
47
--      part of any Compilation Unit; the method employed is implementation
48
--      defined.
49
--
50
--
51
-- CHANGE HISTORY:
52
--      26 OCT 95   SAIC   Initial version for 2.1
53
--      07 JUN 96   SAIC   Revised by reviewer request
54
--      03 NOV 96   SAIC   Documentation revision
55
--
56
--      03 NOV 96   Keith  Documentation revision
57
--      27 AUG 99   RLB    Removed result dependence on uninitialized object.
58
--      30 AUG 99   RLB    Repaired the above.
59
--
60
--!
61
 
62
  pragma Reviewable;
63
 
64
----------------------------------------------------------------- CXH3003_0
65
 
66
package CXH3003_0 is
67
 
68
  type Enum is (Item,Stuff,Things);
69
 
70
  type Int is range 0..256;
71
 
72
  type Unt is mod 256;
73
 
74
  type Flt is digits 5;
75
 
76
  type Fix is delta 0.5 range -1.0..1.0;
77
 
78
  type Root(Disc: Enum) is tagged record
79
    I: Int; U:Unt;
80
  end record;
81
 
82
  type List is array(Unt) of Root(Stuff);
83
 
84
  type A_List is access List;
85
  type A_Proc is access procedure(R:Root);
86
 
87
  procedure P(R:Root);
88
 
89
  function F return A_Proc;
90
 
91
  Global_Variable : Boolean := False;
92
 
93
end CXH3003_0;
94
 
95
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
96
with Report;
97
package body CXH3003_0 is
98
 
99
 procedure P(R:Root) is
100
    Warnable : Positive := 0;                             -- OPTIONAL WARNING
101
  begin
102
    case R.Disc is
103
      when Item   => Report.Comment("Got Item");
104
      when Stuff  => Report.Comment("Got Stuff");
105
      when Things => Report.Comment("Got Things");
106
    end case;
107
    if Report.Ident_Int( Warnable ) = 0 then
108
      Global_Variable := not Global_Variable;     -- known to be initialized
109
    end if;
110
  end P;
111
 
112
  function F return A_Proc is
113
  begin
114
    return P'Access;
115
  end F;
116
 
117
end CXH3003_0;
118
 
119
----------------------------------------------------------------- CXH3003_1
120
 
121
package CXH3003_0.CXH3003_1 is
122
 
123
  protected PT is
124
    entry Set(Switch: Boolean);
125
    function Enquire return Boolean;
126
  private
127
    Toggle : Boolean;
128
  end PT;
129
 
130
  task TT is
131
    entry Release;
132
  end TT;
133
 
134
end CXH3003_0.CXH3003_1;
135
 
136
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
137
 
138
package body CXH3003_0.CXH3003_1 is
139
 
140
  protected body PT is
141
 
142
    entry Set(Switch: Boolean) when True is
143
    begin
144
      Toggle := Switch;
145
    end Set;
146
 
147
    function Enquire return Boolean is
148
    begin
149
      return Toggle;
150
    end Enquire;
151
 
152
  end PT;
153
 
154
  task body TT is
155
  begin
156
    loop
157
      accept Release;
158
      exit when Global_Variable;
159
    end loop;
160
  end TT;
161
 
162
 -- TT activation
163
 
164
end CXH3003_0.CXH3003_1;
165
 
166
------------------------------------------------------------------- CXH3003
167
 
168
with Report;
169
with CXH3003_0.CXH3003_1;
170
procedure CXH30031 is
171
begin
172
 
173
  Report.Test("CXH3003", "Check pragma Reviewable as a configuration pragma");
174
 
175
  Block: declare
176
    A_Truth : Boolean;
177
    Message : String := Report.Ident_Str( "Bad value encountered" );
178
  begin
179
    begin
180
      A_Truth := Report.Ident_Bool( True ) or A_Truth;  -- not initialized
181
      if not A_Truth then
182
        Report.Comment ("True or Uninit = False");
183
        A_Truth := Report.Ident_Bool (True);
184
      else
185
        A_Truth := Report.Ident_Bool (True);
186
          -- We do this separately on each branch in order to insure that a
187
          -- clever optimizer can find out little about this value. Ident_Bool
188
          -- is supposed to be opaque to any optimizer.
189
      end if;
190
    exception
191
      when Constraint_Error | Program_Error =>
192
           -- Possible results of accessing an uninitialized object.
193
        A_Truth := Report.Ident_Bool (True);
194
    end;
195
 
196
    CXH3003_0.CXH3003_1.PT.Set( A_Truth );
197
 
198
    CXH3003_0.Global_Variable := A_Truth;
199
 
200
    CXH3003_0.CXH3003_1.TT.Release;  -- rendezvous with TT
201
 
202
    while CXH3003_0.CXH3003_1.TT'Callable loop  -- wait for TT to complete
203
      delay 1.0;
204
    end loop;
205
 
206
    if   not CXH3003_0.CXH3003_1.PT.Enquire
207
      or not CXH3003_0.Global_Variable then
208
      Report.Failed(Message);
209
    end if;
210
 
211
  end Block;
212
 
213
  Report.Result;
214
 
215
end CXH30031;

powered by: WebSVN 2.1.0

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