From: Samuel Tardieu Date: Mon, 14 Apr 2008 12:08:31 +0000 (+0000) Subject: sem_util.ads, [...] (In_Subprogram): New function. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=17972da719db3ced8d90b01beed66b597f07f806;p=gcc.git 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 39a458fc822..848beee0598 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2008-04-14 Samuel Tardieu + + * 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 PR ada/20822 diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 441b394058d..ed52023e716 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 9ab77bbf9f8..3d5aa776e89 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 519f574b2b3..d8c0b17e8d7 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 23a6dd3c0a6..97d0dc701b1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2008-04-14 Samuel Tardieu + + * gnat.dg/deep_old.adb: New. + 2008-04-14 Eric Botcazou * 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 00000000000..6aca027f4ac --- /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;