1-- CC3019B1.ADA 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-- THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF 26-- NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION. IT IS USED 27-- BY THE MAIN PROCEDURE, I.E., CC3019B2M.ADA. 28-- 29-- *** THIS FILE MUST BE COMPILED AFTER CC3019B0.ADA HAS BEEN 30-- *** COMPILED. 31-- 32-- HISTORY: 33-- EDWARD V. BERARD, 31 AUGUST 1990 34 35WITH CC3019B0_LIST_CLASS ; 36 37GENERIC 38 39 TYPE ELEMENT IS LIMITED PRIVATE ; 40 41 WITH PROCEDURE ASSIGN (SOURCE : IN OUT ELEMENT ; 42 DESTINATION : IN OUT ELEMENT) ; 43 44 WITH FUNCTION "=" (LEFT : IN ELEMENT ; 45 RIGHT : IN ELEMENT) RETURN BOOLEAN ; 46 47PACKAGE CC3019B1_STACK_CLASS IS 48 49 TYPE STACK IS LIMITED PRIVATE ; 50 51 OVERFLOW : EXCEPTION ; 52 UNDERFLOW : EXCEPTION ; 53 54 PROCEDURE PUSH (THIS_ELEMENT : IN OUT ELEMENT ; 55 ON_TO_THIS_STACK : IN OUT STACK) ; 56 57 PROCEDURE POP (THIS_ELEMENT : IN OUT ELEMENT ; 58 OFF_THIS_STACK : IN OUT STACK) ; 59 60 PROCEDURE COPY (THIS_STACK : IN OUT STACK ; 61 TO_THIS_STACK : IN OUT STACK) ; 62 63 PROCEDURE CLEAR (THIS_STACK : IN OUT STACK) ; 64 65 GENERIC 66 67 WITH PROCEDURE PROCESS (THIS_ELEMENT : IN ELEMENT ; 68 CONTINUE : OUT BOOLEAN) ; 69 70 PROCEDURE ITERATE (OVER_THIS_STACK : IN STACK) ; 71 72 FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK : IN STACK) 73 RETURN NATURAL ; 74 75 FUNCTION "=" (LEFT : IN STACK ; 76 RIGHT : IN STACK) RETURN BOOLEAN ; 77 78PRIVATE 79 80 PACKAGE NEW_LIST_CLASS IS 81 NEW CC3019B0_LIST_CLASS (ELEMENT => ELEMENT, 82 ASSIGN => ASSIGN, 83 "=" => "=") ; 84 85 TYPE STACK IS NEW NEW_LIST_CLASS.LIST ; 86 87END CC3019B1_STACK_CLASS ; 88 89PACKAGE BODY CC3019B1_STACK_CLASS IS 90 91 PROCEDURE PUSH (THIS_ELEMENT : IN OUT ELEMENT ; 92 ON_TO_THIS_STACK : IN OUT STACK) IS 93 94 BEGIN -- PUSH 95 96 NEW_LIST_CLASS.ADD ( 97 THIS_ELEMENT => THIS_ELEMENT, 98 TO_THIS_LIST => 99 NEW_LIST_CLASS.LIST (ON_TO_THIS_STACK)) ; 100 101 EXCEPTION 102 103 WHEN NEW_LIST_CLASS.OVERFLOW => RAISE OVERFLOW ; 104 105 END PUSH ; 106 107 PROCEDURE POP (THIS_ELEMENT : IN OUT ELEMENT ; 108 OFF_THIS_STACK : IN OUT STACK) IS 109 110 BEGIN -- POP 111 112 NEW_LIST_CLASS.DELETE ( 113 THIS_ELEMENT => THIS_ELEMENT, 114 FROM_THIS_LIST => 115 NEW_LIST_CLASS.LIST (OFF_THIS_STACK)) ; 116 117 EXCEPTION 118 119 WHEN NEW_LIST_CLASS.UNDERFLOW => RAISE UNDERFLOW ; 120 121 END POP ; 122 123 PROCEDURE COPY (THIS_STACK : IN OUT STACK ; 124 TO_THIS_STACK : IN OUT STACK) IS 125 126 BEGIN -- COPY 127 128 NEW_LIST_CLASS.COPY ( 129 THIS_LIST => NEW_LIST_CLASS.LIST (THIS_STACK), 130 TO_THIS_LIST => NEW_LIST_CLASS.LIST (TO_THIS_STACK)) ; 131 132 END COPY ; 133 134 PROCEDURE CLEAR (THIS_STACK : IN OUT STACK) IS 135 136 BEGIN -- CLEAR 137 138 NEW_LIST_CLASS.CLEAR (NEW_LIST_CLASS.LIST (THIS_STACK)) ; 139 140 END CLEAR ; 141 142 PROCEDURE ITERATE (OVER_THIS_STACK : IN STACK) IS 143 144 PROCEDURE STACK_ITERATE IS NEW NEW_LIST_CLASS.ITERATE 145 (PROCESS => PROCESS) ; 146 147 BEGIN -- ITERATE 148 149 STACK_ITERATE (NEW_LIST_CLASS.LIST (OVER_THIS_STACK)) ; 150 151 END ITERATE ; 152 153 FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK : IN STACK) 154 RETURN NATURAL IS 155 156 BEGIN -- NUMBER_OF_ELEMENTS 157 158 RETURN NEW_LIST_CLASS.NUMBER_OF_ELEMENTS 159 (IN_THIS_LIST => NEW_LIST_CLASS.LIST (ON_THIS_STACK)) ; 160 161 END NUMBER_OF_ELEMENTS ; 162 163 FUNCTION "=" (LEFT : IN STACK ; 164 RIGHT : IN STACK) RETURN BOOLEAN IS 165 166 BEGIN -- "=" 167 168 RETURN NEW_LIST_CLASS."=" ( 169 LEFT => NEW_LIST_CLASS.LIST (LEFT), 170 RIGHT => NEW_LIST_CLASS.LIST (RIGHT)) ; 171 172 END "=" ; 173 174END CC3019B1_STACK_CLASS ; 175