-- B3A2004.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and -- F08630-91-C-0015, 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, for X'Access of a general access type A, the accessibility -- level of the view denoted by X must not be statically deeper than that -- of the access type A. -- -- Check for cases where X is: -- (a) a renaming of an aliased view. -- (b) a dereference of an access-to-object value. -- (c) a view conversion of an aliased view. -- -- TEST DESCRIPTION: -- In order to satisfy accessibility requirements, the designated -- object X must be at the same or a less deep "nesting level" than the -- general access type A -- X must "live" as long as A. 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. -- -- If X is a view of an object denoted by a renaming declaration, its -- accessibility level is that of the renamed view. -- -- If X is a view of an object denoted by a dereference of an access -- value, its accessibility level is that of the associated access type. -- -- If X is a view conversion, its accessibility level is the same as that -- of its operand. -- -- This test declares general access types and aliased views in various -- packages and nested blocks and task bodies, and verifies that X'Access -- is illegal when X has a deeper accessibility level than that of the -- type of X'Access, and legal otherwise. Accessibility is checked in two -- contexts: X'Access is assigned to an access object; X'Access is passed -- as an actual to a subprogram. -- -- The nesting structure is as follows: -- -- - Library-level package -- | (Level = 0) -- - end package -- -- - Main subprogram -- | (Level = 1) -- | begin -- | - Nested block -- | | (Level = 2) -- | | - Nested task -- | | | (Level = 3) -- | | | begin -- | | | *** Testing here -- | | | - Accept statement (Level = 4) -- | | | | *** Testing here -- | | | - end accept -- | | - end task -- | | begin -- | | *** Testing here -- | - end block -- | *** Testing here -- - end Main subprogram -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- 10 Mar 95 SAIC Changed access-to-variable type AccTag_L3 to -- access-to-constant type. -- --! package B3A2004_0 is -- -- Record type, associated objects and access types: -- type Obj_Type is record Comp : Integer := 10; end record; type AccObj_L0 is access all Obj_Type; -- Level = 0. GAT0 : AccObj_L0; Obj_L0 : aliased Obj_Type; -- Level = 0. AAT0 : array (1 .. 4) of aliased Obj_Type; -- Level = 0. -- -- Type with aliased component: -- -- Note that the accessibility level of an aliased component is -- determined from where the composite *object* is declared, and not -- from where the composite *type* is declared. type Rec_With_Comp is record C: aliased Obj_Type; -- Aliased component. end record; -- -- Tagged types, associated objects and access types: -- type Tag_Type is tagged record I : Integer; end record; type Der_Type is new Tag_Type with record B : Boolean; end record; type AccTag_L0 is access all Tag_Type; -- Level = 0. ATT0 : AccTag_L0; Der_L0 : aliased Der_Type; -- Level = 0. end B3A2004_0; --==================================================================-- with B3A2004_0; procedure B3A2004 is type AccObj_L1 is access all B3A2004_0.Obj_Type; -- Level = 1. Obj_L1 : aliased B3A2004_0.Obj_Type; -- Level = 1. GAT1 : AccObj_L1; -- Level = 1. -- The accessibility of a renaming declaration is that of the object -- being renamed. Ren_L0 : B3A2004_0.Obj_Type renames B3A2004_0.Obj_L0; -- Level = 0. type AccTag_L1 is access all B3A2004_0.Tag_Type; -- Level = 1. Der_L1 : aliased B3A2004_0.Der_Type; -- Level = 1. procedure NonTagCall_L1 (X: AccObj_L1) is -- Subprogram with parameter begin -- of a general access type: null; -- non-tagged designated type. end NonTagCall_L1; begin -- B3A2004_0 -- -- Block statement: an inner master, creating a new accessibility level. -- declare type AccObj_L2 is access all B3A2004_0.Obj_Type; -- Level = 2. Obj_L2 : aliased B3A2004_0.Obj_Type; -- Level = 2. GAT2 : AccObj_L2; AAT2 : array (1 .. 4) of aliased B3A2004_0.Obj_Type; -- Level = 2. -- Pool-specific access type: type PoolObj_L2 is access B3A2004_0.Obj_Type; -- Level = 2. -- Composite object with aliased component: Comp_L2 : B3A2004_0.Rec_With_Comp; -- Level = 2. -- The accessibility of a renaming declaration is that of the object -- being renamed. Ren_L1 : B3A2004_0.Obj_Type renames Obj_L1; -- Level = 1. Ren_GAT1_L1 : AccObj_L1 renames GAT1; -- Level = 1. ATT1 : AccTag_L1; -- Declared at deeper level than type. -- (Have no effect on accessibility level). type AccTag_L2 is access all B3A2004_0.Tag_Type; -- Level = 2. Der_L2 : aliased B3A2004_0.Der_Type; -- Level = 2. procedure TagCall_L2 (X: AccTag_L2) is -- Subprogram with parameter begin -- of a general access type: null; -- tagged designated type. end TagCall_L2; -- -- Nested task: an inner master, creating a new accessibility level. -- task Tsk is entry Class_Entry (FP_L4: B3A2004_0.Tag_Type'Class); end Tsk; task body Tsk is PAT2 : PoolObj_L2; -- Level 3 variable, type is level 2. -- (Have no effect on accessibility level). type AccObj_L3 is access all B3A2004_0.Obj_Type; -- Level = 3. GAT3 : AccObj_L3; Obj_L3 : aliased B3A2004_0.Obj_Type; -- Level = 3. AAT3 : array (1 .. 4) of aliased B3A2004_0.Obj_Type; -- Level = 3. -- Renaming of an aliased component: Ren_L2 : B3A2004_0.Obj_Type renames Comp_L2.C; -- Level = 2. type AccTag_L3 is access constant B3A2004_0.Tag_Type; -- Level = 3. ATT3 : AccTag_L3; Der_L3 : aliased B3A2004_0.Der_Type; -- Level = 3. begin -- Tsk. -- 'Access applied to a view denoted by a renaming: B3A2004_0.GAT0 := Ren_L2'Access; -- ERROR: -- Accessibility level of Ren_L2 is deeper than that of -- B3A2004_0.AccObj_L0. NonTagCall_L1 (Ren_L2'Access); -- ERROR: -- Accessibility level of Ren_L2 is deeper than that of AccObj_L1. GAT1 := Ren_L2'Access; -- ERROR: -- Accessibility level of Ren_L2 is deeper than that of AccObj_L1. GAT2 := Ren_L2'Access; -- OK. GAT3 := Ren_L0'Access; -- OK. GAT3 := Ren_L2'Access; -- OK. Ren_GAT1_L1 := Obj_L2'Access; -- ERROR: -- Accessibility level of Obj_L2 is deeper than that of AccObj_L1. Ren_GAT1_L1 := Obj_L1'Access; -- OK. -- 'Access applied to a dereference: GAT3 := B3A2004_0.GAT0.all'Access; -- OK. GAT3 := B3A2004_0.AAT0(1)'Access; -- OK. NonTagCall_L1 (GAT3.all'Access); -- ERROR: -- Accessibility level of AccObj_L3 is deeper than that of AccObj_L1. NonTagCall_L1 (AAT3(2)'Access); -- ERROR: -- Accessibility level of AAT3(2) is deeper than that of AccObj_L1. NonTagCall_L1 (PAT2.all'Access); -- ERROR: -- Accessibility level of PoolObj_L2 is deeper than that of -- AccObj_L1. NonTagCall_L1 (AAT2(3)'Access); -- ERROR: -- Accessibility level of ATT2(3) is deeper than that of AccObj_L1. GAT1 := PAT2.all'Access; -- ERROR: -- Accessibility level of PoolObj_L2 is deeper than that of AccObj_L1. GAT1 := AAT2(4)'Access; -- ERROR: -- Accessibility level of ATT2(4) is deeper than that of AccObj_L1. GAT2 := PAT2.all'Access; -- OK. GAT2 := AAT2(1)'Access; -- OK. -- 'Access applied to a view conversion: ATT1 := B3A2004_0.Tag_Type(Der_L3)'Access; -- ERROR: -- Accessibility level of Der_L3 is deeper than that of AccTag_L1. TagCall_L2 (B3A2004_0.Tag_Type(Der_L3)'Access); -- ERROR: -- Accessibility level of Der_L3 is deeper than that of AccTag_L2. accept Class_Entry (FP_L4: B3A2004_0.Tag_Type'Class) do -- Inner master, level = 4. -- 'Access applied to a view conversion: ATT3 := B3A2004_0.Tag_Type(FP_L4)'Access; -- ERROR: -- Accessibility level of FP_L4 is deeper than that of AccTag_L3. end Class_Entry; end Tsk; begin -- Block statement. -- 'Access applied to a view denoted by a renaming: NonTagCall_L1 (Ren_L1'Access); -- OK. -- 'Access applied to a dereference: B3A2004_0.GAT0 := GAT2.all'Access; -- ERROR: -- Accessibility level of AccObj_L2 is deeper than that of -- B3A2004_0.AccObj_L0. B3A2004_0.GAT0 := AAT2(2)'Access; -- ERROR: -- Accessibility level of ATT2(2) is deeper than that of -- B3A2004_0.AccObj_L0. NonTagCall_L1 (B3A2004_0.GAT0.all'Access); -- OK. NonTagCall_L1 (B3A2004_0.AAT0(4)'Access); -- OK. -- 'Access applied to a view conversion: ATT1 := B3A2004_0.Tag_Type(Der_L1)'Access; -- OK. TagCall_L2 (B3A2004_0.Tag_Type(Der_L1)'Access); -- OK. ATT1 := B3A2004_0.Tag_Type(Der_L2)'Access; -- ERROR: -- Accessibility level of Der_L2 is deeper than that of AccTag_L1. TagCall_L2 (B3A2004_0.Tag_Type(Der_L2)'Access); -- OK. end; -- Block statement. -- 'Access applied to a view denoted by a renaming: B3A2004_0.GAT0 := Ren_L0'Access; -- OK. -- 'Access applied to a view conversion: B3A2004_0.ATT0 := B3A2004_0.Tag_Type(B3A2004_0.Der_L0)'Access; -- OK. B3A2004_0.ATT0 := B3A2004_0.Tag_Type(Der_L1)'Access; -- ERROR: -- Accessibility level of Der_L1 is deeper than that of -- B3A2004_0.AccTag_L0. end B3A2004;