CVS difference for acats/new/c431004.a
--- acats/new/c431004.a 2022/03/30 05:18:36 1.1
+++ acats/new/c431004.a 2022/03/31 09:09:49 1.2
@@ -40,13 +40,16 @@
-- Extension aggregate cases for paragraph 4.3.1(17.1/2). Note that this
-- rule applies to all Ada versions since Amendment 1 for Ada 95.
--
+-- Only limited tagged types can have defaults (by 3.7(9.1/3)), so this
+-- test can only be made on limited tagged types.
+--
-- Aggregates are commonly used. Thus, we assume that almost all cases
-- will eventually appear in actual usage and thus do not try to describe
-- a specific usage scenario.
--
-- CHANGE HISTORY:
-- 2022-02-24 JAC Initial pre-release version.
--- Cleaned up for release.
+-- 2022-03-30 RLB Redid to use extensions, not nested records.
--
--!
@@ -56,83 +59,154 @@
type Units_Type is (Feet, Metres);
- type Tagged_Units_Type is tagged record
- Units_Field : Units_Type;
+ type Tagged_Units_Type is tagged limited record
+ Units_Field : Units_Type := Metres;
end record;
- Tagged_Units : constant Tagged_Units_Type := (Units_Field => Metres);
-
-- Example where a discriminant of a numeric type determines the bounds of a
- -- 1-D array
+ -- 1-D array in an extension.
type Integer_Vector_Type is array (Integer range <>) of Integer;
Max : constant := 100;
subtype Index is Integer range 0 .. Max;
-
- type Poly_Type (N : Index := 1) is record
- IV : Integer_Vector_Type (0 .. N);
- end record;
-
- type Dimensioned_Poly_Type is new Tagged_Units_Type with record
- Poly : Poly_Type;
- end record;
- -- Discriminant explicitly initialised to default
- Dimensioned_Poly_1 : constant Dimensioned_Poly_Type :=
- (Units_Field => Metres,
- Poly => (N => <>,
- IV => <>));
- -- Discriminant explicitly initialised to a specific value
- Dimensioned_Poly_2 : Dimensioned_Poly_Type :=
- (Units_Field => Feet,
- Poly => (N => 2,
- IV => <>));
+ type Poly_Units_Type (N : Index := 1) is new Tagged_Units_Type
+ with record
+ IV : Integer_Vector_Type (0 .. N);
+ end record;
+
+ -- Discriminant explicitly initialised to default:
+ Poly_1 : constant Poly_Units_Type := (Units_Field => Metres,
+ N => <>,
+ IV => <>);
+
+ -- Discriminant explicitly initialised to a specific value:
+ Poly_2 : Poly_Units_Type := (Units_Field => Feet,
+ N => 2,
+ IV => <>);
+
+ -- Discriminant explicit initialized to default in extension aggregate:
+ Poly_3 : constant Poly_Units_Type := (Tagged_Units_Type with
+ N => <>,
+ IV => <>);
+
+ -- Discriminant explicitly initialised to a specific value in
+ -- extension aggregate:
+ Poly_4 : Poly_Units_Type := (Tagged_Units_Type with
+ N => 2,
+ IV => <>);
+
+ -- All components defaulted:
+ Poly_5 : Poly_Units_Type := (Tagged_Units_Type with
+ others => <>);
+
+
-- Example where discriminants of a numeric type determine the bounds of a
- -- matrix
+ -- matrix.
subtype Bounds_Type is Integer range 0 .. 100;
type Matrix_Type is array (Bounds_Type range <>,
Bounds_Type range <>) of Float;
- type Matrix_Rec_Type (Rows : Integer := 2;
- Columns : Integer := 3) is record
- Mat : Matrix_Type (1 .. Rows, 1 .. Columns);
- end record;
+ type Matrix_Units_Type (Rows : Integer := 2;
+ Columns : Integer := 3) is new Tagged_Units_Type
+ with record
+ Mat : Matrix_Type (1 .. Rows, 1 .. Columns);
+ end record;
+
+ Matrix_Rec_1 : constant Matrix_Units_Type :=
+ (Tagged_Units_Type with
+ Rows => <>,
+ Columns => <>,
+ Mat => (others => (others => 0.0)));
+
+ Matrix_Rec_2 : constant Matrix_Units_Type :=
+ (Tagged_Units_Type with
+ Rows => 5,
+ Columns => <>,
+ Mat => (others => (others => 0.0)));
+
+ Matrix_Rec_3 : constant Matrix_Units_Type :=
+ (Tagged_Units_Type with
+ Rows => <>,
+ Columns => 4,
+ Mat => (others => (others => 0.0)));
+
+ Matrix_Rec_4 : constant Matrix_Units_Type :=
+ (Tagged_Units_Type with
+ Rows => 3,
+ Columns => 6,
+ Mat => (others => (others => 0.0)));
- type Dimensioned_Matrix_Rec_Type is new Tagged_Units_Type with record
- Matrix_Rec : Matrix_Rec_Type;
- end record;
+ Matrix_Rec_5 : constant Matrix_Units_Type :=
+ (Tagged_Units_Type with others => <>);
- Dimensioned_Matrix_Rec : Dimensioned_Matrix_Rec_Type :=
- (Units_Field => Metres,
- Matrix_Rec => (Rows => <>,
- Columns => <>,
- Mat => (others => (others => 0.0))));
+ Matrix_Rec_6 : constant Matrix_Units_Type :=
+ (Tagged_Units_Type with Rows => 4, others => <>);
- -- Example where a discriminant of an enumeration type selects a variant
+ -- Example where a discriminant of an enumeration type selects a variant:
type Gender_Type is (Male, Female);
-
- type Person_Type (Gender : Gender_Type := Male) is record
- Height : Float;
- case Gender is
- when Male =>
- Bearded : Boolean;
- when Female =>
- No_Of_Children : Natural;
- end case;
- end record;
-
- type Dimensioned_Person_Type is new Tagged_Units_Type with record
- Person : Person_Type;
- end record;
- Dimensioned_Person : Dimensioned_Person_Type;
-
+ type Poly_Person_Type (N : Index := 2;
+ Gender : Gender_Type := Male) is
+ new Poly_Units_Type(N) with record
+ Height : Float;
+ case Gender is
+ when Male =>
+ Bearded : Boolean;
+ when Female =>
+ No_Of_Children : Natural;
+ end case;
+ end record;
+
+ Person_1 : constant Poly_Person_Type :=
+ (Tagged_Units_Type with
+ N => <>,
+ IV => <>,
+ Gender => <>,
+ Height => <>,
+ Bearded => <>);
+
+ Person_2 : Poly_Person_Type :=
+ (Tagged_Units_Type with others => <>);
+
+ Person_3 : Poly_Person_Type :=
+ (Tagged_Units_Type with
+ N => <>,
+ IV => <>,
+ Gender => Female, No_of_Children => 0,
+ Height => 5.0);
+
+ Person_4 : Poly_Person_Type :=
+ (Tagged_Units_Type with Gender => Female, others => <>);
+
+ Person_5 : Poly_Person_Type :=
+ (Poly_Units_Type with
+ N => <>,
+ Gender => <>,
+ Height => <>,
+ Bearded => <>);
+
+ Person_6 : constant Poly_Person_Type :=
+ (Poly_Units_Type with others => <>);
+
+ Person_7 : constant Poly_Person_Type :=
+ (Poly_Units_Type with
+ N => <>,
+ Gender => Female, No_of_Children => 0,
+ Height => 5.0);
+
+ Person_8 : constant Poly_Person_Type :=
+ (Poly_Units_Type with
+ N => 1,
+ Gender => Female, No_of_Children => 0,
+ Height => 5.0);
+
begin
Report.Test
@@ -140,124 +214,112 @@
"Check that the association in an extension aggregate for a" &
" discriminant with a default can be given by <>");
- -- Check that the default discriminant value of 1 has been used
- if Dimensioned_Poly_1.Poly.N /= 1 then
+ -- Check that the discriminant values are as expected:
+ if Poly_1.N /= 1 then
Report.Failed
- ("Discriminant not as expected, 1-D array, discriminant set to" &
- " default at creation");
+ ("Poly: Discriminant not as expected, 1-D array, record aggregate, " &
+ "discriminant set to default");
end if;
-
- -- Discriminant returned to default by assignment
- Dimensioned_Poly_2 := (Tagged_Units with Poly => (N => <>, IV => <>));
-
- -- Check that the default discriminant value of 1 has been used
- if Dimensioned_Poly_2.Poly.N /= 1 then
+ if Poly_2.N /= 2 then
Report.Failed
- ("Discriminant not as expected, 1-D array, discriminant reset to" &
- " default at subsequent assignment");
+ ("Poly: Discriminant not as expected, 1-D array, record aggregate, " &
+ "discriminant explicitly set");
end if;
-
-
- -- Check that the default discriminant values of 2 and 3 have been used
- if Dimensioned_Matrix_Rec.Matrix_Rec.Rows /= 2 and then
- Dimensioned_Matrix_Rec.Matrix_Rec.Columns /= 3 then
+ if Poly_3.N /= 1 then
Report.Failed
- ("Discriminants not as expected, rows and columns both set to" &
- " defaults at creation");
+ ("Poly: Discriminant not as expected, 1-D array, extension " &
+ "aggregate, discriminant set to default");
end if;
-
- Dimensioned_Matrix_Rec := (Tagged_Units with
- Matrix_Rec => (Rows => <>,
- Columns => <>,
- Mat => (others => (others => 0.0))));
-
- -- Check that the default discriminant values of 2 and 3 have been used
- if Dimensioned_Matrix_Rec.Matrix_Rec.Rows /= 2 and then
- Dimensioned_Matrix_Rec.Matrix_Rec.Columns /= 3 then
+ if Poly_4.N /= 2 then
Report.Failed
- ("Discriminants not as expected, rows and columns both set to" &
- " defaults at subsequent assignment");
+ ("Poly: Discriminant not as expected, 1-D array, extension " &
+ "aggregate, discriminant explicitly set");
end if;
-
- Dimensioned_Matrix_Rec := (Tagged_Units with
- Matrix_Rec => (Rows => 5,
- Columns => <>,
- Mat => (others => (others => 0.0))));
-
- -- Check that the discriminant values of specific 5 and default 3 have been
- -- used
- if Dimensioned_Matrix_Rec.Matrix_Rec.Rows /= 5 and then
- Dimensioned_Matrix_Rec.Matrix_Rec.Columns /= 3 then
+ if Poly_5.N /= 1 then
Report.Failed
- ("Discriminants not as expected, rows specific and columns using" &
- " default");
+ ("Poly: Discriminant not as expected, 1-D array, extension " &
+ "aggregate, all components set to default");
end if;
- Dimensioned_Matrix_Rec := (Tagged_Units with
- Matrix_Rec => (Rows => <>,
- Columns => 4,
- Mat => (others => (others => 0.0))));
- -- Check that the discriminant values of default 2 and specific 4 have been
- -- used
- if Dimensioned_Matrix_Rec.Matrix_Rec.Rows /= 2 and then
- Dimensioned_Matrix_Rec.Matrix_Rec.Columns /= 4 then
+ -- Check that the discriminant values for the matrix type are as expected:
+ if Matrix_Rec_1.Rows /= 2 and then
+ Matrix_Rec_1.Columns /= 3 then
Report.Failed
- ("Discriminants not as expected, rows using default and columns" &
- " specific");
+ ("Matrix: Discriminants not as expected, rows and columns both set" &
+ " to defaults");
end if;
-
- Dimensioned_Matrix_Rec := (Tagged_Units with Matrix_Rec => (others => <>));
-
- -- Check that the default discriminant values of 2 and 3 have been used
- if Dimensioned_Matrix_Rec.Matrix_Rec.Rows /= 2 and then
- Dimensioned_Matrix_Rec.Matrix_Rec.Columns /= 3 then
+ if Matrix_Rec_2.Rows /= 5 and then
+ Matrix_Rec_2.Columns /= 3 then
Report.Failed
- ("Discriminants not as expected, rows and columns both set to" &
- " defaults at subsequent assignment using others");
+ ("Matrix: Discriminants not as expected, rows set, columns defaulted");
end if;
-
- Dimensioned_Matrix_Rec := (Tagged_Units with
- Matrix_Rec => (Rows => 6,
- others => <>));
-
- -- Check that the discriminant values of specific 6 and default 3 have been
- -- used
- if Dimensioned_Matrix_Rec.Matrix_Rec.Rows /= 6 and then
- Dimensioned_Matrix_Rec.Matrix_Rec.Columns /= 3 then
+ if Matrix_Rec_3.Rows /= 2 and then
+ Matrix_Rec_3.Columns /= 4 then
Report.Failed
- ("Discriminants not as expected, rows specific and columns using" &
- " default via others");
+ ("Matrix: Discriminants not as expected, rows defaulted, columns set");
end if;
-
-
- Dimensioned_Person := (Tagged_Units with Person => (Gender => <>,
- Height => <>,
- Bearded => <>));
-
- -- Check that the default discriminant value of Male has been used
- if Dimensioned_Person.Person.Gender /= Male then
+ if Matrix_Rec_4.Rows /= 3 and then
+ Matrix_Rec_4.Columns /= 6 then
Report.Failed
- ("Discriminant not as expected, variant parts");
+ ("Matrix: Discriminants not as expected, rows and columns explicitly" &
+ " set");
end if;
-
- Dimensioned_Person := (Tagged_Units with Person => (others => <>));
-
- -- Check that the default discriminant value of Male has been used
- if Dimensioned_Person.Person.Gender /= Male then
+ if Matrix_Rec_5.Rows /= 2 and then
+ Matrix_Rec_5.Columns /= 3 then
Report.Failed
- ("Discriminant not as expected, variant parts - 2");
+ ("Matrix: Discriminants not as expected, all components defaulted");
end if;
-
- Dimensioned_Person := (Tagged_Units with Person => (Gender => Female,
- others => <>));
-
- -- Check that the discriminant value of Female has been used
- if Dimensioned_Person.Person.Gender /= Female then
+ if Matrix_Rec_6.Rows /= 4 and then
+ Matrix_Rec_6.Columns /= 3 then
Report.Failed
- ("Discriminant not as expected, variant parts - 3");
+ ("Matrix: Discriminants not as expected, rows set explicitly, all " &
+ "other components defaulted");
end if;
+ -- Check that the correct discriminants have been used:
+ if Person_1.N /= 2 or else Person_1.Gender /= Male then
+ Report.Failed
+ ("Person: Discriminants not as expected, discriminants both set to " &
+ "defaults");
+ end if;
+ if Person_2.N /= 2 or else Person_2.Gender /= Male then
+ Report.Failed
+ ("Person: Discriminants not as expected, all components defaulted");
+ end if;
+ if Person_3.N /= 2 or else Person_3.Gender /= Female then
+ Report.Failed
+ ("Person: Discriminants not as expected, Gender explicitly set, N " &
+ "set to default");
+ end if;
+ if Person_4.N /= 2 or else Person_4.Gender /= Female then
+ Report.Failed
+ ("Person: Discriminants not as expected, Gender explicit set, all " &
+ " other components defaulted");
+ end if;
+ if Person_5.N /= 2 or else Person_5.Gender /= Male then
+ Report.Failed
+ ("Person: Discriminants not as expected, poly parent, discriminants " &
+ "set to defaults");
+ end if;
+ if Person_6.N /= 2 or else Person_6.Gender /= Male then
+ Report.Failed
+ ("Person: Discriminants not as expected, poly parent, other " &
+ "components defaulted");
+ end if;
+
+ if Person_7.N /= 2 or else Person_7.Gender /= Female then
+ Report.Failed
+ ("Person: Discriminants not as expected, poly parent, Gender set " &
+ "explicitly, N defaulted");
+ end if;
+
+ if Person_8.N /= 1 or else Person_8.Gender /= Female then
+ Report.Failed
+ ("Person: Discriminants not as expected, poly parent, components set" &
+ " explicitly");
+ end if;
+
Report.Result;
end C431004;
Questions? Ask the ACAA Technical Agent