1-- CA11C01.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 primitive operations declared in a child package 28-- override operations declared in ancestor packages, a client of the 29-- child package inherits the operations correctly. 30-- 31-- TEST DESCRIPTION: 32-- 33-- This test builds on the foundation code file (FA11C00) that contains 34-- a parent package, child package, and grandchild package. The parent 35-- package declares a tagged type and primitive operation. The child 36-- package extends the type, and overrides the primitive operation. The 37-- grandchild package does the same. 38-- 39-- The test procedure "withs" the grandchild package, and receives 40-- visibility to all of its ancestor packages, types and operations. 41-- Three procedures, each with a formal parameter of a specific type are 42-- defined. Each of these invokes a particular version of the overridden 43-- primitive operation Image. Calls to these local procedures are made, 44-- with objects of each of the tagged types as parameters, and the global 45-- variable is finally examined to ensure that the correct version of 46-- primitive operation was inherited by the client and invoked by the 47-- call. 48-- 49-- TEST FILES: 50-- This test depends on the following foundation code: 51-- 52-- FA11C00.A 53-- 54-- 55-- CHANGE HISTORY: 56-- 06 Dec 94 SAIC ACVC 2.0 57-- 58--! 59 60with FA11C00_0.FA11C00_1.FA11C00_2; -- Package Animal.Mammal.Primate 61with Report; 62 63procedure CA11C01 is 64 65 package Animal_Package renames FA11C00_0; 66 package Mammal_Package renames FA11C00_0.FA11C00_1; 67 package Primate_Package renames FA11C00_0.FA11C00_1.FA11C00_2; 68 69 Max_Animals : constant := 3; 70 71 subtype Data_String is String (1 .. 37); 72 type Data_Base_Type is array (1 .. Max_Animals) of Data_String; 73 74 Zoo_Data_Base : Data_Base_Type := (others => (others => ' ')); 75 -- Global variable. 76 77 Salmon : Animal_Package.Animal := (Common_Name => "Chinook Salmon ", 78 Weight => 10); 79 80 Platypus : Mammal_Package.Mammal := (Common_Name => "Tasmanian Platypus ", 81 Weight => 13, 82 Hair_Color => Mammal_Package.Brown); 83 84 Orangutan : Primate_Package.Primate := 85 (Common_Name => "Sumatran Orangutan ", 86 Weight => 220, 87 Hair_Color => Mammal_Package.Red, 88 Habitat => Primate_Package.Arboreal); 89begin 90 91 Report.Test ("CA11C01", "Check that when primitive operations declared " & 92 "in a child package override operations declared " & 93 "in ancestor packages, a client of the child " & 94 "package inherits the operations correctly"); 95 96 declare 97 98 use Animal_Package, Mammal_Package, Primate_Package; 99 100 -- The function Image has been overridden in the child and grandchild 101 -- packages, but the client has inherited all versions of the function, 102 -- and can successfully use them to enter data into the database. 103 -- Each of the following procedures updates the global variable 104 -- Zoo_Data_Base. 105 106 procedure Enter_Animal_Data (A : Animal; I : Integer) is 107 begin 108 Zoo_Data_Base (I) := Image (A); 109 end Enter_Animal_Data; 110 111 procedure Enter_Mammal_Data (M : Mammal; I : Integer) is 112 begin 113 Zoo_Data_Base (I) := Image (M); 114 end Enter_Mammal_Data; 115 116 procedure Enter_Primate_Data (P : Primate; I : Integer) is 117 begin 118 Zoo_Data_Base (I) := Image (P); 119 end Enter_Primate_Data; 120 121 begin 122 123 -- Verify initial test conditions. 124 125 if not (Zoo_Data_Base(1)(1..6) = " ") 126 or else 127 (Zoo_Data_Base(2)(1..6) /= " ") 128 or else 129 (Zoo_Data_Base(3)(1..6) /= " ") 130 then 131 Report.Failed ("Initial condition failure"); 132 end if; 133 134 135 -- Enter data from all three animals into the zoo database. 136 137 Enter_Animal_Data (A => Salmon, I => 1); -- First entry in database. 138 Enter_Mammal_Data (M => Platypus, I => 2); -- Second entry. 139 Enter_Primate_Data (P => Orangutan, I => 3); -- Third entry. 140 141 -- Verify the correct version of the overridden function Image was used 142 -- for entering the specific data. 143 144 if Zoo_Data_Base(1)(1 .. 6) /= "Animal" 145 or else 146 Zoo_Data_Base(1)(26 .. 31) /= "Salmon" 147 then 148 Report.Failed ("Incorrect version of Image for parent type"); 149 end if; 150 151 if (Zoo_Data_Base(2)(1 .. 6) /= "Mammal") 152 or 153 (Zoo_Data_Base(2)(28 .. 35) /= "Platypus") 154 then 155 Report.Failed ("Incorrect version of Image for child type"); 156 end if; 157 158 if ((Zoo_Data_Base(3)(1 .. 7) /= "Primate") 159 or 160 (Zoo_Data_Base(3)(27 .. 35) /= "Orangutan")) 161 then 162 Report.Failed ("Incorrect version of Image for grandchild type"); 163 end if; 164 165 end; 166 167 168 Report.Result; 169 170end CA11C01; 171