2017-09-18 Bob Duff <duff@adacore.com>
* sem_ch4.adb (Analyze_Qualified_Expression): Give an error if the type
mark refers to the current instance. Set the type to Any_Type in that
case, to avoid later crashes.
2017-09-18 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Replace_Discriminant_References): New procedure,
subsidiary of Build_Assignment, used to handle the initialization code
for a mutable record component whose default value is an aggregate that
sets the values of the discriminants of the components.
2017-09-18 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/default_variants.adb: New testcase.
2017-09-18 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause) <Address>: Mark
the entity as being volatile for an overlay that toggles the scalar
storage order.
2017-09-18 Fedor Rybin <frybin@adacore.com>
* doc/gnat_ugn/gnat_utility_programs.rst: Document that gnattest
options -U main and --harness-only are not compatible.
From-SVN: r252913
+2017-09-18 Bob Duff <duff@adacore.com>
+
+ * sem_ch4.adb (Analyze_Qualified_Expression): Give an error if the type
+ mark refers to the current instance. Set the type to Any_Type in that
+ case, to avoid later crashes.
+
+2017-09-18 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch3.adb (Replace_Discriminant_References): New procedure,
+ subsidiary of Build_Assignment, used to handle the initialization code
+ for a mutable record component whose default value is an aggregate that
+ sets the values of the discriminants of the components.
+
+2017-09-18 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_ch13.adb (Analyze_Attribute_Definition_Clause) <Address>: Mark
+ the entity as being volatile for an overlay that toggles the scalar
+ storage order.
+
+2017-09-18 Fedor Rybin <frybin@adacore.com>
+
+ * doc/gnat_ugn/gnat_utility_programs.rst: Document that gnattest
+ options -U main and --harness-only are not compatible.
+
2017-09-18 Hristian Kirtchev <kirtchev@adacore.com>
* freeze.adb, sem_ch6.adb, sem_res.adb: Minor reformatting.
:switch:`--harness-only`
When this option is given, ``gnattest`` creates a harness for all
- sources, treating them as test packages.
+ sources, treating them as test packages. This option is not compatible with
+ closure computation done by -U main.
.. index:: --separate-drivers (gnattest)
Lhs : Node_Id;
Res : List_Id;
+ function Replace_Discr_Ref (N : Node_Id) return Traverse_Result;
+ -- Analysis of the aggregate has replaced discriminants by their
+ -- corresponding discriminals, but these are irrelevant when the
+ -- component has a mutable type and is initialized with an aggregate.
+ -- Instead, they must be replaced by the values supplied in the
+ -- aggregate, that will be assigned during the expansion of the
+ -- assignment.
+
+ -----------------------
+ -- Replace_Discr_Ref --
+ -----------------------
+
+ function Replace_Discr_Ref (N : Node_Id) return Traverse_Result is
+ Val : Node_Id;
+ begin
+ if Is_Entity_Name (N)
+ and then Present (Entity (N))
+ and then Is_Formal (Entity (N))
+ and then Present (Discriminal_Link (Entity (N)))
+ then
+ Val :=
+ Make_Selected_Component (N_Loc,
+ Prefix => New_Copy_Tree (Lhs),
+ Selector_Name => New_Occurrence_Of
+ (Discriminal_Link (Entity (N)), N_Loc));
+ if Present (Val) then
+ Rewrite (N, New_Copy_Tree (Val));
+ end if;
+ end if;
+
+ return OK;
+ end Replace_Discr_Ref;
+
+ procedure Replace_Discriminant_References is
+ new Traverse_Proc (Replace_Discr_Ref);
+
begin
Lhs :=
Make_Selected_Component (N_Loc,
Selector_Name => New_Occurrence_Of (Id, N_Loc));
Set_Assignment_OK (Lhs);
+ if Nkind (Exp) = N_Aggregate
+ and then Has_Discriminants (Typ)
+ and then not Is_Constrained (Base_Type (Typ))
+ then
+ -- The aggregate may provide new values for the discriminants
+ -- of the component, and other components may depend on those
+ -- discriminants. Previous analysis of those expressions have
+ -- replaced the discriminants by the formals of the initialization
+ -- procedure for the type, but these are irrelevant in the
+ -- enclosing initialization procedure: those discriminant
+ -- references must be replaced by the values provided in the
+ -- aggregate.
+
+ Replace_Discriminant_References (Exp);
+ end if;
+
-- Case of an access attribute applied to the current instance.
-- Replace the reference to the type by a reference to the actual
-- object. (Note that this handles the case of the top level of
Register_Address_Clause_Check
(N, U_Ent, No_Uint, O_Ent, Off);
end if;
+
+ -- If the overlay changes the storage order, mark the
+ -- entity as being volatile to block any optimization
+ -- for it since the construct is not really supported
+ -- by the back end.
+
+ if (Is_Record_Type (Etype (U_Ent))
+ or else Is_Array_Type (Etype (U_Ent)))
+ and then (Is_Record_Type (Etype (O_Ent))
+ or else Is_Array_Type (Etype (O_Ent)))
+ and then Reverse_Storage_Order (Etype (U_Ent))
+ /= Reverse_Storage_Order (Etype (O_Ent))
+ then
+ Set_Treat_As_Volatile (U_Ent);
+ end if;
+
else
-- If this is not an overlay, mark a variable as being
-- volatile to prevent unwanted optimizations. It's a
Set_Etype (N, Any_Type);
Find_Type (Mark);
T := Entity (Mark);
+
+ if Nkind_In
+ (Enclosing_Declaration (N),
+ N_Formal_Type_Declaration,
+ N_Full_Type_Declaration,
+ N_Incomplete_Type_Declaration,
+ N_Protected_Type_Declaration,
+ N_Private_Extension_Declaration,
+ N_Private_Type_Declaration,
+ N_Subtype_Declaration,
+ N_Task_Type_Declaration)
+ and then T = Defining_Identifier (Enclosing_Declaration (N))
+ then
+ Error_Msg_N ("current instance not allowed", Mark);
+ T := Any_Type;
+ end if;
+
Set_Etype (N, T);
if T = Any_Type then
+2017-09-18 Ed Schonberg <schonberg@adacore.com>
+
+ * gnat.dg/default_variants.adb: New testcase.
+
2017-09-18 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
PR target/81736
--- /dev/null
+-- { dg-do compile }
+
+procedure Default_Variants is
+
+ type Variant_Kind is (A, B);
+
+ function Get_Default_Value (Kind : in Variant_Kind) return Natural is (10);
+
+ type Variant_Type (Kind : Variant_Kind := A) is
+ record
+ Common : Natural := Get_Default_Value (Kind);
+ case Kind is
+ when A =>
+ A_Value : Integer := Integer'First;
+ when B =>
+ B_Value : Natural := Natural'First;
+ end case;
+ end record;
+
+ type Containing_Type is tagged
+ record
+ Variant_Data : Variant_Type :=
+ (Kind => B, Common => <>, B_Value => 1);
+ end record;
+
+begin
+ null;
+end Default_Variants;
projects / thirdparty / gcc.git / commitdiff
