-- BC3404B.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 BASE TYPE OF A GENERIC ARRAY TYPE PARAMETER
-- MUST BE THE SAME AS THE COMPONENT BASE TYPE OF THE ACTUAL PARAMETER.

-- TEST INTEGER, ENUMERATION, ARRAY, RECORD, PRIVATE, LIMITED PRIVATE,
-- AND ACCESS TYPES AS THE COMPONENT TYPES.
-- NOTE: FIXED, FLOAT, AND TASK TYPES ARE COVERED IN OTHER TESTS.

-- CHECK WHEN THE COMPONENT TYPE OF THE FORMAL ARRAY TYPE IS A GENERIC 
-- FORMAL PARAMETER DECLARED IN THE SAME FORMAL PART.

-- SPS 6/22/82
-- JBG 5/5/83

PROCEDURE BC3404B IS

     SUBTYPE INT IS INTEGER;
     TYPE NI IS NEW INTEGER;
     TYPE NC IS NEW CHARACTER;
     TYPE ARR IS ARRAY (INTEGER) OF INT;
     SUBTYPE SARR IS ARR;
     TYPE NARR IS NEW ARR;
     TYPE REC (D: INTEGER := 3) IS RECORD NULL; END RECORD;
     SUBTYPE CREC IS REC(3);
     SUBTYPE SREC IS CREC;
     TYPE NCREC IS NEW REC(3);
     PACKAGE PRIV IS
          TYPE PV IS PRIVATE;
          TYPE LP IS PRIVATE;
     PRIVATE
          TYPE PV IS NEW INTEGER;
          TYPE LP IS NEW NI;
     END PRIV;
     USE PRIV;
     TYPE NPV IS NEW PV;
     TYPE NLP IS NEW LP;
     SUBTYPE SPV IS PV;
     SUBTYPE SLP IS LP;
     TYPE ACC IS ACCESS INTEGER;
     TYPE AINT IS ACCESS INT;
     SUBTYPE SACC IS ACC;
     TYPE NACC IS NEW ACC;
     SUBTYPE NATURAL IS INTEGER RANGE 1..INTEGER'LAST;

     TYPE AR_I IS ARRAY (NATURAL) OF INTEGER;
     TYPE AR_INT IS ARRAY (NATURAL) OF INT;
     TYPE AR_NI IS ARRAY (NATURAL) OF NI;
     TYPE AR_C IS ARRAY (NATURAL) OF CHARACTER;
     TYPE AR_NC IS ARRAY (NATURAL) OF NC;
     TYPE AR_ARR IS ARRAY (NATURAL) OF ARR;
     TYPE AR_CREC IS ARRAY (NATURAL) OF CREC;
     TYPE AR_PV IS ARRAY (NATURAL) OF PV;
     TYPE AR_LP IS ARRAY (NATURAL) OF LP;
     TYPE AR_ACC IS ARRAY (NATURAL) OF ACC;
     TYPE AR_SARR IS ARRAY (NATURAL) OF SARR;
     TYPE AR_NARR IS ARRAY (NATURAL) OF NARR;
     TYPE AR_SREC IS ARRAY (NATURAL) OF SREC;
     TYPE AR_NCREC IS ARRAY (NATURAL) OF NCREC;
     TYPE AR_NPV IS ARRAY (NATURAL) OF NPV;
     TYPE AR_NLP IS ARRAY (NATURAL) OF NLP;
     TYPE AR_SPV IS ARRAY (NATURAL) OF SPV;
     TYPE AR_SLP IS ARRAY (NATURAL) OF SLP;
     TYPE AR_AINT IS ARRAY (NATURAL) OF AINT;
     TYPE AR_SACC IS ARRAY (NATURAL) OF SACC;
     TYPE AR_NACC IS ARRAY (NATURAL) OF NACC;

     GENERIC
          TYPE T IS PRIVATE;
          TYPE FT IS ARRAY (NATURAL) OF T;
     PACKAGE P IS END P;

     PACKAGE PAR_I1 IS NEW P (INTEGER, AR_I);     -- OK.
     PACKAGE PAR_I2 IS NEW P (INTEGER, AR_INT);   -- OK.
     PACKAGE PAR_I3 IS NEW P (INTEGER, AR_NI);    -- ERROR: AR_NI.
     PACKAGE PAR_I4 IS NEW P (INTEGER, AR_PV);    -- ERROR: AR_PV.
     PACKAGE PAR_I5 IS NEW P (INTEGER, AR_LP);    -- ERROR: AR_LP.

     PACKAGE PAR_C1 IS NEW P (CHARACTER, AR_C);   -- OK.
     PACKAGE PAR_C2 IS NEW P (CHARACTER, AR_NC);  -- ERROR: AR_NC.

     PACKAGE PAR_PV1 IS NEW P (PV, AR_PV);        -- OK.
     PACKAGE PAR_PV2 IS NEW P (PV, AR_LP);        -- ERROR: AR_LP.
     PACKAGE PAR_PV3 IS NEW P (PV, AR_NPV);       -- ERROR: AR_NPV.
     PACKAGE PAR_PV4 IS NEW P (PV, AR_NLP);       -- ERROR: AR_NLP.
     PACKAGE PAR_PV5 IS NEW P (PV, AR_I);         -- ERROR: AR_I.
     PACKAGE PAR_PV6 IS NEW P (PV, AR_NI);        -- ERROR: AR_NI.
     PACKAGE PAR_PV7 IS NEW P (PV, AR_SPV);       -- OK.
     PACKAGE PAR_PV8 IS NEW P (PV, AR_SLP);       -- ERROR: AR_SLP.

     PACKAGE PAR_ARR1 IS NEW P (ARR, AR_ARR);     -- 0K.
     PACKAGE PAR_ARR2 IS NEW P (ARR, AR_SARR);    -- 0K.
     PACKAGE PAR_ARR3 IS NEW P (ARR, AR_NARR);    -- ERROR: AR_NARR.

     PACKAGE PAR_REC1 IS NEW P (CREC, AR_CREC);   -- 0K.
     PACKAGE PAR_REC2 IS NEW P (CREC, AR_SREC);   -- 0K.
     PACKAGE PAR_REC3 IS NEW P (CREC, AR_NCREC);  -- ERROR: AR_NCREC.

     PACKAGE PAR_ACC1 IS NEW P (ACC, AR_ACC);     -- 0K.
     PACKAGE PAR_ACC2 IS NEW P (ACC, AR_SACC);    -- 0K.
     PACKAGE PAR_ACC3 IS NEW P (ACC, AR_NACC);    -- ERROR: AR_NACC.
     PACKAGE PAR_ACC4 IS NEW P (ACC, AR_AINT);    -- ERROR: AR_AINT.

BEGIN
     NULL;
END BC3404B;