-- C460A02.A
|
-- C460A02.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that if the target type of a type conversion is a general
|
-- Check that if the target type of a type conversion is a general
|
-- access type, Program_Error is raised if the accessibility level of
|
-- access type, Program_Error is raised if the accessibility level of
|
-- the operand type is deeper than that of the target type. Check for
|
-- the operand type is deeper than that of the target type. Check for
|
-- cases where the type conversion occurs in an instance body, and
|
-- cases where the type conversion occurs in an instance body, and
|
-- the operand type is declared inside the instance or is the anonymous
|
-- the operand type is declared inside the instance or is the anonymous
|
-- access type of an access parameter or access discriminant.
|
-- access type of an access parameter or access discriminant.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- In order to satisfy accessibility requirements, the operand type must
|
-- 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
|
-- 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
|
-- operand type must "live" as long as the target type. Nesting levels
|
-- are the run-time nestings of masters: block statements; subprogram,
|
-- are the run-time nestings of masters: block statements; subprogram,
|
-- task, and entry bodies; and accept statements. Packages are invisible
|
-- task, and entry bodies; and accept statements. Packages are invisible
|
-- to accessibility rules.
|
-- to accessibility rules.
|
--
|
--
|
-- This test checks for cases where the operand is a component of a
|
-- This test checks for cases where the operand is a component of a
|
-- generic formal object, a stand-alone object, and an access parameter.
|
-- generic formal object, a stand-alone object, and an access parameter.
|
--
|
--
|
-- The test declares three generic units, each containing an access
|
-- The test declares three generic units, each containing an access
|
-- type conversion in which the target type is a formal type:
|
-- type conversion in which the target type is a formal type:
|
--
|
--
|
-- (1) A generic package in which the operand type is the anonymous
|
-- (1) A generic package in which the operand type is the anonymous
|
-- access type of an access discriminant, and the conversion
|
-- access type of an access discriminant, and the conversion
|
-- occurs within the declarative part of the body.
|
-- occurs within the declarative part of the body.
|
--
|
--
|
-- (2) A generic package in which the operand type is declared within
|
-- (2) A generic package in which the operand type is declared within
|
-- the specification, and the conversion occurs within the
|
-- the specification, and the conversion occurs within the
|
-- sequence of statements of the body.
|
-- sequence of statements of the body.
|
--
|
--
|
-- (3) A generic procedure in which the operand type is the anonymous
|
-- (3) A generic procedure in which the operand type is the anonymous
|
-- access type of an access parameter, and the conversion occurs
|
-- access type of an access parameter, and the conversion occurs
|
-- within the sequence of statements.
|
-- within the sequence of statements.
|
--
|
--
|
-- The test verifies the following:
|
-- The test verifies the following:
|
--
|
--
|
-- For (1), Program_Error is raised when the package is instantiated
|
-- For (1), Program_Error is raised when the package is instantiated
|
-- if the actual passed through the formal object has an accessibility
|
-- if the actual passed through the formal object has an accessibility
|
-- level deeper than that of the target type passed as an actual, and
|
-- level deeper than that of the target type passed as an actual, and
|
-- that no exception is raised otherwise. The exception is propagated
|
-- that no exception is raised otherwise. The exception is propagated
|
-- to the innermost enclosing master.
|
-- to the innermost enclosing master.
|
--
|
--
|
-- For (2), Program_Error is raised when the package is instantiated
|
-- For (2), Program_Error is raised when the package is instantiated
|
-- if the package is instantiated at a level deeper than that of the
|
-- 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
|
-- target type passed as an actual, and that no exception is raised
|
-- otherwise. The exception is handled within the package body.
|
-- otherwise. The exception is handled within the package body.
|
--
|
--
|
-- For (3), Program_Error is raised when the instance procedure is
|
-- For (3), Program_Error is raised when the instance procedure is
|
-- called if the actual passed through the access parameter has an
|
-- called if the actual passed through the access parameter has an
|
-- accessibility level deeper than that of the target type passed as
|
-- accessibility level deeper than that of the target type passed as
|
-- an actual, and that no exception is raised otherwise. The exception
|
-- an actual, and that no exception is raised otherwise. The exception
|
-- is handled within the instance procedure.
|
-- is handled within the instance procedure.
|
--
|
--
|
-- TEST FILES:
|
-- TEST FILES:
|
-- The following files comprise this test:
|
-- The following files comprise this test:
|
--
|
--
|
-- F460A00.A
|
-- F460A00.A
|
-- => C460A02.A
|
-- => C460A02.A
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 10 May 95 SAIC Initial prerelease version.
|
-- 10 May 95 SAIC Initial prerelease version.
|
-- 24 Apr 96 SAIC Changed the target type formal to be
|
-- 24 Apr 96 SAIC Changed the target type formal to be
|
-- access-to-constant; Modified code to avoid dead
|
-- access-to-constant; Modified code to avoid dead
|
-- variable optimization.
|
-- variable optimization.
|
--
|
--
|
--!
|
--!
|
|
|
with F460A00;
|
with F460A00;
|
generic
|
generic
|
type Target_Type is access all F460A00.Tagged_Type;
|
type Target_Type is access all F460A00.Tagged_Type;
|
FObj: in out F460A00.Composite_Type;
|
FObj: in out F460A00.Composite_Type;
|
package C460A02_0 is
|
package C460A02_0 is
|
procedure Dummy; -- Needed to allow package body.
|
procedure Dummy; -- Needed to allow package body.
|
end C460A02_0;
|
end C460A02_0;
|
|
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
with Report;
|
with Report;
|
package body C460A02_0 is
|
package body C460A02_0 is
|
Ptr: Target_Type := Target_Type(FObj.D);
|
Ptr: Target_Type := Target_Type(FObj.D);
|
|
|
procedure Dummy is
|
procedure Dummy is
|
begin
|
begin
|
null;
|
null;
|
end Dummy;
|
end Dummy;
|
|
|
begin
|
begin
|
-- Avoid optimization (dead variable removal of Ptr):
|
-- Avoid optimization (dead variable removal of Ptr):
|
if not Report.Equal (Ptr.C, Ptr.C) then -- Always false.
|
if not Report.Equal (Ptr.C, Ptr.C) then -- Always false.
|
Report.Failed ("Unexpected error in C460A02_0 instance");
|
Report.Failed ("Unexpected error in C460A02_0 instance");
|
end if;
|
end if;
|
|
|
end C460A02_0;
|
end C460A02_0;
|
|
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
|
|
with F460A00;
|
with F460A00;
|
generic
|
generic
|
type Designated_Type is private;
|
type Designated_Type is private;
|
type Target_Type is access all Designated_Type;
|
type Target_Type is access all Designated_Type;
|
FObj : in out Target_Type;
|
FObj : in out Target_Type;
|
FRes : in out F460A00.TC_Result_Kind;
|
FRes : in out F460A00.TC_Result_Kind;
|
package C460A02_1 is
|
package C460A02_1 is
|
type Operand_Type is access Designated_Type;
|
type Operand_Type is access Designated_Type;
|
Ptr : Operand_Type := new Designated_Type;
|
Ptr : Operand_Type := new Designated_Type;
|
|
|
procedure Dummy; -- Needed to allow package body.
|
procedure Dummy; -- Needed to allow package body.
|
end C460A02_1;
|
end C460A02_1;
|
|
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
|
|
package body C460A02_1 is
|
package body C460A02_1 is
|
procedure Dummy is
|
procedure Dummy is
|
begin
|
begin
|
null;
|
null;
|
end Dummy;
|
end Dummy;
|
begin
|
begin
|
FRes := F460A00.UN_Init;
|
FRes := F460A00.UN_Init;
|
FObj := Target_Type(Ptr);
|
FObj := Target_Type(Ptr);
|
FRes := F460A00.OK;
|
FRes := F460A00.OK;
|
exception
|
exception
|
when Program_Error => FRes := F460A00.PE_Exception;
|
when Program_Error => FRes := F460A00.PE_Exception;
|
when others => FRes := F460A00.Others_Exception;
|
when others => FRes := F460A00.Others_Exception;
|
end C460A02_1;
|
end C460A02_1;
|
|
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
|
|
with F460A00;
|
with F460A00;
|
generic
|
generic
|
type Designated_Type is new F460A00.Tagged_Type with private;
|
type Designated_Type is new F460A00.Tagged_Type with private;
|
type Target_Type is access constant Designated_Type;
|
type Target_Type is access constant Designated_Type;
|
procedure C460A02_2 (P : access Designated_Type'Class;
|
procedure C460A02_2 (P : access Designated_Type'Class;
|
Res : out F460A00.TC_Result_Kind);
|
Res : out F460A00.TC_Result_Kind);
|
|
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
|
|
with Report;
|
with Report;
|
procedure C460A02_2 (P : access Designated_Type'Class;
|
procedure C460A02_2 (P : access Designated_Type'Class;
|
Res : out F460A00.TC_Result_Kind) is
|
Res : out F460A00.TC_Result_Kind) is
|
Ptr : Target_Type;
|
Ptr : Target_Type;
|
begin
|
begin
|
Res := F460A00.UN_Init;
|
Res := F460A00.UN_Init;
|
Ptr := Target_Type(P);
|
Ptr := Target_Type(P);
|
|
|
-- Avoid optimization (dead variable removal of Ptr):
|
-- Avoid optimization (dead variable removal of Ptr):
|
if not Report.Equal (Ptr.C, Ptr.C) then -- Always false.
|
if not Report.Equal (Ptr.C, Ptr.C) then -- Always false.
|
Report.Failed ("Unexpected error in C460A02_2 instance");
|
Report.Failed ("Unexpected error in C460A02_2 instance");
|
end if;
|
end if;
|
Res := F460A00.OK;
|
Res := F460A00.OK;
|
exception
|
exception
|
when Program_Error => Res := F460A00.PE_Exception;
|
when Program_Error => Res := F460A00.PE_Exception;
|
when others => Res := F460A00.Others_Exception;
|
when others => Res := F460A00.Others_Exception;
|
end C460A02_2;
|
end C460A02_2;
|
|
|
|
|
--==================================================================--
|
--==================================================================--
|
|
|
|
|
with F460A00;
|
with F460A00;
|
with C460A02_0;
|
with C460A02_0;
|
with C460A02_1;
|
with C460A02_1;
|
with C460A02_2;
|
with C460A02_2;
|
|
|
with Report;
|
with Report;
|
procedure C460A02 is
|
procedure C460A02 is
|
begin -- C460A02. -- [ Level = 1 ]
|
begin -- C460A02. -- [ Level = 1 ]
|
|
|
Report.Test ("C460A02", "Run-time accessibility checks: instance " &
|
Report.Test ("C460A02", "Run-time accessibility checks: instance " &
|
"bodies. Operand type of access type conversion is " &
|
"bodies. Operand type of access type conversion is " &
|
"declared inside instance or is anonymous");
|
"declared inside instance or is anonymous");
|
|
|
|
|
SUBTEST1:
|
SUBTEST1:
|
declare -- [ Level = 2 ]
|
declare -- [ Level = 2 ]
|
type AccTag_L2 is access all F460A00.Tagged_Type;
|
type AccTag_L2 is access all F460A00.Tagged_Type;
|
PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type;
|
PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type;
|
Operand_L2 : F460A00.Composite_Type(PTag_L2);
|
Operand_L2 : F460A00.Composite_Type(PTag_L2);
|
|
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
begin -- SUBTEST1.
|
begin -- SUBTEST1.
|
|
|
begin -- [ Level = 3 ]
|
begin -- [ Level = 3 ]
|
declare -- [ Level = 4 ]
|
declare -- [ Level = 4 ]
|
-- The accessibility level of the actual passed as the target type
|
-- The accessibility level of the actual passed as the target type
|
-- in Pack_OK is 2. The accessibility level of the composite actual
|
-- in Pack_OK is 2. The accessibility level of the composite actual
|
-- (and thus, the level of the anonymous type of the access
|
-- (and thus, the level of the anonymous type of the access
|
-- discriminant, which is the same as that of the containing
|
-- discriminant, which is the same as that of the containing
|
-- object) is also 2. Therefore, the access type conversion in
|
-- object) is also 2. Therefore, the access type conversion in
|
-- Pack_OK does not raise an exception upon instantiation:
|
-- Pack_OK does not raise an exception upon instantiation:
|
|
|
package Pack_OK is new C460A02_0
|
package Pack_OK is new C460A02_0
|
(Target_Type => AccTag_L2, FObj => Operand_L2);
|
(Target_Type => AccTag_L2, FObj => Operand_L2);
|
begin
|
begin
|
Result := F460A00.OK; -- Expected result.
|
Result := F460A00.OK; -- Expected result.
|
end;
|
end;
|
exception
|
exception
|
when Program_Error => Result := F460A00.PE_Exception;
|
when Program_Error => Result := F460A00.PE_Exception;
|
when others => Result := F460A00.Others_Exception;
|
when others => Result := F460A00.Others_Exception;
|
end;
|
end;
|
|
|
F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");
|
F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");
|
|
|
end SUBTEST1;
|
end SUBTEST1;
|
|
|
|
|
|
|
SUBTEST2:
|
SUBTEST2:
|
declare -- [ Level = 2 ]
|
declare -- [ Level = 2 ]
|
type AccTag_L2 is access all F460A00.Tagged_Type;
|
type AccTag_L2 is access all F460A00.Tagged_Type;
|
PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type;
|
PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type;
|
|
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
begin -- SUBTEST2.
|
begin -- SUBTEST2.
|
|
|
declare -- [ Level = 3 ]
|
declare -- [ Level = 3 ]
|
Operand_L3 : F460A00.Composite_Type(PTag_L2);
|
Operand_L3 : F460A00.Composite_Type(PTag_L2);
|
begin
|
begin
|
declare -- [ Level = 4 ]
|
declare -- [ Level = 4 ]
|
-- The accessibility level of the actual passed as the target type
|
-- The accessibility level of the actual passed as the target type
|
-- in Pack_PE is 2. The accessibility level of the composite actual
|
-- in Pack_PE is 2. The accessibility level of the composite actual
|
-- (and thus, the level of the anonymous type of the access
|
-- (and thus, the level of the anonymous type of the access
|
-- discriminant, which is the same as that of the containing
|
-- discriminant, which is the same as that of the containing
|
-- object) is 3. Therefore, the access type conversion in Pack_PE
|
-- object) is 3. Therefore, the access type conversion in Pack_PE
|
-- propagates Program_Error upon instantiation:
|
-- propagates Program_Error upon instantiation:
|
|
|
package Pack_PE is new C460A02_0 (AccTag_L2, Operand_L3);
|
package Pack_PE is new C460A02_0 (AccTag_L2, Operand_L3);
|
begin
|
begin
|
Result := F460A00.OK;
|
Result := F460A00.OK;
|
end;
|
end;
|
exception
|
exception
|
when Program_Error => Result := F460A00.PE_Exception;
|
when Program_Error => Result := F460A00.PE_Exception;
|
-- Expected result.
|
-- Expected result.
|
when others => Result := F460A00.Others_Exception;
|
when others => Result := F460A00.Others_Exception;
|
end;
|
end;
|
|
|
F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #2");
|
F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #2");
|
|
|
end SUBTEST2;
|
end SUBTEST2;
|
|
|
|
|
|
|
SUBTEST3:
|
SUBTEST3:
|
declare -- [ Level = 2 ]
|
declare -- [ Level = 2 ]
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
begin -- SUBTEST3.
|
begin -- SUBTEST3.
|
|
|
declare -- [ Level = 3 ]
|
declare -- [ Level = 3 ]
|
type AccArr_L3 is access all F460A00.Array_Type;
|
type AccArr_L3 is access all F460A00.Array_Type;
|
Target: AccArr_L3;
|
Target: AccArr_L3;
|
|
|
-- The accessibility level of the actual passed as the target type
|
-- The accessibility level of the actual passed as the target type
|
-- in Pack_OK is 3. The accessibility level of the operand type is
|
-- 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
|
-- that of the instance, which is also 3. Therefore, the access type
|
-- conversion in Pack_OK does not raise an exception upon
|
-- conversion in Pack_OK does not raise an exception upon
|
-- instantiation. If an exception is (incorrectly) raised, it is
|
-- instantiation. If an exception is (incorrectly) raised, it is
|
-- handled within the instance:
|
-- handled within the instance:
|
|
|
package Pack_OK is new C460A02_1
|
package Pack_OK is new C460A02_1
|
(Designated_Type => F460A00.Array_Type,
|
(Designated_Type => F460A00.Array_Type,
|
Target_Type => AccArr_L3,
|
Target_Type => AccArr_L3,
|
FObj => Target,
|
FObj => Target,
|
FRes => Result);
|
FRes => Result);
|
begin
|
begin
|
null;
|
null;
|
end;
|
end;
|
|
|
F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #3");
|
F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #3");
|
|
|
exception
|
exception
|
when Program_Error =>
|
when Program_Error =>
|
Report.Failed ("SUBTEST #3: Program_Error incorrectly propagated");
|
Report.Failed ("SUBTEST #3: Program_Error incorrectly propagated");
|
when others =>
|
when others =>
|
Report.Failed ("SUBTEST #3: Unexpected exception propagated");
|
Report.Failed ("SUBTEST #3: Unexpected exception propagated");
|
end SUBTEST3;
|
end SUBTEST3;
|
|
|
|
|
|
|
SUBTEST4:
|
SUBTEST4:
|
declare -- [ Level = 2 ]
|
declare -- [ Level = 2 ]
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
begin -- SUBTEST4.
|
begin -- SUBTEST4.
|
|
|
declare -- [ Level = 3 ]
|
declare -- [ Level = 3 ]
|
Target: F460A00.AccArr_L0;
|
Target: F460A00.AccArr_L0;
|
|
|
-- The accessibility level of the actual passed as the target type
|
-- The accessibility level of the actual passed as the target type
|
-- in Pack_PE is 0. The accessibility level of the operand type is
|
-- in Pack_PE is 0. The accessibility level of the operand type is
|
-- that of the instance, which is 3. Therefore, the access type
|
-- that of the instance, which is 3. Therefore, the access type
|
-- conversion in Pack_PE raises Program_Error upon instantiation.
|
-- conversion in Pack_PE raises Program_Error upon instantiation.
|
-- The exception is handled within the instance:
|
-- The exception is handled within the instance:
|
|
|
package Pack_PE is new C460A02_1
|
package Pack_PE is new C460A02_1
|
(Designated_Type => F460A00.Array_Type,
|
(Designated_Type => F460A00.Array_Type,
|
Target_Type => F460A00.AccArr_L0,
|
Target_Type => F460A00.AccArr_L0,
|
FObj => Target,
|
FObj => Target,
|
FRes => Result);
|
FRes => Result);
|
begin
|
begin
|
null;
|
null;
|
end;
|
end;
|
|
|
F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #4");
|
F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #4");
|
|
|
exception
|
exception
|
when Program_Error =>
|
when Program_Error =>
|
Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");
|
Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");
|
when others =>
|
when others =>
|
Report.Failed ("SUBTEST #4: Unexpected exception raised");
|
Report.Failed ("SUBTEST #4: Unexpected exception raised");
|
end SUBTEST4;
|
end SUBTEST4;
|
|
|
|
|
|
|
SUBTEST5:
|
SUBTEST5:
|
declare -- [ Level = 2 ]
|
declare -- [ Level = 2 ]
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
begin -- SUBTEST5.
|
begin -- SUBTEST5.
|
|
|
declare -- [ Level = 3 ]
|
declare -- [ Level = 3 ]
|
-- The instantiation of C460A02_2 should NOT result in any
|
-- The instantiation of C460A02_2 should NOT result in any
|
-- exceptions.
|
-- exceptions.
|
|
|
procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
|
procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
|
F460A00.AccTag_L0);
|
F460A00.AccTag_L0);
|
begin
|
begin
|
-- The accessibility level of the actual passed to Proc is 0. The
|
-- The accessibility level of the actual passed to Proc is 0. The
|
-- accessibility level of the actual passed as the target type is
|
-- accessibility level of the actual passed as the target type is
|
-- also 0. Therefore, the access type conversion in Proc does not
|
-- also 0. Therefore, the access type conversion in Proc does not
|
-- raise an exception when the subprogram is called. If an exception
|
-- raise an exception when the subprogram is called. If an exception
|
-- is (incorrectly) raised, it is handled within the subprogram:
|
-- is (incorrectly) raised, it is handled within the subprogram:
|
|
|
Proc (F460A00.PTagClass_L0, Result);
|
Proc (F460A00.PTagClass_L0, Result);
|
end;
|
end;
|
|
|
F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #5");
|
F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #5");
|
|
|
exception
|
exception
|
when Program_Error =>
|
when Program_Error =>
|
Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");
|
Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");
|
when others =>
|
when others =>
|
Report.Failed ("SUBTEST #5: Unexpected exception raised");
|
Report.Failed ("SUBTEST #5: Unexpected exception raised");
|
end SUBTEST5;
|
end SUBTEST5;
|
|
|
|
|
|
|
SUBTEST6:
|
SUBTEST6:
|
declare -- [ Level = 2 ]
|
declare -- [ Level = 2 ]
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
begin -- SUBTEST6.
|
begin -- SUBTEST6.
|
|
|
declare -- [ Level = 3 ]
|
declare -- [ Level = 3 ]
|
-- The instantiation of C460A02_2 should NOT result in any
|
-- The instantiation of C460A02_2 should NOT result in any
|
-- exceptions.
|
-- exceptions.
|
|
|
procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
|
procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
|
F460A00.AccTag_L0);
|
F460A00.AccTag_L0);
|
begin
|
begin
|
-- In the call to (instantiated) procedure Proc, the first actual
|
-- In the call to (instantiated) procedure Proc, the first actual
|
-- parameter is an allocator. Its accessibility level is that of
|
-- parameter is an allocator. Its accessibility level is that of
|
-- the level of execution of Proc, which is 3. The accessibility
|
-- the level of execution of Proc, which is 3. The accessibility
|
-- level of the actual passed as the target type is 0. Therefore,
|
-- level of the actual passed as the target type is 0. Therefore,
|
-- the access type conversion in Proc raises Program_Error when the
|
-- the access type conversion in Proc raises Program_Error when the
|
-- subprogram is called. The exception is handled within the
|
-- subprogram is called. The exception is handled within the
|
-- subprogram:
|
-- subprogram:
|
|
|
Proc (new F460A00.Tagged_Type, Result);
|
Proc (new F460A00.Tagged_Type, Result);
|
end;
|
end;
|
|
|
F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #6");
|
F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #6");
|
|
|
exception
|
exception
|
when Program_Error =>
|
when Program_Error =>
|
Report.Failed ("SUBTEST #6: Program_Error incorrectly raised");
|
Report.Failed ("SUBTEST #6: Program_Error incorrectly raised");
|
when others =>
|
when others =>
|
Report.Failed ("SUBTEST #6: Unexpected exception raised");
|
Report.Failed ("SUBTEST #6: Unexpected exception raised");
|
end SUBTEST6;
|
end SUBTEST6;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C460A02;
|
end C460A02;
|
|
|