This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] ada: Allow 'Old attribute to be deeper in a subprogram
- From: Samuel Tardieu <sam at rfc1149 dot net>
- To: gcc-patches at gcc dot gnu dot org
- Date: Fri, 11 Apr 2008 22:33:05 +0200
- Subject: [PATCH] ada: Allow 'Old attribute to be deeper in a subprogram
- Organisation: RFC1149 (see http://www.rfc1149.net/)
The semantic analysis unnecessarily restricts the usage of the new 'Old
attribute to the outermost scope of a subprogram body. The attached
program will give an error:
4. if X = X'Old then
|
>>> attribute "Old" can only appear within subprogram
This patch removes this limitation and allows 'Old to appear anywhere
within a subprogram. Note that the expansion already does the correct
job of looking up the outermost context in the subprogram to place the
copy of the initial value there.
Regtested on i686-pc-linux-gnu.
Ok for trunk?
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.
---
gcc/ada/sem_attr.adb | 2 +-
gcc/ada/sem_util.adb | 28 ++++++++++++++++++++++++++++
gcc/ada/sem_util.ads | 6 ++++++
gcc/testsuite/gnat.dg/deep_old.adb | 8 ++++++++
4 files changed, 43 insertions(+), 1 deletions(-)
create mode 100644 gcc/testsuite/gnat.dg/deep_old.adb
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index ae84ffb..19d636b 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3472,7 +3472,7 @@ package body Sem_Attr is
Check_E0;
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);
end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 0bb7c28..325592f 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5374,6 +5374,34 @@ package body Sem_Util is
return False;
end In_Package_Body;
+ -------------------
+ -- In_Subprogram --
+ -------------------
+
+ function In_Subprogram return Boolean is
+ E : Entity_Id;
+ K : Entity_Kind;
+
+ begin
+ -- Use scope chain to check successively outer scopes
+
+ E := Current_Scope;
+ loop
+ K := Ekind (E);
+
+ if K in Subprogram_Kind
+ or else K in Generic_Subprogram_Kind
+ then
+ return True;
+
+ elsif E = Standard_Standard then
+ return False;
+ end if;
+
+ E := Scope (E);
+ end loop;
+ end In_Subprogram;
+
--------------------------------------
-- In_Subprogram_Or_Concurrent_Unit --
--------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index e434f28..17f8de1 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -590,6 +590,12 @@ package Sem_Util is
function In_Package_Body return Boolean;
-- 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;
-- Determines if the current scope is within a subprogram compilation
-- unit (inside a subprogram declaration, subprogram body, or generic
diff --git a/gcc/testsuite/gnat.dg/deep_old.adb b/gcc/testsuite/gnat.dg/deep_old.adb
new file mode 100644
index 0000000..6aca027
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deep_old.adb
@@ -0,0 +1,8 @@
+procedure Deep_Old (X : Integer) is
+begin
+ begin
+ if X = X'Old then
+ null;
+ end if;
+ end;
+end Deep_Old;
--
1.5.5.144.g3e42