-- BC3404A.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 TYPES ARE NOT GENERIC FORMAL PARAMETERS.

-- SPS 6/9/82

PROCEDURE BC3404A 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 SREC IS REC;
     TYPE NREC IS NEW REC;
     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_B IS ARRAY (NATURAL) OF BOOLEAN;
     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_REC IS ARRAY (NATURAL) OF REC;
     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_NREC IS ARRAY (NATURAL) OF NREC;
     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 FT IS ARRAY (NATURAL) OF INTEGER;
     PACKAGE PAR_I IS END PAR_I;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF CHARACTER;
     PACKAGE PAR_C IS END PAR_C;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF PV;
     PACKAGE PAR_PV IS END PAR_PV;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF ARR;
     PACKAGE PAR_ARR IS END PAR_ARR;

     GENERIC
          TYPE FT IS ARRAY (NATURAL) OF REC;
     PACKAGE PAR_REC IS END PAR_REC;

     GENERIC 
          TYPE FT IS ARRAY (NATURAL) OF ACC;
     PACKAGE PAR_ACC IS END PAR_ACC;

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

     PACKAGE PAR_C1 IS NEW PAR_C (AR_C);          -- OK.
     PACKAGE PAR_C2 IS NEW PAR_C (AR_NC);         -- ERROR: AR_NC.

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

     PACKAGE PAR_ARR1 IS NEW PAR_ARR (AR_ARR);    -- OK.
     PACKAGE PAR_ARR2 IS NEW PAR_ARR (AR_SARR);   -- OK.
     PACKAGE PAR_ARR3 IS NEW PAR_ARR (AR_NARR);   -- ERROR: AR_NARR.

     PACKAGE PAR_REC1 IS NEW PAR_REC (AR_REC);    -- OK.
     PACKAGE PAR_REC2 IS NEW PAR_REC (AR_SREC);   -- OK.
     PACKAGE PAR_REC3 IS NEW PAR_REC (AR_NREC);   -- ERROR: AR_NREC.

     PACKAGE PAR_ACC1 IS NEW PAR_ACC (AR_ACC);    -- OK.
     PACKAGE PAR_ACC2 IS NEW PAR_ACC (AR_SACC);   -- OK.
     PACKAGE PAR_ACC3 IS NEW PAR_ACC (AR_NACC);   -- ERROR: AR_NACC.
     PACKAGE PAR_ACC4 IS NEW PAR_ACC (AR_AINT);   -- ERROR: AR_AINT.

BEGIN
     NULL;
END BC3404A;