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/] [ca/] [ca110051.am] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CA110051.AM
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 entities and operations declared in a package can be used
28
--      in the private part of a child of a child of the package.
29
--
30
-- TEST DESCRIPTION:
31
--      Declare a series of library unit packages -- parent, child, and
32
--      grandchild.  The grandchild package will have a private part.
33
--      From within the private part of the grandchild, make use of
34
--      components declared in the parent and grandparent packages.
35
--
36
-- TEST FILES:
37
--      The test consists of the following files:
38
--
39
--         CA110050.A
40
--      => CA110051.AM
41
--
42
--
43
-- CHANGE HISTORY:
44
--      06 Dec 94   SAIC    ACVC 2.0
45
--
46
--!
47
 
48
                                    -- Grandchild Package Message.Text.Encoded
49
package CA110050_0.CA110050_1.CA110050_2 is
50
 
51
   type Coded_Message is new Text_Message_Type with private;
52
 
53
   procedure Send (Message : in     Coded_Message;
54
                   Confirm :    out Coded_Message;
55
                   Status  :    out Boolean);
56
 
57
   function Encode (Message : Text_Message_Type) return Coded_Message;
58
   function Decode (Message : Coded_Message)     return Boolean;
59
   function Test_Connection                      return Boolean;
60
 
61
private
62
 
63
   Uncoded : Descriptor renames Null_Descriptor_Value; -- Grandparent object.
64
 
65
   type Coded_Message is new Text_Message_Type with    -- Parent type.
66
      record
67
         Key       : Descriptor := Uncoded;
68
         Coded_Key : Descriptor := Next_Available_Message;
69
                                 -- Grandparent type, grandparent function.
70
         Scrambled : Text_Type  := Null_Text;          -- Parent object.
71
      end record;
72
 
73
   Coded_Msg : Coded_Message;
74
 
75
   type Blank_Message is new Message_Type with         -- Grandparent type.
76
      record
77
         ID        : Descriptor := Next_Available_Message;
78
                                 -- Grandparent type, grandparent function.
79
      end record;
80
 
81
   Test_Message     : Blank_Message;
82
 
83
   Confirm_String   : constant String := "OK";
84
   Scrambled_String : constant String := "KO";
85
 
86
   Confirm_Text : Text_Type (Confirm_String'Length) :=
87
     (Max_Length => Confirm_String'Length,
88
      Length     => Confirm_String'Length,
89
      Text_Field => Confirm_String);
90
 
91
   Scrambled_Text : Text_Type (Scrambled_String'Length) :=
92
     (Max_Length => Scrambled_String'Length,
93
      Length     => Scrambled_String'Length,
94
      Text_Field => Scrambled_String);
95
 
96
end CA110050_0.CA110050_1.CA110050_2; -- Grandchild Pkg Message.Text.Encoded
97
 
98
     --=================================================================--
99
 
100
                               -- Grandchild Package body Message.Text.Encoded
101
package body CA110050_0.CA110050_1.CA110050_2 is
102
 
103
   procedure Send (Message : in     Coded_Message;
104
                   Confirm :    out Coded_Message;
105
                   Status  :    out Boolean) is
106
 
107
      Confirmation_Message : Coded_Message :=
108
        (Number    => Message.Number,
109
         Text      => Confirm_Text,
110
         Key       => Message.Number,
111
         Coded_Key => Message.Number,
112
         Scrambled => Scrambled_Text);
113
 
114
   begin                                          -- Dummy processing unit.
115
      Confirm := Confirmation_Message;
116
      if Confirm.Number /= Null_Message_Descriptor then
117
         Status := True;
118
      else
119
         Status := False;
120
      end if;
121
   end Send;
122
   -------------------------------------------------------------------------
123
   function Encode (Message : Text_Message_Type)  return Coded_Message is
124
   begin
125
      Coded_Msg.Number       := Message.Number;
126
      if Message.Text.Length > 0 then
127
         Coded_Msg.Text      := Message.Text;     -- Record assignment.
128
         Coded_Msg.Key       := Message.Number;   -- Same as msg number.
129
         Coded_Msg.Coded_Key := Message.Number;   -- Same as msg number.
130
         Coded_Msg.Scrambled := Message.Text;     -- Dummy processing.
131
      end if;
132
      return (Coded_Msg);
133
   end Encode;
134
   -------------------------------------------------------------------------
135
   function Decode (Message : Coded_Message) return Boolean is
136
      Decoded : Boolean := False;
137
   begin
138
      if (Message.Text.Length = Confirm_String'Length)        and then
139
         (Message.Text.Text_Field = Confirm_String)           and then
140
         (Message.Scrambled.Length = Scrambled_String'Length) and then
141
         (Message.Scrambled.Text_Field = Scrambled_String)    and then
142
         (Message.Coded_Key = 15)
143
      then
144
         Decoded := True;
145
      end if;
146
      return (Decoded);
147
   end Decode;
148
   -------------------------------------------------------------------------
149
   function Test_Connection return Boolean is
150
   begin
151
      return Test_Message.Id = 10;
152
   end Test_Connection;
153
 
154
end CA110050_0.CA110050_1.CA110050_2;
155
                               -- Grandchild Package body Message.Text.Encoded
156
 
157
     --=================================================================--
158
 
159
with CA110050_0.CA110050_1.CA110050_2;
160
with Report;
161
 
162
procedure CA110051 is
163
 
164
   package Message_Package renames CA110050_0.CA110050_1;
165
   package Code_Package    renames CA110050_0.CA110050_1.CA110050_2;
166
 
167
   Message_String : constant String := "One if by land, two if by sea";
168
 
169
   Message_Text   : Message_Package.Text_Type (Message_String'Length) :=
170
     (Max_Length => Message_String'Length,
171
      Length     => Message_String'Length,
172
      Text_Field => Message_String);
173
 
174
   Message : Message_Package.Text_Message_Type :=
175
     (Number => CA110050_0.Next_Available_Message,
176
      Text   => Message_Text);
177
 
178
   Confirmation_Message : Code_Package.Coded_Message;
179
   Verification_OK      : Boolean := False;
180
   Transmission_OK      : Boolean := False;
181
 
182
begin
183
 
184
-- This test simulates the use of child library unit packages to implement
185
-- a message encoding and transmission scheme.  The full capability of the
186
-- encoding and transmission mechanisms are not developed here, but the
187
-- intent is to demonstrate that a grandchild library unit package with a
188
-- private part will provide the framework for this type of processing.
189
 
190
   Report.Test ("CA110051", "Check that entities and operations declared "  &
191
                            "in a package can be used in the private part " &
192
                            "of a child of a child of the package");
193
 
194
                            -- The following code demonstrates the use
195
                            -- of functionality contained in a grandchild
196
                            -- library unit.  The grandchild unit made use
197
                            -- of components declared in the ancestor
198
                            -- packages.
199
 
200
   Code_Package.Send                            -- Message object declared
201
     (Message => Code_Package.Encode (Message), -- above in "encoded" by a
202
      Confirm => Confirmation_Message,          -- call to grandchild pkg
203
      Status  => Transmission_OK);              -- function call, reseting
204
                                                -- fields and returning a
205
                                                -- coded message to the
206
                                                -- parameter.  The confirm
207
                                                -- parameter receives an
208
                                                -- encoded message value
209
                                                -- from proc Send, which is
210
                                                -- "decoded"/verified below.
211
 
212
   if not Code_Package.Test_Connection then
213
      Report.Failed ("Bad initialization");
214
   end if;
215
 
216
   Verification_OK := Code_Package.Decode (Confirmation_Message);
217
 
218
   if not (Transmission_OK and Verification_OK) then
219
      Report.Failed ("Message transmission failure");
220
   end if;
221
 
222
   Report.Result;
223
 
224
end CA110051;

powered by: WebSVN 2.1.0

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