1-- C43210A.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 A NON-AGGREGATE EXPRESSION IN A NAMED COMPONENT 26-- ASSOCIATION IS EVALUATED ONCE FOR EACH COMPONENT SPECIFIED 27-- BY THE ASSOCIATION. 28 29-- EG 02/02/84 30 31WITH REPORT; 32 33PROCEDURE C43210A IS 34 35 USE REPORT; 36 37BEGIN 38 39 TEST("C43210A", "CHECK THAT A NON-AGGREGATE IN A NAMED " & 40 "COMPONENT ASSOCIATION IS EVALUATED ONCE " & 41 "FOR EACH COMPONENT SPECIFIED BY THE " & 42 "ASSOCIATION"); 43 44 DECLARE 45 46 TYPE T1 IS ARRAY(1 .. 10) OF INTEGER; 47 TYPE T2 IS ARRAY(1 .. 8, 1 .. 2) OF INTEGER; 48 TYPE T3 IS ARRAY(1 .. 2, 1 .. 8) OF INTEGER; 49 TYPE T4 IS ARRAY(1 .. 8, 1 .. 8) OF INTEGER; 50 51 A1 : T1; 52 A2 : T2; 53 A3 : T3; 54 A4 : T4; 55 CC : INTEGER; 56 57 FUNCTION CALC (A : INTEGER) RETURN INTEGER IS 58 BEGIN 59 CC := CC + 1; 60 RETURN IDENT_INT(A); 61 END CALC; 62 63 PROCEDURE CHECK (A : STRING; B : INTEGER) IS 64 BEGIN 65 IF CC /= B THEN 66 FAILED ("CASE " & A & " : INCORRECT NUMBER OF " & 67 "EVALUATIONS. NUMBER OF EVALUATIONS " & 68 "SHOULD BE " & INTEGER'IMAGE(B) & 69 ", BUT IS " & INTEGER'IMAGE(CC)); 70 END IF; 71 END CHECK; 72 73 BEGIN 74 75CASE_A : BEGIN 76 77 CC := 0; 78 A1 := T1'(4 .. 5 => CALC(2), 6 .. 8 => CALC(4), 79 OTHERS => 5); 80 CHECK ("A", 5); 81 82 END CASE_A; 83 84CASE_B : BEGIN 85 86 CC := 0; 87 A1 := T1'(1 | 4 .. 6 | 3 | 2 => CALC(-1), OTHERS => -2); 88 CHECK ("B", 6); 89 90 END CASE_B; 91 92CASE_C : BEGIN 93 94 CC := 0; 95 A1 := T1'(1 | 3 | 5 | 7 .. 9 => -1, OTHERS => CALC(-2)); 96 CHECK ("C", 4); 97 98 END CASE_C; 99 100CASE_D : BEGIN 101 102 CC := 0; 103 A2 := T2'(4 .. 6 | 8 | 2 .. 3 => (1 .. 2 => CALC(1)), 104 OTHERS => (1 .. 2 => -1)); 105 CHECK ("D", 12); 106 107 END CASE_D; 108 109CASE_E : BEGIN 110 111 CC := 0; 112 A3 := T3'(1 .. 2 => (2 | 4 | 6 .. 8 => CALC(-1), 113 OTHERS => -2)); 114 CHECK ("E", 10); 115 116 END CASE_E; 117 118CASE_F : BEGIN 119 120 CC := 0; 121 A4 := T4'(7 .. 8 | 3 .. 5 => 122 (1 | 2 | 4 | 6 .. 8 => CALC(1), OTHERS => -2), 123 OTHERS => (OTHERS => -2)); 124 CHECK ("F", 30); 125 126 END CASE_F; 127 128CASE_G : BEGIN 129 130 CC := 0; 131 A4 := T4'(5 .. 8 | 3 | 1 => (7 | 1 .. 5 | 8 => -1, 132 OTHERS => CALC(-2)), 133 OTHERS => (OTHERS => CALC(-2))); 134 CHECK ("G", 22); 135 136 END CASE_G; 137 138 END; 139 140 RESULT; 141 142END C43210A; 143