Commit 9fc2854d by Arnaud Charlet

[multiple changes]

2010-10-22  Thomas Quinot  <quinot@adacore.com>

	* uname.adb (Get_Unit_Name.Add_Node_Name): If encountering an error
	node in the unit name, propagate Program_Error to guard against
	cascaded errors.

2010-10-22  Javier Miranda  <miranda@adacore.com>

	* sem_ch8.adb (Find_Selected_Component): Do not generate a subtype for
	selected components of dispatch table wrappers.

2010-10-22  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Make_Initialize_Protection): A protected type that
	implements an interface must be treated as if it has entries, to
	support dispatching select statements.

2010-10-22  Robert Dewar  <dewar@adacore.com>

	* sem_aggr.adb, sem_ch3.adb: Minor reformatting.

From-SVN: r165831
parent f915704f
2010-10-22 Thomas Quinot <quinot@adacore.com>
* uname.adb (Get_Unit_Name.Add_Node_Name): If encountering an error
node in the unit name, propagate Program_Error to guard against
cascaded errors.
2010-10-22 Javier Miranda <miranda@adacore.com>
* sem_ch8.adb (Find_Selected_Component): Do not generate a subtype for
selected components of dispatch table wrappers.
2010-10-22 Ed Schonberg <schonberg@adacore.com>
* exp_ch9.adb (Make_Initialize_Protection): A protected type that
implements an interface must be treated as if it has entries, to
support dispatching select statements.
2010-10-22 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb, sem_ch3.adb: Minor reformatting.
2010-10-22 Javier Miranda <miranda@adacore.com> 2010-10-22 Javier Miranda <miranda@adacore.com>
* sem_aggr.adb (Resolve_Array_Aggregate.Add): If the type of the * sem_aggr.adb (Resolve_Array_Aggregate.Add): If the type of the
......
...@@ -12343,6 +12343,11 @@ package body Exp_Ch9 is ...@@ -12343,6 +12343,11 @@ package body Exp_Ch9 is
-- is a pointer to the record generated by the compiler to represent -- is a pointer to the record generated by the compiler to represent
-- the protected object. -- the protected object.
-- A protected type without entries that covers an interface and
-- overrides the abstract routines with protected procedures is
-- considered equivalent to a protected type with entries in the
-- context of dispatching select statements.
if Has_Entry if Has_Entry
or else Has_Interrupt_Handler (Ptyp) or else Has_Interrupt_Handler (Ptyp)
or else Has_Attach_Handler (Ptyp) or else Has_Attach_Handler (Ptyp)
...@@ -12368,7 +12373,10 @@ package body Exp_Ch9 is ...@@ -12368,7 +12373,10 @@ package body Exp_Ch9 is
raise Program_Error; raise Program_Error;
end case; end case;
if Has_Entry or else not Restricted then if Has_Entry
or else not Restricted
or else Has_Interfaces (Protect_Rec)
then
Append_To (Args, Append_To (Args,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Name_uInit), Prefix => Make_Identifier (Loc, Name_uInit),
......
...@@ -892,7 +892,7 @@ package body Sem_Aggr is ...@@ -892,7 +892,7 @@ package body Sem_Aggr is
procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id) is procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Pkind : constant Node_Kind := Nkind (Parent (N)); Pkind : constant Node_Kind := Nkind (Parent (N));
Aggr_Subtyp : Entity_Id; Aggr_Subtyp : Entity_Id;
-- The actual aggregate subtype. This is not necessarily the same as Typ -- The actual aggregate subtype. This is not necessarily the same as Typ
......
...@@ -5035,9 +5035,9 @@ package body Sem_Ch3 is ...@@ -5035,9 +5035,9 @@ package body Sem_Ch3 is
-- The new type has fewer discriminants, so we need to create a new -- The new type has fewer discriminants, so we need to create a new
-- corresponding record, which is derived from the corresponding -- corresponding record, which is derived from the corresponding
-- record of the parent, and has a stored constraint that captures -- record of the parent, and has a stored constraint that captures
-- the values of the discriminant constraints. -- the values of the discriminant constraints. The corresponding
-- The corresponding record is needed only if expander is active -- record is needed only if expander is active and code generation is
-- and code generation is enabled. -- enabled.
-- The type declaration for the derived corresponding record has the -- The type declaration for the derived corresponding record has the
-- same discriminant part and constraints as the current declaration. -- same discriminant part and constraints as the current declaration.
......
...@@ -5368,9 +5368,29 @@ package body Sem_Ch8 is ...@@ -5368,9 +5368,29 @@ package body Sem_Ch8 is
and then (not Is_Entity_Name (P) and then (not Is_Entity_Name (P)
or else Chars (Entity (P)) /= Name_uInit) or else Chars (Entity (P)) /= Name_uInit)
then then
C_Etype := -- Do not build the subtype when referencing components of
Build_Actual_Subtype_Of_Component ( -- dispatch table wrappers. Required to avoid generating
Etype (Selector), N); -- elaboration code with HI runtimes.
if RTU_Loaded (Ada_Tags)
and then RTE_Available (RE_Dispatch_Table_Wrapper)
and then Scope (Selector) = RTE (RE_Dispatch_Table_Wrapper)
then
C_Etype := Empty;
elsif RTU_Loaded (Ada_Tags)
and then RTE_Available (RE_No_Dispatch_Table_Wrapper)
and then Scope (Selector)
= RTE (RE_No_Dispatch_Table_Wrapper)
then
C_Etype := Empty;
else
C_Etype :=
Build_Actual_Subtype_Of_Component (
Etype (Selector), N);
end if;
else else
C_Etype := Empty; C_Etype := Empty;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -225,10 +225,10 @@ package body Uname is ...@@ -225,10 +225,10 @@ package body Uname is
Kind : constant Node_Kind := Nkind (Node); Kind : constant Node_Kind := Nkind (Node);
begin begin
-- Just ignore an error node (someone else will give a message) -- Bail out on error node (guard against parse error)
if Node = Error then if Node = Error then
return; raise Program_Error;
-- Otherwise see what kind of node we have -- Otherwise see what kind of node we have
......
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