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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c910003.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C910003.A
2
--
3
--                             Grant of Unlimited Rights
4
--
5
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
6
--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
7
--     software and documentation contained herein.  Unlimited rights are
8
--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
9
--     the Government intends to confer upon all recipients unlimited rights
10
--     equal to those held by the Government.  These rights include rights to
11
--     use, duplicate, release or disclose the released technical data and
12
--     computer software in whole or in part, in any manner and for any purpose
13
--     whatsoever, and to have or permit others to do so.
14
--
15
--                                    DISCLAIMER
16
--
17
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
18
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
19
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
20
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
21
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
22
--     PARTICULAR PURPOSE OF SAID MATERIAL.
23
--*
24
--
25
-- OBJECTIVE:
26
--      Check that task discriminants that have an access subtype may be
27
--      dereferenced.
28
--
29
--      Note that discriminants in Ada 83 never can be dereferenced with
30
--      selection or indexing, as they cannot have an access type.
31
--
32
-- TEST DESCRIPTION:
33
--      A protected object is defined to create a simple buffer.
34
--      Two task types are defined, one to put values into the buffer,
35
--      and one to remove them. The tasks are passed a buffer object as
36
--      a discriminant with an access subtype. The producer task type includes
37
--      a discriminant to determine the values to product. The consumer task
38
--      type includes a value to save the results.
39
--      Two producer and one consumer tasks are declared, and the results
40
--      are checked.
41
--
42
-- CHANGE HISTORY:
43
--      10 Mar 99   RLB    Created test.
44
--
45
--!
46
 
47
package C910003_Pack is
48
 
49
    type Item_Type is range 1 .. 100; -- In a real application, this probably
50
                                      -- would be a record type.
51
 
52
    type Item_Array is array (Positive range <>) of Item_Type;
53
 
54
    protected type Buffer is
55
       entry Put (Item  : in Item_Type);
56
       entry Get (Item  : out Item_Type);
57
       function TC_Items_Buffered return Item_Array;
58
    private
59
       Saved_Item : Item_Type;
60
       Empty : Boolean := True;
61
       TC_Items : Item_Array (1 .. 10);
62
       TC_Last  : Natural := 0;
63
    end Buffer;
64
 
65
    type Buffer_Access_Type is access Buffer;
66
 
67
    PRODUCE_COUNT : constant := 2; -- Number of items to produce.
68
 
69
    task type Producer (Buffer_Access : Buffer_Access_Type;
70
                        Start_At : Item_Type);
71
        -- Produces PRODUCE_COUNT items. Starts when activated.
72
 
73
    type TC_Item_Array_Access_Type is access Item_Array (1 .. PRODUCE_COUNT*2);
74
 
75
    task type Consumer (Buffer_Access : Buffer_Access_Type;
76
                        Results : TC_Item_Array_Access_Type) is
77
        -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when
78
        -- activated.
79
        entry Wait_until_Done;
80
    end Consumer;
81
 
82
end C910003_Pack;
83
 
84
 
85
with Report;
86
package body C910003_Pack is
87
 
88
    protected body Buffer is
89
       entry Put (Item  : in Item_Type) when Empty is
90
       begin
91
           Empty := False;
92
           Saved_Item := Item;
93
           TC_Last := TC_Last + 1;
94
           TC_Items(TC_Last) := Item;
95
       end Put;
96
 
97
       entry Get (Item  : out Item_Type) when not Empty is
98
       begin
99
           Empty := True;
100
           Item := Saved_Item;
101
       end Get;
102
 
103
       function TC_Items_Buffered return Item_Array is
104
       begin
105
           return TC_Items(1..TC_Last);
106
       end TC_Items_Buffered;
107
 
108
    end Buffer;
109
 
110
 
111
    task body Producer is
112
        -- Produces PRODUCE_COUNT items. Starts when activated.
113
    begin
114
        for I in 1 .. Report.Ident_Int(PRODUCE_COUNT) loop
115
           Buffer_Access.Put (Start_At + (Item_Type(I)-1)*2);
116
        end loop;
117
    end Producer;
118
 
119
 
120
    task body Consumer is
121
        -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when
122
        -- activated.
123
    begin
124
        for I in 1 .. Report.Ident_Int(PRODUCE_COUNT*2) loop
125
            Buffer_Access.Get (Results (I));
126
            -- Buffer_Access and Results are both dereferenced.
127
        end loop;
128
 
129
        -- Check the results (and function call with a prefix dereference).
130
        if Results.all(Report.Ident_Int(1)) /= Buffer_Access.all.TC_Items_Buffered(Report.Ident_Int(1)) then
131
           Report.Failed ("First item mismatch");
132
        end if;
133
        if Results(Report.Ident_Int(2)) /= Buffer_Access.TC_Items_Buffered(Report.Ident_Int(2)) then
134
           Report.Failed ("Second item mismatch");
135
        end if;
136
        accept Wait_until_Done; -- Tell main that we're done.
137
    end Consumer;
138
 
139
end C910003_Pack;
140
 
141
 
142
with Report;
143
with C910003_Pack;
144
 
145
procedure C910003 is
146
 
147
begin -- C910003
148
 
149
   Report.Test ("C910003", "Check that tasks discriminants of access types can be dereferenced");
150
 
151
 
152
   declare     -- encapsulate the test
153
 
154
      Buffer_Access : C910003_Pack.Buffer_Access_Type :=
155
         new C910003_Pack.Buffer;
156
 
157
      TC_Results : C910003_Pack.TC_Item_Array_Access_Type :=
158
         new C910003_Pack.Item_Array (1 .. C910003_Pack.PRODUCE_COUNT*2);
159
 
160
      Producer_1 : C910003_Pack.Producer (Buffer_Access, 12);
161
      Producer_2 : C910003_Pack.Producer (Buffer_Access, 23);
162
 
163
      Consumer : C910003_Pack.Consumer (Buffer_Access, TC_Results);
164
 
165
      use type C910003_Pack.Item_Array; -- For /=.
166
 
167
   begin
168
      Consumer.Wait_until_Done;
169
      if TC_Results.all /= Buffer_Access.TC_Items_Buffered then
170
           Report.Failed ("Different items buffered than returned - Main");
171
      end if;
172
      if (TC_Results.all /= (12, 14, 23, 25) and
173
          TC_Results.all /= (12, 23, 14, 25) and
174
          TC_Results.all /= (12, 23, 25, 14) and
175
          TC_Results.all /= (23, 12, 14, 25) and
176
          TC_Results.all /= (23, 12, 25, 14) and
177
          TC_Results.all /= (23, 25, 12, 14)) then
178
          -- Above are the only legal results.
179
           Report.Failed ("Wrong results");
180
      end if;
181
   end;     -- encapsulation
182
 
183
   Report.Result;
184
 
185
end C910003;

powered by: WebSVN 2.1.0

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