-- If pragma is not enabled, rewrite as Null statement. If pragma is
-- disabled, it has already been rewritten as a Null statement.
--
- -- Likewise, do this in CodePeer mode, because the expanded code is too
+ -- Likewise, ignore structural variants for execution.
+ --
+ -- Also do this in CodePeer mode, because the expanded code is too
-- complicated for CodePeer to analyse.
- if Is_Ignored (N) or else CodePeer_Mode then
+ if Is_Ignored (N)
+ or else Chars (Last_Var) = Name_Structural
+ or else CodePeer_Mode
+ then
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
return;
Loc : constant Source_Ptr := Sloc (Prag);
- Aggr : Node_Id;
+ Aggr : constant Node_Id :=
+ Expression (First (Pragma_Argument_Associations (Prag)));
Formal_Map : Elist_Id;
Last : Node_Id;
- Last_Variant : Node_Id;
+ Last_Variant : constant Node_Id :=
+ Nlists.Last (Component_Associations (Aggr));
Proc_Bod : Node_Id;
Proc_Decl : Node_Id;
Proc_Id : Entity_Id;
Variant : Node_Id;
begin
- -- Do nothing if pragma is not present or is disabled
+ -- Do nothing if pragma is not present or is disabled.
+ -- Also ignore structural variants for execution.
- if Is_Ignored (Prag) then
+ if Is_Ignored (Prag)
+ or else Chars (Nlists.Last (Choices (Last_Variant))) = Name_Structural
+ then
return;
end if;
- Aggr := Expression (First (Pragma_Argument_Associations (Prag)));
-
-- The expansion of Subprogram Variant is quite distributed as it
-- produces various statements to capture and compare the arguments.
-- To preserve the original context, set the Is_Assertion_Expr flag.
Last := Proc_Decl;
Curr_Decls := New_List;
- Last_Variant := Nlists.Last (Component_Associations (Aggr));
Variant := First (Component_Associations (Aggr));
while Present (Variant) loop
if Chars (Variant) = No_Name then
Error_Pragma_Arg_Ident ("expect name `Increases`", Variant);
- elsif Chars (Variant) not in Name_Decreases | Name_Increases
+ elsif Chars (Variant) not in
+ Name_Decreases | Name_Increases | Name_Structural
then
declare
Name : String := Get_Name_String (Chars (Variant));
Error_Pragma_Arg_Ident
("expect name `Decreases`", Variant);
+ elsif Name'Length >= 4
+ and then Name (1 .. 4) = "stru"
+ then
+ Error_Pragma_Arg_Ident
+ ("expect name `Structural`", Variant);
+
else
Error_Pragma_Arg_Ident
- ("expect name `Increases` or `Decreases`", Variant);
+ ("expect name `Increases`, `Decreases`,"
+ & " or `Structural`", Variant);
end if;
end;
+
+ elsif Chars (Variant) = Name_Structural
+ and then List_Length (Pragma_Argument_Associations (N)) > 1
+ then
+ Error_Pragma_Arg_Ident
+ ("Structural variant shall be the only variant", Variant);
end if;
-- Preanalyze_Assert_Expression, but without enforcing any of
Preanalyze_Assert_Expression (Expression (Variant));
- -- Expression of a discrete type is allowed
+ -- Expression of a discrete type is allowed. Nothing to
+ -- check for structural variants.
- if Is_Discrete_Type (Etype (Expression (Variant))) then
+ if Chars (Variant) = Name_Structural
+ or else Is_Discrete_Type (Etype (Expression (Variant)))
+ then
null;
-- Expression of a Big_Integer type (or its ghost variant) is
-- Subprogram_Variant --
------------------------
- -- pragma Subprogram_Variant ( SUBPROGRAM_VARIANT_ITEM
- -- {, SUBPROGRAM_VARIANT_ITEM } );
-
- -- SUBPROGRAM_VARIANT_ITEM ::=
- -- CHANGE_DIRECTION => discrete_EXPRESSION
+ -- pragma Subprogram_Variant ( SUBPROGRAM_VARIANT_LIST );
- -- CHANGE_DIRECTION ::= Increases | Decreases
+ -- SUBPROGRAM_VARIANT_LIST ::= STRUCTURAL_SUBPROGRAM_VARIANT_ITEM
+ -- | NUMERIC_SUBPROGRAM_VARIANT_ITEMS
+ -- NUMERIC_SUBPROGRAM_VARIANT_ITEMS ::=
+ -- NUMERIC_SUBPROGRAM_VARIANT_ITEM
+ -- {, NUMERIC_SUBPROGRAM_VARIANT_ITEM}
+ -- NUMERIC_SUBPROGRAM_VARIANT_ITEM ::= CHANGE_DIRECTION => EXPRESSION
+ -- STRUCTURAL_SUBPROGRAM_VARIANT_ITEM ::= Structural => EXPRESSION
+ -- CHANGE_DIRECTION ::= Increases | Decreases
-- Characteristics:
-- Check placement of OTHERS if available (SPARK RM 6.1.3(1))
if Nkind (Direction) = N_Identifier then
- if Chars (Direction) /= Name_Decreases
- and then
- Chars (Direction) /= Name_Increases
+ if Chars (Direction) not in Name_Decreases
+ | Name_Increases
+ | Name_Structural
then
Error_Msg_N ("wrong direction", Direction);
end if;
Preanalyze_Assert_Expression (Expr);
- -- Expression of a discrete type is allowed
+ -- Expression of a discrete type is allowed. Nothing more to check
+ -- for structural variants.
- if Is_Discrete_Type (Etype (Expr)) then
+ if Is_Discrete_Type (Etype (Expr))
+ or else Chars (Direction) = Name_Structural
+ then
null;
-- Expression of a Big_Integer type (or its ghost variant) is only
Variant := First (Component_Associations (Variants));
while Present (Variant) loop
Analyze_Variant (Variant);
+
+ if Chars (First (Choices (Variant))) = Name_Structural
+ and then List_Length (Component_Associations (Variants)) > 1
+ then
+ Error_Msg_N
+ ("Structural variant shall be the only variant", Variant);
+ end if;
+
Next (Variant);
end loop;