1-- C393B13.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-- TEST OBJECTIVE: 27-- Check that an extended type can be derived from an abstract type 28-- when that derivation is declared in a child package. 29-- 30-- TEST DESCRIPTION: 31-- Add a visible child to Alert_Foundation. Using the abstract type 32-- Alert as parent, declare an extended type with discriminant and new 33-- record components. Override the Handle procedure. 34-- 35-- TEST FILES: 36-- This test depends on the following foundation code: 37-- 38-- F393B00.A Package Alert_Foundation 39-- 40-- 41-- CHANGE HISTORY: 42-- 06 Dec 94 SAIC ACVC 2.0 43-- 15 Oct 95 SAIC Fixed bugs for ACVC 2.0.1 44-- 45--! 46 47package F393B00.C393B13_0 is 48 -- Alert_Foundation.Public_Child 49 50 subtype Msg_Length_Range is integer range 0 .. 240; 51 Max_Msg_Length : constant Msg_Length_Range := 80; 52 Message : String := "Test Passed"; 53 54 type Child_Alert (Length : Msg_Length_Range) 55 is new Alert with record -- abstract type is in parent package 56 Times_Handled : Natural := 0; 57 Msg : String (1..Length); 58 end record; 59 60 procedure Handle (CA : in out Child_Alert); -- required override 61 62end F393B00.C393B13_0; 63 -- Alert_Foundation.Public_Child; 64 65--=======================================================================-- 66 67package body F393B00.C393B13_0 is 68 -- Alert_Foundation.Public_Child 69 70 procedure Handle (CA : in out Child_Alert) is 71 begin 72 CA.Msg(1..Message'Length) := Message; 73 CA.Times_Handled := CA.Times_Handled + 1; 74 end; 75 76end F393B00.C393B13_0; 77 -- Alert_Foundation.Public_Child 78 79--=======================================================================-- 80 81with Report; 82with F393B00.C393B13_0; 83 -- Alert_foundation.Public_Child; 84procedure C393B13 is 85 package Child renames F393B00.C393B13_0; 86 CA : Child.Child_Alert(Child.Message'Length); 87 88begin 89 90 Report.Test ("C393B13", "Check that an extended type can be derived " & 91 "from an abstract type"); 92 93 if CA.Times_Handled /= 0 then 94 Report.Failed ("Wrong initialization"); 95 end if; 96 97 Child.Handle (CA); 98 if (CA.Times_Handled /= 1) 99 or (CA.Msg /= Child.Message) then 100 Report.Failed ("Wrong results from Handle"); 101 end if; 102 103 Report.Result; 104 105end C393B13; 106