1-- C34007V.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-- OBJECTIVE: 26-- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED 27-- (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A 28-- ONE-DIMENSIONAL ARRAY TYPE. THIS TEST IS PART 2 OF 2 TESTS 29-- WHICH COVER THE OBJECTIVE. THE FIRST PART IS IN TEST C34007D. 30 31-- HISTORY: 32-- BCB 04/12/90 CREATED ORIGINAL TEST FROM SPLIT OF C34007D.ADA. 33-- THS 09/18/90 REMOVED DECLARATION OF B, DELETED PROCEDURE A, 34-- AND REMOVED ALL REFERENCES TO B. 35 36WITH SYSTEM; USE SYSTEM; 37WITH REPORT; USE REPORT; 38 39PROCEDURE C34007V IS 40 41 SUBTYPE COMPONENT IS INTEGER; 42 43 TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT; 44 45 SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_INT (5) .. 46 IDENT_INT (7)); 47 48 PACKAGE PKG IS 49 50 TYPE PARENT IS ACCESS DESIGNATED; 51 52 FUNCTION CREATE ( F, L : NATURAL; 53 C : COMPONENT; 54 DUMMY : PARENT -- TO RESOLVE OVERLOADING. 55 ) RETURN PARENT; 56 57 END PKG; 58 59 USE PKG; 60 61 TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7)); 62 63 X : T := NEW SUBDESIGNATED'(OTHERS => 2); 64 K : INTEGER := X'SIZE; 65 Y : T := NEW SUBDESIGNATED'(1, 2, 3); 66 W : PARENT := NEW SUBDESIGNATED'(OTHERS => 2); 67 C : COMPONENT := 1; 68 N : CONSTANT := 1; 69 70 FUNCTION V RETURN T IS 71 BEGIN 72 RETURN NEW SUBDESIGNATED'(OTHERS => C); 73 END V; 74 75 PACKAGE BODY PKG IS 76 77 FUNCTION CREATE 78 ( F, L : NATURAL; 79 C : COMPONENT; 80 DUMMY : PARENT 81 ) RETURN PARENT 82 IS 83 A : PARENT := NEW DESIGNATED (F .. L); 84 B : COMPONENT := C; 85 BEGIN 86 FOR I IN F .. L LOOP 87 A (I) := B; 88 B := B + 1; 89 END LOOP; 90 RETURN A; 91 END CREATE; 92 93 END PKG; 94 95 FUNCTION IDENT (X : T) RETURN T IS 96 BEGIN 97 IF X = NULL OR ELSE 98 EQUAL (X'LENGTH, X'LENGTH) THEN 99 RETURN X; -- ALWAYS EXECUTED. 100 END IF; 101 RETURN NEW SUBDESIGNATED; 102 END IDENT; 103 104BEGIN 105 TEST ("C34007V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " & 106 "ARE DECLARED (IMPLICITLY) FOR DERIVED " & 107 "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " & 108 "ONE-DIMENSIONAL ARRAY TYPE. THIS TEST IS " & 109 "PART 2 OF 2 TESTS WHICH COVER THE OBJECTIVE. " & 110 "THE FIRST PART IS IN TEST C34007V"); 111 112 W := PARENT (CREATE (2, 3, 4, X)); 113 IF W = NULL OR ELSE W.ALL /= (4, 5) THEN 114 FAILED ("INCORRECT CONVERSION TO PARENT - 2"); 115 END IF; 116 117 X := IDENT (Y); 118 IF X.ALL /= (1, 2, 3) OR CREATE (2, 3, 4, X) . ALL /= (4, 5) THEN 119 FAILED ("INCORRECT .ALL (VALUE)"); 120 END IF; 121 122 X.ALL := (10, 11, 12); 123 IF X /= Y OR Y.ALL /= (10, 11, 12) THEN 124 FAILED ("INCORRECT .ALL (ASSIGNMENT)"); 125 END IF; 126 127 Y.ALL := (1, 2, 3); 128 BEGIN 129 CREATE (2, 3, 4, X) . ALL := (10, 11); 130 EXCEPTION 131 WHEN OTHERS => 132 FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)"); 133 END; 134 135 136 X := IDENT (Y); 137 IF X (IDENT_INT (5)) /= 1 OR 138 CREATE (2, 3, 4, X) (3) /= 5 THEN 139 FAILED ("INCORRECT INDEX (VALUE)"); 140 END IF; 141 142 Y.ALL := (1, 2, 3); 143 X := IDENT (Y); 144 BEGIN 145 CREATE (2, 3, 4, X) (2) := 10; 146 EXCEPTION 147 WHEN OTHERS => 148 FAILED ("EXCEPTION FOR INDEX (ASSIGNMENT)"); 149 END; 150 151 IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2, 3) OR 152 CREATE (1, 4, 4, X) (1 .. 3) /= (4, 5, 6) THEN 153 FAILED ("INCORRECT SLICE (VALUE)"); 154 END IF; 155 156 Y.ALL := (1, 2, 3); 157 X := IDENT (Y); 158 BEGIN 159 CREATE (1, 4, 4, X) (2 .. 4) := (10, 11, 12); 160 EXCEPTION 161 WHEN OTHERS => 162 FAILED ("EXCEPTION FOR SLICE (ASSIGNMENT)"); 163 END; 164 165 IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR 166 X = CREATE (2, 3, 4, X) THEN 167 FAILED ("INCORRECT ="); 168 END IF; 169 170 IF X /= Y OR NOT (X /= NULL) OR NOT (X /= CREATE (2, 3, 4, X)) THEN 171 FAILED ("INCORRECT /="); 172 END IF; 173 174 IF NOT (X IN T) OR CREATE (2, 3, 4, X) IN T THEN 175 FAILED ("INCORRECT ""IN"""); 176 END IF; 177 178 IF X NOT IN T OR NOT (CREATE (2, 3, 4, X) NOT IN T) THEN 179 FAILED ("INCORRECT ""NOT IN"""); 180 END IF; 181 182 RESULT; 183END C34007V; 184