Subversion Repositories openrisc_me

-- C432001.A

--

--                             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.

--*

--

-- OBJECTIVE:

--

--      Check that extension aggregates may be used to specify values

--      for types that are record extensions. Check that the

--      type of the ancestor expression may be any nonlimited type that

--      is a record extension, including private types and private

--      extensions. Check that the type for the aggregate is

--      derived from the type of the ancestor expression.

--

-- TEST DESCRIPTION:

--

--      Two progenitor nonlimited record types are declared, one

--      nonprivate and one private. Using these as parent types,

--      all possible combinations of record extensions are declared

--      (Nonprivate record extension of nonprivate type, private

--      extension of nonprivate type, nonprivate record extension of

--      private type, and private extension of private type). Finally,

--      each of these types is extended using nonprivate record

--      extensions.

--

--      Extension of private types is done in packages other than

--      the ones containing the parent declaration. This is done

--      to eliminate errors with extension of the partial view of

--      a type, which is not an objective of this test.

--

--      All components of private types and private extensions are given

--      default values. This eliminates the need for separate subprograms

--      whose sole purpose is to place a value into a private record type.

--

--      Types that have been extended are checked using an object of their

--      parent type as the ancestor expression. For those types that

--      have been extended twice, using only nonprivate record extensions,

--      a check is made using an object of their grandparent type as

--      the ancestor expression.

--

--      For each type, a subprogram is defined which checks the contents

--      of the parameter, which is a value of the record extension.

--      Components of nonprivate record extensions are checked against

--      passed-in parameters of the component type. Components of private

--      extensions are checked to ensure that they maintain their initial

--      values.

--

--      To check that the aggregate's type is derived from its ancestor,

--      each Check subprogram in turn calls the Check subprogram for

--      its parent type. Explicit conversion is used to convert the

--      record extension to the parent type.

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--

--!

with Report;

package C432001_0 is

   type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic);

   type N is tagged record

      How_Long_Ago : Natural := Report.Ident_Int(1);

      Era          : Eras := Cenozoic;

   end record;

   function Check (Rec : in N;

                   N   : in Natural;

                   E   : in Eras) return Boolean;

   type P is tagged private;

   function Check (Rec : in P) return Boolean;

private

   type P is tagged record

      How_Long_Ago : Natural := Report.Ident_Int(150);

      Era          : Eras := Mesozoic;

   end record;

end C432001_0;

package body C432001_0 is

   function Check (Rec : in P) return Boolean is

   begin

      return Rec.How_Long_Ago = 150 and Rec.Era = Mesozoic;

   end Check;

   function Check (Rec : in N;

                   N   : in Natural;

                   E   : in Eras) return Boolean is

   begin

      return Rec.How_Long_Ago = N and Rec.Era = E;

   end Check;

end C432001_0;

with C432001_0;

package C432001_1 is

   type Periods is

      (Aphebian, Helikian, Hadrynian,

       Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian,

       Triassic, Jurassic, Cretaceous,

       Tertiary, Quaternary);

   type N_N is new C432001_0.N with record

      Period : Periods := C432001_1.Quaternary;

   end record;

   function Check (Rec : in N_N;

                   N   : in Natural;

                   E   : in C432001_0.Eras;

                   P   : in Periods) return Boolean;

   type N_P is new C432001_0.N with private;

   function Check (Rec : in N_P) return Boolean;

   type P_N is new C432001_0.P with record

      Period : Periods := C432001_1.Jurassic;

   end record;

   function Check (Rec : in P_N;

                   P   : in Periods) return Boolean;

   type P_P is new C432001_0.P with private;

   function Check (Rec : in P_P) return Boolean;

   type P_P_Null is new C432001_0.P with null record;

private

   type N_P is new C432001_0.N with record

      Period : Periods := C432001_1.Quaternary;

   end record;

   type P_P is new C432001_0.P with record

      Period : Periods := C432001_1.Jurassic;

   end record;

end C432001_1;

with Report;

package body C432001_1 is

   function Check (Rec : in N_N;

                   N   : in Natural;

                   E   : in C432001_0.Eras;

                   P   : in Periods) return Boolean is

   begin

      if not C432001_0.Check (C432001_0.N (Rec), N, E) then

         Report.Failed ("Conversion to parent type of " &

                        "nonprivate portion of " &

                        "nonprivate extension failed");

      end if;

      return Rec.Period = P;

   end Check;

   function Check (Rec : in N_P) return Boolean is

   begin

      if not C432001_0.Check (C432001_0.N (Rec), 1, C432001_0.Cenozoic) then

         Report.Failed ("Conversion to parent type of " &

                        "nonprivate portion of " &

                        "private extension failed");

      end if;

      return Rec.Period = C432001_1.Quaternary;

   end Check;

   function Check (Rec : in P_N;

                   P   : in Periods) return Boolean is

   begin

      if not C432001_0.Check (C432001_0.P (Rec)) then

         Report.Failed ("Conversion to parent type of " &

                        "private portion of " &

                        "nonprivate extension failed");

      end if;

      return Rec.Period = P;

   end Check;

   function Check (Rec : in P_P) return Boolean is

   begin

      if not C432001_0.Check (C432001_0.P (Rec)) then

         Report.Failed ("Conversion to parent type of " &

                        "private portion of " &

                        "private extension failed");

      end if;

      return Rec.Period = C432001_1.Jurassic;

   end Check;

end C432001_1;

with C432001_0;

with C432001_1;

package C432001_2 is

   -- All types herein are nonprivate extensions, since aggregates

   -- cannot be given for private extensions

   type N_N_N is new C432001_1.N_N with record

      Sample_On_Loan : Boolean;

   end record;

   function Check (Rec : in N_N_N;

                   N   : in Natural;

                   E   : in C432001_0.Eras;

                   P   : in C432001_1.Periods;

                   B   : in Boolean) return Boolean;

   type N_P_N is new C432001_1.N_P with record

      Sample_On_Loan : Boolean;

   end record;

   function Check (Rec : in N_P_N;

                   B   : Boolean) return Boolean;

   type P_N_N is new C432001_1.P_N with record

      Sample_On_Loan : Boolean;

   end record;

   function Check (Rec : in P_N_N;

                   P   : in C432001_1.Periods;

                   B   : Boolean) return Boolean;

   type P_P_N is new C432001_1.P_P with record

      Sample_On_Loan : Boolean;

   end record;

   function Check (Rec : in P_P_N;

                   B   : Boolean) return Boolean;

end C432001_2;

with Report;

package body C432001_2 is

   -- direct access to operator

   use type C432001_1.Periods;

   function Check (Rec : in N_N_N;

                   N   : in Natural;

                   E   : in C432001_0.Eras;

                   P   : in C432001_1.Periods;

                   B   : in Boolean) return Boolean is

   begin

      if not C432001_1.Check (C432001_1.N_N (Rec), N, E, P) then

         Report.Failed ("Conversion to parent " &

                        "nonprivate type extension " &

                        "failed");

      end if;

      return Rec.Sample_On_Loan = B;

   end Check;

   function Check (Rec : in N_P_N;

                   B   : Boolean) return Boolean is

   begin

      if not C432001_1.Check (C432001_1.N_P (Rec)) then

         Report.Failed ("Conversion to parent " &

                        "private type extension " &

                        "failed");

      end if;

      return Rec.Sample_On_Loan = B;

   end Check;

   function Check (Rec : in P_N_N;

                   P   : in C432001_1.Periods;

                   B   : Boolean) return Boolean is

   begin

      if not C432001_1.Check (C432001_1.P_N (Rec), P) then

         Report.Failed ("Conversion to parent " &

                        "nonprivate type extension " &

                        "failed");

      end if;

      return Rec.Sample_On_Loan = B;

   end Check;

   function Check (Rec : in P_P_N;

                   B   : Boolean) return Boolean is

   begin

      if not C432001_1.Check (C432001_1.P_P (Rec)) then

         Report.Failed ("Conversion to parent " &

                        "private type extension " &

                        "failed");

      end if;

      return Rec.Sample_On_Loan = B;

   end Check;

end C432001_2;

with C432001_0;

with C432001_1;

with C432001_2;

with Report;

procedure C432001 is

   N_Object : C432001_0.N := (How_Long_Ago => Report.Ident_Int(375),

                              Era          => C432001_0.Paleozoic);

   P_Object : C432001_0.P; -- default value is (150,

                           --                   C432001_0.Mesozoic)

   N_N_Object : C432001_1.N_N :=

      (N_Object with Period => C432001_1.Devonian);

   P_N_Object : C432001_1.P_N :=

      (P_Object with Period => C432001_1.Jurassic);

   N_P_Object : C432001_1.N_P; -- default is (1,

                               --             C432001_0.Cenozoic,

                               --             C432001_1.Quaternary)

   P_P_Object : C432001_1.P_P; -- default is (150,

                               --             C432001_0.Mesozoic,

                               --             C432001_1.Jurassic)

   P_P_Null_Ob:C432001_1.P_P_Null := (P_Object with null record);

   N_N_N_Object : C432001_2.N_N_N :=

      (N_N_Object with Sample_On_Loan => Report.Ident_Bool(True));

   N_P_N_Object : C432001_2.N_P_N :=

      (N_P_Object with Sample_On_Loan => Report.Ident_Bool(False));

   P_N_N_Object : C432001_2.P_N_N :=

      (P_N_Object with Sample_On_Loan => Report.Ident_Bool(True));

   P_P_N_Object : C432001_2.P_P_N :=

      (P_P_Object with Sample_On_Loan => Report.Ident_Bool(False));

   P_N_Object_2 : C432001_1.P_N := (C432001_0.P(P_N_N_Object)

                                    with C432001_1.Carboniferous);

   N_N_Object_2 : C432001_1.N_N := (C432001_0.N'(42,C432001_0.Precambrian)

                                    with C432001_1.Carboniferous);

begin

   Report.Test ("C432001", "Extension aggregates");

   -- check ultimate ancestor types

   if not C432001_0.Check (N_Object,

                           375,

                           C432001_0.Paleozoic) then

      Report.Failed ("Object of " &

                     "nonprivate type " &

                     "failed content check");

   end if;

   if not C432001_0.Check (P_Object) then

      Report.Failed ("Object of " &

                     "private type " &

                     "failed content check");

   end if;

   -- check direct type extensions

   if not C432001_1.Check (N_N_Object,

                           375,

                           C432001_0.Paleozoic,

                           C432001_1.Devonian) then

      Report.Failed ("Object of " &

                     "nonprivate extension of nonprivate type " &

                     "failed content check");

   end if;

   if not C432001_1.Check (N_P_Object) then

      Report.Failed ("Object of " &

                     "private extension of nonprivate type " &

                     "failed content check");

   end if;

   if not C432001_1.Check (P_N_Object,

                           C432001_1.Jurassic) then

      Report.Failed ("Object of " &

                     "nonprivate extension of private type " &

                     "failed content check");

   end if;

   if not C432001_1.Check (P_P_Object) then

      Report.Failed ("Object of " &

                     "private extension of private type " &

                     "failed content check");

   end if;

    if not C432001_1.Check (P_P_Null_Ob) then

      Report.Failed ("Object of " &

                     "private type " &

                     "failed content check");

   end if;

   -- check direct extensions of extensions

   if not C432001_2.Check (N_N_N_Object,

                           375,

                           C432001_0.Paleozoic,

                           C432001_1.Devonian,

                           True) then

      Report.Failed ("Object of " &

                     "nonprivate extension of nonprivate extension " &

                     "(of nonprivate parent) " &

                     "failed content check");

   end if;

   if not C432001_2.Check (N_P_N_Object, False) then

      Report.Failed ("Object of " &

                     "nonprivate extension of private extension " &

                     "(of nonprivate parent) " &

                     "failed content check");

   end if;

   if not C432001_2.Check (P_N_N_Object,

                           C432001_1.Jurassic,

                           True) then

      Report.Failed ("Object of " &

                     "nonprivate extension of nonprivate extension " &

                     "(of private parent) " &

                     "failed content check");

   end if;

   if not C432001_2.Check (P_P_N_Object, False) then

      Report.Failed ("Object of " &

                     "nonprivate extension of private extension " &

                     "(of private parent) " &

                     "failed content check");

   end if;

   -- check that the extension aggregate may specify an expression of

   -- a "grandparent" ancestor type

   -- types tested are derived through nonprivate extensions only

   -- (extension aggregates are not allowed if the path from the

   -- ancestor type wanders through a private extension)

   N_N_N_Object :=

      (N_Object with Period => C432001_1.Devonian,

                     Sample_On_Loan => Report.Ident_Bool(True));

   if not C432001_2.Check (N_N_N_Object,

                           375,

                           C432001_0.Paleozoic,

                           C432001_1.Devonian,

                           True) then

      Report.Failed ("Object of " &

                     "nonprivate extension " &

                     "of nonprivate ancestor " &

                     "failed content check");

   end if;

   P_N_N_Object :=

      (P_Object with Period => C432001_1.Jurassic,

                     Sample_On_Loan => Report.Ident_Bool(True));

   if not C432001_2.Check (P_N_N_Object,

                           C432001_1.Jurassic,

                           True) then

      Report.Failed ("Object of " &

                     "nonprivate extension " &

                     "of private ancestor " &

                     "failed content check");

   end if;

  -- Check additional cases

   if not C432001_1.Check (P_N_Object_2,

                           C432001_1.Carboniferous) then

      Report.Failed ("Additional Object of " &

                     "nonprivate extension of private type " &

                     "failed content check");

   end if;

   if not C432001_1.Check (N_N_Object_2,

                           42,

                           C432001_0.Precambrian,

                           C432001_1.Carboniferous) then

      Report.Failed ("Additional Object of " &

                     "nonprivate extension of nonprivate type " &

                     "failed content check");

   end if;

   Report.Result;

end C432001;