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/] [c3/] [c3a0011.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C3A0011.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
-- OBJECTIVE:
27
--      Check that an access-to-subprogram object whose type is declared in a
28
--      parent package, may be used to invoke subprograms in a child package.
29
--      Check that such access objects may be stored in a data structure and
30
--      that subprograms may be called by walking the data structure.
31
--
32
-- TEST DESCRIPTION:
33
--      In the package, declare an access to procedure type.  Declare an
34
--      array of the access type.  Declare three different procedures that
35
--      can be referred to by the access to procedure type.
36
--
37
--      In the visible child package, declare two procedures that can be
38
--      referred to by the access to procedure type of the parent.  Build
39
--      the array by calling each procedure indirectly through the access
40
--      value.
41
--
42
--
43
-- CHANGE HISTORY:
44
--      06 Dec 94   SAIC    ACVC 2.0
45
--      16 Dec 94   SAIC    Improved visibility of "/=" in main body
46
--
47
--!
48
 
49
package C3A0011_0 is -- Interpreter
50
 
51
   type Compass_Point is mod 360;
52
 
53
   function Heading return Compass_Point;
54
 
55
   -- Type accesses to any procedure
56
   type Action_Ptr is access procedure;
57
 
58
   -- Array of access to procedure
59
   type Action_Array is array (Natural range <>) of Action_Ptr;
60
 
61
   procedure Rotate_Left;
62
 
63
   procedure Rotate_Right;
64
 
65
   procedure Center;
66
 
67
private
68
   The_Heading : Compass_Point := Compass_Point'First;
69
 
70
end C3A0011_0;
71
 
72
 
73
-----------------------------------------------------------------------------
74
 
75
 
76
package body C3A0011_0 is
77
 
78
   function Heading return Compass_Point is
79
   begin
80
     return The_Heading;
81
   end Heading;
82
 
83
   procedure Rotate_Left is
84
   begin
85
      The_Heading := The_Heading - 90;
86
   end Rotate_Left;
87
 
88
 
89
   procedure Rotate_Right is
90
   begin
91
      The_Heading := The_Heading + 90;
92
   end Rotate_Right;
93
 
94
 
95
   procedure Center is
96
   begin
97
      The_Heading := 0;
98
   end Center;
99
 
100
end C3A0011_0;
101
 
102
 
103
-----------------------------------------------------------------------------
104
 
105
 
106
package C3A0011_0.Action is
107
 
108
   procedure Rotate_Front;
109
 
110
   procedure Rotate_Back;
111
 
112
end C3A0011_0.Action;
113
 
114
 
115
-----------------------------------------------------------------------------
116
 
117
 
118
package body C3A0011_0.Action is
119
 
120
   procedure Rotate_Front is
121
   begin
122
      The_Heading := The_Heading + 5;
123
   end Rotate_Front;
124
 
125
 
126
   procedure Rotate_Back is
127
   begin
128
      The_Heading := The_Heading - 5;
129
   end Rotate_Back;
130
 
131
end C3A0011_0.Action;
132
 
133
 
134
-----------------------------------------------------------------------------
135
 
136
 
137
with C3A0011_0.Action;
138
 
139
with Report;
140
 
141
procedure C3A0011 is
142
 
143
   Total_Actions   : constant := 6;
144
 
145
   Action_Sequence : C3A0011_0.Action_Array (1 .. Total_Actions);
146
 
147
   type Result_Array is array (Natural range <>) of C3A0011_0.Compass_Point;
148
 
149
   Action_Results  : Result_Array(1 .. Total_Actions);
150
 
151
   package IA renames C3A0011_0.Action;
152
 
153
begin
154
 
155
   Report.Test ("C3A0011", "Check that an access-to-subprogram object whose "
156
                         & "type is declared in a parent package, may be "
157
                         & "used to invoke subprograms in a child package. "
158
                         & "Check that such access objects may be stored in "
159
                         & "a data structure and that subprograms may be "
160
                         & "called by walking the data structure");
161
 
162
   -- Build the action sequence
163
   Action_Sequence := (C3A0011_0.Rotate_Left'Access,
164
                       C3A0011_0.Center'Access,
165
                       C3A0011_0.Rotate_Right'Access,
166
                       IA.Rotate_Front'Access,
167
                       C3A0011_0.Center'Access,
168
                       IA.Rotate_Back'Access);
169
 
170
   -- Build the expected result
171
   Action_Results := ( 270, 0, 90, 95, 0, 355 );
172
 
173
   -- Assign actions by invoking subprogram designated by access value
174
   for I in Action_Sequence'Range loop
175
      Action_Sequence(I).all;
176
      if C3A0011_0."/="( C3A0011_0.Heading, Action_Results(I) ) then
177
        Report.Failed ("Expecting "
178
                       & C3A0011_0.Compass_Point'Image(Action_Results(I))
179
                       & " Got"
180
                       & C3A0011_0.Compass_Point'Image(C3A0011_0.Heading));
181
      end if;
182
   end loop;
183
 
184
   Report.Result;
185
 
186
end C3A0011;

powered by: WebSVN 2.1.0

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