diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c4/c432004.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c4/c432004.a | 319 |
1 files changed, 0 insertions, 319 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c4/c432004.a b/gcc/testsuite/ada/acats/tests/c4/c432004.a deleted file mode 100644 index 3a148621115..00000000000 --- a/gcc/testsuite/ada/acats/tests/c4/c432004.a +++ /dev/null @@ -1,319 +0,0 @@ --- C432004.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 type of an extension aggregate may be derived from the --- type of the ancestor part through multiple record extensions. Check --- for ancestor parts that are subtype marks. Check that the type of the --- ancestor part may be abstract. --- --- TEST DESCRIPTION: --- This test defines the following type hierarchies: --- --- (A) (F) --- Abstract Abstract --- Tagged record Tagged private --- / \ / \ --- / (C) (G) \ --- (B) Abstract Abstract (H) --- Record private record Private --- extension extension extension extension --- | | | | --- (D) (E) (I) (J) --- Record Record Record Record --- extension extension extension extension --- --- Extension aggregates for B, D, E, I, and J are constructed using each --- of its ancestor types as the ancestor part (except for E and J, for --- which only the immediate ancestor is used, since using A and F, --- respectively, as the ancestor part would be illegal). --- --- X1 : B := (A with ...); --- X2 : D := (A with ...); X5 : I := (F with ...); --- X3 : D := (B with ...); X6 : I := (G with ...); --- X4 : E := (C with ...); X7 : J := (H with ...); --- --- For each assignment of an aggregate, the value of the target object is --- checked to ensure that the proper values for each component were --- assigned. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -package C432004_0 is - - type Drawers is record - Building : natural; - end record; - - type Location is access Drawers; - - type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic); - - type SampleType_A is abstract tagged record - Era : Eras := Cenozoic; - Loc : Location; - end record; - - type SampleType_F is abstract tagged private; - - -- The following function is needed to verify the values of the - -- private components. - function TC_Correct_Result (Rec : SampleType_F'Class; - E : Eras) return Boolean; - -private - type SampleType_F is abstract tagged record - Era : Eras := Mesozoic; - end record; - -end C432004_0; - - --==================================================================-- - -package body C432004_0 is - - function TC_Correct_Result (Rec : SampleType_F'Class; - E : Eras) return Boolean is - begin - return (Rec.Era = E); - end TC_Correct_Result; - -end C432004_0; - - --==================================================================-- - -with C432004_0; -package C432004_1 is - - type Periods is - (Aphebian, Helikian, Hadrynian, - Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian, - Triassic, Jurassic, Cretaceous, - Tertiary, Quaternary); - - type SampleType_B is new C432004_0.SampleType_A with record - Period : Periods := Quaternary; - end record; - - type SampleType_C is abstract new C432004_0.SampleType_A with private; - - -- The following function is needed to verify the values of the - -- extension's private components. - function TC_Correct_Result (Rec : SampleType_C'Class; - P : Periods) return Boolean; - - type SampleType_G is abstract new C432004_0.SampleType_F with record - Period : Periods := Jurassic; - Loc : C432004_0.Location; - end record; - - type SampleType_H is new C432004_0.SampleType_F with private; - - -- The following function is needed to verify the values of the - -- extension's private components. - function TC_Correct_Result (Rec : SampleType_H'Class; - P : Periods; - E : C432004_0.Eras) return Boolean; - -private - type SampleType_C is abstract new C432004_0.SampleType_A with record - Period : Periods := Quaternary; - end record; - - type SampleType_H is new C432004_0.SampleType_F with record - Period : Periods := Jurassic; - end record; - -end C432004_1; - - --==================================================================-- - -package body C432004_1 is - - function TC_Correct_Result (Rec : SampleType_C'Class; - P : Periods) return Boolean is - begin - return (Rec.Period = P); - end TC_Correct_Result; - - ------------------------------------------------------------- - function TC_Correct_Result (Rec : SampleType_H'Class; - P : Periods; - E : C432004_0.Eras) return Boolean is - begin - return (Rec.Period = P) and C432004_0.TC_Correct_Result (Rec, E); - end TC_Correct_Result; - -end C432004_1; - - --==================================================================-- - -with C432004_0; -with C432004_1; -package C432004_2 is - - -- All types herein are record extensions, since aggregates - -- cannot be given for private extensions - - type SampleType_D is new C432004_1.SampleType_B with record - Sample_On_Loan : Boolean := False; - end record; - - type SampleType_E is new C432004_1.SampleType_C - with null record; - - type SampleType_I is new C432004_1.SampleType_G with record - Sample_On_Loan : Boolean := True; - end record; - - type SampleType_J is new C432004_1.SampleType_H with record - Sample_On_Loan : Boolean := True; - end record; - -end C432004_2; - - - --==================================================================-- - -with Report; -with C432004_0; -with C432004_1; -with C432004_2; -use C432004_1; -use C432004_2; - -procedure C432004 is - - -- Variety of extension aggregates. - - -- Default values for the components of SampleType_A - -- (Era => Cenozoic, Loc => null). - Sample_B : SampleType_B - := (C432004_0.SampleType_A with Period => Devonian); - - -- Default values from SampleType_A (Era => Cenozoic, Loc => null). - Sample_D1 : SampleType_D - := (C432004_0.SampleType_A with Period => Cambrian, - Sample_On_Loan => True); - - -- Default values from SampleType_A and SampleType_B - -- (Era => Cenozoic, Loc => null, Period => Quaternary). - Sample_D2 : SampleType_D - := (SampleType_B with Sample_On_Loan => True); - - -- Default values from SampleType_A and SampleType_C - -- (Era => Cenozoic, Loc => null, Period => Quaternary). - Sample_E : SampleType_E - := (SampleType_C with null record); - - -- Default value from SampleType_F (Era => Mesozoic). - Sample_I1 : SampleType_I - := (C432004_0.SampleType_F with Period => Tertiary, - Loc => new C432004_0.Drawers'(Building => 9), - Sample_On_Loan => False); - - -- Default values from SampleType_F and SampleType_G - -- (Era => Mesozoic, Period => Jurassic, Loc => null). - Sample_I2 : SampleType_I - := (SampleType_G with Sample_On_Loan => False); - - -- Default values from SampleType_H (Era => Mesozoic, Period => Jurassic). - Sample_J : SampleType_J - := (SampleType_H with Sample_On_Loan => False); - - use type C432004_0.Eras; - use type C432004_0.Location; - -begin - - Report.Test ("C432004", "Check that the type of an extension aggregate " & - "may be derived from the type of the ancestor part through " & - "multiple record extensions"); - - if Sample_B /= (C432004_0.Cenozoic, null, Devonian) then - Report.Failed ("Object of record extension of abstract ancestor, " & - "SampleType_B, failed content check"); - end if; - - ------------------- - if Sample_D1 /= (Era => C432004_0.Cenozoic, Loc => null, - Period => Cambrian, Sample_On_Loan => True) then - Report.Failed ("Object 1 of record extension of record extension, " & - "of abstract ancestor, SampleType_D, failed content " & - "check"); - end if; - - ------------------- - if Sample_D2 /= (C432004_0.Cenozoic, null, Quaternary, True) then - Report.Failed ("Object 2 of record extension of record extension, " & - "of abstract ancestor, SampleType_D, failed content " & - "check"); - end if; - ------------------- - if Sample_E.Era /= C432004_0.Cenozoic or - Sample_E.Loc /= null or - not TC_Correct_Result (Sample_E, Quaternary) then - Report.Failed ("Object of record extension of abstract private " & - "extension of abstract ancestor, SampleType_E, " & - "failed content check"); - end if; - - ------------------- - if not C432004_0.TC_Correct_Result (Sample_I1, C432004_0.Mesozoic) or - Sample_I1.Period /= Tertiary or - Sample_I1.Loc.Building /= 9 or - Sample_I1.Sample_On_Loan /= False then - Report.Failed ("Object 1 of record extension of abstract record " & - "extension of abstract private ancestor, " & - "SampleType_I, failed content check"); - end if; - - ------------------- - if not C432004_0.TC_Correct_Result (Sample_I2, C432004_0.Mesozoic) or - Sample_I2.Period /= Jurassic or - Sample_I2.Loc /= null or - Sample_I2.Sample_On_Loan /= False then - Report.Failed ("Object 2 of record extension of abstract record " & - "extension of abstract private ancestor, " & - "SampleType_I, failed content check"); - end if; - - ------------------- - if not TC_Correct_Result (Sample_J, - Jurassic, - C432004_0.Mesozoic) or - Sample_J.Sample_On_Loan /= False then - Report.Failed ("Object of record extension of private extension " & - "of abstract private ancestor, SampleType_J, " & - "failed content check"); - end if; - - Report.Result; - -end C432004; |