Commit 63bb4268 by Arnaud Charlet

[multiple changes]

2013-10-14  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch11.adb: Fix typo.

2013-10-14  Thomas Quinot  <quinot@adacore.com>

	* exp_util.ads: Minor reformatting.

2013-10-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): Reject full views
	with no explicit discriminant constraints, when the parents of
	the partial view and the full view are constrained subtypes with
	different constraints.

2013-10-14  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Array_Type): New procedure, abstracts out
	this code from Freeze.
	(Freeze_Array_Type): Detect pragma Pack overriding foreign convention
	(Freeze_Record_Type): Ditto.

From-SVN: r203553
parent e74d643a
2013-10-14 Arnaud Charlet <charlet@adacore.com>
* exp_ch11.adb: Fix typo.
2013-10-14 Thomas Quinot <quinot@adacore.com>
* exp_util.ads: Minor reformatting.
2013-10-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): Reject full views
with no explicit discriminant constraints, when the parents of
the partial view and the full view are constrained subtypes with
different constraints.
2013-10-14 Robert Dewar <dewar@adacore.com>
* freeze.adb (Freeze_Array_Type): New procedure, abstracts out
this code from Freeze.
(Freeze_Array_Type): Detect pragma Pack overriding foreign convention
(Freeze_Record_Type): Ditto.
2013-10-14 Hristian Kirtchev <kirtchev@adacore.com> 2013-10-14 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Dependency_Clause): Add new local variable * sem_prag.adb (Analyze_Dependency_Clause): Add new local variable
......
...@@ -1026,7 +1026,7 @@ package body Exp_Ch11 is ...@@ -1026,7 +1026,7 @@ package body Exp_Ch11 is
-- end; -- end;
-- This expansion is not performed when using GCC ZCX. Gigi -- This expansion is not performed when using GCC ZCX. Gigi
-- will insert a call to intialize the choice parameter. -- will insert a call to initialize the choice parameter.
if Present (Choice_Parameter (Handler)) if Present (Choice_Parameter (Handler))
and then Exception_Mechanism /= Back_End_Exceptions and then Exception_Mechanism /= Back_End_Exceptions
......
...@@ -359,9 +359,9 @@ package Exp_Util is ...@@ -359,9 +359,9 @@ package Exp_Util is
-- by the compiler and used by GDB. -- by the compiler and used by GDB.
procedure Evaluate_Name (Nam : Node_Id); procedure Evaluate_Name (Nam : Node_Id);
-- Remove the all side effects from a name which appears as part of an -- Remove all side effects from a name which appears as part of an object
-- object renaming declaration. More comments are needed here that explain -- renaming declaration. More comments are needed here that explain how
-- how this differs from Force_Evaluation and Remove_Side_Effects ??? -- this differs from Force_Evaluation and Remove_Side_Effects ???
procedure Evolve_And_Then (Cond : in out Node_Id; Cond1 : Node_Id); procedure Evolve_And_Then (Cond : in out Node_Id; Cond1 : Node_Id);
-- Rewrites Cond with the expression: Cond and then Cond1. If Cond is -- Rewrites Cond with the expression: Cond and then Cond1. If Cond is
......
...@@ -1001,7 +1001,7 @@ package body Sem_Ch3 is ...@@ -1001,7 +1001,7 @@ package body Sem_Ch3 is
if Nkind (Def) in N_Has_Etype then if Nkind (Def) in N_Has_Etype then
if Etype (Def) = T_Name then if Etype (Def) = T_Name then
Error_Msg_N Error_Msg_N
("type& cannot be used before end of its declaration", Def); ("typer cannot be used before end of its declaration", Def);
end if; end if;
-- If this is not a subtype, then this is an access_definition -- If this is not a subtype, then this is an access_definition
...@@ -7337,45 +7337,68 @@ package body Sem_Ch3 is ...@@ -7337,45 +7337,68 @@ package body Sem_Ch3 is
and then (Is_Constrained (Parent_Type) or else Constraint_Present) and then (Is_Constrained (Parent_Type) or else Constraint_Present)
then then
-- First, we must analyze the constraint (see comment in point 5.) -- First, we must analyze the constraint (see comment in point 5.)
-- The constraint may come from the subtype indication of the full
-- declaration.
if Constraint_Present then if Constraint_Present then
New_Discrs := Build_Discriminant_Constraints (Parent_Type, Indic); New_Discrs :=
Build_Discriminant_Constraints (Parent_Type, Indic);
if Has_Discriminants (Derived_Type) -- If there is no explicit constraint, there might be one that is
and then Has_Private_Declaration (Derived_Type) -- inherited from a constrained parent type. In that case verify that
and then Present (Discriminant_Constraint (Derived_Type)) -- it conforms to the constraint in the partial view. In perverse
then -- cases the parent subtypes of the partial and full view can have
-- Verify that constraints of the full view statically match -- different constraints.
-- those given in the partial view.
declare elsif Present (Stored_Constraint (Parent_Type)) then
C1, C2 : Elmt_Id; New_Discrs := Stored_Constraint (Parent_Type);
begin else
C1 := First_Elmt (New_Discrs); New_Discrs := No_Elist;
C2 := First_Elmt (Discriminant_Constraint (Derived_Type)); end if;
while Present (C1) and then Present (C2) loop
if Fully_Conformant_Expressions (Node (C1), Node (C2))
or else
(Is_OK_Static_Expression (Node (C1))
and then
Is_OK_Static_Expression (Node (C2))
and then
Expr_Value (Node (C1)) = Expr_Value (Node (C2)))
then
null;
else if Has_Discriminants (Derived_Type)
and then Has_Private_Declaration (Derived_Type)
and then Present (Discriminant_Constraint (Derived_Type))
and then Present (New_Discrs)
then
-- Verify that constraints of the full view statically match
-- those given in the partial view.
declare
C1, C2 : Elmt_Id;
Error_Node : Node_Id;
begin
C1 := First_Elmt (New_Discrs);
C2 := First_Elmt (Discriminant_Constraint (Derived_Type));
while Present (C1) and then Present (C2) loop
if Fully_Conformant_Expressions (Node (C1), Node (C2))
or else
(Is_OK_Static_Expression (Node (C1))
and then
Is_OK_Static_Expression (Node (C2))
and then
Expr_Value (Node (C1)) = Expr_Value (Node (C2)))
then
null;
else
if Constraint_Present then
Error_Msg_N ( Error_Msg_N (
"constraint not conformant to previous declaration", "constraint not conformant to previous declaration",
Node (C1)); Node (C1));
else
Error_Msg_N (
"constraint of full view is incompatible " &
"with partial view", N);
end if; end if;
end if;
Next_Elmt (C1); Next_Elmt (C1);
Next_Elmt (C2); Next_Elmt (C2);
end loop; end loop;
end; end;
end if;
end if; end if;
-- Insert and analyze the declaration for the unconstrained base type -- Insert and analyze the declaration for the unconstrained base type
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment