diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c36204d.ada')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c3/c36204d.ada | 598 |
1 files changed, 598 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c36204d.ada b/gcc/testsuite/ada/acats/tests/c3/c36204d.ada new file mode 100644 index 000000000..afdadbf53 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c3/c36204d.ada @@ -0,0 +1,598 @@ +-- C36204D.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. +--* +-- CHECK THAT EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES. +-- BOTH ARRAY OBJECTS AND TYPES ARE CHECKED. THIS TEST CHECKS +-- THE ABOVE FOR ARRAYS WITHIN GENERIC PROGRAM UNITS. + +-- HISTROY +-- EDWARD V. BERARD, 9 AUGUST 1990 + +WITH REPORT ; +WITH SYSTEM ; + +PROCEDURE C36204D IS + + SHORT_START : CONSTANT := -10 ; + SHORT_END : CONSTANT := 10 ; + TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ; + SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ; + + TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, + SEP, OCT, NOV, DEC) ; + SUBTYPE MID_YEAR IS MONTH_TYPE RANGE MAY .. AUG ; + TYPE DAY_TYPE IS RANGE 1 .. 31 ; + TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ; + TYPE DATE IS RECORD + MONTH : MONTH_TYPE ; + DAY : DAY_TYPE ; + YEAR : YEAR_TYPE ; + END RECORD ; + + TODAY : DATE := (MONTH => AUG, + DAY => 10, + YEAR => 1990) ; + + FIRST_DATE : DATE := (DAY => 6, + MONTH => JUN, + YEAR => 1967) ; + + FUNCTION "=" (LEFT : IN SYSTEM.ADDRESS ; + RIGHT : IN SYSTEM.ADDRESS ) RETURN BOOLEAN + RENAMES SYSTEM."=" ; + + GENERIC + + TYPE FIRST_INDEX IS (<>) ; + FIRST_INDEX_LENGTH : IN NATURAL ; + FIRST_TEST_VALUE : IN FIRST_INDEX ; + TYPE SECOND_INDEX IS (<>) ; + SECOND_INDEX_LENGTH : IN NATURAL ; + SECOND_TEST_VALUE : IN SECOND_INDEX ; + TYPE THIRD_INDEX IS (<>) ; + THIRD_INDEX_LENGTH : IN NATURAL ; + THIRD_TEST_VALUE : IN THIRD_INDEX ; + TYPE FIRST_COMPONENT_TYPE IS PRIVATE ; + FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; + SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; + TYPE SECOND_COMPONENT_TYPE IS PRIVATE ; + THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; + FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; + + PACKAGE ARRAY_ATTRIBUTE_TEST IS + + TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX) + OF FIRST_COMPONENT_TYPE ; + + TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX) + OF SECOND_COMPONENT_TYPE ; + + END ARRAY_ATTRIBUTE_TEST ; + + PACKAGE BODY ARRAY_ATTRIBUTE_TEST IS + + FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + FIRST_DEFAULT_VALUE)) ; + + SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => + THIRD_DEFAULT_VALUE))) ; + + THIRD_ARRAY : CONSTANT MATRIX + := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + SECOND_DEFAULT_VALUE)) ; + + FOURTH_ARRAY : CONSTANT CUBE + := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => + FOURTH_DEFAULT_VALUE))) ; + + FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ; + FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ; + FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ; + FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ; + + SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ; + SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ; + SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ; + SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ; + SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ; + SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ; + + FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ; + FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ; + + SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ; + SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ; + SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ; + + MATRIX_SIZE : NATURAL := MATRIX'SIZE ; + CUBE_SIZE : NATURAL := CUBE'SIZE ; + + FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ; + SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ; + TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ; + FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ; + + BEGIN -- ARRAY_ATTRIBUTE_TEST + + IF (FA1 /= FIRST_INDEX'FIRST) OR + (FA3 /= SECOND_INDEX'FIRST) OR + (SA1 /= FIRST_INDEX'FIRST) OR + (SA3 /= SECOND_INDEX'FIRST) OR + (SA5 /= THIRD_INDEX'FIRST) THEN + REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST - PACKAGE") ; + END IF ; + + IF (FA2 /= FIRST_INDEX'LAST) OR + (FA4 /= SECOND_INDEX'LAST) OR + (SA2 /= FIRST_INDEX'LAST) OR + (SA4 /= SECOND_INDEX'LAST) OR + (SA6 /= THIRD_INDEX'LAST) THEN + REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST - PACKAGE") ; + END IF ; + + IF (FAL1 /= FIRST_INDEX_LENGTH) OR + (FAL2 /= SECOND_INDEX_LENGTH) OR + (SAL1 /= FIRST_INDEX_LENGTH) OR + (SAL2 /= SECOND_INDEX_LENGTH) OR + (SAL3 /= THIRD_INDEX_LENGTH) THEN + REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH - PACKAGE") ; + END IF ; + + FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP + FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP + FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) := + SECOND_DEFAULT_VALUE ; + END LOOP ; + END LOOP ; + + IF FIRST_ARRAY /= THIRD_ARRAY THEN + REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & + "FOR 2-DIMENSIONAL ARRAY. - PACKAGE") ; + END IF ; + + FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP + FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP + FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP + SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX) + := FOURTH_DEFAULT_VALUE ; + END LOOP ; + END LOOP ; + END LOOP ; + + IF SECOND_ARRAY /= FOURTH_ARRAY THEN + REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & + "FOR 3-DIMENSIONAL ARRAY. - PACKAGE") ; + END IF ; + + IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR + (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR + (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR + (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR + (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN + REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & + "- PACKAGE") ; + END IF ; + + IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN + REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " & + "- PACKAGE") ; + END IF ; + + IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA) + OR (SAA = TAA) OR (TAA = FRAA) THEN + REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " & + "- PACKAGE") ; + END IF ; + + END ARRAY_ATTRIBUTE_TEST ; + + GENERIC + + TYPE FIRST_INDEX IS (<>) ; + FIRST_INDEX_LENGTH : IN NATURAL ; + FIRST_TEST_VALUE : IN FIRST_INDEX ; + TYPE SECOND_INDEX IS (<>) ; + SECOND_INDEX_LENGTH : IN NATURAL ; + SECOND_TEST_VALUE : IN SECOND_INDEX ; + TYPE THIRD_INDEX IS (<>) ; + THIRD_INDEX_LENGTH : IN NATURAL ; + THIRD_TEST_VALUE : IN THIRD_INDEX ; + TYPE FIRST_COMPONENT_TYPE IS PRIVATE ; + FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; + SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; + TYPE SECOND_COMPONENT_TYPE IS PRIVATE ; + THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; + FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; + + PROCEDURE PROC_ARRAY_ATT_TEST ; + + PROCEDURE PROC_ARRAY_ATT_TEST IS + + TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX) + OF FIRST_COMPONENT_TYPE ; + + TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX) + OF SECOND_COMPONENT_TYPE ; + + FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + FIRST_DEFAULT_VALUE)) ; + + SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => + THIRD_DEFAULT_VALUE))) ; + + THIRD_ARRAY : CONSTANT MATRIX + := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + SECOND_DEFAULT_VALUE)) ; + + FOURTH_ARRAY : CONSTANT CUBE + := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => + FOURTH_DEFAULT_VALUE))) ; + + FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ; + FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ; + FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ; + FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ; + + SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ; + SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ; + SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ; + SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ; + SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ; + SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ; + + FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ; + FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ; + + SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ; + SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ; + SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ; + + MATRIX_SIZE : NATURAL := MATRIX'SIZE ; + CUBE_SIZE : NATURAL := CUBE'SIZE ; + + FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ; + SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ; + TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ; + FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ; + + BEGIN -- PROC_ARRAY_ATT_TEST + + IF (FA1 /= FIRST_INDEX'FIRST) OR + (FA3 /= SECOND_INDEX'FIRST) OR + (SA1 /= FIRST_INDEX'FIRST) OR + (SA3 /= SECOND_INDEX'FIRST) OR + (SA5 /= THIRD_INDEX'FIRST) THEN + REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " & + "- PROCEDURE") ; + END IF ; + + IF (FA2 /= FIRST_INDEX'LAST) OR + (FA4 /= SECOND_INDEX'LAST) OR + (SA2 /= FIRST_INDEX'LAST) OR + (SA4 /= SECOND_INDEX'LAST) OR + (SA6 /= THIRD_INDEX'LAST) THEN + REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " & + "- PROCEDURE") ; + END IF ; + + IF (FAL1 /= FIRST_INDEX_LENGTH) OR + (FAL2 /= SECOND_INDEX_LENGTH) OR + (SAL1 /= FIRST_INDEX_LENGTH) OR + (SAL2 /= SECOND_INDEX_LENGTH) OR + (SAL3 /= THIRD_INDEX_LENGTH) THEN + REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " & + "- PROCEDURE") ; + END IF ; + + FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP + FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP + FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) := + SECOND_DEFAULT_VALUE ; + END LOOP ; + END LOOP ; + + IF FIRST_ARRAY /= THIRD_ARRAY THEN + REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & + "FOR 2-DIMENSIONAL ARRAY. - PROCEDURE") ; + END IF ; + + FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP + FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP + FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP + SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX) + := FOURTH_DEFAULT_VALUE ; + END LOOP ; + END LOOP ; + END LOOP ; + + IF SECOND_ARRAY /= FOURTH_ARRAY THEN + REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & + "FOR 3-DIMENSIONAL ARRAY. - PROCEDURE") ; + END IF ; + + IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR + (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR + (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR + (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR + (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN + REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & + "- PROCEDURE") ; + END IF ; + + IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN + REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " & + "- PROCEDURE") ; + END IF ; + + IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA) + OR (SAA = TAA) OR (TAA = FRAA) THEN + REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " & + "- PROCEDURE") ; + END IF ; + + END PROC_ARRAY_ATT_TEST ; + + GENERIC + + TYPE FIRST_INDEX IS (<>) ; + FIRST_INDEX_LENGTH : IN NATURAL ; + FIRST_TEST_VALUE : IN FIRST_INDEX ; + TYPE SECOND_INDEX IS (<>) ; + SECOND_INDEX_LENGTH : IN NATURAL ; + SECOND_TEST_VALUE : IN SECOND_INDEX ; + TYPE THIRD_INDEX IS (<>) ; + THIRD_INDEX_LENGTH : IN NATURAL ; + THIRD_TEST_VALUE : IN THIRD_INDEX ; + TYPE FIRST_COMPONENT_TYPE IS PRIVATE ; + FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; + SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; + TYPE SECOND_COMPONENT_TYPE IS PRIVATE ; + THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; + FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; + + FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN ; + + FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN IS + + TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX) + OF FIRST_COMPONENT_TYPE ; + + TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX) + OF SECOND_COMPONENT_TYPE ; + + FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + FIRST_DEFAULT_VALUE)) ; + + SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => + THIRD_DEFAULT_VALUE))) ; + + THIRD_ARRAY : CONSTANT MATRIX + := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + SECOND_DEFAULT_VALUE)) ; + + FOURTH_ARRAY : CONSTANT CUBE + := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => + (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => + (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => + FOURTH_DEFAULT_VALUE))) ; + + FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ; + FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ; + FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ; + FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ; + + SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ; + SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ; + SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ; + SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ; + SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ; + SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ; + + FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ; + FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ; + + SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ; + SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ; + SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ; + + MATRIX_SIZE : NATURAL := MATRIX'SIZE ; + CUBE_SIZE : NATURAL := CUBE'SIZE ; + + FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ; + SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ; + TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ; + FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ; + + BEGIN -- FUNC_ARRAY_ATT_TEST + + IF (FA1 /= FIRST_INDEX'FIRST) OR + (FA3 /= SECOND_INDEX'FIRST) OR + (SA1 /= FIRST_INDEX'FIRST) OR + (SA3 /= SECOND_INDEX'FIRST) OR + (SA5 /= THIRD_INDEX'FIRST) THEN + REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " & + "- FUNCTION") ; + END IF ; + + IF (FA2 /= FIRST_INDEX'LAST) OR + (FA4 /= SECOND_INDEX'LAST) OR + (SA2 /= FIRST_INDEX'LAST) OR + (SA4 /= SECOND_INDEX'LAST) OR + (SA6 /= THIRD_INDEX'LAST) THEN + REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " & + "- FUNCTION") ; + END IF ; + + IF (FAL1 /= FIRST_INDEX_LENGTH) OR + (FAL2 /= SECOND_INDEX_LENGTH) OR + (SAL1 /= FIRST_INDEX_LENGTH) OR + (SAL2 /= SECOND_INDEX_LENGTH) OR + (SAL3 /= THIRD_INDEX_LENGTH) THEN + REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " & + "- FUNCTION") ; + END IF ; + + FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP + FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP + FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) := + SECOND_DEFAULT_VALUE ; + END LOOP ; + END LOOP ; + + IF FIRST_ARRAY /= THIRD_ARRAY THEN + REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & + "FOR 2-DIMENSIONAL ARRAY. - FUNCTION") ; + END IF ; + + FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP + FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP + FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP + SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX) + := FOURTH_DEFAULT_VALUE ; + END LOOP ; + END LOOP ; + END LOOP ; + + IF SECOND_ARRAY /= FOURTH_ARRAY THEN + REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & + "FOR 3-DIMENSIONAL ARRAY. - FUNCTION") ; + END IF ; + + IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR + (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR + (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR + (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR + (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN + REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & + "- FUNCTION") ; + END IF ; + + IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN + REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " & + "- FUNCTION") ; + END IF ; + + IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA) + OR (SAA = TAA) OR (TAA = FRAA) THEN + REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " & + "- FUNCTION") ; + END IF ; + + RETURN TRUE ; + + END FUNC_ARRAY_ATT_TEST ; + + +BEGIN -- C36204D + + REPORT.TEST ("C36204D", "ARRAY ATTRIBUTES RETURN CORRECT " & + "VALUES WITHIN GENERIC PROGRAM UNITS.") ; + + LOCAL_BLOCK: + + DECLARE + + DUMMY : BOOLEAN := FALSE ; + + PACKAGE NEW_ARRAY_ATTRIBUTE_TEST IS NEW ARRAY_ATTRIBUTE_TEST ( + FIRST_INDEX => SHORT_RANGE, + FIRST_INDEX_LENGTH => SHORT_LENGTH, + FIRST_TEST_VALUE => -7, + SECOND_INDEX => MONTH_TYPE, + SECOND_INDEX_LENGTH => 12, + SECOND_TEST_VALUE => AUG, + THIRD_INDEX => BOOLEAN, + THIRD_INDEX_LENGTH => 2, + THIRD_TEST_VALUE => FALSE, + FIRST_COMPONENT_TYPE => MONTH_TYPE, + FIRST_DEFAULT_VALUE => JAN, + SECOND_DEFAULT_VALUE => DEC, + SECOND_COMPONENT_TYPE => DATE, + THIRD_DEFAULT_VALUE => TODAY, + FOURTH_DEFAULT_VALUE => FIRST_DATE) ; + + PROCEDURE NEW_PROC_ARRAY_ATT_TEST IS NEW PROC_ARRAY_ATT_TEST ( + FIRST_INDEX => MONTH_TYPE, + FIRST_INDEX_LENGTH => 12, + FIRST_TEST_VALUE => AUG, + SECOND_INDEX => SHORT_RANGE, + SECOND_INDEX_LENGTH => SHORT_LENGTH, + SECOND_TEST_VALUE => -7, + THIRD_INDEX => BOOLEAN, + THIRD_INDEX_LENGTH => 2, + THIRD_TEST_VALUE => FALSE, + FIRST_COMPONENT_TYPE => DATE, + FIRST_DEFAULT_VALUE => TODAY, + SECOND_DEFAULT_VALUE => FIRST_DATE, + SECOND_COMPONENT_TYPE => MONTH_TYPE, + THIRD_DEFAULT_VALUE => JAN, + FOURTH_DEFAULT_VALUE => DEC) ; + + FUNCTION NEW_FUNC_ARRAY_ATT_TEST IS NEW FUNC_ARRAY_ATT_TEST ( + FIRST_INDEX => DAY_TYPE, + FIRST_INDEX_LENGTH => 31, + FIRST_TEST_VALUE => 25, + SECOND_INDEX => SHORT_RANGE, + SECOND_INDEX_LENGTH => SHORT_LENGTH, + SECOND_TEST_VALUE => -7, + THIRD_INDEX => MID_YEAR, + THIRD_INDEX_LENGTH => 4, + THIRD_TEST_VALUE => JUL, + FIRST_COMPONENT_TYPE => DATE, + FIRST_DEFAULT_VALUE => TODAY, + SECOND_DEFAULT_VALUE => FIRST_DATE, + SECOND_COMPONENT_TYPE => MONTH_TYPE, + THIRD_DEFAULT_VALUE => JAN, + FOURTH_DEFAULT_VALUE => DEC) ; + + BEGIN -- LOCAL_BLOCK + + NEW_PROC_ARRAY_ATT_TEST ; + + DUMMY := NEW_FUNC_ARRAY_ATT_TEST ; + IF NOT DUMMY THEN + REPORT.FAILED ("WRONG VALUE RETURNED BY FUNCTION.") ; + END IF ; + + END LOCAL_BLOCK ; + + REPORT.RESULT ; + +END C36204D ; |