[PATCH v3] ada: Allow 'Old attribute to be deeper in a subprogram

Samuel Tardieu sam@rfc1149.net
Fri Apr 11 23:43:00 GMT 2008


[Grmpf, resend, an unrelated chunk (on which I'm still undecided whether
 to go this way or not) made its way through PATCH v2, this one is the one
 I intended to send :-)]

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               |    9 +++++++++
 gcc/ada/sem_util.ads               |    6 ++++++
 gcc/testsuite/gnat.dg/deep_old.adb |    8 ++++++++
 4 files changed, 24 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..d383f0f 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5374,6 +5374,15 @@ package body Sem_Util is
       return False;
    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 --
    --------------------------------------
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



More information about the Gcc-patches mailing list