URL
https://opencores.org/ocsvn/scarts/scarts/trunk
Subversion Repositories scarts
[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c45344a.ada] - Rev 12
Compare with Previous | Blame | View Log
-- C45344A.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 THE CORRECT RESULT IS PRODUCED WHEN A FUNCTION RETURNS -- THE RESULT OF A CATENATION WHOSE BOUNDS ARE NOT DEFINED STATICALLY. -- R.WILLIAMS 9/1/86 WITH REPORT; USE REPORT; PROCEDURE C45344A IS BEGIN TEST ( "C45344A", "CHECK THAT THE CORRECT RESULT IS PRODUCED " & "WHEN A FUNCTION RETURNS THE RESULT OF A " & "CATENATION WHOSE BOUNDS ARE NOT DEFINED " & "STATICALLY" ); DECLARE SUBTYPE INT IS INTEGER RANGE IDENT_INT (1) .. IDENT_INT (30); TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER; SUBTYPE CARR IS ARR (1 .. 9); C : CARR; AR1 : ARR (IDENT_INT (2) .. IDENT_INT (4)) := (IDENT_INT (2) .. IDENT_INT (4) => 1); AR2 : ARR (IDENT_INT (6) .. IDENT_INT (6)) := (IDENT_INT (6) .. IDENT_INT (6) => 2); AR3 : ARR (IDENT_INT (4) .. IDENT_INT (2)); FUNCTION F (A, B : ARR; N : NATURAL) RETURN ARR IS BEGIN IF N = 0 THEN RETURN A & B; ELSE RETURN F (A & B, B, N - 1); END IF; END F; FUNCTION G (A : INTEGER; B : ARR; N : NATURAL) RETURN ARR IS BEGIN IF N = 0 THEN RETURN A & B; ELSE RETURN G (A, A & B, N - 1); END IF; END G; FUNCTION H (A : ARR; B : INTEGER; N : NATURAL) RETURN ARR IS BEGIN IF N = 0 THEN RETURN A & B; ELSE RETURN H (A & B, B, N - 1); END IF; END H; PROCEDURE CHECK (X, Y : ARR; F, L : INTEGER; STR : STRING) IS OK : BOOLEAN := TRUE; BEGIN IF X'FIRST /= F AND X'LAST /= L THEN FAILED ( "INCORRECT RANGE FOR " & STR); ELSE FOR I IN F .. L LOOP IF X (I) /= Y (I) THEN OK := FALSE; END IF; END LOOP; IF NOT OK THEN FAILED ( "INCORRECT VALUE FOR " & STR); END IF; END IF; END CHECK; BEGIN C := (1 .. 4 => 1, 5 .. 9 => 2); CHECK (F (AR1, AR2, IDENT_INT (3)), C, 2, 8, "F - 1" ); CHECK (F (AR3, AR2, IDENT_INT (3)), C, 6, 9, "F - 2" ); CHECK (F (AR2, AR3, IDENT_INT (3)), C, 6, 6, "F - 3" ); C := (1 ..4 => 5, 5 .. 9 => 1); CHECK (G (5, AR1, IDENT_INT (3)), C, 1, 7, "G - 1" ); CHECK (G (5, AR3, IDENT_INT (3)), C, 1, 4, "G - 2" ); CHECK (H (AR3, 5, IDENT_INT (3)), C, 1, 4, "H - 1" ); C := (1 ..4 => 1, 5 .. 9 => 5); CHECK (H (AR1, 5, IDENT_INT (3)), C, 2, 8, "H - 2" ); END; RESULT; END C45344A;