1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
-- C940015.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- TEST OBJECTIVE:
-- Check that the component_declarations of a protected_operation
-- are elaborated in the proper order.
--
-- TEST DESCRIPTION:
-- A discriminated protected object is declared with some
-- components that depend upon the discriminant and some that
-- do not depend upon the discriminant. All the components
-- are initialized with a function call. As a side-effect of
-- the function call the parameter passed to the function is
-- recorded in an elaboration order array.
-- Two objects of the protected type are declared. The
-- elaboration order is recorded and checked against the
-- expected order.
--
--
-- CHANGE HISTORY:
-- 09 Jan 96 SAIC Initial Version for 2.1
-- 09 Jul 96 SAIC Addressed reviewer comments.
-- 13 Feb 97 PWB.CTA Removed doomed attempt to check per-object
-- constraint elaborations.
--!
with Report;
procedure C940015 is
Verbose : constant Boolean := False;
Do_Display : Boolean := Verbose;
type Index is range 0..10;
type List is array (1..10) of Integer;
Last : Natural range 0 .. List'Last := 0;
E_List : List := (others => 0);
function Elaborate (Id : Integer) return Index is
begin
Last := Last + 1;
E_List (Last) := Id;
if Verbose then
Report.Comment ("Elaborating" & Integer'Image (Id));
end if;
return Index(Id mod 10);
end Elaborate;
function Elaborate (Id, Per_Obj_Expr : Integer) return Index is
begin
return Elaborate (Id);
end Elaborate;
begin
Report.Test ("C940015", "Check that the component_declarations of a" &
" protected object are elaborated in the" &
" proper order");
declare
-- an unprotected queue type
type Storage is array (Index range <>) of Integer;
type Queue (Size, Flag : Index := 1) is
record
Head : Index := 1;
Tail : Index := 1;
Count : Index := 0;
Buffer : Storage (1..Size);
end record;
-- protected group of queues type
protected type Prot_Queues (Size : Index := Elaborate (104)) is
procedure Clear;
-- other needed procedures not provided at this time
private
-- elaborate at type elaboration
Fixed_Queue_1 : Queue (3,
Elaborate (105));
-- elaborate at type elaboration
Fixed_Queue_2 : Queue (6,
Elaborate (107));
end Prot_Queues;
protected body Prot_Queues is
procedure Clear is
begin
Fixed_Queue_1.Count := 0;
Fixed_Queue_1.Head := 1;
Fixed_Queue_1.Tail := 1;
Fixed_Queue_2.Count := 0;
Fixed_Queue_2.Head := 1;
Fixed_Queue_2.Tail := 1;
end Clear;
end Prot_Queues;
PO1 : Prot_Queues(9);
PO2 : Prot_Queues;
Expected_Elab_Order : List := (
-- from the elaboration of the protected type Prot_Queues
105, 107,
-- from the unconstrained object PO2
104,
others => 0);
begin
for I in List'Range loop
if E_List (I) /= Expected_Elab_Order (I) then
Report.Failed ("wrong elaboration order");
Do_Display := True;
end if;
end loop;
if Do_Display then
Report.Comment ("Expected Actual");
for I in List'Range loop
Report.Comment (
Integer'Image (Expected_Elab_Order(I)) &
Integer'Image (E_List(I)));
end loop;
end if;
-- make use of the protected objects
PO1.Clear;
PO2.Clear;
end;
Report.Result;
end C940015;
|
