+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.
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,
Aspect_Pre,
Aspect_Precondition,
Aspect_Predicate, -- GNAT
+ Aspect_Predicate_Failure,
Aspect_Priority,
Aspect_Read,
Aspect_Refined_Depends, -- GNAT
Aspect_Pre => Expression,
Aspect_Precondition => Expression,
Aspect_Predicate => Expression,
+ Aspect_Predicate_Failure => Expression,
Aspect_Priority => Expression,
Aspect_Read => Name,
Aspect_Refined_Depends => Expression,
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,
-- 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:
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,
(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.
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;
----------------------------
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;
----------------------------
Pragma_Pre |
Pragma_Precondition |
Pragma_Predicate |
+ Pragma_Predicate_Failure |
Pragma_Preelaborate |
Pragma_Pre_Class |
Pragma_Priority |
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
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
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
-- 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));
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 |
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 =>
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
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 --
------------------
-- 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,
Pragma_Pre => -1,
Pragma_Precondition => -1,
Pragma_Predicate => -1,
+ Pragma_Predicate_Failure => -1,
Pragma_Preelaborable_Initialization => -1,
Pragma_Preelaborate => 0,
Pragma_Pre_Class => -1,
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
Pragma_Pre,
Pragma_Precondition,
Pragma_Predicate,
+ Pragma_Predicate_Failure,
Pragma_Preelaborable_Initialization,
Pragma_Preelaborate,
Pragma_Pre_Class,
projects / gcc.git / commitdiff