[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
This commit is contained in:
Arnaud Charlet
parent
75b87c163f
commit
a2c314c72b
|
|
@ -1,3 +1,24 @@
|
|||
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.
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
----------------------------
|
||||
|
|
|
|||
|
|
@ -1421,6 +1421,7 @@ begin
|
|||
Pragma_Pre |
|
||||
Pragma_Precondition |
|
||||
Pragma_Predicate |
|
||||
Pragma_Predicate_Failure |
|
||||
Pragma_Preelaborate |
|
||||
Pragma_Pre_Class |
|
||||
Pragma_Priority |
|
||||
|
|
|
|||
|
|
@ -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 =>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
Loading…
Reference in New Issue