Subversion Repositories openrisc_me

-- C432003.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 if the type of the ancestor part of an extension aggregate

--      has discriminants that are not inherited by the type of the aggregate,

--      and the ancestor part is a subtype mark that denotes a constrained

--      subtype, Constraint_Error is raised if: 1) any discriminant of the

--      ancestor has a different value than that specified for a corresponding

--      discriminant in the derived type definition for some ancestor of the

--      type of the aggregate, or 2) the value for the discriminant in the

--      record association list is not the value of the corresponding

--      discriminant.  Check that the components of the value of the

--      aggregate not given by the record component association list are

--      initialized by default as for an object of the ancestor type.

--

-- TEST DESCRIPTION:

--      Consider:

--

--      type T (D1: ...) is tagged ...

--

--      type    DT is new T with ...

--      subtype ST is DT (D1 => 3);    -- Constrained subtype.

--

--      type NT1 (D2: ...) is new DT (D1 => D2) with null record;

--      type NT2 (D2: ...) is new DT (D1 => 6)  with null record;

--      type NT3           is new DT (D1 => 6)  with null record;

--

--      A: NT1 := (T  with D2 => 6); -- OK: T  is unconstrained.

--      B: NT1 := (DT with D2 => 6); -- OK: DT is unconstrained.

--      C: NT1 := (ST with D2 => 6); -- NO: ST.D1 /= D2.

--

--      D: NT2 := (T  with D2 => 4); -- OK: T  is unconstrained.

--      E: NT2 := (DT with D2 => 4); -- OK: DT is unconstrained.

--      F: NT2 := (ST with  . . . ); -- NO: ST.D1 /= DT.D1 as specified in NT2.

--

--      G: NT3 := (T  with D1 => 6); -- OK: T  is unconstrained.

--      H: NT3 := (DT with D1 => 6); -- OK: DT is unconstrained.

--      I: NT3 := (ST with D1 => 6); -- NO: ST.D1 /= DT.D1 as specified in NT3.

--

--      In A, B, D, E, G, and H the ancestor part is the name of an

--      unconstrained subtype, so this rule does not apply. In C, F, and I

--      the ancestor part (ST) is the name of a constrained subtype of DT,

--      which is itself a derived type of a discriminated tagged type T. ST

--      constrains the discriminant of DT (D1) to the value 3; thus, the

--      type of any extension aggregate for which ST is the ancestor part

--      must have an ancestor which also constrained D1 to 3. F and I raise

--      Constraint_Error because NT2 and NT3, respectively, constrain D1 to

--      6. C raises Constraint_Error because NT1 constrains D1 to the value

--      of D2, which is set to 6 in the record component association list of

--      the aggregate.

--

--      This test verifies each of the three scenarios above:

--

--         (1) Ancestor of type of aggregate constrains discriminant with

--             new discriminant.

--         (2) Ancestor of type of aggregate constrains discriminant with

--             value, and has a new discriminant part.

--         (3) Ancestor of type of aggregate constrains discriminant with

--             value, and has no discriminant part.

--

--      Verification is made for cases where the type of the aggregate is

--      once- and twice-removed from the type of the ancestor part.

--

--      Additionally, a case is included where a new discriminant corresponds

--      to multiple discriminants of the type of the ancestor part.

--

--      To test the portion of the objective concerning "initialization by

--      default," the test verifies that, after a successful aggregate

--      assignment, components not assigned an explicit value by the aggregate

--      contain the default values for the corresponding components of the

--      ancestor type.

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--      15 Dec 94   SAIC    Removed discriminant defaults from tagged types.

--      17 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected subtype constraint

--                          for component NT_C3.Str2. Added missing component

--                          checks. Removed record component update from

--                          Avoid_Optimization. Fixed incorrect component

--                          checks.

--      02 Dec 95   SAIC    ACVC 2.0.1 fixes: Corrected Failed comment for

--                          Q case.

--

--!

package C432003_0 is

   Default_String : constant String := "This is a default string"; -- len = 24

   Another_String : constant String := "Another default string";   -- len = 22

   subtype Length is Natural range 0..255;

   type ROOT (D1 : Length) is tagged

      record

         S1  : String (1..D1) := Default_String(1..D1);

         Acc : Natural := 356;

      end record;

   procedure Avoid_Optimization (Rec : in out ROOT); -- Inherited by all type

                                                     -- extensions.

   type Unconstrained_Der is new ROOT with

      record

         Str1 : String(1..5) := "abcde";

      end record;

   subtype Constrained_Subtype is Unconstrained_Der (D1 => 10);

   type NT_A1 (D2 : Length) is new Unconstrained_Der (D1 => D2) with

      record

         S2 : String(1..D2);         -- Inherited discrim. constrained by

      end record;                    -- new discriminant.

   type NT_A2 (D3 : Length) is new NT_A1 (D2 => D3) with

      record

         S3 : String(1..D3);         -- Inherited discrim. constrained by

      end record;                    -- new discriminant.

   type NT_B1 (D2 : Length) is new Unconstrained_Der (D1 => 5) with

      record

         S2 : String(1..D2);         -- Inherited discrim. constrained by

      end record;                    -- explicit value.

   type NT_B2 (D3 : Length) is new NT_B1 (D2 => 10) with

      record

         S3 : String(1..D3);         -- Inherited discrim. constrained by

      end record;                    -- explicit value.

   type NT_B3 (D2 : Length) is new Unconstrained_Der (D1 => 10) with

      record

         S2 : String(1..D2);

      end record;

   type NT_C1 is new Unconstrained_Der (D1 => 5) with

      record

         Str2 : String(1..5);         -- Inherited discrim. constrained

      end record;                     -- No new value.

   type NT_C2 (D2 : Length) is new NT_C1 with

      record

         S2 : String(1..D2);          -- Inherited discrim. not further

      end record;                     -- constrained, new discriminant.

   type NT_C3 is new Unconstrained_Der(D1 => 10) with

      record

         Str2 : String(1..5);

      end record;

   type MULTI_ROOT (D1 : Length; D2 : Length) is tagged

      record

         S1 : String (1..D1) := Default_String(1..D1);

         S2 : String (1..D2) := Another_String(1..D2);

      end record;

   procedure Avoid_Optimization (Rec : in out MULTI_ROOT); -- Inherited by all

                                                           -- type extensions.

   type Mult_Unconstr_Der is new MULTI_ROOT with

      record

         Str1 : String(1..8) := "AbCdEfGh";  -- Derived, no constraints.

      end record;

   -- Subtypes with constrained discriminants.

   subtype Mult_Constr_Sub1 is Mult_Unconstr_Der(D1 => 15,  -- Disc. have

                                                 D2 => 20); -- diff values

   subtype Mult_Constr_Sub2 is Mult_Unconstr_Der(D1 => 15,  -- Disc. have

                                                 D2 => 15); -- same value

   type Mult_NT_A1 (D3 : Length) is

     new Mult_Unconstr_Der (D1 => D3, D2 => D3) with

      record

         S3 : String(1..D3);      -- Both inherited discriminants constrained

      end record;                 -- by new discriminant.

end C432003_0;

   --=====================================================================--

with Report;

package body C432003_0 is

   procedure Avoid_Optimization (Rec : in out ROOT) is

   begin

      Rec.S1 := Report.Ident_Str(Rec.S1);

   end Avoid_Optimization;

   procedure Avoid_Optimization (Rec : in out MULTI_ROOT) is

   begin

      Rec.S1 := Report.Ident_Str(Rec.S1);

   end Avoid_Optimization;

end C432003_0;

   --=====================================================================--

with C432003_0;

with Report;

procedure C432003 is

begin

   Report.Test("C432003", "Extension aggregates where ancestor part "      &

                          "is a subtype mark that denotes a constrained "  &

                          "subtype causing Constraint_Error if any "       &

                          "discriminant of the ancestor has a different "  &

                          "value than that specified for a corresponding " &

                          "discriminant in the derived type definition "   &

                          "for some ancestor of the type of the aggregate");

   Test_Block:

      declare

         -- Variety of string object declarations.

         String2  : String(1..2)  := Report.Ident_Str("12");

         String5  : String(1..5)  := Report.Ident_Str("12345");

         String8  : String(1..8)  := Report.Ident_Str("AbCdEfGh");

         String10 : String(1..10) := Report.Ident_Str("1234567890");

         String15 : String(1..15) := Report.Ident_Str("123456789012345");

         String20 : String(1..20) := Report.Ident_Str("12345678901234567890");

      begin

         begin

            declare

               A : C432003_0.NT_A1 :=                                  -- OK

                     (C432003_0.ROOT with D2   => 5,

                                          Str1 => "cdefg",

                                          S2   => String5);

            begin

               C432003_0.Avoid_Optimization(A);

               if A.Acc  /= 356       or

                  A.Str1 /= "cdefg"   or

                  A.S2   /= String5   or

                  A.D2   /= 5         or

                  A.S1   /= C432003_0.Default_String(1..5)

               then

                  Report.Failed("Incorrect object values for Object A");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object A");

         end;

         begin

            declare

               C: C432003_0.NT_A1 :=                                   -- OK

                    (C432003_0.Constrained_Subtype with D2 => 10,

                                                        S2 => String10);

            begin

               C432003_0.Avoid_Optimization(C);

               if C.D2   /= 10        or  C.Acc /= 356      or

                  C.Str1 /= "abcde"   or  C.S2  /= String10 or

                  C.S1   /= C432003_0.Default_String(1..10)

               then

                  Report.Failed("Incorrect object values for Object C");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object C");

         end;

         begin

            declare

               D: C432003_0.NT_A1 :=                                  -- C_E

                    (C432003_0.Constrained_Subtype with

                       D2 => Report.Ident_Int(5),

                       S2 => String5);

            begin

               C432003_0.Avoid_Optimization(D);

               Report.Failed("Constraint_Error not raised for Object D");

            end;

         exception

            when Constraint_Error =>

               null;  -- Raise of Constraint_Error is expected.

         end;

         begin

            declare

               E: C432003_0.NT_A2 :=                                   -- OK

                    (C432003_0.Constrained_Subtype with D3 => 10,

                                                        S2 => String10,

                                                        S3 => String10);

            begin

               C432003_0.Avoid_Optimization(E);

               if E.D3   /= 10        or  E.Acc /= 356        or

                  E.Str1 /= "abcde"   or  E.S2  /= String10   or

                  E.S3   /= String10  or

                  E.S1   /= C432003_0.Default_String(1..10)

               then

                  Report.Failed("Incorrect object values for Object E");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object E");

         end;

         begin

            declare

               F: C432003_0.NT_A2 :=                                  -- C_E

                    (C432003_0.Constrained_Subtype with

                       D3 => Report.Ident_Int(5),

                       S2 => String5,

                       S3 => String5);

            begin

               C432003_0.Avoid_Optimization(F);

               Report.Failed("Constraint_Error not raised for Object F");

            end;

         exception

            when Constraint_Error =>

               null;  -- Raise of Constraint_Error is expected.

         end;

         begin

            declare

               G: C432003_0.NT_B2 :=                                  -- OK

                    (C432003_0.ROOT with D3   => 5,

                                         Str1 => "cdefg",

                                         S2   => String10,

                                         S3   => String5);

            begin

               C432003_0.Avoid_Optimization(G);

               if G.D3   /= 5         or  G.Acc /= 356       or

                  G.Str1 /= "cdefg"   or  G.S2  /= String10  or

                  G.S3   /= String5   or

                  G.S1   /= C432003_0.Default_String(1..5)

               then

                  Report.Failed("Incorrect object values for Object G");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object G");

         end;

         begin

            declare

               H: C432003_0.NT_B3 :=                                    -- OK

                    (C432003_0.Unconstrained_Der with D2 => 5,

                                                      S2 => String5);

            begin

               C432003_0.Avoid_Optimization(H);

               if H.D2   /= 5          or  H.Acc /= 356      or

                  H.Str1 /= "abcde"    or  H.S2  /= String5  or

                  H.S1   /= C432003_0.Default_String(1..10)

               then

                  Report.Failed("Incorrect object values for Object H");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object H");

         end;

         begin

            declare

               I: C432003_0.NT_B1 :=                                  -- C_E

                    (C432003_0.Constrained_Subtype with

                        D2 => Report.Ident_Int(10),

                        S2 => String10);

            begin

               C432003_0.Avoid_Optimization(I);

               Report.Failed("Constraint_Error not raised for Object I");

            end;

         exception

            when Constraint_Error =>

               null;  -- Raise of Constraint_Error is expected.

         end;

         begin

            declare

               J: C432003_0.NT_B2 :=                                  -- C_E

                    (C432003_0.Constrained_Subtype with

                       D3 => Report.Ident_Int(10),

                       S2 => String10,

                       S3 => String10);

            begin

               C432003_0.Avoid_Optimization(J);

               Report.Failed("Constraint_Error not raised by Object J");

            end;

         exception

            when Constraint_Error =>

               null;  -- Raise of Constraint_Error is expected.

         end;

         begin

            declare

               K: C432003_0.NT_B3 :=                                   -- OK

                    (C432003_0.Constrained_Subtype with D2 => 5,

                                                        S2 => String5);

            begin

               C432003_0.Avoid_Optimization(K);

               if K.D2   /= 5          or  K.Acc /= 356       or

                  K.Str1 /= "abcde"    or  K.S2  /= String5   or

                  K.S1   /= C432003_0.Default_String(1..10)

               then

                  Report.Failed("Incorrect object values for Object K");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object K");

         end;

         begin

            declare

               M: C432003_0.NT_C2 :=                                   -- OK

                    (C432003_0.ROOT with D2   => 10,

                                         Str1 => "cdefg",

                                         Str2 => String5,

                                         S2   => String10);

            begin

               C432003_0.Avoid_Optimization(M);

               if M.D2   /= 10         or  M.Acc /= 356       or

                  M.Str1 /= "cdefg"    or  M.S2  /= String10  or

                  M.Str2 /= String5    or

                  M.S1   /= C432003_0.Default_String(1..5)

               then

                  Report.Failed("Incorrect object values for Object M");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object M");

         end;

         begin

            declare

               O: C432003_0.NT_C1 :=                                  -- C_E

                    (C432003_0.Constrained_Subtype with

                       Str2 => Report.Ident_Str(String5));

            begin

               C432003_0.Avoid_Optimization(O);

               Report.Failed("Constraint_Error not raised for Object O");

            end;

         exception

            when Constraint_Error =>

               null;  -- Raise of Constraint_Error is expected.

         end;

         begin

            declare

               P: C432003_0.NT_C2 :=                                  -- C_E

                    (C432003_0.Constrained_Subtype with

                       D2   => Report.Ident_Int(10),

                       Str2 => String5,

                       S2   => String10);

            begin

               C432003_0.Avoid_Optimization(P);

               Report.Failed("Constraint_Error not raised by Object P");

            end;

         exception

            when Constraint_Error =>

               null;  -- Raise of Constraint_Error is expected.

         end;

         begin

            declare

               Q: C432003_0.NT_C3 :=

                  (C432003_0.Constrained_Subtype with Str2 => String5);  -- OK

            begin

               C432003_0.Avoid_Optimization(Q);

               if Q.Str2 /= String5  or

                  Q.Acc  /= 356      or

                  Q.Str1 /= "abcde"  or

                  Q.D1   /= 10       or

                  Q.S1   /= C432003_0.Default_String(1..10)

               then

                  Report.Failed("Incorrect object values for Object Q");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object Q");

         end;

         -- The following cases test where a new discriminant corresponds

         -- to multiple discriminants of the type of the ancestor part.

         begin

            declare

               S: C432003_0.Mult_NT_A1 :=                              -- OK

                    (C432003_0.Mult_Unconstr_Der with D3 => 15,

                                                      S3 => String15);

            begin

               C432003_0.Avoid_Optimization(S);

               if S.S1   /= C432003_0.Default_String(1..15)  or

                  S.Str1 /= String8                          or

                  S.S2   /= C432003_0.Another_String(1..15)  or

                  S.S3   /= String15                         or

                  S.D3   /= 15

               then

                  Report.Failed("Incorrect object values for Object S");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object S");

         end;

         begin

            declare

               U: C432003_0.Mult_NT_A1 :=                             -- C_E

                    (C432003_0.Mult_Constr_Sub1 with

                       D3 => Report.Ident_Int(15),

                       S3 => String15);

            begin

               C432003_0.Avoid_Optimization(U);

               Report.Failed("Constraint_Error not raised for Object U");

            end;

         exception

            when Constraint_Error =>

               null;  -- Raise of Constraint_Error is expected.

         end;

         begin

            declare

               V: C432003_0.Mult_NT_A1 :=                              -- OK

                    (C432003_0.Mult_Constr_Sub2 with D3 => 15,

                                                     S3 => String15);

            begin

               C432003_0.Avoid_Optimization(V);

               if V.D3   /= 15        or

                  V.Str1 /= String8   or

                  V.S3   /= String15  or

                  V.S1   /= C432003_0.Default_String(1..15) or

                  V.S2   /= C432003_0.Another_String(1..15)

               then

                  Report.Failed("Incorrect object values for Object V");

               end if;

            end;

         exception

            when Constraint_Error =>

               Report.Failed("Constraint_Error raised for Object V");

         end;

      exception

         when others => Report.Failed("Exception raised in Test_Block");

      end Test_Block;

      Report.Result;

end C432003;