Commit 46fe0142 by Arnaud Charlet

[multiple changes]

2009-07-20  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb (Gnat1drv): Set operating mode to Generate_Code when
	CodePeer_Mode is set, to benefit from full front-end expansion
	(e.g. generics).

2009-07-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb: Add guard.

	* exp_disp.adb, sem_disp.adb (Make_DT): Check underlying view of type
	for possible attribute definition of External_Tag, in case clause
	appears in the private part of a package.

From-SVN: r149816
parent f043707f
2009-07-20 Arnaud Charlet <charlet@adacore.com>
* gnat1drv.adb (Gnat1drv): Set operating mode to Generate_Code when
CodePeer_Mode is set, to benefit from full front-end expansion
(e.g. generics).
2009-07-20 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb: Add guard.
* exp_disp.adb, sem_disp.adb (Make_DT): Check underlying view of type
for possible attribute definition of External_Tag, in case clause
appears in the private part of a package.
2009-07-20 Jerome Guitton <guitton@adacore.com> 2009-07-20 Jerome Guitton <guitton@adacore.com>
* gcc-interface/Makefile.in: cleanup powerpc linux target pairs. * gcc-interface/Makefile.in: cleanup powerpc linux target pairs.
......
...@@ -4405,12 +4405,13 @@ package body Exp_Disp is ...@@ -4405,12 +4405,13 @@ package body Exp_Disp is
-- specific tagged type, as opposed to one of its ancestors. -- specific tagged type, as opposed to one of its ancestors.
-- If the type is an unconstrained type extension, we are building the -- If the type is an unconstrained type extension, we are building the
-- dispatch table of its anonymous base type, so the external tag, if -- dispatch table of its anonymous base type, so the external tag, if
-- any was specified, must be retrieved from the first subtype. -- any was specified, must be retrieved from the first subtype. Go to
-- the full view in case the clause is in the private part.
else else
declare declare
Def : constant Node_Id := Get_Attribute_Definition_Clause Def : constant Node_Id := Get_Attribute_Definition_Clause
(First_Subtype (Typ), (Underlying_Type (First_Subtype (Typ)),
Attribute_External_Tag); Attribute_External_Tag);
Old_Val : String_Id; Old_Val : String_Id;
......
...@@ -184,11 +184,10 @@ procedure Gnat1drv is ...@@ -184,11 +184,10 @@ procedure Gnat1drv is
Polling_Required := False; Polling_Required := False;
-- Set operating mode to check semantics with full front-end -- Set operating mode to Generate_Code to benefit from full
-- expansion, but no back-end code generation. -- front-end expansion (e.g. generics).
Operating_Mode := Check_Semantics; Operating_Mode := Generate_Code;
Debug_Flag_X := True;
-- We need SCIL generation of course -- We need SCIL generation of course
......
...@@ -3644,15 +3644,16 @@ package body Sem_Res is ...@@ -3644,15 +3644,16 @@ package body Sem_Res is
and then (Is_Class_Wide_Type (Designated_Type (A_Typ)) and then (Is_Class_Wide_Type (Designated_Type (A_Typ))
or else (Nkind (A) = N_Attribute_Reference or else (Nkind (A) = N_Attribute_Reference
and then and then
Is_Class_Wide_Type (Etype (Prefix (A))))) Is_Class_Wide_Type (Etype (Prefix (A)))))
and then not Is_Class_Wide_Type (Designated_Type (F_Typ)) and then not Is_Class_Wide_Type (Designated_Type (F_Typ))
and then not Is_Controlling_Formal (F) and then not Is_Controlling_Formal (F)
-- Disable these checks in imported C++ subprograms -- Disable these checks for call to imported C++ subprograms
and then not (Is_Imported (Entity (Name (N))) and then not
and then Convention (Entity (Name (N))) (Is_Entity_Name (Name (N))
= Convention_CPP) and then Is_Imported (Entity (Name (N)))
and then Convention (Entity (Name (N))) = Convention_CPP)
then then
Error_Msg_N Error_Msg_N
("access to class-wide argument not allowed here!", A); ("access to class-wide argument not allowed here!", A);
......
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