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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c980003.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C980003.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
-- TEST OBJECTIVE:
27
--      Check that aborts are deferred during the execution of an
28
--      Initialize procedure (as the last step of the default
29
--      initialization of a controlled object), during the execution
30
--      of a Finalize procedure (as part of the finalization of a
31
--      controlled object), and during an assignment operation to an
32
--      object with a controlled part.
33
--
34
-- TEST DESCRIPTION:
35
--      A controlled type is created with Initialize, Adjust, and
36
--      Finalize operations.  These operations note in a protected
37
--      object when the operation starts and completes.  This change
38
--      in state of the protected object will open the barrier for
39
--      the entry in the protected object.
40
--      The test contains declarations of objects of the controlled
41
--      type.  An asynchronous select is used to attempt to abort
42
--      the operations on the controlled type.  The asynchronous select
43
--      makes use of the state change to the protected object to
44
--      trigger the abort.
45
--
46
--
47
-- CHANGE HISTORY:
48
--      11 Jan 96   SAIC    Initial Release for 2.1
49
--       5 May 96   SAIC    Incorporated Reviewer comments.
50
--      10 Oct 96   SAIC    Addressed issue where assignment statement
51
--                          can be 2 assignment operations.
52
--
53
--!
54
 
55
with Ada.Finalization;
56
package C980003_0 is
57
    Verbose : constant Boolean := False;
58
 
59
    -- the following flag is set true whenever the
60
    -- Initialize operation is called.
61
    Init_Occurred : Boolean;
62
 
63
    type Is_Controlled is new Ada.Finalization.Controlled with
64
         record
65
             Id : Integer;
66
         end record;
67
 
68
     procedure Initialize (Object : in out Is_Controlled);
69
     procedure Finalize   (Object : in out Is_Controlled);
70
     procedure Adjust     (Object : in out Is_Controlled);
71
 
72
     type States is (Unknown,
73
                     Start_Init,   Finished_Init,
74
                     Start_Adjust, Finished_Adjust,
75
                     Start_Final,  Finished_Final);
76
 
77
     protected State_Manager is
78
        procedure Reset;
79
        procedure Set (New_State : States);
80
        function Current return States;
81
        entry Wait_For_Change;
82
     private
83
        Current_State : States := Unknown;
84
        Changed : Boolean := False;
85
     end State_Manager;
86
 
87
end C980003_0;
88
 
89
 
90
with Report;
91
with ImpDef;
92
package body C980003_0 is
93
     protected body State_Manager is
94
         procedure Reset is
95
         begin
96
             Current_State := Unknown;
97
             Changed := False;
98
         end Reset;
99
 
100
         procedure Set (New_State : States) is
101
         begin
102
             Changed := True;
103
             Current_State := New_State;
104
         end Set;
105
 
106
         function Current return States is
107
         begin
108
             return Current_State;
109
         end Current;
110
 
111
         entry Wait_For_Change when Changed is
112
         begin
113
             Changed := False;
114
         end Wait_For_Change;
115
     end State_Manager;
116
 
117
     procedure Initialize (Object : in out Is_Controlled) is
118
     begin
119
        if Verbose then
120
            Report.Comment ("starting initialize");
121
        end if;
122
        State_Manager.Set (Start_Init);
123
        if Verbose then
124
            Report.Comment ("in initialize");
125
        end if;
126
        delay ImpDef.Switch_To_New_Task;  -- tempting place for abort
127
        State_Manager.Set (Finished_Init);
128
        if Verbose then
129
            Report.Comment ("finished initialize");
130
        end if;
131
        Init_Occurred := True;
132
     end Initialize;
133
 
134
     procedure Finalize   (Object : in out Is_Controlled) is
135
     begin
136
        if Verbose then
137
            Report.Comment ("starting finalize");
138
        end if;
139
        State_Manager.Set (Start_Final);
140
        if Verbose then
141
            Report.Comment ("in finalize");
142
        end if;
143
        delay ImpDef.Switch_To_New_Task; -- tempting place for abort
144
        State_Manager.Set (Finished_Final);
145
        if Verbose then
146
            Report.Comment ("finished finalize");
147
        end if;
148
     end Finalize;
149
 
150
     procedure Adjust     (Object : in out Is_Controlled) is
151
     begin
152
        if Verbose then
153
            Report.Comment ("starting adjust");
154
        end if;
155
        State_Manager.Set (Start_Adjust);
156
        if Verbose then
157
            Report.Comment ("in adjust");
158
        end if;
159
        delay ImpDef.Switch_To_New_Task; -- tempting place for abort
160
        State_Manager.Set (Finished_Adjust);
161
        if Verbose then
162
            Report.Comment ("finished adjust");
163
        end if;
164
     end Adjust;
165
end C980003_0;
166
 
167
 
168
with Report;
169
with ImpDef;
170
with C980003_0;  use C980003_0;
171
with Ada.Unchecked_Deallocation;
172
procedure C980003 is
173
 
174
    procedure Check_State (Should_Be : States;
175
                           Msg       : String) is
176
        Cur : States := State_Manager.Current;
177
    begin
178
        if Cur /= Should_Be then
179
            Report.Failed (Msg);
180
            Report.Comment ("expected: " & States'Image (Should_Be) &
181
                            "  found: " & States'Image (Cur));
182
        elsif Verbose then
183
            Report.Comment ("passed: " & Msg);
184
        end if;
185
    end Check_State;
186
 
187
begin
188
 
189
    Report.Test ("C980003", "Check that aborts are deferred during" &
190
                            " initialization, finalization, and assignment" &
191
                            " operations on controlled objects");
192
 
193
    Check_State (Unknown, "initial condition");
194
 
195
    -- check that initialization and finalization take place
196
    Init_Occurred := False;
197
    select
198
        State_Manager.Wait_For_Change;
199
    then abort
200
        declare
201
            My_Controlled_Obj : Is_Controlled;
202
        begin
203
            delay 0.0;   -- abort completion point
204
            Report.Failed ("state change did not occur");
205
        end;
206
    end select;
207
    if not Init_Occurred then
208
        Report.Failed ("Initialize did not complete");
209
    end if;
210
    Check_State (Finished_Final, "init/final for declared item");
211
 
212
    -- check adjust
213
    State_Manager.Reset;
214
    declare
215
        Source, Dest : Is_Controlled;
216
    begin
217
        Check_State (Finished_Init, "adjust initial state");
218
        Source.Id := 3;
219
        Dest.Id := 4;
220
        State_Manager.Reset;  -- so we will wait for change
221
        select
222
            State_Manager.Wait_For_Change;
223
        then abort
224
            Dest := Source;
225
        end select;
226
 
227
        -- there are two implementation methods for the
228
        -- assignment statement:
229
        --   1.  no temporary was used in the assignment statement
230
        --        thus the entire
231
        --        assignment statement is abort deferred.
232
        --   2.  a temporary was used in the assignment statement so
233
        --        there are two assignment operations.  An abort may
234
        --        occur between the assignment operations
235
        -- Various optimizations are allowed by 7.6 that can affect
236
        -- how many times Adjust and Finalize are called.
237
        -- Depending upon the implementation, the state can be either
238
        -- Finished_Adjust or Finished_Finalize.   If it is any other
239
        -- state then the abort took place at the wrong time.
240
 
241
        case State_Manager.Current is
242
        when Finished_Adjust =>
243
            if Verbose then
244
                Report.Comment ("assignment aborted after adjust");
245
            end if;
246
        when Finished_Final =>
247
            if Verbose then
248
                Report.Comment ("assignment aborted after finalize");
249
            end if;
250
        when Start_Adjust =>
251
            Report.Failed ("assignment aborted in adjust");
252
        when Start_Final =>
253
            Report.Failed ("assignment aborted in finalize");
254
        when Start_Init =>
255
            Report.Failed ("assignment aborted in initialize");
256
        when Finished_Init =>
257
            Report.Failed ("assignment aborted after initialize");
258
        when Unknown =>
259
            Report.Failed ("assignment aborted in unknown state");
260
        end case;
261
 
262
 
263
        if Dest.Id /= 3 then
264
            if Verbose then
265
                Report.Comment ("assignment not performed");
266
            end if;
267
        end if;
268
    end;
269
 
270
 
271
     -- check dynamically allocated objects
272
    State_Manager.Reset;
273
    declare
274
        type Pointer_Type is access Is_Controlled;
275
        procedure Free is new Ada.Unchecked_Deallocation (
276
              Is_Controlled, Pointer_Type);
277
        Ptr : Pointer_Type;
278
    begin
279
      -- make sure initialize is done when object is allocated
280
      Ptr := new Is_Controlled;
281
      Check_State (Finished_Init, "init when item allocated");
282
      -- now try aborting the finalize
283
      State_Manager.Reset;
284
      select
285
             State_Manager.Wait_For_Change;
286
      then abort
287
             Free (Ptr);
288
      end select;
289
      Check_State (Finished_Final, "finalization in dealloc");
290
    end;
291
 
292
    Report.Result;
293
 
294
end C980003;

powered by: WebSVN 2.1.0

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