aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2014-01-23 18:06:29 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2014-01-23 18:06:29 +0100
commitea0f1fc8e4414c655d03febbb63536ab9225e250 (patch)
tree940269d4a068a80cd066a98d66f485dd89bd2769
parent19992053df788e3280ae25dc272a43e8384b8db1 (diff)
downloadgcc-ea0f1fc8e4414c655d03febbb63536ab9225e250.zip
gcc-ea0f1fc8e4414c655d03febbb63536ab9225e250.tar.gz
gcc-ea0f1fc8e4414c655d03febbb63536ab9225e250.tar.bz2
[multiple changes]
2014-01-23 Robert Dewar <dewar@adacore.com> * opt.adb (Register_Opt_Config_Switches): Save SPARK_Mode_Pragma setting. 2014-01-23 Ed Schonberg <schonberg@adacore.com> * sem_util.adb (Is_Potentially_Unevaluated): Predicate only applies to expressions that come from source. * sem_attr.adb (Analyze_Attribute, case 'Old): Improve error message. (Analyze_Attribute, case 'Loop_Entry): Apply SPARK 2014 legality rule regarding potentially unevaluated expressions, to prefix of attribute. From-SVN: r206993
-rw-r--r--gcc/ada/ChangeLog15
-rw-r--r--gcc/ada/opt.adb1
-rw-r--r--gcc/ada/sem_attr.adb25
-rw-r--r--gcc/ada/sem_util.adb8
4 files changed, 40 insertions, 9 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ae2480e..4b3c213 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2014-01-23 Robert Dewar <dewar@adacore.com>
+
+ * opt.adb (Register_Opt_Config_Switches): Save SPARK_Mode_Pragma
+ setting.
+
+2014-01-23 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_util.adb (Is_Potentially_Unevaluated): Predicate only
+ applies to expressions that come from source.
+ * sem_attr.adb (Analyze_Attribute, case 'Old): Improve error
+ message.
+ (Analyze_Attribute, case 'Loop_Entry): Apply SPARK 2014 legality
+ rule regarding potentially unevaluated expressions, to prefix
+ of attribute.
+
2014-01-23 Ed Schonberg <schonberg@adacore.com>
* exp_util.adb (Make_Invqriant_Call): If type of expression is
diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb
index 20ecb4f5..383f5f4 100644
--- a/gcc/ada/opt.adb
+++ b/gcc/ada/opt.adb
@@ -64,6 +64,7 @@ package body Opt is
Polling_Required_Config := Polling_Required;
Short_Descriptors_Config := Short_Descriptors;
SPARK_Mode_Config := SPARK_Mode;
+ SPARK_Mode_Pragma_Config := SPARK_Mode_Pragma;
Use_VADS_Size_Config := Use_VADS_Size;
-- Reset the indication that Optimize_Alignment was set locally, since
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 1ce0d83..fdd1d0c 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3994,13 +3994,23 @@ package body Sem_Attr is
Check_References_In_Prefix (Loop_Id);
-- The prefix must denote a static entity if the pragma does not
- -- apply to the innermost enclosing loop statement.
+ -- apply to the innermost enclosing loop statement, or if it appears
+ -- within a potentially unevaluated epxression.
- if Present (Enclosing_Loop)
- and then Entity (Identifier (Enclosing_Loop)) /= Loop_Id
- and then not Is_Entity_Name (P)
+ if Is_Entity_Name (P)
+ or else Nkind (Parent (P)) = N_Object_Renaming_Declaration
then
- Error_Attr_P ("prefix of attribute % must denote an entity");
+ null;
+
+ elsif Present (Enclosing_Loop)
+ and then Entity (Identifier (Enclosing_Loop)) /= Loop_Id
+ then
+ Error_Attr_P ("prefix of attribute % that applies to "
+ & "outer loop must denote an entity");
+
+ elsif Is_Potentially_Unevaluated (P) then
+ Error_Attr_P ("prefix of attribute % that is potentially "
+ & "unevaluated must denote an entity");
end if;
end Loop_Entry;
@@ -4525,9 +4535,8 @@ package body Sem_Attr is
and then Is_Potentially_Unevaluated (N)
and then not Is_Entity_Name (P)
then
- Error_Msg_N
- ("prefix that is potentially unevaluated must denote an entity",
- N);
+ Error_Attr_P ("prefix of attribute % that is potentially "
+ & "unevaluated must denote an entity");
end if;
-- The attribute appears within a pre/postcondition, but refers to
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index be59c9b..9a8428d 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10334,7 +10334,13 @@ package body Sem_Util is
Expr := Par;
Par := Parent (Par);
- if Nkind (Par) not in N_Subexpr then
+ -- If the context is not an expression, or if is the result of
+ -- expansion of an enclosing construct (such as another attribute)
+ -- the predicate does not apply.
+
+ if Nkind (Par) not in N_Subexpr
+ or else not Comes_From_Source (Par)
+ then
return False;
end if;
end loop;