diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c03.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c03.a | 186 |
1 files changed, 186 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c03.a new file mode 100644 index 000000000..b75a66034 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c03.a @@ -0,0 +1,186 @@ +-- CA11C03.A +-- +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- +-- OBJECTIVE: +-- Check that when a child unit is "withed", visibility is obtained to +-- all ancestor units named in the expanded name of the "withed" child +-- unit. Check that when the parent unit is "used", the simple name of +-- a "withed" child unit is made directly visible. +-- +-- TEST DESCRIPTION: +-- To satisfy the first part of the objective, various references are +-- made to types and functions declared in the ancestor packages of the +-- foundation code package hierarchy. Since the grandchild library unit +-- package has been "withed" by this test, the visibility of these +-- components demonstrates that visibility of the ancestor package names +-- is provided when the expanded name of a child library unit is "withed". +-- +-- The declare block in the test program includes a "use" clause of the +-- parent package (FA11C00_0.FA11C00_1) of the "withed" child package. +-- As a result, the simple name of the child package (FA11C00_2) is +-- directly visible. The type and function declared in the child +-- package are now visible when qualified with the simple name of the +-- "withed" package (FA11C00_2). +-- +-- This test simulates the formatting of data strings, based on the +-- component fields of a "doubly-extended" tagged record type. +-- +-- TEST FILES: +-- This test depends on the following foundation code: +-- +-- FA11C00.A +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- +--! + +with FA11C00_0.FA11C00_1.FA11C00_2; -- "with" of child library package + -- Animal.Mammal.Primate. + -- This will be used in conjunction with + -- a "use" of FA11C00_0.FA11C00_1 below + -- to verify a portion of the objective. +with Report; + +procedure CA11C03 is + + Blank_Name_String : constant FA11C00_0.Species_Name_Type := (others => ' '); + -- Visibility of grandparent package. + -- The package FA11C00_0 is visible since + -- it is an ancestor that is mentioned in + -- the expanded name of its "withed" + -- grandchild package. + + Blank_Hair_Color : + String (1..FA11C00_0.FA11C00_1.Hair_Color_Type'Width) := (others => ' '); + -- Visibility of parent package. + -- The package FA11C00_0.FA11C00_1 is + -- visible due to the "with" of its + -- child package. + + subtype Data_String_Type is String (1 .. 60); + + TC_Result_String : Data_String_Type := (others => ' '); + + -- + + function Format_Primate_Data (Name : String := Blank_Name_String; + Hair : String := Blank_Hair_Color) + return Data_String_Type is + + Pos : Integer := 1; + Hair_Color_Field_Separator : constant String := " Hair Color: "; + + Result_String : Data_String_Type := (others => ' '); + + begin + Result_String (Pos .. Name'Length) := Name; -- Enter name at start + -- of string. + Pos := Pos + Name'Length; -- Increment counter to + -- next blank position. + Result_String + (Pos .. Pos + Hair_Color_Field_Separator'Length + Hair'Length - 1) := + Hair_Color_Field_Separator & Hair; -- Include hair color data + -- in result string. + return (Result_String); + end Format_Primate_Data; + + +begin + + Report.Test ("CA11C03", "Check that when a child unit is WITHED, " & + "visibility is obtained to all ancestor units " & + "named in the expanded name of the WITHED child " & + "unit. Check that when the parent unit is USED, " & + "the simple name of a WITHED child unit is made " & + "directly visible" ); + + declare + use FA11C00_0.FA11C00_1; -- This "use" clause will allow direct + -- visibility to the simple name of + -- package FA11C00_0.FA11C00_1.FA11C00_2, + -- since this child package was "withed" by + -- the main program. + + Tarsier : FA11C00_2.Primate := (Common_Name => "East-Indian Tarsier ", + Weight => 7, + Hair_Color => Brown, + Habitat => FA11C00_2.Arboreal); + + -- Demonstrates visibility of package + -- FA11C00_0.FA11C00_1.FA11C00_2. + -- + -- Type Primate referenced with the simple + -- name of package FA11C00_2 only. + -- + -- Simple name of package FA11C00_2 is + -- directly visible through "use" of parent. + + begin + + -- Verify that the Format_Primate_Data function will return a blank + -- filled string when no parameters are provided in the call. + + TC_Result_String := Format_Primate_Data; + + if (TC_Result_String (1 .. 20) /= Blank_Name_String) then + Report.Failed ("Incorrect initialization value from function"); + end if; + + + -- Use function Format_Primate_Data to return a formatted data string. + + TC_Result_String := + Format_Primate_Data + (Name => FA11C00_2.Image (Tarsier), + -- Function returns a 37 character string + -- value. + Hair => Hair_Color_Type'Image(Tarsier.Hair_Color)); + -- The Hair_Color_Type is referenced + -- directly, without package + -- FA11C00_0.FA11C00_1 qualifier. + -- No qualification of Hair_Color_Type is + -- needed due to "use" clause. + + -- Note that the result of calling 'Image + -- with an enumeration type argument + -- results in an upper-case string. + -- (See conditional statement below.) + + -- Verify the results of the function call. + + if not (TC_Result_String (1 .. 37) = + "Primate Species: East-Indian Tarsier " and then + TC_Result_String (38 .. 55) = + " Hair Color: BROWN") then + Report.Failed ("Incorrect result returned from function call"); + end if; + + end; + + Report.Result; + +end CA11C03; |