1-- C48004F.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 FORM "NEW T" IS PERMITTED IF T IS AN ACCESS TYPE.
26
27-- RM  01/12/80
28-- JBG 03/03/83
29-- EG  07/05/84
30
31WITH REPORT;
32
33PROCEDURE C48004F  IS
34
35     USE REPORT;
36
37BEGIN
38
39     TEST("C48004F","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
40                    "IS AN ACCESS TYPE");
41
42     DECLARE
43
44          TYPE AINT IS ACCESS INTEGER;
45          TYPE A_AINT IS ACCESS AINT;
46          VA_AINT : A_AINT;
47
48          TYPE AST IS ACCESS STRING;
49          SUBTYPE CAST_4 IS AST(1 .. 4);
50          TYPE A_AST IS ACCESS AST;
51          TYPE ACAST_3 IS ACCESS AST(1 .. 3);
52          V_AAST : A_AST;
53          V_ACAST_3 : ACAST_3;
54
55          TYPE UR(A, B : INTEGER) IS
56               RECORD
57                    C : INTEGER;
58               END RECORD;
59          SUBTYPE CR IS UR(1, 2);
60          TYPE A_CR IS ACCESS CR;
61          TYPE AA_CR IS ACCESS A_CR;
62          V_AA_CR : AA_CR;
63
64     BEGIN
65
66          VA_AINT := NEW AINT;
67          IF VA_AINT.ALL /= NULL THEN
68               FAILED ("VARIABLE IS NOT NULL - CASE 1");
69          END IF;
70
71          BEGIN
72
73               V_ACAST_3 := NEW CAST_4;
74               IF V_ACAST_3.ALL /= NULL THEN
75                    FAILED ("VARIABLE IS NOT NULL - CASE 2");
76               END IF;
77
78          EXCEPTION
79
80               WHEN OTHERS =>
81                    FAILED ("EXCEPTION RAISED - CASE 2");
82
83          END;
84
85          V_AAST := NEW AST;
86          IF V_AAST.ALL /= NULL THEN
87               FAILED ("VARIABLE IS NOT NULL - CASE 3");
88          END IF;
89
90          V_AA_CR := NEW A_CR;
91          IF V_AA_CR.ALL /= NULL THEN
92               FAILED ("VARIABLE IS NOT NULL - CASE 4");
93          END IF;
94
95     END;
96
97     RESULT;
98
99END C48004F;
100