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 | |
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
-rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
-rw-r--r-- | gcc/ada/aspects.adb | 1 | ||||
-rw-r--r-- | gcc/ada/aspects.ads | 6 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 28 | ||||
-rw-r--r-- | gcc/ada/par-prag.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 52 | ||||
-rw-r--r-- | gcc/ada/sem_ch5.adb | 13 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 44 | ||||
-rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 |
9 files changed, 153 insertions, 15 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f93439e..c409799 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,26 @@ 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. + +2015-10-26 Bob Duff <duff@adacore.com> + * exp_ch7.adb, exp_ch6.adb: Minor comment fix. 2015-10-26 Hristian Kirtchev <kirtchev@adacore.com> diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index e2bf1ea..4398f92 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -582,6 +582,7 @@ package body Aspects is Aspect_Pre => Aspect_Pre, Aspect_Precondition => Aspect_Pre, Aspect_Predicate => Aspect_Predicate, + Aspect_Predicate_Failure => Aspect_Predicate_Failure, Aspect_Preelaborate => Aspect_Preelaborate, Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization, Aspect_Priority => Aspect_Priority, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 55c51a1..5e042ad 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -125,6 +125,7 @@ package Aspects is Aspect_Pre, Aspect_Precondition, Aspect_Predicate, -- GNAT + Aspect_Predicate_Failure, Aspect_Priority, Aspect_Read, Aspect_Refined_Depends, -- GNAT @@ -361,6 +362,7 @@ package Aspects is Aspect_Pre => Expression, Aspect_Precondition => Expression, Aspect_Predicate => Expression, + Aspect_Predicate_Failure => Expression, Aspect_Priority => Expression, Aspect_Read => Name, Aspect_Refined_Depends => Expression, @@ -472,6 +474,7 @@ package Aspects is Aspect_Pre => Name_Pre, Aspect_Precondition => Name_Precondition, Aspect_Predicate => Name_Predicate, + Aspect_Predicate_Failure => Name_Predicate_Failure, Aspect_Preelaborable_Initialization => Name_Preelaborable_Initialization, Aspect_Preelaborate => Name_Preelaborate, Aspect_Priority => Name_Priority, @@ -587,7 +590,7 @@ package Aspects is -- constructs. To handle forward references in such aspects, the compiler -- delays the analysis of their respective pragmas by collecting them in -- N_Contract nodes. The pragmas are then analyzed at the end of the - -- declarative region which contains the related construct. For details, + -- declarative region containing the related construct. For details, -- see routines Analyze_xxx_In_Decl_Part. -- The following shows which aspects are delayed. There are three cases: @@ -676,6 +679,7 @@ package Aspects is Aspect_Pre => Always_Delay, Aspect_Precondition => Always_Delay, Aspect_Predicate => Always_Delay, + Aspect_Predicate_Failure => Always_Delay, Aspect_Preelaborable_Initialization => Always_Delay, Aspect_Preelaborate => Always_Delay, Aspect_Priority => Always_Delay, 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; ---------------------------- diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index a3ed732..c317949 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1421,6 +1421,7 @@ begin Pragma_Pre | Pragma_Precondition | Pragma_Predicate | + Pragma_Predicate_Failure | Pragma_Preelaborate | Pragma_Pre_Class | Pragma_Priority | diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index d02d8e5..36eb7ad 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1642,7 +1642,7 @@ package body Sem_Ch13 is end if; Set_Corresponding_Aspect (Aitem, Aspect); - Set_From_Aspect_Specification (Aitem, True); + Set_From_Aspect_Specification (Aitem); end Make_Aitem_Pragma; -- Start of processing for Analyze_One_Aspect @@ -1979,7 +1979,7 @@ package body Sem_Ch13 is Expression => Ent), Make_Pragma_Argument_Association (Sloc (Expr), Expression => Relocate_Node (Expr))), - Pragma_Name => Name_Predicate); + Pragma_Name => Name_Predicate); -- Mark type has predicates, and remember what kind of -- aspect lead to this predicate (we need this to access @@ -2010,6 +2010,46 @@ package body Sem_Ch13 is Ensure_Freeze_Node (Full_View (E)); end if; + -- Predicate_Failure + + when Aspect_Predicate_Failure => + + -- This aspect applies only to subtypes + + if not Is_Type (E) then + Error_Msg_N + ("predicate can only be specified for a subtype", + Aspect); + goto Continue; + + elsif Is_Incomplete_Type (E) then + Error_Msg_N + ("predicate cannot apply to incomplete view", Aspect); + goto Continue; + end if; + + -- Construct the pragma + + Make_Aitem_Pragma + (Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Sloc (Ent), + Expression => Ent), + Make_Pragma_Argument_Association (Sloc (Expr), + Expression => Relocate_Node (Expr))), + Pragma_Name => Name_Predicate_Failure); + + Set_Has_Predicates (E); + + -- If the type is private, indicate that its completion + -- has a freeze node, because that is the one that will + -- be visible at freeze time. + + if Is_Private_Type (E) and then Present (Full_View (E)) then + Set_Has_Predicates (Full_View (E)); + Set_Has_Delayed_Aspects (Full_View (E)); + Ensure_Freeze_Node (Full_View (E)); + end if; + -- Case 2b: Aspects corresponding to pragmas with two -- arguments, where the second argument is a local name -- referring to the entity, and the first argument is the @@ -7670,7 +7710,7 @@ package body Sem_Ch13 is -- Start of processing for Build_Discrete_Static_Predicate begin - -- Establish bounds for the predicate + -- Establish bounds for the predicate if Compile_Time_Known_Value (Type_Low_Bound (Typ)) then TLo := Expr_Value (Type_Low_Bound (Typ)); @@ -9373,6 +9413,9 @@ package body Sem_Ch13 is Aspect_Type_Invariant => T := Standard_Boolean; + when Aspect_Predicate_Failure => + T := Standard_String; + -- Here is the list of aspects that don't require delay analysis when Aspect_Abstract_State | @@ -12509,9 +12552,10 @@ package body Sem_Ch13 is case A_Id is -- For now we only deal with aspects that do not generate -- subprograms, or that may mention current instances of - -- types. These will require special handling (TBD). + -- types. These will require special handling (???TBD). when Aspect_Predicate | + Aspect_Predicate_Failure | Aspect_Invariant | Aspect_Static_Predicate | Aspect_Dynamic_Predicate => diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 3e79179..0c9c56e 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -316,7 +316,18 @@ package body Sem_Ch5 is Get_First_Interp (Lhs, I, It); while Present (It.Typ) loop - if Has_Compatible_Type (Rhs, It.Typ) then + -- An indexed component with generalized indexing is always + -- overloaded with the corresponding dereference. Discard + -- the interpretation that yields a reference type, which + -- is not assignable. + + if Nkind (Lhs) = N_Indexed_Component + and then Present (Generalized_Indexing (Lhs)) + and then Has_Implicit_Dereference (It.Typ) + then + null; + + elsif Has_Compatible_Type (Rhs, It.Typ) then if T1 /= Any_Type then -- An explicit dereference is overloaded if the prefix diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0b6e64d..cd5f9d0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -18243,6 +18243,47 @@ package body Sem_Prag is Discard := Rep_Item_Too_Late (Typ, N, FOnly => True); end Predicate; + ----------------------- + -- Predicate_Failure -- + ----------------------- + + -- pragma Predicate_Failure + -- ([Entity =>] type_LOCAL_NAME, + -- [Message =>] string_EXPRESSION); + + when Pragma_Predicate_Failure => Predicate_Failure : declare + Discard : Boolean; + Typ : Entity_Id; + Type_Id : Node_Id; + + begin + GNAT_Pragma; + Check_Arg_Count (2); + Check_Optional_Identifier (Arg1, Name_Entity); + Check_Optional_Identifier (Arg2, Name_Message); + + Check_Arg_Is_Local_Name (Arg1); + + Type_Id := Get_Pragma_Arg (Arg1); + Find_Type (Type_Id); + Typ := Entity (Type_Id); + + if Typ = Any_Type then + return; + end if; + + -- A pragma that applies to a Ghost entity becomes Ghost for the + -- purposes of legality checks and removal of ignored Ghost code. + + Mark_Pragma_As_Ghost (N, Typ); + + -- The remaining processing is simply to link the pragma on to + -- the rep item chain, for processing when the type is frozen. + -- This is accomplished by a call to Rep_Item_Too_Late. + + Discard := Rep_Item_Too_Late (Typ, N, FOnly => True); + end Predicate_Failure; + ------------------ -- Preelaborate -- ------------------ @@ -27291,7 +27332,7 @@ package body Sem_Prag is -- 0 indicates that appearance in any argument is not significant -- +n indicates that appearance as argument n is significant, but all -- other arguments are not significant - -- 9n arguments from n on are significant, before n inisignificant + -- 9n arguments from n on are significant, before n insignificant Sig_Flags : constant array (Pragma_Id) of Int := (Pragma_Abort_Defer => -1, @@ -27446,6 +27487,7 @@ package body Sem_Prag is Pragma_Pre => -1, Pragma_Precondition => -1, Pragma_Predicate => -1, + Pragma_Predicate_Failure => -1, Pragma_Preelaborable_Initialization => -1, Pragma_Preelaborate => 0, Pragma_Pre_Class => -1, diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 6d9ca7d..76d8028 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -570,6 +570,7 @@ package Snames is Name_Pre : constant Name_Id := N + $; -- GNAT Name_Precondition : constant Name_Id := N + $; -- GNAT Name_Predicate : constant Name_Id := N + $; -- GNAT + Name_Predicate_Failure : constant Name_Id := N + $; -- Ada 12 Name_Preelaborable_Initialization : constant Name_Id := N + $; -- Ada 05 Name_Preelaborate : constant Name_Id := N + $; Name_Pre_Class : constant Name_Id := N + $; -- GNAT @@ -1895,6 +1896,7 @@ package Snames is Pragma_Pre, Pragma_Precondition, Pragma_Predicate, + Pragma_Predicate_Failure, Pragma_Preelaborable_Initialization, Pragma_Preelaborate, Pragma_Pre_Class, |