1-- C48006A.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 AN ALLOCATOR OF THE FORM "NEW T'(X)" ALLOCATES A NEW
26-- OBJECT EACH TIME IT IS EXECUTED AND THAT IF T IS A SCALAR OR ACCESS
27-- TYPE, THE ALLOCATED OBJECT HAS THE VALUE OF X.
28
29-- RM  01/14/80
30-- RM  01/O1/82
31-- SPS 10/27/82
32-- EG  07/05/84
33
34WITH REPORT;
35
36PROCEDURE C48006A IS
37
38     USE REPORT;
39
40BEGIN
41
42     TEST("C48006A","CHECK THAT THE FORM 'NEW T'(X)' " &
43                    "ALLOCATES A NEW OBJECT " &
44                    "AND THAT IF T IS A SCALAR OR ACCESS TYPE, THE "   &
45                    "ALLOCATED OBJECT HAS THE VALUE OF X");
46
47     DECLARE
48
49          TYPE ATA IS ACCESS INTEGER;
50          TYPE AATA IS ACCESS ATA;
51          VA1, VA2, VA3 : ATA;
52          VAA1, VAA2, VAA3 : AATA;
53
54     BEGIN
55
56          VA1 := NEW INTEGER'(5 + 7);
57          IF VA1.ALL /= IDENT_INT(12) THEN
58               FAILED("WRONG VALUES - VA1");
59          END IF;
60
61          VA2 := NEW INTEGER'(1 + 2);
62          IF (VA1.ALL /= IDENT_INT(12) OR
63              VA2.ALL /= IDENT_INT( 3)) THEN
64               FAILED("WRONG VALUES - VA2");
65          END IF;
66
67          VA3 := NEW INTEGER'(IDENT_INT(3) + IDENT_INT(4));
68          IF (VA1.ALL /= IDENT_INT(12) OR
69              VA2.ALL /= IDENT_INT( 3) OR
70              VA3.ALL /= IDENT_INT( 7)) THEN
71               FAILED("WRONG VALUES - VA3");
72          END IF;
73
74          VAA1 := NEW ATA'(NEW INTEGER'(3));
75          IF VAA1.ALL.ALL /= IDENT_INT(3) THEN
76               FAILED ("WRONG VALUES - VAA1");
77          END IF;
78
79          VAA2 := NEW ATA'(NEW INTEGER'(IDENT_INT(5)));
80          IF (VAA1.ALL.ALL /= 3 OR
81              VAA2.ALL.ALL /= 5 ) THEN
82               FAILED ("WRONG VALUES - VAA2");
83          END IF;
84
85          VAA3 := NEW ATA'(NEW INTEGER'(IDENT_INT(6)));
86          IF (VAA1.ALL.ALL /= 3 OR
87              VAA2.ALL.ALL /= 5 OR
88              VAA3.ALL.ALL /= 6 ) THEN
89               FAILED ("WRONG VALUES - VAA3");
90          END IF;
91
92     END;
93
94     RESULT;
95
96END C48006A;
97