OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc70b01.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CC70B01.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 a formal package actual part may specify actual parameters
28
--      for a generic formal package. Check that a use clause in the generic
29
--      formal part provides direct visibility of declarations within the
30
--      generic formal package. Check that the scope of such a use clause
31
--      extends to the generic subprogram body. Check that the visible part of
32
--      the generic formal package includes the first list of basic
33
--      declarative items of the package specification.
34
--
35
--      Check the case where the formal package is declared in a generic
36
--      subprogram.
37
--
38
-- TEST DESCRIPTION:
39
--      Declare a list abstraction in a generic package which manages lists of
40
--      elements of any nonlimited type (foundation code). Declare a generic
41
--      subprogram which operates on lists of elements of discrete types.
42
--      Provide the generic subprogram with two formal parameters: (1) a
43
--      formal discrete type which represents a list element type, and (2) a
44
--      generic formal package with the list abstraction package as template.
45
--      Use the formal discrete type as the generic formal actual part for the
46
--      formal package. Include a use clause for the formal package in the
47
--      generic subprogram formal part.
48
--
49
-- TEST FILES:
50
--      The following files comprise this test:
51
--
52
--         FC70B00.A
53
--         CC70B01.A
54
--
55
--
56
-- CHANGE HISTORY:
57
--      06 Dec 94   SAIC    ACVC 2.0
58
--
59
--!
60
 
61
-- Declare a generic subprogram which performs an operation on lists of
62
-- discrete objects.
63
 
64
with FC70B00;  -- Generic list abstraction.
65
generic
66
 
67
   -- Import the list abstraction defined in FC70B00. To ensure that only
68
   -- list abstraction instances defining lists of *discrete* elements will be
69
   -- accepted as actuals to this generic, declare a formal discrete type and
70
   -- pass it as an actual parameter to the formal package.
71
   --
72
   -- Only instances declared for the same discrete type as that used to
73
   -- instantiate this generic subprogram will be accepted.
74
 
75
   type Elem_Type is (<>);                  -- Discrete types only.
76
   with package List_Mgr is new FC70B00 (Elem_Type);
77
 
78
   use List_Mgr;                            -- Use clause for formal package.
79
 
80
procedure CC70B01_0 (L : in out List_Type); -- List_Mgr.List_Type directly
81
                                            -- visible.
82
 
83
 
84
     --==================================================================--
85
 
86
 
87
procedure CC70B01_0 (L : in out List_Type) is  -- Declarations in List_Mgr
88
begin                                          -- still directly visible.
89
   Reset (L);
90
   while not End_Of_List (L) loop
91
      Write_Element (L, Elem_Type'First);      -- This statement assumes
92
   end loop;                                   -- Elem_Type is discrete.
93
end CC70B01_0;
94
 
95
 
96
     --==================================================================--
97
 
98
 
99
with FC70B00;    -- Generic list abstraction.
100
with CC70B01_0;  -- Generic "zeroing" operation for lists of discrete types.
101
 
102
with Report;
103
procedure CC70B01 is
104
 
105
   type Points is range 0 .. 10;                    -- Discrete type.
106
   package Lists_of_Scores is new FC70B00 (Points); -- List-of-points
107
                                                    -- abstraction.
108
   Scores : Lists_of_Scores.List_Type;              -- List of points.
109
 
110
   procedure Reset_All_Scores is new                -- Operation on lists of
111
     CC70B01_0 (Points, Lists_of_Scores);           -- points.
112
 
113
 
114
   -- Begin test code declarations: -----------------------
115
 
116
   type TC_Score_Array is array (1 .. 3) of Points;
117
 
118
   TC_Initial_Values : constant TC_Score_Array := (2, 4, 6);
119
   TC_Final_Values   : constant TC_Score_Array := (0, 0, 0);
120
 
121
   TC_Correct_Initial_Values : Boolean := False;
122
   TC_Correct_Final_Values   : Boolean := False;
123
 
124
 
125
   procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
126
   begin                                  -- Initial list contains 3 scores
127
      for I in TC_Score_Array'Range loop  -- with the values 2, 4, and 6.
128
         Lists_of_Scores.Add_Element (L, TC_Initial_Values(I));
129
      end loop;
130
   end TC_Initialize_List;
131
 
132
 
133
   procedure TC_Verify_List (L        : in out Lists_of_Scores.List_Type;
134
                             Expected : in     TC_Score_Array;
135
                             OK       :    out Boolean) is
136
      Actual : TC_Score_Array;
137
   begin                                  -- Verify that all scores have been
138
      Lists_of_Scores.Reset (L);          -- set to zero.
139
      for I in TC_Score_Array'Range loop
140
         Lists_of_Scores.Read_Element (L, Actual(I));
141
      end loop;
142
      OK := (Actual = Expected);
143
   end TC_Verify_List;
144
 
145
   -- End test code declarations. -------------------------
146
 
147
 
148
begin
149
   Report.Test ("CC70B01", "Check that a library-level generic subprogram "   &
150
                "may have a formal package as a formal parameter, and that "  &
151
                "the generic formal actual part may specify explicit actual " &
152
                "parameters. Check that a use clause is legal in the "        &
153
                "generic formal part");
154
 
155
   TC_Initialize_List (Scores);
156
   TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
157
 
158
   if not TC_Correct_Initial_Values then
159
      Report.Failed ("List contains incorrect initial values");
160
   end if;
161
 
162
   Reset_All_Scores (Scores);
163
   TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
164
 
165
   if not TC_Correct_Final_Values then
166
      Report.Failed ("List contains incorrect final values");
167
   end if;
168
 
169
   Report.Result;
170
end CC70B01;

powered by: WebSVN 2.1.0

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