1-- C48011A.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-- OBJECTIVE:
26--     CHECK THAT OVERLOADED ALLOCATORS ARE DETERMINED TO HAVE THE
27--     APPROPRIATE TYPE.
28
29-- HISTORY:
30--     JET 08/17/88  CREATED ORIGINAL TEST.
31
32WITH REPORT; USE REPORT;
33PROCEDURE C48011A IS
34
35     TYPE ACC1 IS ACCESS INTEGER;
36     TYPE ACC2 IS ACCESS INTEGER;
37
38     A1 : ACC1 := NULL;
39     A2 : ACC2 := NULL;
40
41     TYPE REC1 IS RECORD
42          A : INTEGER;
43     END RECORD;
44
45     TYPE REC2 IS RECORD
46          A : ACC2;
47     END RECORD;
48
49     TYPE AREC1 IS ACCESS REC1;
50     TYPE AREC2 IS ACCESS REC2;
51
52     PROCEDURE PROC(A : ACC1) IS
53     BEGIN
54          IF A.ALL /= 1 THEN
55               FAILED("INCORRECT CALL OF FIRST PROC");
56          END IF;
57     END PROC;
58
59     PROCEDURE PROC(A : INTEGER) IS
60     BEGIN
61          IF A /= 2 THEN
62               FAILED("INCORRECT CALL OF SECOND PROC");
63          END IF;
64     END PROC;
65
66     FUNCTION FUNC(I : INTEGER) RETURN AREC1 IS
67     BEGIN
68          IF I /= 1 THEN
69               FAILED("INCORRECT CALL OF FIRST FUNC");
70          END IF;
71          RETURN NEW REC1'(A => 0);
72     END FUNC;
73
74     FUNCTION FUNC(I : INTEGER) RETURN AREC2 IS
75     BEGIN
76          IF I /= 2 THEN
77               FAILED("INCORRECT CALL OF SECOND FUNC");
78          END IF;
79          RETURN NEW REC2'(A => NULL);
80     END FUNC;
81
82BEGIN
83     TEST ("C48011A", "CHECK THAT OVERLOADED ALLOCATORS ARE " &
84                      "DETERMINED TO HAVE THE APPROPRIATE TYPE");
85
86     IF A1 = NEW INTEGER'(1) THEN
87          FAILED("INCORRECT RETURN VALUE FROM ALLOCATOR 1");
88     END IF;
89
90     IF A2 = NEW INTEGER'(2) THEN
91          FAILED("INCORRECT RETURN VALUE FROM ALLOCATOR 2");
92     END IF;
93
94     FUNC(1).A := INTEGER'(1);
95     FUNC(IDENT_INT(2)).A := NEW INTEGER'(2);
96
97     PROC(NEW INTEGER'(IDENT_INT(1)));
98     PROC(IDENT_INT(2));
99
100     RESULT;
101END C48011A;
102