diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2015-10-26 14:26:11 +0100 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2015-10-26 14:26:11 +0100 |
| commit | a2c314c72b070a170ade9858c6a0ece2105c4508 (patch) | |
| tree | 009f50ecfd2e3c00060714be3a86ffa02c6b0482 /gcc/ada/exp_util.adb | |
| parent | 75b87c163fccf0fb5ae07c0d34678949c90414f6 (diff) | |
| download | gcc-a2c314c72b070a170ade9858c6a0ece2105c4508.zip gcc-a2c314c72b070a170ade9858c6a0ece2105c4508.tar.gz gcc-a2c314c72b070a170ade9858c6a0ece2105c4508.tar.bz2 | |
[multiple changes]
2015-10-26 Bob Duff <duff@adacore.com>
* snames.ads-tmpl, aspects.adb, aspects.ads: Add the aspect and
pragma names and enter into relevant tables.
* sem_ch13.adb (Analyze_Aspect_Specifications): Analyze aspect
Predicate_Failure.
* sem_prag.adb (Predicate_Failure): Analyze pragma Predicate_Failure.
* exp_util.adb (Make_Predicate_Check): When building the Check
pragma, if Predicate_Failure has been specified, add the relevant
String argument to the pragma.
* par-prag.adb (Prag): Add Predicate_Failure to list of pragmas
handled during semantic analysis.
2015-10-26 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Assignment): If the left-hand side
is an indexed component with generalized indexing, discard
interpretation that yields a reference type, which is not
assignable. This prevent spurious ambiguities when the right-hand
side is an aggregate which does not provide a target type.
From-SVN: r229358
Diffstat (limited to 'gcc/ada/exp_util.adb')
| -rw-r--r-- | gcc/ada/exp_util.adb | 28 |
1 files changed, 20 insertions, 8 deletions
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index aec7320..d546fa8 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6507,8 +6507,9 @@ package body Exp_Util is (Typ : Entity_Id; Expr : Node_Id) return Node_Id is - Loc : constant Source_Ptr := Sloc (Expr); - Nam : Name_Id; + Loc : constant Source_Ptr := Sloc (Expr); + Nam : Name_Id; + Arg_List : List_Id; begin -- If predicate checks are suppressed, then return a null statement. @@ -6537,14 +6538,24 @@ package body Exp_Util is Nam := Name_Predicate; end if; + Arg_List := New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Make_Identifier (Loc, Nam)), + Make_Pragma_Argument_Association (Loc, + Expression => Make_Predicate_Call (Typ, Expr))); + + if Has_Aspect (Typ, Aspect_Predicate_Failure) then + Append_To (Arg_List, + Make_Pragma_Argument_Association (Loc, + Expression => + New_Copy_Tree (Expression + (Find_Aspect (Typ, Aspect_Predicate_Failure))))); + end if; + return Make_Pragma (Loc, Pragma_Identifier => Make_Identifier (Loc, Name_Check), - Pragma_Argument_Associations => New_List ( - Make_Pragma_Argument_Association (Loc, - Expression => Make_Identifier (Loc, Nam)), - Make_Pragma_Argument_Association (Loc, - Expression => Make_Predicate_Call (Typ, Expr)))); + Pragma_Argument_Associations => Arg_List); end Make_Predicate_Check; ---------------------------- @@ -9427,7 +9438,8 @@ package body Exp_Util is return Present (S) and then Get_TSS_Name (S) /= TSS_Null - and then not Is_Predicate_Function (S); + and then not Is_Predicate_Function (S) + and then not Is_Predicate_Function_M (S); end Within_Internal_Subprogram; ---------------------------- |