aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2009-07-20 15:27:46 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2009-07-20 15:27:46 +0200
commit46fe0142e1f8287fc12ffc4f50f2b2017536a396 (patch)
tree7c69fb55e5b3b96a3f71edeb69caf5474d14d555
parentf043707fcfe68d11d4a7d45ffad3b3d40f6923f1 (diff)
downloadgcc-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/ChangeLog14
-rw-r--r--gcc/ada/exp_disp.adb5
-rw-r--r--gcc/ada/gnat1drv.adb7
-rw-r--r--gcc/ada/sem_res.adb11
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);