diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-07-20 15:27:46 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-07-20 15:27:46 +0200 |
commit | 46fe0142e1f8287fc12ffc4f50f2b2017536a396 (patch) | |
tree | 7c69fb55e5b3b96a3f71edeb69caf5474d14d555 | |
parent | f043707fcfe68d11d4a7d45ffad3b3d40f6923f1 (diff) | |
download | gcc-46fe0142e1f8287fc12ffc4f50f2b2017536a396.zip gcc-46fe0142e1f8287fc12ffc4f50f2b2017536a396.tar.gz gcc-46fe0142e1f8287fc12ffc4f50f2b2017536a396.tar.bz2 |
[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
-rw-r--r-- | gcc/ada/ChangeLog | 14 | ||||
-rw-r--r-- | gcc/ada/exp_disp.adb | 5 | ||||
-rw-r--r-- | gcc/ada/gnat1drv.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 11 |
4 files changed, 26 insertions, 11 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f80b041..e16a9be 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +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> * gcc-interface/Makefile.in: cleanup powerpc linux target pairs. diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 99f918b..f60e7bc 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -4405,12 +4405,13 @@ package body Exp_Disp is -- specific tagged type, as opposed to one of its ancestors. -- If the type is an unconstrained type extension, we are building the -- 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 declare Def : constant Node_Id := Get_Attribute_Definition_Clause - (First_Subtype (Typ), + (Underlying_Type (First_Subtype (Typ)), Attribute_External_Tag); Old_Val : String_Id; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 79065e2..c77d74f 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -184,11 +184,10 @@ procedure Gnat1drv is Polling_Required := False; - -- Set operating mode to check semantics with full front-end - -- expansion, but no back-end code generation. + -- Set operating mode to Generate_Code to benefit from full + -- front-end expansion (e.g. generics). - Operating_Mode := Check_Semantics; - Debug_Flag_X := True; + Operating_Mode := Generate_Code; -- We need SCIL generation of course diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 372750b..b8235e5 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3644,15 +3644,16 @@ package body Sem_Res is and then (Is_Class_Wide_Type (Designated_Type (A_Typ)) or else (Nkind (A) = N_Attribute_Reference 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_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 Convention (Entity (Name (N))) - = Convention_CPP) + and then not + (Is_Entity_Name (Name (N)) + and then Is_Imported (Entity (Name (N))) + and then Convention (Entity (Name (N))) = Convention_CPP) then Error_Msg_N ("access to class-wide argument not allowed here!", A); |