Commit 63b5225b by Yannick Moy Committed by Arnaud Charlet

2014-05-21 Yannick Moy <moy@adacore.com>

	* lib-xref-spark_specific.adb, lib-xref.ads, lib-xref.adb
	(Enclosing_Subprogram_Or_Package): Only return a library-level
	package.

From-SVN: r210700
parent a8a89b74
2014-05-21 Yannick Moy <moy@adacore.com>
* lib-xref-spark_specific.adb, lib-xref.ads, lib-xref.adb
(Enclosing_Subprogram_Or_Package): Only return a library-level
package.
2014-05-21 Javier Miranda <miranda@adacore.com> 2014-05-21 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): Initialize Parent_Base * sem_ch3.adb (Build_Derived_Record_Type): Initialize Parent_Base
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2011-2013, Free Software Foundation, Inc. -- -- Copyright (C) 2011-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -23,10 +23,9 @@ ...@@ -23,10 +23,9 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with SPARK_Xrefs; use SPARK_Xrefs; with SPARK_Xrefs; use SPARK_Xrefs;
with Einfo; use Einfo; with Einfo; use Einfo;
with Nmake; use Nmake; with Nmake; use Nmake;
with Put_SPARK_Xrefs;
with GNAT.HTable; with GNAT.HTable;
...@@ -972,7 +971,9 @@ package body SPARK_Specific is ...@@ -972,7 +971,9 @@ package body SPARK_Specific is
-- Enclosing_Subprogram_Or_Package -- -- Enclosing_Subprogram_Or_Package --
------------------------------------- -------------------------------------
function Enclosing_Subprogram_Or_Package (N : Node_Id) return Entity_Id is function Enclosing_Subprogram_Or_Library_Package
(N : Node_Id) return Entity_Id
is
Result : Entity_Id; Result : Entity_Id;
begin begin
...@@ -990,12 +991,26 @@ package body SPARK_Specific is ...@@ -990,12 +991,26 @@ package body SPARK_Specific is
while Present (Result) loop while Present (Result) loop
case Nkind (Result) is case Nkind (Result) is
when N_Package_Specification => when N_Package_Specification =>
Result := Defining_Unit_Name (Result);
exit; -- Only return a library-level package
if Is_Library_Level_Entity (Defining_Entity (Result)) then
Result := Defining_Entity (Result);
exit;
else
Result := Parent (Result);
end if;
when N_Package_Body => when N_Package_Body =>
Result := Defining_Unit_Name (Result);
exit; -- Only return a library-level package
if Is_Library_Level_Entity (Defining_Entity (Result)) then
Result := Defining_Entity (Result);
exit;
else
Result := Parent (Result);
end if;
when N_Subprogram_Specification => when N_Subprogram_Specification =>
Result := Defining_Unit_Name (Result); Result := Defining_Unit_Name (Result);
...@@ -1045,7 +1060,7 @@ package body SPARK_Specific is ...@@ -1045,7 +1060,7 @@ package body SPARK_Specific is
end if; end if;
return Result; return Result;
end Enclosing_Subprogram_Or_Package; end Enclosing_Subprogram_Or_Library_Package;
----------------- -----------------
-- Entity_Hash -- -- Entity_Hash --
...@@ -1107,7 +1122,7 @@ package body SPARK_Specific is ...@@ -1107,7 +1122,7 @@ package body SPARK_Specific is
Create_Heap; Create_Heap;
end if; end if;
Ref_Scope := Enclosing_Subprogram_Or_Package (N); Ref_Scope := Enclosing_Subprogram_Or_Library_Package (N);
Deref.Ent := Heap; Deref.Ent := Heap;
Deref.Loc := Loc; Deref.Loc := Loc;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1998-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1029,8 +1029,10 @@ package body Lib.Xref is ...@@ -1029,8 +1029,10 @@ package body Lib.Xref is
Ref := Sloc (Nod); Ref := Sloc (Nod);
Def := Sloc (Ent); Def := Sloc (Ent);
Ref_Scope := SPARK_Specific.Enclosing_Subprogram_Or_Package (Nod); Ref_Scope :=
Ent_Scope := SPARK_Specific.Enclosing_Subprogram_Or_Package (Ent); SPARK_Specific.Enclosing_Subprogram_Or_Library_Package (Nod);
Ent_Scope :=
SPARK_Specific.Enclosing_Subprogram_Or_Library_Package (Ent);
-- Since we are reaching through renamings in SPARK mode, we may -- Since we are reaching through renamings in SPARK mode, we may
-- end up with standard constants. Ignore those. -- end up with standard constants. Ignore those.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1998-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -624,8 +624,12 @@ package Lib.Xref is ...@@ -624,8 +624,12 @@ package Lib.Xref is
package SPARK_Specific is package SPARK_Specific is
function Enclosing_Subprogram_Or_Package (N : Node_Id) return Entity_Id; function Enclosing_Subprogram_Or_Library_Package
-- Return the closest enclosing subprogram of package (N : Node_Id) return Entity_Id;
-- Return the closest enclosing subprogram of package. Only return a
-- library level package. If the package is enclosed in a subprogram,
-- return the subprogram. This ensures that GNATprove can distinguish
-- local variables from global variables.
procedure Generate_Dereference procedure Generate_Dereference
(N : Node_Id; (N : Node_Id;
......
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