sem_util.ads, [...] (In_Subprogram): New function.
authorSamuel Tardieu <sam@rfc1149.net>
Mon, 14 Apr 2008 12:08:31 +0000 (12:08 +0000)
committerSamuel Tardieu <sam@gcc.gnu.org>
Mon, 14 Apr 2008 12:08:31 +0000 (12:08 +0000)
    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

gcc/ada/ChangeLog
gcc/ada/sem_attr.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/deep_old.adb [new file with mode: 0644]

index 39a458fc822492f5963c96114c1d82b85428add0..848beee0598ada69aab1c069d99e3e2d244cf5b0 100644 (file)
@@ -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>
 
        PR ada/20822
index 441b394058df16474c920a19808fc5869f790b7f..ed52023e716f724df8abf7517e24b155aaa8685a 100644 (file)
@@ -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;
 
index 9ab77bbf9f800912ade63548b28eacf9736f6bdd..3d5aa776e893c2174573d12148569f8d5174f865 100644 (file)
@@ -5365,6 +5365,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 --
    --------------------------------------
index 519f574b2b3d159b8af29d6fb7695496d534f426..d8c0b17e8d7e8ec78767fa5a8e4b7ca7aa5a0f97 100644 (file)
@@ -587,6 +587,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
index 23a6dd3c0a673647bb91bca60e21ac0971c82cd4..97d0dc701b14ae821d8d62508d0ad82f64db3202 100644 (file)
@@ -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>
 
        * gnat.dg/loop_address2.adb: New test.
diff --git a/gcc/testsuite/gnat.dg/deep_old.adb b/gcc/testsuite/gnat.dg/deep_old.adb
new file mode 100644 (file)
index 0000000..6aca027
--- /dev/null
@@ -0,0 +1,8 @@
+procedure Deep_Old (X : Integer) is
+begin
+   begin
+      if X = X'Old then
+         null;
+      end if;
+   end;
+end Deep_Old;