OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11006.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CA11006.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 the private part of a child library unit can utilize
28
--      its parent unit's private definition.
29
--
30
-- TEST DESCRIPTION:
31
--      Declare a package and public child package, both with private
32
--      parts.  The child package will have a private extension of a type
33
--      declared in the parent's private part.  In addition, the private
34
--      part of the child package specification will make use of some of
35
--      the components declared in the private part of the parent.
36
--
37
--
38
-- CHANGE HISTORY:
39
--      06 Dec 94   SAIC    ACVC 2.0
40
--      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
41
--
42
--!
43
 
44
package CA11006_0 is      -- Package File_Package
45
 
46
   type File_Descriptor is private;
47
   type File_Mode       is (Read_Only, Write_Only, Read_Write);
48
   type File_Type       is tagged private;
49
 
50
   function  Next_Available_File return File_Descriptor;
51
 
52
private
53
 
54
   type File_Measure    is range 0 .. 1000;
55
   type File_Descriptor is new Integer;
56
 
57
   Null_File       : constant File_Descriptor := 0;
58
   Default_Mode    : constant File_Mode       := Read_Write;
59
 
60
   type File_Type is tagged
61
     record
62
        Descriptor : File_Descriptor := Null_File;
63
        Mode       : File_Mode       := Default_Mode;
64
     end record;
65
 
66
   System_File : File_Type;
67
 
68
end CA11006_0;               -- Package File_Package
69
 
70
     --=================================================================--
71
 
72
package body CA11006_0 is    -- Package File_Package
73
 
74
   File_Count : Integer := 0;
75
 
76
   function Next_Available_File return File_Descriptor is
77
   begin
78
      File_Count := File_Count + 1;
79
      return File_Descriptor (File_Count);
80
   end Next_Available_File;
81
 
82
end CA11006_0;               -- Package File_Package
83
 
84
     --=================================================================--
85
 
86
package CA11006_0.CA11006_1 is        -- Child package File_Package.Operations
87
 
88
   type File_Length_Type   is private;
89
   type Extended_File_Type is new File_Type with private;
90
 
91
   System_Extended_File : constant Extended_File_Type;
92
 
93
   procedure Create_File (Mode : in     File_Mode;
94
                          File :    out Extended_File_Type);
95
 
96
   procedure Compress_File (Original        : in     Extended_File_Type;
97
                            Compressed_File :    out Extended_File_Type);
98
 
99
   function  Validate (File : in Extended_File_Type) return Boolean;
100
 
101
   function  Validate_Compression (File : in Extended_File_Type)
102
     return Boolean;
103
                                   -- These two validation functions provide
104
                                   -- the capability to check the private
105
                                   -- components defined in the parent and
106
                                   -- child packages from within the client
107
                                   -- program.
108
private
109
 
110
   type File_Length_Type is new File_Measure;       -- Parent private type.
111
 
112
   Min_File_Size : File_Length_Type := File_Length_Type'First;
113
   Max_File_Size : File_Length_Type := File_Length_Type'Last;
114
 
115
   type Extended_File_Type is new File_Type with        -- Parent type.
116
      record
117
         Blocks : File_Length_Type := Min_File_Size;
118
      end record;
119
 
120
   System_Extended_File : constant Extended_File_Type :=
121
     (Descriptor => System_File.Descriptor,      -- Parent private object.
122
      Mode       => Read_Only,                   -- Parent enumeration literal.
123
      Blocks     => Min_File_Size);
124
 
125
 
126
end CA11006_0.CA11006_1;             -- Child Package File_Package.Operations
127
 
128
     --=================================================================--
129
 
130
                                -- Child package body File_Package.Operations
131
package body CA11006_0.CA11006_1 is
132
 
133
   procedure Create_File
134
     (Mode : in     File_Mode;
135
      File :    out Extended_File_Type) is
136
   begin
137
      File.Descriptor := Next_Available_File;    -- Parent subprogram.
138
      File.Mode       := Default_Mode;           -- Parent private constant.
139
      File.Blocks     := Max_File_Size;
140
   end Create_File;
141
   ------------------------------------------------------------------------
142
   procedure Compress_File (Original        : in     Extended_File_Type;
143
                            Compressed_File :    out Extended_File_Type) is
144
   begin
145
      Compressed_File.Descriptor := Next_Available_File;
146
      Compressed_File.Mode       := Read_Only;
147
      Compressed_File.Blocks     := Original.Blocks / 2;  -- Simulated file
148
   end Compress_File;                                     -- compression.
149
   ------------------------------------------------------------------------
150
   function  Validate (File : in Extended_File_Type) return Boolean is
151
   begin
152
      if ((File.Descriptor /= System_Extended_File.Descriptor) and
153
          (File.Mode = Read_Write)                             and
154
          (File.Blocks = Max_File_Size))                       then
155
         return True;
156
      else
157
         return False;
158
      end if;
159
   end Validate;
160
   ------------------------------------------------------------------------
161
   function  Validate_Compression (File : in Extended_File_Type)
162
      return Boolean is
163
   begin
164
      if ((File.Descriptor /= System_File.Descriptor) and
165
          (File.Mode = Read_Only)                     and
166
          (File.Blocks = Max_File_Size/2))            then
167
         return True;
168
      else
169
         return False;
170
      end if;
171
   end Validate_Compression;
172
 
173
end CA11006_0.CA11006_1;         -- Child package body File_Package.Operations
174
 
175
     --=================================================================--
176
 
177
with CA11006_0.CA11006_1;        -- with Child package File_Package.Operations
178
with Report;
179
 
180
procedure CA11006 is
181
 
182
   package File      renames CA11006_0;
183
   package File_Ops  renames CA11006_0.CA11006_1;
184
 
185
   Validation_File_Mode : File.File_Mode := File.Read_Only;
186
   Validation_File,
187
   Storage_Copy         : File_Ops.Extended_File_Type;
188
 
189
begin
190
 
191
   Report.Test ("CA11006", "Check that the private part of a child "  &
192
                           "library unit can utilize its parent "     &
193
                           "unit's private definition");
194
 
195
   File_Ops.Create_File (Validation_File_Mode, Validation_File);
196
 
197
   if not File_Ops.Validate (Validation_File) then
198
      Report.Failed ("Incorrect initialization of file");
199
   end if;
200
 
201
   File_Ops.Compress_File (Validation_File, Storage_Copy);
202
 
203
   if not (File_Ops.Validate (Validation_File) and
204
           File_Ops.Validate_Compression (Storage_Copy))
205
   then
206
      Report.Failed ("Incorrect compression of file");
207
   end if;
208
 
209
   Report.Result;
210
 
211
end CA11006;

powered by: WebSVN 2.1.0

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