diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cc/cc51b03.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cc/cc51b03.a | 258 |
1 files changed, 0 insertions, 258 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cc/cc51b03.a b/gcc/testsuite/ada/acats/tests/cc/cc51b03.a deleted file mode 100644 index 0cbeeb46f63..00000000000 --- a/gcc/testsuite/ada/acats/tests/cc/cc51b03.a +++ /dev/null @@ -1,258 +0,0 @@ --- CC51B03.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 the attribute S'Definite, where S is an indefinite formal --- private or derived type, returns true if the actual corresponding to --- S is definite, and returns false otherwise. --- --- TEST DESCRIPTION: --- A definite subtype is any subtype which is not indefinite. An --- indefinite subtype is either: --- a) An unconstrained array subtype. --- b) A subtype with unknown discriminants (this includes class-wide --- types). --- c) A subtype with unconstrained discriminants without defaults. --- --- The possible forms of indefinite formal subtype are as follows: --- --- Formal derived types: --- X - Ancestor is an unconstrained array type --- * - Ancestor is a discriminated record type without defaults --- X - Ancestor is a discriminated tagged type --- * - Ancestor type has unknown discriminants --- - Formal type has an unknown discriminant part --- * - Formal type has a known discriminant part --- --- Formal private types: --- - Formal type has an unknown discriminant part --- * - Formal type has a known discriminant part --- --- The formal subtypes preceded by an 'X' above are not covered, because --- other rules prevent a definite subtype from being passed as an actual. --- The formal subtypes preceded by an '*' above are not covered, because --- 'Definite is less likely to be used for these formals. --- --- The following kinds of actuals are passed to various of the formal --- types listed above: --- --- - Undiscriminated type --- - Type with defaulted discriminants --- - Type with undefaulted discriminants --- - Class-wide type --- --- A typical usage of S'Definite might be algorithm selection in a --- generic I/O package, e.g., the use of fixed-length or variable-length --- records depending on whether the actual is definite or indefinite. --- In such situations, S'Definite would appear in if conditions or other --- contexts requiring a boolean expression. This test checks S'Definite --- in such usage contexts but, for brevity, omits any surrounding --- usage code. --- --- TEST FILES: --- The following files comprise this test: --- --- FC51B00.A --- -> CC51B03.A --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with FC51B00; -- Indefinite subtype declarations. -package CC51B03_0 is - - -- - -- Formal private type cases: - -- - - generic - type Formal (<>) is private; -- Formal has unknown - package PrivateFormalUnknownDiscriminants is -- discriminant part. - function Is_Definite return Boolean; - end PrivateFormalUnknownDiscriminants; - - - -- - -- Formal derived type cases: - -- - - generic - type Formal (<>) is new FC51B00.Vector -- Formal has an unknown disc. - with private; -- part; ancestor is tagged. - package TaggedAncestorUnknownDiscriminants is - function Is_Definite return Boolean; - end TaggedAncestorUnknownDiscriminants; - - -end CC51B03_0; - - - --==================================================================-- - - -package body CC51B03_0 is - - package body PrivateFormalUnknownDiscriminants is - function Is_Definite return Boolean is - begin - if Formal'Definite then -- Attribute used in "if" - -- ...Execute algorithm #1... -- condition inside subprogram. - return True; - else - -- ...Execute algorithm #2... - return False; - end if; - end Is_Definite; - end PrivateFormalUnknownDiscriminants; - - - package body TaggedAncestorUnknownDiscriminants is - function Is_Definite return Boolean is - begin - return Formal'Definite; -- Attribute used in return - end Is_Definite; -- statement inside subprogram. - end TaggedAncestorUnknownDiscriminants; - - -end CC51B03_0; - - - --==================================================================-- - - -with FC51B00; -package CC51B03_1 is - - subtype Spin_Type is Natural range 0 .. 3; - - type Extended_Vector (Spin : Spin_Type) is -- Tagged type with - new FC51B00.Vector with null record; -- discriminant (indefinite). - - -end CC51B03_1; - - - --==================================================================-- - - -with FC51B00; -- Indefinite subtype declarations. -with CC51B03_0; -- Generic package declarations. -with CC51B03_1; - -with Report; -procedure CC51B03 is - - -- - -- Instances for formal private type with unknown discriminants: - -- - - package PrivateFormal_UndiscriminatedTaggedActual is new - CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Vector); - - package PrivateFormal_ClassWideActual is new - CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Vector'Class); - - package PrivateFormal_DiscriminatedTaggedActual is new - CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Square_Pair); - - package PrivateFormal_DiscriminatedUndefaultedRecordActual is new - CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Square); - - - subtype Length is Natural range 0 .. 20; - type Message (Len : Length := 0) is record -- Record type with defaulted - Text : String (1 .. Len); -- discriminant (definite). - end record; - - package PrivateFormal_DiscriminatedDefaultedRecordActual is new - CC51B03_0.PrivateFormalUnknownDiscriminants (Message); - - - -- - -- Instances for formal derived tagged type with unknown discriminants: - -- - - package DerivedFormal_UndiscriminatedTaggedActual is new - CC51B03_0.TaggedAncestorUnknownDiscriminants (FC51B00.Vector); - - package DerivedFormal_ClassWideActual is new - CC51B03_0.TaggedAncestorUnknownDiscriminants (FC51B00.Vector'Class); - - package DerivedFormal_DiscriminatedTaggedActual is new - CC51B03_0.TaggedAncestorUnknownDiscriminants (CC51B03_1.Extended_Vector); - - -begin - Report.Test ("CC51B03", "Check that S'Definite returns true if the " & - "actual corresponding to S is definite, and false otherwise"); - - - if not PrivateFormal_UndiscriminatedTaggedActual.Is_Definite then - Report.Failed ("Formal private/unknown discriminants: wrong " & - "result for undiscriminated tagged actual"); - end if; - - if PrivateFormal_ClassWideActual.Is_Definite then - Report.Failed ("Formal private/unknown discriminants: wrong " & - "result for class-wide actual"); - end if; - - if PrivateFormal_DiscriminatedTaggedActual.Is_Definite then - Report.Failed ("Formal private/unknown discriminants: wrong " & - "result for discriminated tagged actual"); - end if; - - if PrivateFormal_DiscriminatedUndefaultedRecordActual.Is_Definite then - Report.Failed ("Formal private/unknown discriminants: wrong result " & - "for record actual with undefaulted discriminants"); - end if; - - if not PrivateFormal_DiscriminatedDefaultedRecordActual.Is_Definite then - Report.Failed ("Formal private/unknown discriminants: wrong result " & - "for record actual with defaulted discriminants"); - end if; - - - if not DerivedFormal_UndiscriminatedTaggedActual.Is_Definite then - Report.Failed ("Formal derived/unknown discriminants: wrong result " & - "for undiscriminated tagged actual"); - end if; - - if DerivedFormal_ClassWideActual.Is_Definite then - Report.Failed ("Formal derived/unknown discriminants: wrong result " & - "for class-wide actual"); - end if; - - if DerivedFormal_DiscriminatedTaggedActual.Is_Definite then - Report.Failed ("Formal derived/unknown discriminants: wrong result " & - "for discriminated tagged actual"); - end if; - - - Report.Result; -end CC51B03; |