OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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
This commit is contained in:
Arnaud Charlet 2013-10-14 15:40:56 +02:00
parent e74d643a35
commit 63bb426804
5 changed files with 632 additions and 532 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/ChangeLog
View File

@ -1,3 +1,25 @@
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>
* sem_prag.adb (Analyze_Dependency_Clause): Add new local variable

2
gcc/ada/exp_ch11.adb
View File

@ -1026,7 +1026,7 @@ package body Exp_Ch11 is
-- end;
-- 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))
and then Exception_Mechanism /= Back_End_Exceptions

6
gcc/ada/exp_util.ads
View File

@ -359,9 +359,9 @@ package Exp_Util is
-- by the compiler and used by GDB.
procedure Evaluate_Name (Nam : Node_Id);
-- Remove the all side effects from a name which appears as part of an
-- object renaming declaration. More comments are needed here that explain
-- how this differs from Force_Evaluation and Remove_Side_Effects ???
-- Remove all side effects from a name which appears as part of an object
-- renaming declaration. More comments are needed here that explain how
-- this differs from Force_Evaluation and Remove_Side_Effects ???
procedure Evolve_And_Then (Cond : in out Node_Id; Cond1 : Node_Id);
-- Rewrites Cond with the expression: Cond and then Cond1. If Cond is

1053
gcc/ada/freeze.adb
View File

File diff suppressed because it is too large Load Diff

81
gcc/ada/sem_ch3.adb
View File

@ -1001,7 +1001,7 @@ package body Sem_Ch3 is
if Nkind (Def) in N_Has_Etype then
if Etype (Def) = T_Name then
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;
-- If this is not a subtype, then this is an access_definition
@ -7337,45 +7337,68 @@ package body Sem_Ch3 is
and then (Is_Constrained (Parent_Type) or else Constraint_Present)
then
-- 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
New_Discrs := Build_Discriminant_Constraints (Parent_Type, Indic);
New_Discrs :=
Build_Discriminant_Constraints (Parent_Type, Indic);
if Has_Discriminants (Derived_Type)
and then Has_Private_Declaration (Derived_Type)
and then Present (Discriminant_Constraint (Derived_Type))
then
-- Verify that constraints of the full view statically match
-- those given in the partial view.
-- If there is no explicit constraint, there might be one that is
-- inherited from a constrained parent type. In that case verify that
-- it conforms to the constraint in the partial view. In perverse
-- cases the parent subtypes of the partial and full view can have
-- different constraints.
declare
C1, C2 : Elmt_Id;
elsif Present (Stored_Constraint (Parent_Type)) then
New_Discrs := Stored_Constraint (Parent_Type);
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
New_Discrs := No_Elist;
end if;
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 (
"constraint not conformant to previous declaration",
Node (C1));
else
Error_Msg_N (
"constraint of full view is incompatible " &
"with partial view", N);
end if;
end if;
Next_Elmt (C1);
Next_Elmt (C2);
end loop;
end;
end if;
Next_Elmt (C1);
Next_Elmt (C2);
end loop;
end;
end if;
-- Insert and analyze the declaration for the unconstrained base type