-- BC3405D.ADA

--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
-- CHECK THAT THE COMPONENT TYPE OF A GENERIC FORMAL TYPE AND THE ACTUAL
-- ARRAY TYPE MUST BE EITHER CONSTRAINED OR UNCONSTRAINED.

-- CHECK WHEN THE COMPONENT TYPE IS AN ACCESS TYPE DESIGNATING OBJECTS
-- OF AN ARRAY TYPE OR OF A TYPE WITH DISCRIMINANTS.

-- CHECK WHEN THE COMPONENT TYPE IS NOT A GENERIC FORMAL PARAMETER.

-- SPS 6/28/82
-- SPS 2/22/83

PROCEDURE BC3405D IS

     TYPE REC (D: INTEGER := 3) IS RECORD NULL; END RECORD;

     PACKAGE PRIV IS
          TYPE PV (D: INTEGER) IS PRIVATE;
          TYPE LP (D: INTEGER := 3) IS LIMITED PRIVATE;
     PRIVATE
          TYPE PV (D: INTEGER) IS RECORD NULL; END RECORD;
          TYPE LP (D: INTEGER := 3) IS RECORD NULL; END RECORD;
     END PRIV;
     USE PRIV;
     
     TYPE AST IS ACCESS STRING;
     SUBTYPE ASTC IS AST(1..3);

     TYPE AREC IS ACCESS REC;
     SUBTYPE ARECC IS AREC(D => 3);

     TYPE APV IS ACCESS PV;
     SUBTYPE APVC IS APV(D => 3);

     TYPE ALP IS ACCESS LP;
     SUBTYPE ALPC IS ALP(D => 3);

     SUBTYPE NATURAL IS INTEGER RANGE 1..INTEGER'LAST;

     TYPE AR_AST   IS ARRAY (NATURAL) OF AST;
     TYPE AR_ASTC  IS ARRAY (NATURAL) OF ASTC;
     TYPE AR_AREC  IS ARRAY (NATURAL) OF AREC;
     TYPE AR_ARECC IS ARRAY (NATURAL) OF ARECC;
     TYPE AR_APV   IS ARRAY (NATURAL) OF APV;
     TYPE AR_APVC  IS ARRAY (NATURAL) OF APVC;
     TYPE AR_ALP   IS ARRAY (NATURAL) OF ALP;
     TYPE AR_ALPC  IS ARRAY (NATURAL) OF ALPC;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF AST;
     PACKAGE PAST IS END PAST;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF ASTC;
     PACKAGE PASTC IS END PASTC;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF AREC;
     PACKAGE PAREC IS END PAREC;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF ARECC;
     PACKAGE PARECC IS END PARECC;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF APV;
     PACKAGE PAPV IS END PAPV;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF ALP;
     PACKAGE PALP IS END PALP;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF APVC;
     PACKAGE PAPVC IS END PAPVC;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF ALPC;
     PACKAGE PALPC IS END PALPC;

     PACKAGE PAST1 IS NEW PAST(AR_AST);       -- OK.
     PACKAGE PAST2 IS NEW PAST(AR_ASTC);      -- ERROR: AR_ASTC.

     PACKAGE PASTC1 IS NEW PASTC(AR_AST);     -- ERROR: AR_AST.
     PACKAGE PASTC2 IS NEW PASTC(AR_ASTC);    -- OK.

     PACKAGE PAREC1 IS NEW PAREC(AR_AREC);    -- OK.
     PACKAGE PAREC2 IS NEW PAREC(AR_ARECC);   -- ERROR: AR_ARECC.

     PACKAGE PARECC1 IS NEW PARECC(AR_AREC);  -- ERROR: AR_AREC.
     PACKAGE PARECC2 IS NEW PARECC(AR_ARECC); -- OK.

     PACKAGE PAPV1 IS NEW PAPV(AR_APV);       -- OK.
     PACKAGE PAPV2 IS NEW PAPV(AR_APVC);      -- ERROR: AR_APVC.

     PACKAGE PAPVC1 IS NEW PAPVC(AR_APV);     -- ERROR: AR_APV.
     PACKAGE PAPVC2 IS NEW PAPVC(AR_APVC);    -- OK.

     PACKAGE PALP1 IS NEW PALP(AR_ALP);       -- OK.
     PACKAGE PALP2 IS NEW PALP(AR_ALPC);      -- ERROR: AR_ALPC.

     PACKAGE PALPC1 IS NEW PALPC(AR_ALP);     -- ERROR: AR_ALP.
     PACKAGE PALPC2 IS NEW PALPC(AR_ALPC);    -- OK.

BEGIN
     NULL;
END BC3405D;