sem_util.ads, [...] (In_Subprogram): New function.
gcc/ada/ * sem_util.ads, sem_util.adb (In_Subprogram): New function. * sem_attr.adb (Analyze_Attribute, Attribute_Old case): Use it. gcc/testsuite/ * gnat.dg/deep_old.adb: New. From-SVN: r134260
This commit is contained in:
parent
e965b4534f
commit
17972da719
|
@ -1,3 +1,8 @@
|
||||||
|
2008-04-14 Samuel Tardieu <sam@rfc1149.net>
|
||||||
|
|
||||||
|
* sem_util.ads, sem_util.adb (In_Subprogram): New function.
|
||||||
|
* sem_attr.adb (Analyze_Attribute, Attribute_Old case): Use it.
|
||||||
|
|
||||||
2008-04-14 Rolf Ebert <rolf.ebert.gcc@gmx.de>
|
2008-04-14 Rolf Ebert <rolf.ebert.gcc@gmx.de>
|
||||||
|
|
||||||
PR ada/20822
|
PR ada/20822
|
||||||
|
|
|
@ -3472,7 +3472,7 @@ package body Sem_Attr is
|
||||||
Check_E0;
|
Check_E0;
|
||||||
Set_Etype (N, P_Type);
|
Set_Etype (N, P_Type);
|
||||||
|
|
||||||
if not Is_Subprogram (Current_Scope) then
|
if not In_Subprogram then
|
||||||
Error_Attr ("attribute % can only appear within subprogram", N);
|
Error_Attr ("attribute % can only appear within subprogram", N);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
|
@ -5365,6 +5365,15 @@ package body Sem_Util is
|
||||||
return False;
|
return False;
|
||||||
end In_Package_Body;
|
end In_Package_Body;
|
||||||
|
|
||||||
|
-------------------
|
||||||
|
-- In_Subprogram --
|
||||||
|
-------------------
|
||||||
|
|
||||||
|
function In_Subprogram return Boolean is
|
||||||
|
begin
|
||||||
|
return Current_Subprogram /= Empty;
|
||||||
|
end In_Subprogram;
|
||||||
|
|
||||||
--------------------------------------
|
--------------------------------------
|
||||||
-- In_Subprogram_Or_Concurrent_Unit --
|
-- In_Subprogram_Or_Concurrent_Unit --
|
||||||
--------------------------------------
|
--------------------------------------
|
||||||
|
|
|
@ -587,6 +587,12 @@ package Sem_Util is
|
||||||
function In_Package_Body return Boolean;
|
function In_Package_Body return Boolean;
|
||||||
-- Returns True if current scope is within a package body
|
-- Returns True if current scope is within a package body
|
||||||
|
|
||||||
|
function In_Subprogram return Boolean;
|
||||||
|
-- Determines if the current scope is within a subprogram compilation
|
||||||
|
-- unit (inside a subprogram declaration, subprogram body, or generic
|
||||||
|
-- subprogram declaration). The test is for appearing anywhere within
|
||||||
|
-- such a construct (that is it does not need to be directly within).
|
||||||
|
|
||||||
function In_Subprogram_Or_Concurrent_Unit return Boolean;
|
function In_Subprogram_Or_Concurrent_Unit return Boolean;
|
||||||
-- Determines if the current scope is within a subprogram compilation
|
-- Determines if the current scope is within a subprogram compilation
|
||||||
-- unit (inside a subprogram declaration, subprogram body, or generic
|
-- unit (inside a subprogram declaration, subprogram body, or generic
|
||||||
|
|
|
@ -1,3 +1,7 @@
|
||||||
|
2008-04-14 Samuel Tardieu <sam@rfc1149.net>
|
||||||
|
|
||||||
|
* gnat.dg/deep_old.adb: New.
|
||||||
|
|
||||||
2008-04-14 Eric Botcazou <ebotcazou@adacore.com>
|
2008-04-14 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
* gnat.dg/loop_address2.adb: New test.
|
* gnat.dg/loop_address2.adb: New test.
|
||||||
|
|
|
@ -0,0 +1,8 @@
|
||||||
|
procedure Deep_Old (X : Integer) is
|
||||||
|
begin
|
||||||
|
begin
|
||||||
|
if X = X'Old then
|
||||||
|
null;
|
||||||
|
end if;
|
||||||
|
end;
|
||||||
|
end Deep_Old;
|
Loading…
Reference in New Issue