This patch modifies the parsing of protected and task definitions to detect
illegal placement of pragmas Assert and Debug within the protected or task
item lists.
------------
-- Source --
------------
-- synch_pragmas.ads
package Synch_Pragmas is
protected PO is
pragma Assert (PO'Size > 0); -- Error
procedure P;
pragma Assert (PO'Size > 0); -- Error
private
pragma Assert (PO'Size > 0); -- Error
function F return Boolean;
pragma Assert (PO'Size > 0); -- Error
Comp : Integer;
pragma Assert (PO'Size > 0); -- Error
end PO;
protected type PT is
pragma Assert (PT'Size > 0); -- Error
procedure P;
pragma Assert (PT'Size > 0); -- Error
private
pragma Assert (PT'Size > 0); -- Error
function F return Boolean;
pragma Assert (PT'Size > 0); -- Error
Comp : Integer;
pragma Assert (PT'Size > 0); -- Error
end PT;
task TO is
pragma Assert (TO'Size > 0); -- Error
entry E;
pragma Assert (TO'Size > 0); -- Error
private
pragma Assert (TO'Size > 0); -- Error
entry E2;
pragma Assert (TO'Size > 0); -- Error
end TO;
task type TT is
pragma Assert (TT'Size > 0); -- Error
entry E;
pragma Assert (TT'Size > 0); -- Error
private
pragma Assert (TT'Size > 0); -- Error
entry E2;
pragma Assert (TT'Size > 0); -- Error
end TT;
end Synch_Pragmas;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c synch_pragmas.ads
synch_pragmas.ads:3:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:5:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:7:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:9:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:11:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:15:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:17:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:19:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:21:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:23:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:27:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:29:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:31:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:33:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:37:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:39:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:41:07: pragma "Assert" must be in declaration/statement
context
synch_pragmas.ads:43:07: pragma "Assert" must be in declaration/statement
context
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-01-23 Hristian Kirtchev <kirtc...@adacore.com>
* par-ch9.adb (P_Protected_Definition): Parse
any optional and potentially illegal pragmas which appear in
a protected operation declaration list.
(P_Task_Items): Parse
any optional and potentially illegal pragmas which appear in a
task item list.
Index: par-ch9.adb
===================================================================
--- par-ch9.adb (revision 244773)
+++ par-ch9.adb (working copy)
@@ -338,10 +338,10 @@
Decl_Sloc := Token_Ptr;
if Token = Tok_Pragma then
- Append (P_Pragma, Items);
+ P_Pragmas_Opt (Items);
- -- Ada 2005 (AI-397): Reserved words NOT and OVERRIDING
- -- may begin an entry declaration.
+ -- Ada 2005 (AI-397): Reserved words NOT and OVERRIDING may begin an
+ -- entry declaration.
elsif Token = Tok_Entry
or else Token = Tok_Not
@@ -350,8 +350,9 @@
Append (P_Entry_Declaration, Items);
elsif Token = Tok_For then
- -- Representation clause in task declaration. The only rep
- -- clause which is legal in a protected is an address clause,
+
+ -- Representation clause in task declaration. The only rep clause
+ -- which is legal in a protected declaration is an address clause,
-- so that is what we try to scan out.
Item_Node := P_Representation_Clause;
@@ -617,8 +618,10 @@
-- Error recovery: cannot raise Error_Resync
function P_Protected_Definition return Node_Id is
- Def_Node : Node_Id;
- Item_Node : Node_Id;
+ Def_Node : Node_Id;
+ Item_Node : Node_Id;
+ Priv_Decls : List_Id;
+ Vis_Decls : List_Id;
begin
Def_Node := New_Node (N_Protected_Definition, Token_Ptr);
@@ -631,33 +634,63 @@
-- Loop to scan visible declarations (protected operation declarations)
- Set_Visible_Declarations (Def_Node, New_List);
+ Vis_Decls := New_List;
+ Set_Visible_Declarations (Def_Node, Vis_Decls);
+ -- Flag and discard all pragmas which cannot appear in the protected
+ -- definition. Note that certain pragmas are still allowed as long as
+ -- they apply to entries, entry families, or protected subprograms.
+
+ P_Pragmas_Opt (Vis_Decls);
+
loop
Item_Node := P_Protected_Operation_Declaration_Opt;
+
+ if Present (Item_Node) then
+ Append (Item_Node, Vis_Decls);
+ end if;
+
+ P_Pragmas_Opt (Vis_Decls);
+
exit when No (Item_Node);
- Append (Item_Node, Visible_Declarations (Def_Node));
end loop;
-- Deal with PRIVATE part (including graceful handling of multiple
-- PRIVATE parts).
Private_Loop : while Token = Tok_Private loop
- if No (Private_Declarations (Def_Node)) then
- Set_Private_Declarations (Def_Node, New_List);
+ Priv_Decls := Private_Declarations (Def_Node);
+
+ if Present (Priv_Decls) then
+ Error_Msg_SC ("duplicate private part");
else
- Error_Msg_SC ("duplicate private part");
+ Priv_Decls := New_List;
+ Set_Private_Declarations (Def_Node, Priv_Decls);
end if;
Scan; -- past PRIVATE
+ -- Flag and discard all pragmas which cannot appear in the protected
+ -- definition. Note that certain pragmas are still allowed as long as
+ -- they apply to entries, entry families, or protected subprograms.
+
+ P_Pragmas_Opt (Priv_Decls);
+
Declaration_Loop : loop
if Token = Tok_Identifier then
- P_Component_Items (Private_Declarations (Def_Node));
+ P_Component_Items (Priv_Decls);
+ P_Pragmas_Opt (Priv_Decls);
+
else
Item_Node := P_Protected_Operation_Declaration_Opt;
+
+ if Present (Item_Node) then
+ Append (Item_Node, Priv_Decls);
+ end if;
+
+ P_Pragmas_Opt (Priv_Decls);
+
exit Declaration_Loop when No (Item_Node);
- Append (Item_Node, Private_Declarations (Def_Node));
end if;
end loop Declaration_Loop;
end loop Private_Loop;
