Commit 8f252d27 by Thomas Quinot Committed by Arnaud Charlet

scos.ads (In_Decision): Add missing entry for 'a'.

2013-01-02  Thomas Quinot  <quinot@adacore.com>

	* scos.ads (In_Decision): Add missing entry for 'a'.
	* sem_prag.adb (Analyze_Pragma, case pragma Check): Omit
	call to Set_SCO_Pragma_Enabled for Invariant and Predicate.
	* sem_ch13.adb: Minor comment update.

From-SVN: r194777
parent e0d7fe6d
2013-01-02 Thomas Quinot <quinot@adacore.com>
* scos.ads (In_Decision): Add missing entry for 'a'.
* sem_prag.adb (Analyze_Pragma, case pragma Check): Omit
call to Set_SCO_Pragma_Enabled for Invariant and Predicate.
* sem_ch13.adb: Minor comment update.
2012-12-21 Ed Schonberg <schonberg@adacore.com> 2012-12-21 Ed Schonberg <schonberg@adacore.com>
PR ada/53737 PR ada/53737
......
...@@ -385,8 +385,8 @@ package SCOs is ...@@ -385,8 +385,8 @@ package SCOs is
Table_Increment => 300); Table_Increment => 300);
Is_Decision : constant array (Character) of Boolean := Is_Decision : constant array (Character) of Boolean :=
('E' | 'G' | 'I' | 'P' | 'A' | 'W' | 'X' => True, ('E' | 'G' | 'I' | 'P' | 'a' | 'A' | 'W' | 'X' => True,
others => False); others => False);
-- Indicates which C1 values correspond to decisions -- Indicates which C1 values correspond to decisions
-- The SCO_Table_Entry values appear as follows: -- The SCO_Table_Entry values appear as follows:
......
...@@ -5229,8 +5229,7 @@ package body Sem_Ch13 is ...@@ -5229,8 +5229,7 @@ package body Sem_Ch13 is
Exp := New_Copy_Tree (Arg2); Exp := New_Copy_Tree (Arg2);
-- Preserve sloc of original pragma Invariant (this is required -- Preserve sloc of original pragma Invariant
-- by Par_SCO).
Loc := Sloc (Ritem); Loc := Sloc (Ritem);
......
...@@ -2233,7 +2233,7 @@ package body Sem_Prag is ...@@ -2233,7 +2233,7 @@ package body Sem_Prag is
(Get_Pragma_Arg (Arg2), Standard_String); (Get_Pragma_Arg (Arg2), Standard_String);
end if; end if;
-- For a pragma in the extended main source unit, record enabled -- For a pragma PPC in the extended main source unit, record enabled
-- status in SCO. -- status in SCO.
-- This may seem redundant with the call to Check_Enabled occurring -- This may seem redundant with the call to Check_Enabled occurring
...@@ -7449,8 +7449,9 @@ package body Sem_Prag is ...@@ -7449,8 +7449,9 @@ package body Sem_Prag is
-- [,[Message =>] String_EXPRESSION]); -- [,[Message =>] String_EXPRESSION]);
when Pragma_Check => Check : declare when Pragma_Check => Check : declare
Expr : Node_Id; Expr : Node_Id;
Eloc : Source_Ptr; Eloc : Source_Ptr;
Cname : Name_Id;
Check_On : Boolean; Check_On : Boolean;
-- Set True if category of assertions referenced by Name enabled -- Set True if category of assertions referenced by Name enabled
...@@ -7477,14 +7478,28 @@ package body Sem_Prag is ...@@ -7477,14 +7478,28 @@ package body Sem_Prag is
return; return;
end if; end if;
-- Indicate if pragma is enabled. The Original_Node reference here Cname := Chars (Get_Pragma_Arg (Arg1));
-- is to deal with pragma Assert rewritten as a Check pragma. Check_On := Check_Enabled (Cname);
Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1))); case Cname is
when Name_Predicate |
Name_Invariant =>
if Check_On and then not Split_PPC (N) then -- Nothing to do: since checks occur in client units,
Set_SCO_Pragma_Enabled (Loc); -- the SCO for the aspect in the declaration unit is
end if; -- conservatively always enabled.
null;
when others =>
if Check_On and then not Split_PPC (N) then
-- Mark pragma/aspect SCO as enabled
Set_SCO_Pragma_Enabled (Loc);
end if;
end case;
-- If expansion is active and the check is not enabled then we -- If expansion is active and the check is not enabled then we
-- rewrite the Check as: -- rewrite the Check as:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment