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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c940015.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- 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
 
50
with Report;
51
 
52
procedure 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
 
77
begin
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
 
149
end C940015;

powered by: WebSVN 2.1.0

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