diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ca/ca11c03.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/ca/ca11c03.a | 186 |
1 files changed, 0 insertions, 186 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ca/ca11c03.a b/gcc/testsuite/ada/acats/tests/ca/ca11c03.a deleted file mode 100644 index b75a6603483..00000000000 --- a/gcc/testsuite/ada/acats/tests/ca/ca11c03.a +++ /dev/null @@ -1,186 +0,0 @@ --- 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; |