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/] [ca11017.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CA11017.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 children.
29
--
30
-- TEST DESCRIPTION:
31
--      A scenario is created that demonstrates the potential of adding a
32
--      public 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 string abstraction in a package which manipulates string
38
--      replacement. Define a parent package which provides operations for
39
--      a record type with discriminant.  Declare a public child of this
40
--      package which adds functionality to the original subsystem.  In the
41
--      parent body, call operations from the public child.
42
--
43
--      In the main program, check that operations in the parent and public
44
--      child perform as expected.
45
--
46
--
47
-- CHANGE HISTORY:
48
--      06 Dec 94   SAIC    ACVC 2.0
49
--
50
--!
51
 
52
-- Simulates application which manipulates strings.
53
 
54
package CA11017_0 is
55
 
56
   type String_Rec (The_Size : positive) is private;
57
 
58
   type Substring is new string;
59
 
60
   -- ... Various other types used by the application.
61
 
62
   procedure Replace (In_The_String   : in out String_Rec;
63
                      At_The_Position : in     positive;
64
                      With_The_String : in     String_Rec);
65
 
66
   -- ... Various other operations used by the application.
67
 
68
private
69
   -- Different size for each individual record.
70
 
71
   type String_Rec (The_Size : positive) is
72
      record
73
         The_Length  : natural := 0;
74
         The_Content : Substring (1 .. The_Size);
75
      end record;
76
 
77
end CA11017_0;
78
 
79
     --=================================================================--
80
 
81
-- Public child added during code maintenance without disturbing a
82
-- large system.  This public child would add functionality to the
83
-- original system.
84
 
85
package CA11017_0.CA11017_1 is
86
 
87
   Position_Error : exception;
88
 
89
   function Equal_Length (Left  : in String_Rec;
90
                          Right : in String_Rec) return boolean;
91
 
92
   function Same_Content (Left  : in String_Rec;
93
                          Right : in String_Rec) return boolean;
94
 
95
   procedure Copy (From_The_Substring : in     Substring;
96
                   To_The_String      : in out String_Rec);
97
 
98
   -- ... Various other operations used by the application.
99
 
100
end CA11017_0.CA11017_1;
101
 
102
     --=================================================================--
103
 
104
package body CA11017_0.CA11017_1 is
105
 
106
   function Equal_Length (Left  : in String_Rec;
107
                          Right : in String_Rec) return boolean is
108
   -- Quick comparison between the lengths of the input strings.
109
 
110
   begin
111
      return (Left.The_Length = Right.The_Length);  -- Parent's private
112
                                                    -- type.
113
   end Equal_Length;
114
   --------------------------------------------------------------------
115
   function Same_Content (Left  : in String_Rec;
116
                          Right : in String_Rec) return boolean is
117
 
118
   begin
119
      for I in 1 .. Left.The_Length loop
120
         if Left.The_Content (I) = Right.The_Content (I) then
121
            return true;
122
         else
123
            return false;
124
         end if;
125
      end loop;
126
 
127
   end Same_Content;
128
   --------------------------------------------------------------------
129
   procedure Copy (From_The_Substring : in     Substring;
130
                   To_The_String      : in out String_Rec) is
131
   begin
132
      To_The_String.The_Content        -- Parent's private type.
133
        (1 .. From_The_Substring'length) := From_The_Substring;
134
 
135
      To_The_String.The_Length         -- Parent's private type.
136
                                         := From_The_Substring'length;
137
   end Copy;
138
 
139
end CA11017_0.CA11017_1;
140
 
141
     --=================================================================--
142
 
143
--  After child is added to the subsystem, a maintainer decides
144
--  to take advantage of the new functionality and rewrites the
145
--  parent's body.
146
 
147
with CA11017_0.CA11017_1;
148
 
149
package body CA11017_0 is
150
 
151
   -- Calls functions from public child for a quick comparison of the
152
   -- input strings.  If their lengths are the same, do the replacement.
153
 
154
   procedure Replace (In_The_String   : in out String_Rec;
155
                      At_The_Position : in     positive;
156
                      With_The_String : in     String_Rec) is
157
      End_Position : natural := At_The_Position +
158
                                With_The_String.The_Length - 1;
159
 
160
   begin
161
      if not CA11017_0.CA11017_1.Equal_Length  -- Public child's operation.
162
        (With_The_String, In_The_String) then
163
           raise CA11017_0.CA11017_1.Position_Error;
164
                                               -- Public child's exception.
165
      else
166
         In_The_String.The_Content (At_The_Position .. End_Position) :=
167
           With_The_String.The_Content (1 .. With_The_String.The_Length);
168
      end if;
169
 
170
   end Replace;
171
 
172
end CA11017_0;
173
 
174
     --=================================================================--
175
 
176
with Report;
177
 
178
with CA11017_0.CA11017_1;   -- Explicit with public child package,
179
                            -- implicit with parent package (CA11017_0).
180
 
181
procedure CA11017 is
182
 
183
   package String_Pkg renames CA11017_0;
184
   use String_Pkg;
185
 
186
begin
187
 
188
   Report.Test ("CA11017", "Check that body of the parent package can " &
189
                "depend on one of its own public children");
190
 
191
-- Both input strings have the same size. Replace the first string by the
192
-- second string.
193
 
194
        Replace_Subtest:
195
        declare
196
           The_First_String, The_Second_String : String_Rec (16);
197
                                                 -- Parent's private type.
198
           The_Position                        : positive := 1;
199
        begin
200
           CA11017_1.Copy ("This is the time",
201
                           To_The_String => The_First_String);
202
 
203
           CA11017_1.Copy ("For all good men", The_Second_String);
204
 
205
           Replace (The_First_String, The_Position, The_Second_String);
206
 
207
           -- Compare results using function from public child since
208
           -- the type is private.
209
 
210
           if not CA11017_1.Same_Content
211
                            (The_First_String, The_Second_String) then
212
              Report.Failed ("Incorrect results");
213
           end if;
214
 
215
        end Replace_Subtest;
216
 
217
-- During processing, the application may erroneously attempt to replace
218
-- strings of different size. This would result in the raising of an
219
-- exception.
220
 
221
        Exception_Subtest:
222
        declare
223
           The_First_String  : String_Rec (17);
224
                                                 -- Parent's private type.
225
           The_Second_String : String_Rec (13);
226
                                                 -- Parent's private type.
227
           The_Position      : positive := 2;
228
        begin
229
           CA11017_1.Copy (" ACVC Version 2.0", The_First_String);
230
 
231
           CA11017_1.Copy (From_The_Substring => "ACVC 9X Basic",
232
                           To_The_String      => The_Second_String);
233
 
234
           Replace (The_First_String, The_Position, The_Second_String);
235
 
236
           Report.Failed ("Exception was not raised");
237
 
238
        exception
239
           when CA11017_1.Position_Error =>
240
                  Report.Comment ("Exception is raised as expected");
241
 
242
        end Exception_Subtest;
243
 
244
   Report.Result;
245
 
246
end CA11017;

powered by: WebSVN 2.1.0

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