1-- CC3019A.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-- CHECK THAT INSTANTIATIONS OF NESTED GENERIC UNITS ARE PROCESSED 26-- CORRECTLY. 27 28-- JBG 11/6/85 29 30GENERIC 31 TYPE ELEMENT_TYPE IS PRIVATE; 32PACKAGE CC3019A_QUEUES IS 33 34 TYPE QUEUE_TYPE IS PRIVATE; 35 36 PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE; 37 VALUE : ELEMENT_TYPE); 38 39 GENERIC 40 WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE); 41 PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE); 42 43PRIVATE 44 45 TYPE CONTENTS_TYPE IS ARRAY (1..3) OF ELEMENT_TYPE; 46 TYPE QUEUE_TYPE IS 47 RECORD 48 CONTENTS : CONTENTS_TYPE; 49 SIZE : NATURAL := 0; 50 END RECORD; 51 52END CC3019A_QUEUES; 53 54PACKAGE BODY CC3019A_QUEUES IS 55 56 PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE; 57 VALUE : ELEMENT_TYPE) IS 58 BEGIN 59 TO_Q.SIZE := TO_Q.SIZE + 1; 60 TO_Q.CONTENTS(TO_Q.SIZE) := VALUE; 61 END ADD; 62 63-- GENERIC 64-- WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE); 65 PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE) IS 66 BEGIN 67 FOR I IN TO_Q.CONTENTS'FIRST .. TO_Q.SIZE LOOP 68 APPLY (TO_Q.CONTENTS(I)); 69 END LOOP; 70 END ITERATOR; 71 72END CC3019A_QUEUES; 73 74WITH REPORT; USE REPORT; 75WITH CC3019A_QUEUES; 76PROCEDURE CC3019A IS 77 78 SUBTYPE STR6 IS STRING (1..6); 79 80 TYPE STR6_ARR IS ARRAY (1..3) OF STR6; 81 STR6_VALS : STR6_ARR := ("111111", "222222", 82 IDENT_STR("333333")); 83 CUR_STR_INDEX : NATURAL := 1; 84 85 TYPE INT_ARR IS ARRAY (1..3) OF INTEGER; 86 INT_VALS : INT_ARR := (-1, 3, IDENT_INT(3)); 87 CUR_INT_INDEX : NATURAL := 1; 88 89-- THIS PROCEDURE IS CALLED ONCE FOR EACH ELEMENT OF THE QUEUE 90-- 91 PROCEDURE CHECK_STR (VAL : STR6) IS 92 BEGIN 93 IF VAL /= STR6_VALS(CUR_STR_INDEX) THEN 94 FAILED ("STR6 ITERATOR FOR INDEX =" & 95 INTEGER'IMAGE(CUR_STR_INDEX) & " WITH VALUE " & 96 """" & VAL & """"); 97 END IF; 98 CUR_STR_INDEX := CUR_STR_INDEX + 1; 99 EXCEPTION 100 WHEN CONSTRAINT_ERROR => 101 FAILED ("STR6 - CONSTRAINT_ERROR RAISED"); 102 WHEN OTHERS => 103 FAILED ("STR6 - UNEXPECTED EXCEPTION"); 104 END CHECK_STR; 105 106 PROCEDURE CHECK_INT (VAL : INTEGER) IS 107 BEGIN 108 IF VAL /= INT_VALS(CUR_INT_INDEX) THEN 109 FAILED ("INTEGER ITERATOR FOR INDEX =" & 110 INTEGER'IMAGE(CUR_INT_INDEX) & " WITH VALUE " & 111 """" & INTEGER'IMAGE(VAL) & """"); 112 END IF; 113 CUR_INT_INDEX := CUR_INT_INDEX + 1; 114 EXCEPTION 115 WHEN CONSTRAINT_ERROR => 116 FAILED ("INTEGER - CONSTRAINT_ERROR RAISED"); 117 WHEN OTHERS => 118 FAILED ("INTEGER - UNEXPECTED EXCEPTION"); 119 END CHECK_INT; 120 121 PACKAGE STR6_QUEUE IS NEW CC3019A_QUEUES (STR6); 122 USE STR6_QUEUE; 123 124 PACKAGE INT_QUEUE IS NEW CC3019A_QUEUES (INTEGER); 125 USE INT_QUEUE; 126 127BEGIN 128 129 TEST ("CC3019A", "CHECK NESTED GENERICS - ITERATORS"); 130 131 DECLARE 132 Q1 : STR6_QUEUE.QUEUE_TYPE; 133 134 PROCEDURE CHK_STR IS NEW STR6_QUEUE.ITERATOR (CHECK_STR); 135 136 BEGIN 137 138 ADD (Q1, "111111"); 139 ADD (Q1, "222222"); 140 ADD (Q1, "333333"); 141 142 CUR_STR_INDEX := 1; 143 CHK_STR (Q1); 144 145 EXCEPTION 146 WHEN OTHERS => 147 FAILED ("UNEXPECTED EXCEPTION - Q1"); 148 END; 149 150-- REPEAT FOR INTEGERS 151 152 DECLARE 153 Q2 : INT_QUEUE.QUEUE_TYPE; 154 155 PROCEDURE CHK_INT IS NEW INT_QUEUE.ITERATOR (CHECK_INT); 156 157 BEGIN 158 159 ADD (Q2, -1); 160 ADD (Q2, 3); 161 ADD (Q2, 3); 162 163 CUR_INT_INDEX := 1; 164 CHK_INT (Q2); 165 166 EXCEPTION 167 WHEN OTHERS => 168 FAILED ("UNEXPECTED EXCEPTION - Q2"); 169 END; 170 171 RESULT; 172 173END CC3019A; 174