diff options
| author | Samuel Tardieu <sam@rfc1149.net> | 2008-04-14 12:08:31 +0000 |
|---|---|---|
| committer | Samuel Tardieu <sam@gcc.gnu.org> | 2008-04-14 12:08:31 +0000 |
| commit | 17972da719db3ced8d90b01beed66b597f07f806 (patch) | |
| tree | c41b3f7f63d76e906c54bbe9a251a6d3ed8f6c3a | |
| parent | e965b4534fb33510b35640bcc36873d398817374 (diff) | |
| download | gcc-17972da719db3ced8d90b01beed66b597f07f806.zip gcc-17972da719db3ced8d90b01beed66b597f07f806.tar.gz gcc-17972da719db3ced8d90b01beed66b597f07f806.tar.bz2 | |
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
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 6 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/deep_old.adb | 8 |
6 files changed, 33 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 39a458f..848beee 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 441b394..ed52023 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 9ab77bb..3d5aa77 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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 -- -------------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 519f574..d8c0b17 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 23a6dd3..97d0dc7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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 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; |