1-- C45344A.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 THE CORRECT RESULT IS PRODUCED WHEN A FUNCTION RETURNS 26-- THE RESULT OF A CATENATION WHOSE BOUNDS ARE NOT DEFINED STATICALLY. 27 28-- R.WILLIAMS 9/1/86 29 30WITH REPORT; USE REPORT; 31PROCEDURE C45344A IS 32 33BEGIN 34 TEST ( "C45344A", "CHECK THAT THE CORRECT RESULT IS PRODUCED " & 35 "WHEN A FUNCTION RETURNS THE RESULT OF A " & 36 "CATENATION WHOSE BOUNDS ARE NOT DEFINED " & 37 "STATICALLY" ); 38 39 DECLARE 40 SUBTYPE INT IS INTEGER RANGE IDENT_INT (1) .. IDENT_INT (30); 41 42 TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER; 43 SUBTYPE CARR IS ARR (1 .. 9); 44 C : CARR; 45 46 AR1 : ARR (IDENT_INT (2) .. IDENT_INT (4)) := 47 (IDENT_INT (2) .. IDENT_INT (4) => 1); 48 49 AR2 : ARR (IDENT_INT (6) .. IDENT_INT (6)) := 50 (IDENT_INT (6) .. IDENT_INT (6) => 2); 51 52 AR3 : ARR (IDENT_INT (4) .. IDENT_INT (2)); 53 54 FUNCTION F (A, B : ARR; N : NATURAL) RETURN ARR IS 55 BEGIN 56 IF N = 0 THEN 57 RETURN A & B; 58 ELSE 59 RETURN F (A & B, B, N - 1); 60 END IF; 61 END F; 62 63 FUNCTION G (A : INTEGER; B : ARR; N : NATURAL) RETURN ARR IS 64 BEGIN 65 IF N = 0 THEN 66 RETURN A & B; 67 ELSE 68 RETURN G (A, A & B, N - 1); 69 END IF; 70 END G; 71 72 FUNCTION H (A : ARR; B : INTEGER; N : NATURAL) RETURN ARR IS 73 BEGIN 74 IF N = 0 THEN 75 RETURN A & B; 76 ELSE 77 RETURN H (A & B, B, N - 1); 78 END IF; 79 END H; 80 81 PROCEDURE CHECK (X, Y : ARR; F, L : INTEGER; STR : STRING) IS 82 OK : BOOLEAN := TRUE; 83 BEGIN 84 IF X'FIRST /= F AND X'LAST /= L THEN 85 FAILED ( "INCORRECT RANGE FOR " & STR); 86 ELSE 87 FOR I IN F .. L LOOP 88 IF X (I) /= Y (I) THEN 89 OK := FALSE; 90 END IF; 91 END LOOP; 92 93 IF NOT OK THEN 94 FAILED ( "INCORRECT VALUE FOR " & STR); 95 END IF; 96 END IF; 97 END CHECK; 98 99 BEGIN 100 C := (1 .. 4 => 1, 5 .. 9 => 2); 101 CHECK (F (AR1, AR2, IDENT_INT (3)), C, 2, 8, "F - 1" ); 102 CHECK (F (AR3, AR2, IDENT_INT (3)), C, 6, 9, "F - 2" ); 103 CHECK (F (AR2, AR3, IDENT_INT (3)), C, 6, 6, "F - 3" ); 104 105 C := (1 ..4 => 5, 5 .. 9 => 1); 106 CHECK (G (5, AR1, IDENT_INT (3)), C, 1, 7, "G - 1" ); 107 CHECK (G (5, AR3, IDENT_INT (3)), C, 1, 4, "G - 2" ); 108 109 CHECK (H (AR3, 5, IDENT_INT (3)), C, 1, 4, "H - 1" ); 110 111 C := (1 ..4 => 1, 5 .. 9 => 5); 112 CHECK (H (AR1, 5, IDENT_INT (3)), C, 2, 8, "H - 2" ); 113 END; 114 115 RESULT; 116END C45344A; 117