1-- C940015.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 the component_declarations of a protected_operation
28--      are elaborated in the proper order.
29--
30-- TEST DESCRIPTION:
31--      A discriminated protected object is declared with some
32--      components that depend upon the discriminant and some that
33--      do not depend upon the discriminant.  All the components
34--      are initialized with a function call.  As a side-effect of
35--      the function call the parameter passed to the function is
36--      recorded in an elaboration order array.
37--      Two objects of the protected type are declared.  The
38--      elaboration order is recorded and checked against the
39--      expected order.
40--
41--
42-- CHANGE HISTORY:
43--      09 Jan 96   SAIC    Initial Version for 2.1
44--      09 Jul 96   SAIC    Addressed reviewer comments.
45--      13 Feb 97   PWB.CTA Removed doomed attempt to check per-object
46--                          constraint elaborations.
47--!
48
49
50with Report;
51
52procedure C940015 is
53    Verbose : constant Boolean := False;
54    Do_Display : Boolean := Verbose;
55
56    type Index is range 0..10;
57
58    type List is array (1..10) of Integer;
59    Last : Natural range 0 .. List'Last := 0;
60    E_List : List := (others => 0);
61
62    function Elaborate (Id : Integer) return Index is
63    begin
64        Last := Last + 1;
65        E_List (Last) := Id;
66        if Verbose then
67            Report.Comment ("Elaborating" & Integer'Image (Id));
68        end if;
69        return Index(Id mod 10);
70    end Elaborate;
71
72    function Elaborate (Id, Per_Obj_Expr : Integer) return Index is
73    begin
74        return Elaborate (Id);
75    end Elaborate;
76
77begin
78
79    Report.Test ("C940015", "Check that the component_declarations of a" &
80                            " protected object are elaborated in the" &
81                            " proper order");
82    declare
83        -- an unprotected queue type
84        type Storage is array (Index range <>) of Integer;
85        type Queue (Size, Flag : Index := 1) is
86            record
87                Head : Index := 1;
88                Tail : Index := 1;
89                Count : Index := 0;
90                Buffer : Storage (1..Size);
91            end record;
92
93        -- protected group of queues type
94        protected type Prot_Queues (Size : Index := Elaborate (104)) is
95            procedure Clear;
96            -- other needed procedures not provided at this time
97        private
98               -- elaborate at type elaboration
99            Fixed_Queue_1    : Queue (3,
100                                      Elaborate (105));
101               -- elaborate at type elaboration
102            Fixed_Queue_2    : Queue (6,
103                                      Elaborate (107));
104        end Prot_Queues;
105        protected body Prot_Queues is
106            procedure Clear is
107            begin
108                Fixed_Queue_1.Count := 0;
109                Fixed_Queue_1.Head := 1;
110                Fixed_Queue_1.Tail := 1;
111                Fixed_Queue_2.Count := 0;
112                Fixed_Queue_2.Head := 1;
113                Fixed_Queue_2.Tail := 1;
114            end Clear;
115        end Prot_Queues;
116
117        PO1 : Prot_Queues(9);
118        PO2 : Prot_Queues;
119
120        Expected_Elab_Order : List := (
121           -- from the elaboration of the protected type Prot_Queues
122           105, 107,
123           -- from the unconstrained object PO2
124           104,
125           others => 0);
126    begin
127        for I in List'Range loop
128            if E_List (I) /= Expected_Elab_Order (I) then
129                Report.Failed ("wrong elaboration order");
130                Do_Display := True;
131            end if;
132        end loop;
133        if Do_Display then
134            Report.Comment ("Expected  Actual");
135            for I in List'Range loop
136                Report.Comment (
137                   Integer'Image (Expected_Elab_Order(I)) &
138                   Integer'Image (E_List(I)));
139            end loop;
140        end if;
141
142        -- make use of the protected objects
143        PO1.Clear;
144        PO2.Clear;
145    end;
146
147    Report.Result;
148
149end C940015;
150