Subversion Repositories openrisc

-- C460A02.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 target type of a type conversion is a general

--      access type, Program_Error is raised if the accessibility level of

--      the operand type is deeper than that of the target type. Check for

--      cases where the type conversion occurs in an instance body, and

--      the operand type is declared inside the instance or is the anonymous

--      access type of an access parameter or access discriminant.

--

-- TEST DESCRIPTION:

--      In order to satisfy accessibility requirements, the operand type must

--      be at the same or a less deep nesting level than the target type -- the

--      operand type must "live" as long as the target type. Nesting levels

--      are the run-time nestings of masters: block statements; subprogram,

--      task, and entry bodies; and accept statements. Packages are invisible

--      to accessibility rules.

--

--      This test checks for cases where the operand is a component of a

--      generic formal object, a stand-alone object, and an access parameter.

--

--      The test declares three generic units, each containing an access

--      type conversion in which the target type is a formal type:

--

--         (1) A generic package in which the operand type is the anonymous

--             access type of an access discriminant, and the conversion

--             occurs within the declarative part of the body.

--

--         (2) A generic package in which the operand type is declared within

--             the specification, and the conversion occurs within the

--             sequence of statements of the body.

--

--         (3) A generic procedure in which the operand type is the anonymous

--             access type of an access parameter, and the conversion occurs

--             within the sequence of statements.

--

--      The test verifies the following:

--

--         For (1), Program_Error is raised when the package is instantiated

--         if the actual passed through the formal object has an accessibility

--         level deeper than that of the target type passed as an actual, and

--         that no exception is raised otherwise. The exception is propagated

--         to the innermost enclosing master.

--

--         For (2), Program_Error is raised when the package is instantiated

--         if the package is instantiated at a level deeper than that of the

--         target type passed as an actual, and that no exception is raised

--         otherwise. The exception is handled within the package body.

--

--         For (3), Program_Error is raised when the instance procedure is

--         called if the actual passed through the access parameter has an

--         accessibility level deeper than that of the target type passed as

--         an actual, and that no exception is raised otherwise. The exception

--         is handled within the instance procedure.

--

-- TEST FILES:

--      The following files comprise this test:

--

--         F460A00.A

--      => C460A02.A

--

--

-- CHANGE HISTORY:

--      10 May 95   SAIC    Initial prerelease version.

--      24 Apr 96   SAIC    Changed the target type formal to be

--                          access-to-constant; Modified code to avoid dead

--                          variable optimization.

--

--!

with F460A00;

generic

   type Target_Type is access all F460A00.Tagged_Type;

   FObj: in out F460A00.Composite_Type;

package C460A02_0 is

   procedure Dummy; -- Needed to allow package body.

end C460A02_0;

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

with Report;

package body C460A02_0 is

   Ptr: Target_Type := Target_Type(FObj.D);

   procedure Dummy is

   begin

      null;

   end Dummy;

begin

   -- Avoid optimization (dead variable removal of Ptr):

   if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.

      Report.Failed ("Unexpected error in C460A02_0 instance");

   end if;

end C460A02_0;

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

with F460A00;

generic

   type Designated_Type is private;

   type Target_Type is access all Designated_Type;

   FObj : in out Target_Type;

   FRes : in out F460A00.TC_Result_Kind;

package C460A02_1 is

   type Operand_Type is access Designated_Type;

   Ptr : Operand_Type := new Designated_Type;

   procedure Dummy; -- Needed to allow package body.

end C460A02_1;

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

package body C460A02_1 is

   procedure Dummy is

   begin

      null;

   end Dummy;

begin

   FRes := F460A00.UN_Init;

   FObj := Target_Type(Ptr);

   FRes := F460A00.OK;

exception

   when Program_Error => FRes := F460A00.PE_Exception;

   when others        => FRes := F460A00.Others_Exception;

end C460A02_1;

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

with F460A00;

generic

   type Designated_Type is new F460A00.Tagged_Type with private;

   type Target_Type is access constant Designated_Type;

procedure C460A02_2 (P   : access Designated_Type'Class;

                     Res : out    F460A00.TC_Result_Kind);

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

with Report;

procedure C460A02_2 (P   : access Designated_Type'Class;

                     Res : out    F460A00.TC_Result_Kind) is

   Ptr : Target_Type;

begin

   Res := F460A00.UN_Init;

   Ptr := Target_Type(P);

   -- Avoid optimization (dead variable removal of Ptr):

   if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.

      Report.Failed ("Unexpected error in C460A02_2 instance");

   end if;

   Res := F460A00.OK;

exception

   when Program_Error => Res := F460A00.PE_Exception;

   when others        => Res := F460A00.Others_Exception;

end C460A02_2;

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

with F460A00;

with C460A02_0;

with C460A02_1;

with C460A02_2;

with Report;

procedure C460A02 is

begin -- C460A02.                                              -- [ Level = 1 ]

   Report.Test ("C460A02", "Run-time accessibility checks: instance " &

                "bodies. Operand type of access type conversion is "  &

                "declared inside instance or is anonymous");

   SUBTEST1:

   declare                                                     -- [ Level = 2 ]

      type AccTag_L2 is access all F460A00.Tagged_Type;

      PTag_L2    : AccTag_L2 := new F460A00.Tagged_Type;

      Operand_L2 : F460A00.Composite_Type(PTag_L2);

      Result     : F460A00.TC_Result_Kind := F460A00.UN_Init;

   begin -- SUBTEST1.

      begin                                                    -- [ Level = 3 ]

         declare                                               -- [ Level = 4 ]

            -- The accessibility level of the actual passed as the target type

            -- in Pack_OK is 2. The accessibility level of the composite actual

            -- (and thus, the level of the anonymous type of the access

            -- discriminant, which is the same as that of the containing

            -- object) is also 2. Therefore, the access type conversion in

            -- Pack_OK does not raise an exception upon instantiation:

            package Pack_OK is new C460A02_0

              (Target_Type => AccTag_L2, FObj => Operand_L2);

         begin

            Result := F460A00.OK;                           -- Expected result.

         end;

      exception

         when Program_Error => Result := F460A00.PE_Exception;

         when others        => Result := F460A00.Others_Exception;

      end;

      F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");

   end SUBTEST1;

   SUBTEST2:

   declare                                                     -- [ Level = 2 ]

      type AccTag_L2 is access all F460A00.Tagged_Type;

      PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type;

      Result  : F460A00.TC_Result_Kind := F460A00.UN_Init;

   begin -- SUBTEST2.

      declare                                                  -- [ Level = 3 ]

         Operand_L3 : F460A00.Composite_Type(PTag_L2);

      begin

         declare                                               -- [ Level = 4 ]

            -- The accessibility level of the actual passed as the target type

            -- in Pack_PE is 2. The accessibility level of the composite actual

            -- (and thus, the level of the anonymous type of the access

            -- discriminant, which is the same as that of the containing

            -- object) is 3. Therefore, the access type conversion in Pack_PE

            -- propagates Program_Error upon instantiation:

            package Pack_PE is new C460A02_0 (AccTag_L2, Operand_L3);

         begin

            Result := F460A00.OK;

         end;

      exception

         when Program_Error => Result := F460A00.PE_Exception;

                                                          -- Expected result.

         when others        => Result := F460A00.Others_Exception;

      end;

      F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #2");

   end SUBTEST2;

   SUBTEST3:

   declare                                                     -- [ Level = 2 ]

      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;

   begin -- SUBTEST3.

      declare                                                  -- [ Level = 3 ]

         type AccArr_L3 is access all F460A00.Array_Type;

         Target: AccArr_L3;

         -- The accessibility level of the actual passed as the target type

         -- in Pack_OK is 3. The accessibility level of the operand type is

         -- that of the instance, which is also 3. Therefore, the access type

         -- conversion in Pack_OK does not raise an exception upon

         -- instantiation. If an exception is (incorrectly) raised, it is

         -- handled within the instance:

         package Pack_OK is new C460A02_1

           (Designated_Type => F460A00.Array_Type,

            Target_Type     => AccArr_L3,

            FObj            => Target,

            FRes            => Result);

      begin

         null;

      end;

      F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #3");

   exception

      when Program_Error =>

         Report.Failed ("SUBTEST #3: Program_Error incorrectly propagated");

      when others        =>

         Report.Failed ("SUBTEST #3: Unexpected exception propagated");

   end SUBTEST3;

   SUBTEST4:

   declare                                                     -- [ Level = 2 ]

      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;

   begin -- SUBTEST4.

      declare                                                  -- [ Level = 3 ]

         Target: F460A00.AccArr_L0;

         -- The accessibility level of the actual passed as the target type

         -- in Pack_PE is 0. The accessibility level of the operand type is

         -- that of the instance, which is 3. Therefore, the access type

         -- conversion in Pack_PE raises Program_Error upon instantiation.

         -- The exception is handled within the instance:

         package Pack_PE is new C460A02_1

           (Designated_Type => F460A00.Array_Type,

            Target_Type     => F460A00.AccArr_L0,

            FObj            => Target,

            FRes            => Result);

      begin

         null;

      end;

      F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #4");

   exception

      when Program_Error =>

         Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");

      when others        =>

         Report.Failed ("SUBTEST #4: Unexpected exception raised");

   end SUBTEST4;

   SUBTEST5:

   declare                                                     -- [ Level = 2 ]

      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;

   begin -- SUBTEST5.

      declare                                                  -- [ Level = 3 ]

         -- The instantiation of C460A02_2 should NOT result in any

         -- exceptions.

         procedure Proc is new C460A02_2 (F460A00.Tagged_Type,

                                          F460A00.AccTag_L0);

      begin

         -- The accessibility level of the actual passed to Proc is 0. The

         -- accessibility level of the actual passed as the target type is

         -- also 0. Therefore, the access type conversion in Proc does not

         -- raise an exception when the subprogram is called. If an exception

         -- is (incorrectly) raised, it is handled within the subprogram:

         Proc (F460A00.PTagClass_L0, Result);

      end;

      F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #5");

   exception

      when Program_Error =>

         Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");

      when others        =>

         Report.Failed ("SUBTEST #5: Unexpected exception raised");

   end SUBTEST5;

   SUBTEST6:

   declare                                                     -- [ Level = 2 ]

      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;

   begin -- SUBTEST6.

      declare                                                  -- [ Level = 3 ]

         -- The instantiation of C460A02_2 should NOT result in any

         -- exceptions.

         procedure Proc is new C460A02_2 (F460A00.Tagged_Type,

                                          F460A00.AccTag_L0);

      begin

         -- In the call to (instantiated) procedure Proc, the first actual

         -- parameter is an allocator. Its accessibility level is that of

         -- the level of execution of Proc, which is 3. The accessibility

         -- level of the actual passed as the target type is 0.  Therefore,

         -- the access type conversion in Proc raises Program_Error when the

         -- subprogram is called. The exception is handled within the

         -- subprogram:

         Proc (new F460A00.Tagged_Type, Result);

      end;

      F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #6");

   exception

      when Program_Error =>

         Report.Failed ("SUBTEST #6: Program_Error incorrectly raised");

      when others        =>

         Report.Failed ("SUBTEST #6: Unexpected exception raised");

   end SUBTEST6;

   Report.Result;

end C460A02;