-- B370001.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 a discriminant specification for an access discriminant -- may not appear in the declaration of a type (that is not a task or -- protected type) if the word limited does not appear in the -- definition of the type or in that of one of its ancestors. -- -- Check for basic cases, including a type that is limited only -- due to the presence of a limited component. -- -- Check for the generic case, where the type is derived from -- a nonlimited tagged formal private type, or a formal private -- extension. -- -- Check for the instance case, where the type is derived from a -- limited tagged formal private type, and the corresponding actual -- is not limited. Check in both the visible and private part of -- an instance, using record and private extensions. -- -- TEST DESCRIPTION: -- For the basic case: -- -- Verify that it is illegal to declare a record type with an access -- discriminant, where the record type is limited only because it has -- a limited component. Verify that it is illegal to declare a tagged -- type with an access discriminant, if the tagged type is not -- explicitly declared limited. Check that a record extension with an -- access discriminant is legal if an ancestor of the parent type is -- limited, but illegal if no ancestors are limited. -- -- For the generic case: -- -- Verify that it is illegal to derive a type with an access -- discriminant from a formal nonlimited tagged private type or a -- formal private extension whose ancestor is not limited. Check -- that a record extension with an access discriminant is legal if -- the parent is a formal private extension which has a limited -- ancestor. -- -- For the instance case: -- -- Derive a type with an access discriminant from a formal limited -- private type. Verify that the derived type is legal in the instance -- if the actual type is a task or protected type, or is limited due -- to the presence of the word limited in its definition. -- -- Derive a type with an access discriminant from a formal limited -- tagged private type. Verify, for both record and private extensions, -- that the derived type is illegal in the instance if the actual type -- is not limited. -- -- -- CHANGE HISTORY: -- 06 Mar 95 SAIC Initial prerelease version. -- --! package B370001_0 is type Disc is new Natural range 0 .. 10; type LimTag is tagged limited record -- Limited due to word "limited." C : Integer; end record; type DerLimTag is new LimTag with -- Limited since parent is limited. null record; task type Tsk (X: access Disc) is end; -- Task type is limited. protected type PT (X: access Disc) is -- Protected type is limited. procedure Op; end PT; type LimRec (X: access Disc) is -- Limited due to word "limited." limited record C : Integer; end record; type NLTag is tagged record -- Non-limited. C : Integer; end record; end B370001_0; --==================================================================-- with B370001_0; use B370001_0; package B370001 is -- -- Basic cases: -- type NonLimRec (D: access Disc); -- OPTIONAL ERROR: -- Incomplete type is legal; full type is not. type AccRec is access NonLimRec; type NonLimRec (D: access Disc) is record -- ERROR: -- Non-task/protected type with access discriminant -- must be explicitly declared limited. C: LimTag; end record; type NonLimTag (D: access Disc) is tagged record -- ERROR: -- Non-task/protected type with access discriminant -- must be explicitly declared limited. C: Integer; end record; type Der_Lim_Parent (D: access Disc) is new DerLimTag with null record; -- OK. type Der_NonLim_Parent (D: access Disc) is new NLTag with null record; -- ERROR: -- No ancestor of parent type is limited. -- -- Generic cases: -- generic type FP is tagged private; type FDOK is new LimTag with private; type FDBad is new NLTag with private; package Generic_Cases is type Der_FP (D: access Disc) is new FP with null record; -- ERROR: -- Parent type is not limited. type Der_FDOK (D: access Disc) is new FDOK with null record; -- OK. type Der_FDBad (<>) is new FDBad with private; -- OPTIONAL ERROR: -- Partial view is legal; full view is not. private type Der_FDBad (D: access Disc) is new FDBad with null record; -- ERROR: -- No ancestor of parent is limited. end Generic_Cases; -- -- Instance cases: -- generic type FP (DD: access Disc) is limited private; package GenNonTag is type DFP (D: access Disc) is new FP(D); end GenNonTag; package Instance_Tsk is new GenNonTag (Tsk); -- OK. package Instance_PT is new GenNonTag (PT); -- OK. package Instance_LimRec is new GenNonTag (LimRec); -- OK. generic type FP is tagged limited private; package GenVis is type DFP (D: access Disc) is new FP with null record; end GenVis; package InstVis_NLTag is new GenVis (NLTag); -- ERROR: -- No ancestor of record extension in instance is limited. package InstVis_DerLimTag is new GenVis (DerLimTag); -- OK. generic type FP is tagged limited private; package GenPri is type DFP (<>) is new FP with private; private type DFP (D: access Disc) is new FP with null record; end GenPri; package InstPri_NLTag is new GenPri (NLTag); -- ERROR: -- No ancestor of private extension in instance is limited. package InstPri_LimTag is new GenPri (LimTag); -- OK. end B370001;