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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CA11C03.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 when a child unit is "withed", visibility is obtained to
28
--      all ancestor units named in the expanded name of the "withed" child
29
--      unit.  Check that when the parent unit is "used", the simple name of
30
--      a "withed" child unit is made directly visible.
31
--
32
-- TEST DESCRIPTION:
33
--      To satisfy the first part of the objective, various references are
34
--      made to types and functions declared in the ancestor packages of the
35
--      foundation code package hierarchy.  Since the grandchild library unit
36
--      package has been "withed" by this test, the visibility of these
37
--      components demonstrates that visibility of the ancestor package names
38
--      is provided when the expanded name of a child library unit is "withed".
39
--
40
--      The declare block in the test program includes a "use" clause of the
41
--      parent package (FA11C00_0.FA11C00_1) of the "withed" child package.
42
--      As a result, the simple name of the child package (FA11C00_2) is
43
--      directly visible.  The type and function declared in the child
44
--      package are now visible when qualified with the simple name of the
45
--      "withed" package (FA11C00_2).
46
--
47
--      This test simulates the formatting of data strings, based on the
48
--      component fields of a "doubly-extended" tagged record type.
49
--
50
-- TEST FILES:
51
--      This test depends on the following foundation code:
52
--
53
--         FA11C00.A
54
--
55
--
56
-- CHANGE HISTORY:
57
--      06 Dec 94   SAIC    ACVC 2.0
58
--
59
--!
60
 
61
with FA11C00_0.FA11C00_1.FA11C00_2;  -- "with" of child library package
62
                                     -- Animal.Mammal.Primate.
63
                                     -- This will be used in conjunction with
64
                                     -- a "use" of FA11C00_0.FA11C00_1 below
65
                                     -- to verify a portion of the objective.
66
with Report;
67
 
68
procedure CA11C03 is
69
 
70
   Blank_Name_String : constant FA11C00_0.Species_Name_Type := (others => ' ');
71
                                     -- Visibility of grandparent package.
72
                                     -- The package FA11C00_0 is visible since
73
                                     -- it is an ancestor that is mentioned in
74
                                     -- the expanded name of its "withed"
75
                                     -- grandchild package.
76
 
77
   Blank_Hair_Color :
78
     String (1..FA11C00_0.FA11C00_1.Hair_Color_Type'Width) := (others => ' ');
79
                                     -- Visibility of parent package.
80
                                     -- The package FA11C00_0.FA11C00_1 is
81
                                     -- visible due to the "with" of its
82
                                     -- child package.
83
 
84
   subtype Data_String_Type is String (1 .. 60);
85
 
86
   TC_Result_String : Data_String_Type := (others => ' ');
87
 
88
   --
89
 
90
   function Format_Primate_Data (Name : String := Blank_Name_String;
91
                                 Hair : String := Blank_Hair_Color)
92
     return Data_String_Type is
93
 
94
      Pos                        : Integer := 1;
95
      Hair_Color_Field_Separator : constant String := " Hair Color: ";
96
 
97
      Result_String              : Data_String_Type := (others => ' ');
98
 
99
   begin
100
      Result_String (Pos .. Name'Length) := Name;    -- Enter name at start
101
                                                     -- of string.
102
      Pos := Pos + Name'Length;                      -- Increment counter to
103
                                                     -- next blank position.
104
      Result_String
105
        (Pos .. Pos + Hair_Color_Field_Separator'Length + Hair'Length - 1) :=
106
        Hair_Color_Field_Separator & Hair;           -- Include hair color data
107
                                                     -- in result string.
108
      return (Result_String);
109
   end Format_Primate_Data;
110
 
111
 
112
begin
113
 
114
   Report.Test ("CA11C03", "Check that when a child unit is WITHED, "        &
115
                           "visibility is obtained to all ancestor units "   &
116
                           "named in the expanded name of the WITHED child " &
117
                           "unit. Check that when the parent unit is USED, " &
118
                           "the simple name of a WITHED child unit is made " &
119
                           "directly visible" );
120
 
121
   declare
122
      use FA11C00_0.FA11C00_1;    -- This "use" clause will allow direct
123
                                  -- visibility to the simple name of
124
                                  -- package FA11C00_0.FA11C00_1.FA11C00_2,
125
                                  -- since this child package was "withed" by
126
                                  -- the main program.
127
 
128
      Tarsier : FA11C00_2.Primate := (Common_Name => "East-Indian Tarsier ",
129
                                      Weight      => 7,
130
                                      Hair_Color  => Brown,
131
                                      Habitat     => FA11C00_2.Arboreal);
132
 
133
                                  -- Demonstrates visibility of package
134
                                  -- FA11C00_0.FA11C00_1.FA11C00_2.
135
                                  --
136
                                  -- Type Primate referenced with the simple
137
                                  -- name of package FA11C00_2 only.
138
                                  --
139
                                  -- Simple name of package FA11C00_2 is
140
                                  -- directly visible through "use" of parent.
141
 
142
   begin
143
 
144
      -- Verify that the Format_Primate_Data function will return a blank
145
      -- filled string when no parameters are provided in the call.
146
 
147
      TC_Result_String := Format_Primate_Data;
148
 
149
      if (TC_Result_String (1 .. 20)  /= Blank_Name_String) then
150
         Report.Failed ("Incorrect initialization value from function");
151
      end if;
152
 
153
 
154
      -- Use function Format_Primate_Data to return a formatted data string.
155
 
156
      TC_Result_String :=
157
        Format_Primate_Data
158
         (Name => FA11C00_2.Image (Tarsier),
159
                                  -- Function returns a 37 character string
160
                                  -- value.
161
          Hair => Hair_Color_Type'Image(Tarsier.Hair_Color));
162
                                  -- The Hair_Color_Type is referenced
163
                                  -- directly, without package
164
                                  -- FA11C00_0.FA11C00_1 qualifier.
165
                                  -- No qualification of Hair_Color_Type is
166
                                  -- needed due to "use" clause.
167
 
168
                                  -- Note that the result of calling 'Image
169
                                  -- with an enumeration type argument
170
                                  -- results in an upper-case string.
171
                                  -- (See conditional statement below.)
172
 
173
      -- Verify the results of the function call.
174
 
175
      if not  (TC_Result_String (1 .. 37) =
176
                "Primate Species: East-Indian Tarsier " and then
177
              TC_Result_String (38 .. 55) =
178
                " Hair Color: BROWN") then
179
        Report.Failed ("Incorrect result returned from function call");
180
      end if;
181
 
182
   end;
183
 
184
   Report.Result;
185
 
186
end CA11C03;

powered by: WebSVN 2.1.0

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