diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c4/c432001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c4/c432001.a | 512 |
1 files changed, 0 insertions, 512 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c4/c432001.a b/gcc/testsuite/ada/acats/tests/c4/c432001.a deleted file mode 100644 index dab75b388f5..00000000000 --- a/gcc/testsuite/ada/acats/tests/c4/c432001.a +++ /dev/null @@ -1,512 +0,0 @@ --- C432001.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 extension aggregates may be used to specify values --- for types that are record extensions. Check that the --- type of the ancestor expression may be any nonlimited type that --- is a record extension, including private types and private --- extensions. Check that the type for the aggregate is --- derived from the type of the ancestor expression. --- --- TEST DESCRIPTION: --- --- Two progenitor nonlimited record types are declared, one --- nonprivate and one private. Using these as parent types, --- all possible combinations of record extensions are declared --- (Nonprivate record extension of nonprivate type, private --- extension of nonprivate type, nonprivate record extension of --- private type, and private extension of private type). Finally, --- each of these types is extended using nonprivate record --- extensions. --- --- Extension of private types is done in packages other than --- the ones containing the parent declaration. This is done --- to eliminate errors with extension of the partial view of --- a type, which is not an objective of this test. --- --- All components of private types and private extensions are given --- default values. This eliminates the need for separate subprograms --- whose sole purpose is to place a value into a private record type. --- --- Types that have been extended are checked using an object of their --- parent type as the ancestor expression. For those types that --- have been extended twice, using only nonprivate record extensions, --- a check is made using an object of their grandparent type as --- the ancestor expression. --- --- For each type, a subprogram is defined which checks the contents --- of the parameter, which is a value of the record extension. --- Components of nonprivate record extensions are checked against --- passed-in parameters of the component type. Components of private --- extensions are checked to ensure that they maintain their initial --- values. --- --- To check that the aggregate's type is derived from its ancestor, --- each Check subprogram in turn calls the Check subprogram for --- its parent type. Explicit conversion is used to convert the --- record extension to the parent type. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Report; -package C432001_0 is - - type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic); - - type N is tagged record - How_Long_Ago : Natural := Report.Ident_Int(1); - Era : Eras := Cenozoic; - end record; - - function Check (Rec : in N; - N : in Natural; - E : in Eras) return Boolean; - - type P is tagged private; - - function Check (Rec : in P) return Boolean; - -private - - type P is tagged record - How_Long_Ago : Natural := Report.Ident_Int(150); - Era : Eras := Mesozoic; - end record; - -end C432001_0; - -package body C432001_0 is - - function Check (Rec : in P) return Boolean is - begin - return Rec.How_Long_Ago = 150 and Rec.Era = Mesozoic; - end Check; - - function Check (Rec : in N; - N : in Natural; - E : in Eras) return Boolean is - begin - return Rec.How_Long_Ago = N and Rec.Era = E; - end Check; - -end C432001_0; - -with C432001_0; -package C432001_1 is - - type Periods is - (Aphebian, Helikian, Hadrynian, - Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian, - Triassic, Jurassic, Cretaceous, - Tertiary, Quaternary); - - type N_N is new C432001_0.N with record - Period : Periods := C432001_1.Quaternary; - end record; - - function Check (Rec : in N_N; - N : in Natural; - E : in C432001_0.Eras; - P : in Periods) return Boolean; - - type N_P is new C432001_0.N with private; - - function Check (Rec : in N_P) return Boolean; - - type P_N is new C432001_0.P with record - Period : Periods := C432001_1.Jurassic; - end record; - - function Check (Rec : in P_N; - P : in Periods) return Boolean; - - type P_P is new C432001_0.P with private; - - function Check (Rec : in P_P) return Boolean; - - type P_P_Null is new C432001_0.P with null record; - -private - - type N_P is new C432001_0.N with record - Period : Periods := C432001_1.Quaternary; - end record; - - type P_P is new C432001_0.P with record - Period : Periods := C432001_1.Jurassic; - end record; - -end C432001_1; - -with Report; -package body C432001_1 is - - function Check (Rec : in N_N; - N : in Natural; - E : in C432001_0.Eras; - P : in Periods) return Boolean is - begin - if not C432001_0.Check (C432001_0.N (Rec), N, E) then - Report.Failed ("Conversion to parent type of " & - "nonprivate portion of " & - "nonprivate extension failed"); - end if; - return Rec.Period = P; - end Check; - - - function Check (Rec : in N_P) return Boolean is - begin - if not C432001_0.Check (C432001_0.N (Rec), 1, C432001_0.Cenozoic) then - Report.Failed ("Conversion to parent type of " & - "nonprivate portion of " & - "private extension failed"); - end if; - return Rec.Period = C432001_1.Quaternary; - end Check; - - function Check (Rec : in P_N; - P : in Periods) return Boolean is - begin - if not C432001_0.Check (C432001_0.P (Rec)) then - Report.Failed ("Conversion to parent type of " & - "private portion of " & - "nonprivate extension failed"); - end if; - return Rec.Period = P; - end Check; - - function Check (Rec : in P_P) return Boolean is - begin - if not C432001_0.Check (C432001_0.P (Rec)) then - Report.Failed ("Conversion to parent type of " & - "private portion of " & - "private extension failed"); - end if; - return Rec.Period = C432001_1.Jurassic; - end Check; - -end C432001_1; - -with C432001_0; -with C432001_1; -package C432001_2 is - - -- All types herein are nonprivate extensions, since aggregates - -- cannot be given for private extensions - - type N_N_N is new C432001_1.N_N with record - Sample_On_Loan : Boolean; - end record; - - function Check (Rec : in N_N_N; - N : in Natural; - E : in C432001_0.Eras; - P : in C432001_1.Periods; - B : in Boolean) return Boolean; - - type N_P_N is new C432001_1.N_P with record - Sample_On_Loan : Boolean; - end record; - - function Check (Rec : in N_P_N; - B : Boolean) return Boolean; - - type P_N_N is new C432001_1.P_N with record - Sample_On_Loan : Boolean; - end record; - - function Check (Rec : in P_N_N; - P : in C432001_1.Periods; - B : Boolean) return Boolean; - - type P_P_N is new C432001_1.P_P with record - Sample_On_Loan : Boolean; - end record; - - function Check (Rec : in P_P_N; - B : Boolean) return Boolean; - -end C432001_2; - -with Report; -package body C432001_2 is - - -- direct access to operator - use type C432001_1.Periods; - - - function Check (Rec : in N_N_N; - N : in Natural; - E : in C432001_0.Eras; - P : in C432001_1.Periods; - B : in Boolean) return Boolean is - begin - if not C432001_1.Check (C432001_1.N_N (Rec), N, E, P) then - Report.Failed ("Conversion to parent " & - "nonprivate type extension " & - "failed"); - end if; - return Rec.Sample_On_Loan = B; - end Check; - - - function Check (Rec : in N_P_N; - B : Boolean) return Boolean is - begin - if not C432001_1.Check (C432001_1.N_P (Rec)) then - Report.Failed ("Conversion to parent " & - "private type extension " & - "failed"); - end if; - return Rec.Sample_On_Loan = B; - end Check; - - function Check (Rec : in P_N_N; - P : in C432001_1.Periods; - B : Boolean) return Boolean is - begin - if not C432001_1.Check (C432001_1.P_N (Rec), P) then - Report.Failed ("Conversion to parent " & - "nonprivate type extension " & - "failed"); - end if; - return Rec.Sample_On_Loan = B; - end Check; - - function Check (Rec : in P_P_N; - B : Boolean) return Boolean is - begin - if not C432001_1.Check (C432001_1.P_P (Rec)) then - Report.Failed ("Conversion to parent " & - "private type extension " & - "failed"); - end if; - return Rec.Sample_On_Loan = B; - end Check; - -end C432001_2; - - -with C432001_0; -with C432001_1; -with C432001_2; -with Report; -procedure C432001 is - - N_Object : C432001_0.N := (How_Long_Ago => Report.Ident_Int(375), - Era => C432001_0.Paleozoic); - - P_Object : C432001_0.P; -- default value is (150, - -- C432001_0.Mesozoic) - - N_N_Object : C432001_1.N_N := - (N_Object with Period => C432001_1.Devonian); - - P_N_Object : C432001_1.P_N := - (P_Object with Period => C432001_1.Jurassic); - - N_P_Object : C432001_1.N_P; -- default is (1, - -- C432001_0.Cenozoic, - -- C432001_1.Quaternary) - - P_P_Object : C432001_1.P_P; -- default is (150, - -- C432001_0.Mesozoic, - -- C432001_1.Jurassic) - - P_P_Null_Ob:C432001_1.P_P_Null := (P_Object with null record); - - N_N_N_Object : C432001_2.N_N_N := - (N_N_Object with Sample_On_Loan => Report.Ident_Bool(True)); - - N_P_N_Object : C432001_2.N_P_N := - (N_P_Object with Sample_On_Loan => Report.Ident_Bool(False)); - - P_N_N_Object : C432001_2.P_N_N := - (P_N_Object with Sample_On_Loan => Report.Ident_Bool(True)); - - P_P_N_Object : C432001_2.P_P_N := - (P_P_Object with Sample_On_Loan => Report.Ident_Bool(False)); - - P_N_Object_2 : C432001_1.P_N := (C432001_0.P(P_N_N_Object) - with C432001_1.Carboniferous); - - N_N_Object_2 : C432001_1.N_N := (C432001_0.N'(42,C432001_0.Precambrian) - with C432001_1.Carboniferous); - -begin - - Report.Test ("C432001", "Extension aggregates"); - - -- check ultimate ancestor types - - if not C432001_0.Check (N_Object, - 375, - C432001_0.Paleozoic) then - Report.Failed ("Object of " & - "nonprivate type " & - "failed content check"); - end if; - - if not C432001_0.Check (P_Object) then - Report.Failed ("Object of " & - "private type " & - "failed content check"); - end if; - - -- check direct type extensions - - if not C432001_1.Check (N_N_Object, - 375, - C432001_0.Paleozoic, - C432001_1.Devonian) then - Report.Failed ("Object of " & - "nonprivate extension of nonprivate type " & - "failed content check"); - end if; - - if not C432001_1.Check (N_P_Object) then - Report.Failed ("Object of " & - "private extension of nonprivate type " & - "failed content check"); - end if; - - if not C432001_1.Check (P_N_Object, - C432001_1.Jurassic) then - Report.Failed ("Object of " & - "nonprivate extension of private type " & - "failed content check"); - end if; - - if not C432001_1.Check (P_P_Object) then - Report.Failed ("Object of " & - "private extension of private type " & - "failed content check"); - end if; - - if not C432001_1.Check (P_P_Null_Ob) then - Report.Failed ("Object of " & - "private type " & - "failed content check"); - end if; - - - -- check direct extensions of extensions - - if not C432001_2.Check (N_N_N_Object, - 375, - C432001_0.Paleozoic, - C432001_1.Devonian, - True) then - Report.Failed ("Object of " & - "nonprivate extension of nonprivate extension " & - "(of nonprivate parent) " & - "failed content check"); - end if; - - if not C432001_2.Check (N_P_N_Object, False) then - Report.Failed ("Object of " & - "nonprivate extension of private extension " & - "(of nonprivate parent) " & - "failed content check"); - end if; - - if not C432001_2.Check (P_N_N_Object, - C432001_1.Jurassic, - True) then - Report.Failed ("Object of " & - "nonprivate extension of nonprivate extension " & - "(of private parent) " & - "failed content check"); - end if; - - if not C432001_2.Check (P_P_N_Object, False) then - Report.Failed ("Object of " & - "nonprivate extension of private extension " & - "(of private parent) " & - "failed content check"); - end if; - - -- check that the extension aggregate may specify an expression of - -- a "grandparent" ancestor type - - -- types tested are derived through nonprivate extensions only - -- (extension aggregates are not allowed if the path from the - -- ancestor type wanders through a private extension) - - N_N_N_Object := - (N_Object with Period => C432001_1.Devonian, - Sample_On_Loan => Report.Ident_Bool(True)); - - if not C432001_2.Check (N_N_N_Object, - 375, - C432001_0.Paleozoic, - C432001_1.Devonian, - True) then - Report.Failed ("Object of " & - "nonprivate extension " & - "of nonprivate ancestor " & - "failed content check"); - end if; - - P_N_N_Object := - (P_Object with Period => C432001_1.Jurassic, - Sample_On_Loan => Report.Ident_Bool(True)); - - if not C432001_2.Check (P_N_N_Object, - C432001_1.Jurassic, - True) then - Report.Failed ("Object of " & - "nonprivate extension " & - "of private ancestor " & - "failed content check"); - end if; - - -- Check additional cases - if not C432001_1.Check (P_N_Object_2, - C432001_1.Carboniferous) then - Report.Failed ("Additional Object of " & - "nonprivate extension of private type " & - "failed content check"); - end if; - - if not C432001_1.Check (N_N_Object_2, - 42, - C432001_0.Precambrian, - C432001_1.Carboniferous) then - Report.Failed ("Additional Object of " & - "nonprivate extension of nonprivate type " & - "failed content check"); - end if; - - Report.Result; - -end C432001; |