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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C940014.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 as part of the finalization of a protected object
28
--      each call remaining on an entry queue of the objet is removed
29
--      from its queue and Program_Error is raised at the place of
30
--      the corresponding entry_call_statement.
31
--
32
-- TEST DESCRIPTION:
33
--      The example in 9.4(20a-20f);6.0 demonstrates how to cause a
34
--      protected object to finalize while tasks are still waiting
35
--      on its entry queues.  The first part of this test mirrors
36
--      that example.  The second part of the test expands upon
37
--      the example code to add an object with finalization code
38
--      to the protected object.  The finalization code should be
39
--      executed after Program_Error is raised in the callers left
40
--      on the entry queues.
41
--
42
--
43
-- CHANGE HISTORY:
44
--      08 Jan 96   SAIC    Initial Release for 2.1
45
--      10 Jul 96   SAIC    Incorporated Reviewer comments to fix race
46
--                          condition.
47
--
48
--!
49
 
50
 
51
with Ada.Finalization;
52
package C940014_0 is
53
    Verbose : constant Boolean := False;
54
    Finalization_Occurred : Boolean := False;
55
 
56
    type Has_Finalization is new Ada.Finalization.Limited_Controlled with
57
          record
58
             Placeholder : Integer;
59
          end record;
60
    procedure Finalize (Object : in out Has_Finalization);
61
end C940014_0;
62
 
63
 
64
with Report;
65
with ImpDef;
66
package body C940014_0 is
67
    procedure Finalize (Object : in out Has_Finalization) is
68
    begin
69
        delay ImpDef.Clear_Ready_Queue;
70
        Finalization_Occurred := True;
71
        if Verbose then
72
            Report.Comment ("in Finalize");
73
        end if;
74
    end Finalize;
75
end C940014_0;
76
 
77
 
78
 
79
with Report;
80
with ImpDef;
81
with Ada.Finalization;
82
with C940014_0;
83
 
84
procedure C940014 is
85
   Verbose : constant Boolean := C940014_0.Verbose;
86
 
87
begin
88
 
89
   Report.Test ("C940014", "Check that the finalization of a protected" &
90
                           " object results in program_error being raised" &
91
                           " at the point of the entry call statement for" &
92
                           " any tasks remaining on any entry queue");
93
 
94
   First_Check: declare
95
       -- example from ARM 9.4(20a-f);6.0 with minor mods
96
       task T is
97
           entry E;
98
       end T;
99
       task body T is
100
           protected PO is
101
               entry Ee;
102
           end PO;
103
           protected body PO is
104
               entry Ee when Report.Ident_Bool (False) is
105
               begin
106
                   null;
107
               end Ee;
108
           end PO;
109
       begin
110
           accept E do
111
                requeue PO.Ee;
112
           end E;
113
           if Verbose then
114
                Report.Comment ("task about to terminate");
115
           end if;
116
       end T;
117
   begin  -- First_Check
118
       begin
119
           T.E;
120
           delay ImpDef.Clear_Ready_Queue;
121
           Report.Failed ("exception not raised in First_Check");
122
       exception
123
           when Program_Error =>
124
               if Verbose then
125
                   Report.Comment ("ARM Example passed");
126
               end if;
127
           when others =>
128
               Report.Failed ("wrong exception in First_Check");
129
       end;
130
   end First_Check;
131
 
132
 
133
   Second_Check : declare
134
      -- here we want to check that the raising of Program_Error
135
      -- occurs before the other finalization actions.
136
       task T is
137
           entry E;
138
       end T;
139
       task body T is
140
           protected PO is
141
               entry Ee;
142
           private
143
               Component : C940014_0.Has_Finalization;
144
           end PO;
145
           protected body PO is
146
               entry Ee when Report.Ident_Bool (False) is
147
               begin
148
                   null;
149
               end Ee;
150
           end PO;
151
       begin
152
           accept E do
153
                requeue PO.Ee;
154
           end E;
155
           if Verbose then
156
                Report.Comment ("task about to terminate");
157
           end if;
158
       end T;
159
   begin  -- Second_Check
160
       T.E;
161
       delay ImpDef.Clear_Ready_Queue;
162
       Report.Failed ("exception not raised in Second_Check");
163
   exception
164
       when Program_Error =>
165
           if C940014_0.Finalization_Occurred then
166
               Report.Failed ("wrong order for finalization");
167
           elsif Verbose then
168
               Report.Comment ("Second_Check passed");
169
           end if;
170
       when others =>
171
           Report.Failed ("Wrong exception in Second_Check");
172
   end Second_Check;
173
 
174
 
175
   Report.Result;
176
 
177
end C940014;

powered by: WebSVN 2.1.0

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