1-- C48004D.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 A RECORD, PRIVATE,
26-- OR LIMITED TYPE WITHOUT DISCRIMINANTS.
27
28-- RM  01/12/80
29-- JBG 03/03/83
30-- EG  07/05/84
31
32WITH REPORT;
33
34PROCEDURE C48004D IS
35
36     USE REPORT;
37
38BEGIN
39
40     TEST("C48004D","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
41                    "IS A RECORD, PRIVATE, OR LIMITED TYPE WITHOUT " &
42                    "DISCRIMINANTS");
43
44     DECLARE
45
46          TYPE  TC  IS
47               RECORD
48                    C : INTEGER := 18;
49               END RECORD;
50          TYPE ATC IS ACCESS TC;
51          VC : ATC;
52
53          PACKAGE  P  IS
54               TYPE   PRIV  IS PRIVATE;
55               TYPE  LPRIV  IS LIMITED PRIVATE;
56               TYPE A_PRIV  IS  ACCESS PRIV;
57               TYPE A_LPRIV  IS  ACCESS LPRIV;
58               PROCEDURE   CHECK( X: A_PRIV  );
59               PROCEDURE  LCHECK( X: A_LPRIV );
60               PROCEDURE LRCHECK( X: LPRIV );
61          PRIVATE
62               TYPE   PRIV  IS
63                    RECORD
64                         Q : INTEGER := 19;
65                    END RECORD;
66               TYPE  LPRIV  IS
67                    RECORD
68                         Q : INTEGER := 20;
69                    END RECORD;
70          END P;
71
72
73          VP  :  P.A_PRIV;
74          VLP : P.A_LPRIV;
75
76          TYPE LCR IS
77               RECORD
78                    C : P.LPRIV;
79               END RECORD;
80          TYPE A_LCR IS ACCESS LCR;
81          VLCR : A_LCR;
82
83          PACKAGE BODY  P  IS
84
85               PROCEDURE  CHECK( X: A_PRIV )  IS
86               BEGIN
87                    IF  X.Q /= 19  THEN  FAILED( "WRONG VALUES - C2" );
88                    END IF;
89               END CHECK;
90
91               PROCEDURE  LCHECK( X: A_LPRIV )  IS
92               BEGIN
93                    IF  X.Q /= 20  THEN  FAILED( "WRONG VALUES - C3" );
94                    END IF;
95               END LCHECK;
96
97               PROCEDURE LRCHECK (X : LPRIV) IS
98               BEGIN
99                    IF X.Q /= 20 THEN
100                         FAILED ("WRONG VALUES - C4");
101                    END IF;
102               END LRCHECK;
103
104          END P;
105
106     BEGIN
107
108          VC  :=  NEW TC;
109          IF  VC.C /= 18  THEN FAILED( "WRONG VALUES  -  C1" );
110          END IF;
111
112          VP  :=  NEW P.PRIV;
113          P.CHECK( VP );
114          VLP :=  NEW P.LPRIV;
115          P.LCHECK( VLP );
116
117          VLCR := NEW LCR;
118          P.LRCHECK( VLCR.ALL.C );
119
120     END;
121
122     RESULT;
123
124END C48004D;
125