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