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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CA11018.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 body of the parent package may depend on one of its own
28
--      public generic children.
29
--
30
-- TEST DESCRIPTION:
31
--      A scenario is created that demonstrates the potential of adding a
32
--      public generic child during code maintenance without distubing a large
33
--      subsystem.  After child is added to the subsystem, a maintainer
34
--      decides to take advantage of the new functionality and rewrites
35
--      the parent's body.
36
--
37
--      Declare a message application in a package which highlights some
38
--      key words.  Declare a public generic child of this package which adds
39
--      functionality to the original subsystem.  In the parent body,
40
--      instantiate the child.
41
--
42
--      In the main program, check that the operations in the parent,
43
--      and instances of the public child package perform as expected.
44
--
45
--
46
-- CHANGE HISTORY:
47
--      06 Dec 94   SAIC    ACVC 2.0
48
--      14 Dec 94   SAIC    Modified Copy_Particularly_Designated_Pkg inst.
49
--      17 Nov 95   SAIC    Update and repair for ACVC 2.0.1
50
--
51
--!
52
 
53
-- Simulates application which displays messages.
54
 
55
package CA11018_0 is
56
 
57
   type Designated_Num is new Integer range 0 .. 100;
58
 
59
   type Particularly_Designated_Num is new Integer range 0 .. 100;
60
 
61
   type Message is new String;
62
 
63
   type Message_Rec is tagged private;
64
 
65
   type Designated_Msg is new Message_Rec with private;
66
 
67
   type Particularly_Designated_Msg is new Message_Rec with private;
68
 
69
   -- Analyzes message for presence of word in the secret message. If found,
70
   -- word is highlighted.
71
 
72
   procedure Highlight_Designated (The_Word       : in     Message;
73
                                   In_The_Message : in out Designated_Msg);
74
 
75
 
76
   -- Analyzes message for presence of word in the secret message. If found,
77
   -- word is highlighted and do other actions.
78
 
79
   procedure Highlight_Particularly_Designated
80
     (The_Word       : in     Message;
81
      In_The_Message : in out Particularly_Designated_Msg);
82
 
83
 
84
   -- Begin test code declarations: -----------------------
85
 
86
   TC_Designated_Not_Zero : Boolean := false;
87
 
88
   TC_Particularly_Designated_Not_Zero : Boolean := false;
89
 
90
   -- The following two functions are used to check for function
91
   -- calls from the public generic child.
92
 
93
   function TC_Designated_Success return Boolean;
94
 
95
   function TC_Particularly_Designated_Success return Boolean;
96
 
97
   -- End test code declarations. -------------------------
98
 
99
private
100
   type Message_Rec is tagged
101
      record
102
         The_Length  : natural := 0;
103
         The_Content : Message (1 .. 60);
104
      end record;
105
 
106
   type Designated_Msg is new Message_Rec with null record;
107
   -- ... More components in real application.
108
 
109
   type Particularly_Designated_Msg is new Message_Rec with null record;
110
   -- ... More components in real application.
111
 
112
end CA11018_0;
113
 
114
     --=================================================================--
115
 
116
 
117
-- Public generic child package of message display application.  Imagine that
118
-- messages of one security level are associated with a type derived from
119
-- integer.  For overall system security, messages of a different security
120
-- level are associated with a different type derived from integer.  By
121
-- instantiating this package for each security level, the results of Count
122
-- applied to one kind of message cannot inadvertently be compared with the
123
-- results applied to a different kind.
124
 
125
generic
126
   type Msg_Type is new Message_Rec with private;
127
                                              -- Derived from parent's type.
128
   type Count is range <>;
129
 
130
package CA11018_0.CA11018_1 is
131
 
132
   TC_Function_Called : Boolean := false;
133
 
134
   function Find_Word (Wrd : in Message;
135
                       Msg : in Msg_Type) return Count;
136
 
137
end CA11018_0.CA11018_1;
138
 
139
     --=================================================================--
140
 
141
package body CA11018_0.CA11018_1 is
142
 
143
   function Find_Word (Wrd : in Message;
144
                       Msg : in Msg_Type) return Count is
145
 
146
      Num  : Count   := Count'first;
147
 
148
   -- Count how many time the word appears within the given message.
149
 
150
   begin
151
      -- ... Error-checking code omitted for brevity.
152
 
153
      for I in 1 .. (Msg.The_Length - Wrd'length + 1) loop
154
                                                 -- Parent's private type
155
         if Msg.The_Content (I .. I + Wrd'length - 1) = Wrd
156
                                                 -- Parent's private type
157
           then
158
              Num := Num + 1;
159
         end if;
160
 
161
      end loop;
162
 
163
      TC_Function_Called := true;
164
 
165
      return (Num);
166
 
167
   end Find_Word;
168
 
169
end CA11018_0.CA11018_1;
170
 
171
     --=================================================================--
172
 
173
with CA11018_0.CA11018_1;   -- Public generic child.
174
 
175
pragma Elaborate (CA11018_0.CA11018_1);
176
package body CA11018_0 is
177
 
178
   ----------------------------------------------------
179
   -- Parent's body depends on public generic child. --
180
   ----------------------------------------------------
181
 
182
   -- Instantiate the public child for the secret message.
183
 
184
   package Designated_Pkg is new CA11018_0.CA11018_1
185
     (Msg_Type => Designated_Msg, Count => Designated_Num);
186
 
187
   -- Instantiate the public child for the top secret message.
188
 
189
   package Particularly_Designated_Pkg is new CA11018_0.CA11018_1
190
     (Particularly_Designated_Msg, Particularly_Designated_Num);
191
 
192
   -- End instantiations. -----------------------------
193
 
194
 
195
   function TC_Designated_Success return Boolean is
196
   -- Check to see if the function in the public generic child is called.
197
 
198
   begin
199
      return Designated_Pkg.TC_Function_Called;
200
   end TC_Designated_Success;
201
   --------------------------------------------------------------
202
   function TC_Particularly_Designated_Success return Boolean is
203
   -- Check to see if the function in the public generic child is called.
204
 
205
   begin
206
      return Particularly_Designated_Pkg.TC_Function_Called;
207
   end TC_Particularly_Designated_Success;
208
   --------------------------------------------------------------
209
   -- Calls functions from public child to search for a key word.
210
   -- If the word appears more than once in each message,
211
   -- highlight all of them.
212
 
213
   procedure Highlight_Designated (The_Word       : in     Message;
214
                                   In_The_Message : in out Designated_Msg) is
215
 
216
   -- Not a real highlight procedure.  Real application can use graphic
217
   -- device to highlight all occurrences of words.
218
 
219
   begin
220
      --------------------------------------------------------------
221
      -- Parent's body uses function from instantiation of public --
222
      -- generic child.                                           --
223
      --------------------------------------------------------------
224
 
225
      if Designated_Pkg.Find_Word          -- Child's operation.
226
        (The_Word, In_The_Message) > 0 then
227
 
228
          -- Highlight all occurrences in lavender.
229
 
230
          TC_Designated_Not_Zero := true;
231
      end if;
232
 
233
   end Highlight_Designated;
234
   --------------------------------------------------------------
235
   procedure Highlight_Particularly_Designated
236
     (The_Word       : in     Message;
237
      In_The_Message : in out Particularly_Designated_Msg) is
238
 
239
   -- Not a real highlight procedure.  Real application can use graphic
240
   -- device to highlight all occurrences of words.
241
 
242
   begin
243
      --------------------------------------------------------------
244
      -- Parent's body uses function from instantiation of public --
245
      -- generic child.                                           --
246
      --------------------------------------------------------------
247
 
248
      if Particularly_Designated_Pkg.Find_Word     -- Child's operation.
249
        (The_Word, In_The_Message) > 0 then
250
 
251
          -- Highlight all occurrences in chartreuse.
252
          -- Do other more secret stuff.
253
 
254
          TC_Particularly_Designated_Not_Zero := true;
255
      end if;
256
 
257
   end Highlight_Particularly_Designated;
258
 
259
end CA11018_0;
260
 
261
     --=================================================================--
262
 
263
-- Public generic child to copy words to the messages.
264
 
265
generic
266
   type Message_Type is new Message_Rec with private;
267
                        -- Derived from parent's type.
268
 
269
package CA11018_0.CA11018_2 is
270
 
271
   procedure Copy (From_The_Word  : in     Message;
272
                   To_The_Message : in out Message_Type);
273
 
274
end CA11018_0.CA11018_2;
275
 
276
     --=================================================================--
277
 
278
package body CA11018_0.CA11018_2 is
279
 
280
   procedure Copy (From_The_Word  : in     Message;
281
                   To_The_Message : in out Message_Type) is
282
 
283
   -- Copy words to the appropriate messages.
284
 
285
   begin
286
      To_The_Message.The_Content        -- Parent's private type.
287
        (1 .. From_The_Word'length) := From_The_Word;
288
 
289
      To_The_Message.The_Length         -- Parent's private type.
290
                                    := From_The_Word'length;
291
   end Copy;
292
 
293
end CA11018_0.CA11018_2;
294
 
295
     --=================================================================--
296
 
297
with Report;
298
 
299
with CA11018_0.CA11018_2;   -- Public generic child package, copy words
300
                            -- to the message.
301
                            -- Implicit with parent package (CA11018_0).
302
 
303
procedure CA11018 is
304
 
305
   package Message_Pkg renames CA11018_0;
306
 
307
begin
308
 
309
   Report.Test ("CA11018", "Check that body of the parent package can " &
310
                "depend on one of its own public generic children");
311
 
312
-- Highlight the word "Alert" from the secret message.
313
 
314
       Designated_Subtest:
315
       declare
316
          The_Message : Message_Pkg.Designated_Msg;  -- Parent's private type.
317
 
318
          -- Instantiate the public child to copy words to the secret message.
319
 
320
          package Copy_Designated_Pkg is new CA11018_0.CA11018_2
321
            (Message_Pkg.Designated_Msg);
322
 
323
       begin
324
          Copy_Designated_Pkg.Copy ("Alert Level 1 : Alert The Guard",
325
                                To_The_Message => The_Message);
326
 
327
          Message_Pkg.Highlight_Designated ("Alert", The_Message);
328
 
329
          if not Message_Pkg.TC_Designated_Not_Zero and
330
            Message_Pkg.TC_Designated_Success then
331
               Report.Failed ("Alert should have been highlighted");
332
          end if;
333
 
334
       end Designated_Subtest;
335
 
336
-- Highlight the word "Push The Alarm" from the top secret message.
337
 
338
       Particularly_Designated_Subtest:
339
       declare
340
          The_Message : Message_Pkg.Particularly_Designated_Msg ;
341
                                         -- Parent's private type.
342
 
343
          -- Instantiate the public child to copy words to the top secret
344
          -- message.
345
 
346
          package Copy_Particularly_Designated_Pkg is new
347
            CA11018_0.CA11018_2 (Message_Pkg.Particularly_Designated_Msg);
348
 
349
       begin
350
          Copy_Particularly_Designated_Pkg.Copy
351
            ("Alert Level 10 : Alert The Guard and Push The Alarm",
352
             The_Message);
353
 
354
          Message_Pkg.Highlight_Particularly_Designated
355
            ("Push The Alarm", The_Message);
356
 
357
          if not Message_Pkg.TC_Particularly_Designated_Not_Zero and
358
            Message_Pkg.TC_Particularly_Designated_Success then
359
               Report.Failed ("Key words should have been highlighted");
360
          end if;
361
 
362
       end Particularly_Designated_Subtest;
363
 
364
   Report.Result;
365
 
366
end CA11018;

powered by: WebSVN 2.1.0

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