| -- C34007V.ADA |
| |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- OBJECTIVE: |
| -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED |
| -- (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A |
| -- ONE-DIMENSIONAL ARRAY TYPE. THIS TEST IS PART 2 OF 2 TESTS |
| -- WHICH COVER THE OBJECTIVE. THE FIRST PART IS IN TEST C34007D. |
| |
| -- HISTORY: |
| -- BCB 04/12/90 CREATED ORIGINAL TEST FROM SPLIT OF C34007D.ADA. |
| -- THS 09/18/90 REMOVED DECLARATION OF B, DELETED PROCEDURE A, |
| -- AND REMOVED ALL REFERENCES TO B. |
| |
| WITH SYSTEM; USE SYSTEM; |
| WITH REPORT; USE REPORT; |
| |
| PROCEDURE C34007V IS |
| |
| SUBTYPE COMPONENT IS INTEGER; |
| |
| TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT; |
| |
| SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_INT (5) .. |
| IDENT_INT (7)); |
| |
| PACKAGE PKG IS |
| |
| TYPE PARENT IS ACCESS DESIGNATED; |
| |
| FUNCTION CREATE ( F, L : NATURAL; |
| C : COMPONENT; |
| DUMMY : PARENT -- TO RESOLVE OVERLOADING. |
| ) RETURN PARENT; |
| |
| END PKG; |
| |
| USE PKG; |
| |
| TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7)); |
| |
| X : T := NEW SUBDESIGNATED'(OTHERS => 2); |
| K : INTEGER := X'SIZE; |
| Y : T := NEW SUBDESIGNATED'(1, 2, 3); |
| W : PARENT := NEW SUBDESIGNATED'(OTHERS => 2); |
| C : COMPONENT := 1; |
| N : CONSTANT := 1; |
| |
| FUNCTION V RETURN T IS |
| BEGIN |
| RETURN NEW SUBDESIGNATED'(OTHERS => C); |
| END V; |
| |
| PACKAGE BODY PKG IS |
| |
| FUNCTION CREATE |
| ( F, L : NATURAL; |
| C : COMPONENT; |
| DUMMY : PARENT |
| ) RETURN PARENT |
| IS |
| A : PARENT := NEW DESIGNATED (F .. L); |
| B : COMPONENT := C; |
| BEGIN |
| FOR I IN F .. L LOOP |
| A (I) := B; |
| B := B + 1; |
| END LOOP; |
| RETURN A; |
| END CREATE; |
| |
| END PKG; |
| |
| FUNCTION IDENT (X : T) RETURN T IS |
| BEGIN |
| IF X = NULL OR ELSE |
| EQUAL (X'LENGTH, X'LENGTH) THEN |
| RETURN X; -- ALWAYS EXECUTED. |
| END IF; |
| RETURN NEW SUBDESIGNATED; |
| END IDENT; |
| |
| BEGIN |
| TEST ("C34007V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " & |
| "ARE DECLARED (IMPLICITLY) FOR DERIVED " & |
| "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " & |
| "ONE-DIMENSIONAL ARRAY TYPE. THIS TEST IS " & |
| "PART 2 OF 2 TESTS WHICH COVER THE OBJECTIVE. " & |
| "THE FIRST PART IS IN TEST C34007V"); |
| |
| W := PARENT (CREATE (2, 3, 4, X)); |
| IF W = NULL OR ELSE W.ALL /= (4, 5) THEN |
| FAILED ("INCORRECT CONVERSION TO PARENT - 2"); |
| END IF; |
| |
| X := IDENT (Y); |
| IF X.ALL /= (1, 2, 3) OR CREATE (2, 3, 4, X) . ALL /= (4, 5) THEN |
| FAILED ("INCORRECT .ALL (VALUE)"); |
| END IF; |
| |
| X.ALL := (10, 11, 12); |
| IF X /= Y OR Y.ALL /= (10, 11, 12) THEN |
| FAILED ("INCORRECT .ALL (ASSIGNMENT)"); |
| END IF; |
| |
| Y.ALL := (1, 2, 3); |
| BEGIN |
| CREATE (2, 3, 4, X) . ALL := (10, 11); |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)"); |
| END; |
| |
| |
| X := IDENT (Y); |
| IF X (IDENT_INT (5)) /= 1 OR |
| CREATE (2, 3, 4, X) (3) /= 5 THEN |
| FAILED ("INCORRECT INDEX (VALUE)"); |
| END IF; |
| |
| Y.ALL := (1, 2, 3); |
| X := IDENT (Y); |
| BEGIN |
| CREATE (2, 3, 4, X) (2) := 10; |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ("EXCEPTION FOR INDEX (ASSIGNMENT)"); |
| END; |
| |
| IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2, 3) OR |
| CREATE (1, 4, 4, X) (1 .. 3) /= (4, 5, 6) THEN |
| FAILED ("INCORRECT SLICE (VALUE)"); |
| END IF; |
| |
| Y.ALL := (1, 2, 3); |
| X := IDENT (Y); |
| BEGIN |
| CREATE (1, 4, 4, X) (2 .. 4) := (10, 11, 12); |
| EXCEPTION |
| WHEN OTHERS => |
| FAILED ("EXCEPTION FOR SLICE (ASSIGNMENT)"); |
| END; |
| |
| IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR |
| X = CREATE (2, 3, 4, X) THEN |
| FAILED ("INCORRECT ="); |
| END IF; |
| |
| IF X /= Y OR NOT (X /= NULL) OR NOT (X /= CREATE (2, 3, 4, X)) THEN |
| FAILED ("INCORRECT /="); |
| END IF; |
| |
| IF NOT (X IN T) OR CREATE (2, 3, 4, X) IN T THEN |
| FAILED ("INCORRECT ""IN"""); |
| END IF; |
| |
| IF X NOT IN T OR NOT (CREATE (2, 3, 4, X) NOT IN T) THEN |
| FAILED ("INCORRECT ""NOT IN"""); |
| END IF; |
| |
| RESULT; |
| END C34007V; |