* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165831
138bc75d-0d04-0410-961f-
82ee72b054a4
+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>
* sem_aggr.adb (Resolve_Array_Aggregate.Add): If the type of the
-- is a pointer to the record generated by the compiler to represent
-- 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
or else Has_Interrupt_Handler (Ptyp)
or else Has_Attach_Handler (Ptyp)
raise Program_Error;
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,
Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Name_uInit),
procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
- Pkind : constant Node_Kind := Nkind (Parent (N));
+ Pkind : constant Node_Kind := Nkind (Parent (N));
Aggr_Subtyp : Entity_Id;
-- The actual aggregate subtype. This is not necessarily the same as Typ
-- The new type has fewer discriminants, so we need to create a new
-- corresponding record, which is derived from the corresponding
-- record of the parent, and has a stored constraint that captures
- -- the values of the discriminant constraints.
- -- The corresponding record is needed only if expander is active
- -- and code generation is enabled.
+ -- the values of the discriminant constraints. The corresponding
+ -- record is needed only if expander is active and code generation is
+ -- enabled.
-- The type declaration for the derived corresponding record has the
-- same discriminant part and constraints as the current declaration.
and then (not Is_Entity_Name (P)
or else Chars (Entity (P)) /= Name_uInit)
then
- C_Etype :=
- Build_Actual_Subtype_Of_Component (
- Etype (Selector), N);
+ -- Do not build the subtype when referencing components of
+ -- dispatch table wrappers. Required to avoid generating
+ -- 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
C_Etype := Empty;
end if;
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
Kind : constant Node_Kind := Nkind (Node);
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
- return;
+ raise Program_Error;
-- Otherwise see what kind of node we have
OSDN Git Service
