aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYannick Moy <moy@adacore.com>2012-03-30 09:24:09 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2012-03-30 11:24:09 +0200
commit23e7bf6a4e4ac29e1914b2da55d460e12f0d2b8c (patch)
tree97aaa7e088533c7bdf4416f7e09ade6f1aadd88e
parentcdc96e3ea6420085948a45fef41bece7f4b6fc1b (diff)
downloadgcc-23e7bf6a4e4ac29e1914b2da55d460e12f0d2b8c.zip
gcc-23e7bf6a4e4ac29e1914b2da55d460e12f0d2b8c.tar.gz
gcc-23e7bf6a4e4ac29e1914b2da55d460e12f0d2b8c.tar.bz2
lib-xref-alfa.adb (Generate_Dereference): Use Get_Code_Unit instead of Get_Source_Unit to get file for reference.
2012-03-30 Yannick Moy <moy@adacore.com> * lib-xref-alfa.adb (Generate_Dereference): Use Get_Code_Unit instead of Get_Source_Unit to get file for reference. (Traverse_Compilation_Unit): Do not add scopes for generic units. * lib-xref.adb (Generate_Reference): Use Get_Code_Unit instead of Get_Source_Unit to get file for reference. * sem_ch12.adb (Analyze_Package_Instantiation): Enable instantiation in Alfa mode. From-SVN: r186002
-rw-r--r--gcc/ada/ChangeLog10
-rw-r--r--gcc/ada/lib-xref-alfa.adb20
-rw-r--r--gcc/ada/lib-xref.adb58
-rw-r--r--gcc/ada/sem_ch12.adb1
4 files changed, 61 insertions, 28 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 450239a..0be106c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2012-03-30 Yannick Moy <moy@adacore.com>
+
+ * lib-xref-alfa.adb (Generate_Dereference): Use Get_Code_Unit
+ instead of Get_Source_Unit to get file for reference.
+ (Traverse_Compilation_Unit): Do not add scopes for generic units.
+ * lib-xref.adb (Generate_Reference): Use Get_Code_Unit instead
+ of Get_Source_Unit to get file for reference.
+ * sem_ch12.adb (Analyze_Package_Instantiation): Enable
+ instantiation in Alfa mode.
+
2012-03-30 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Process_Declarations): Replace
diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb
index f454463..5903879 100644
--- a/gcc/ada/lib-xref-alfa.adb
+++ b/gcc/ada/lib-xref-alfa.adb
@@ -1051,15 +1051,13 @@ package body Alfa is
Loc : constant Source_Ptr := Sloc (N);
Index : Nat;
- Ref : Source_Ptr;
Ref_Scope : Entity_Id;
-- Start of processing for Generate_Dereference
begin
- Ref := Original_Location (Loc);
- if Ref > No_Location then
+ if Loc > No_Location then
Drefs.Increment_Last;
Index := Drefs.Last;
@@ -1075,21 +1073,21 @@ package body Alfa is
Ref_Scope := Enclosing_Subprogram_Or_Package (N);
Deref.Ent := Heap;
- Deref.Loc := Ref;
+ Deref.Loc := Loc;
Deref.Typ := Typ;
-- It is as if the special "Heap" was defined in every scope where
-- it is referenced.
- Deref.Eun := Get_Source_Unit (Ref);
- Deref.Lun := Get_Source_Unit (Ref);
+ Deref.Eun := Get_Code_Unit (Loc);
+ Deref.Lun := Get_Code_Unit (Loc);
Deref.Ref_Scope := Ref_Scope;
Deref.Ent_Scope := Ref_Scope;
Deref_Entry.Def := No_Location;
- Deref_Entry.Ent_Scope_File := Get_Source_Unit (Ref_Scope);
+ Deref_Entry.Ent_Scope_File := Get_Code_Unit (N);
end;
end if;
end Generate_Dereference;
@@ -1125,6 +1123,14 @@ package body Alfa is
Lu := Proper_Body (Lu);
end if;
+ -- Do not add scopes for generic units
+
+ if Nkind (Lu) = N_Package_Body
+ and then Ekind (Corresponding_Spec (Lu)) in Generic_Unit_Kind
+ then
+ return;
+ end if;
+
-- Call Process on all declarations
if Nkind (Lu) in N_Declaration
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index d02420b..a328bea 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -378,7 +378,6 @@ package body Lib.Xref is
Def : Source_Ptr;
Ent : Entity_Id;
Ent_Scope : Entity_Id;
- Ent_Scope_File : Unit_Number_Type;
Formal : Entity_Id;
Kind : Entity_Kind;
Nod : Node_Id;
@@ -633,6 +632,16 @@ package body Lib.Xref is
or else Typ = 'i'
or else Typ = 'k'
or else (Typ = 'b' and then Is_Generic_Instance (E))
+
+ -- Allow the generation of references to reads, writes and calls
+ -- in Alfa mode when the related context comes from an instance.
+
+ or else
+ (Alfa_Mode
+ and then In_Extended_Main_Code_Unit (N)
+ and then (Typ = 'm'
+ or else Typ = 'r'
+ or else Typ = 's'))
then
null;
else
@@ -880,11 +889,12 @@ package body Lib.Xref is
-- Ignore references from within an instance. The only exceptions to
-- this are default subprograms, for which we generate an implicit
- -- reference.
+ -- reference and compilations in Alfa_Mode.
and then
(Instantiation_Location (Sloc (N)) = No_Location
- or else Typ = 'i')
+ or else Typ = 'i'
+ or else Alfa_Mode)
-- Ignore dummy references
@@ -995,9 +1005,6 @@ package body Lib.Xref is
-- Record reference to entity
- Ref := Original_Location (Sloc (Nod));
- Def := Original_Location (Sloc (Ent));
-
if Actual_Typ = 'p'
and then Is_Subprogram (Nod)
and then Present (Overridden_Operation (Nod))
@@ -1006,6 +1013,9 @@ package body Lib.Xref is
end if;
if Alfa_Mode then
+ Ref := Sloc (Nod);
+ Def := Sloc (Ent);
+
Ref_Scope := Alfa.Enclosing_Subprogram_Or_Package (Nod);
Ent_Scope := Alfa.Enclosing_Subprogram_Or_Package (Ent);
@@ -1018,22 +1028,30 @@ package body Lib.Xref is
return;
end if;
- Ent_Scope_File := Get_Source_Unit (Ent_Scope);
+ Add_Entry
+ ((Ent => Ent,
+ Loc => Ref,
+ Typ => Actual_Typ,
+ Eun => Get_Code_Unit (Def),
+ Lun => Get_Code_Unit (Ref),
+ Ref_Scope => Ref_Scope,
+ Ent_Scope => Ent_Scope),
+ Ent_Scope_File => Get_Code_Unit (Ent));
+
else
- Ref_Scope := Empty;
- Ent_Scope := Empty;
- Ent_Scope_File := No_Unit;
+ Ref := Original_Location (Sloc (Nod));
+ Def := Original_Location (Sloc (Ent));
+
+ Add_Entry
+ ((Ent => Ent,
+ Loc => Ref,
+ Typ => Actual_Typ,
+ Eun => Get_Source_Unit (Def),
+ Lun => Get_Source_Unit (Ref),
+ Ref_Scope => Empty,
+ Ent_Scope => Empty),
+ Ent_Scope_File => No_Unit);
end if;
-
- Add_Entry
- ((Ent => Ent,
- Loc => Ref,
- Typ => Actual_Typ,
- Eun => Get_Source_Unit (Def),
- Lun => Get_Source_Unit (Ref),
- Ref_Scope => Ref_Scope,
- Ent_Scope => Ent_Scope),
- Ent_Scope_File => Ent_Scope_File);
end if;
end Generate_Reference;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 0547729..159594f 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3704,7 +3704,6 @@ package body Sem_Ch12 is
or else Might_Inline_Subp)
and then not Is_Actual_Pack
and then not Inline_Now
- and then not Alfa_Mode
and then (Operating_Mode = Generate_Code
or else (Operating_Mode = Check_Semantics
and then ASIS_Mode));