If a statement appears where a declaration is expected, then an appropriate error message is given, but the tree is malformed leading to a later crash if -gnatQ is used.
The following should compile with -gnatQ without giving a "compilation abandoned" message: 1. procedure AssignInD is 2. X : Integer; 3. X := 2; | >>> statement not allowed in declarative part 4. Y : Integer; 5. begin 6. null; 7. end; In addition, this patch implements the -gnatd.2 debug flag which suppresses error messages of this kind (if the above is compiled with -gnatd.2, no error message is given). Tested on x86_64-pc-linux-gnu, committed on trunk 2015-02-20 Robert Dewar <de...@adacore.com> * debug.adb: Add documentation for -gnatd.2 (allow statements in decl sequences). * par-ch3.adb (P_Identifier_Declarations): Handle statement appearing where declaration expected more cleanly. (Statement_When_Declaration_Expected): Implement debug flag -gnatd.2.
Index: debug.adb =================================================================== --- debug.adb (revision 220835) +++ debug.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -155,8 +155,8 @@ -- d8 Force opposite endianness in packed stuff -- d9 Allow lock free implementation - -- d.1 - -- d.2 + -- d.1 Enable unnesting of nested procedures + -- d.2 Allow statements in declarative part -- d.3 -- d.4 -- d.5 @@ -746,6 +746,14 @@ -- d9 This allows lock free implementation for protected objects -- (see Exp_Ch9). + -- d.1 Enable unnesting of nested procedures. This special pass does not + -- actually unnest things, but it ensures that a nested procedure + -- does not contain any uplevel references. + + -- d.2 Allow statements within declarative parts. This is not usually + -- allowed, but in some debugging contexts (e.g. testing the circuit + -- for unnesting of procedures), it is useful to allow this. + ------------------------------------------ -- Documentation for Binder Debug Flags -- ------------------------------------------ Index: par-ch3.adb =================================================================== --- par-ch3.adb (revision 220835) +++ par-ch3.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1455,6 +1455,16 @@ else Restore_Scan_State (Scan_State); + + -- Reset Token_Node, because it already got changed from an + -- Identifier to a Defining_Identifier, and we don't want that + -- for a statement! + + Token_Node := + Make_Identifier (Sloc (Token_Node), Chars (Token_Node)); + + -- And now scan out one or more statements + Statement_When_Declaration_Expected (Decls, Done, In_Spec); return; end if; @@ -4777,6 +4787,12 @@ if In_Spec then null; + -- Just ignore it if we are in -gnatd.2 (allow statements to appear + -- in declaration sequences) mode. + + elsif Debug_Flag_Dot_2 then + null; + -- In the declarative part case, take a second statement as a sure -- sign that we really have a missing BEGIN, and end the declarative -- part now. Note that the caller will fix up the first message to @@ -4790,26 +4806,32 @@ -- Case of first occurrence of unexpected statement else - -- If we are in a package spec, then give message of statement - -- not allowed in package spec. This message never gets changed. + -- Do not give error message if we are operating in -gnatd.2 mode + -- (alllow statements to appear in declarative parts). - if In_Spec then - Error_Msg_SC ("statement not allowed in package spec"); + if not Debug_Flag_Dot_2 then - -- If in declarative part, then we give the message complaining - -- about finding a statement when a declaration is expected. This - -- gets changed to a complaint about a missing BEGIN if we later - -- find that no BEGIN is present. + -- If we are in a package spec, then give message of statement + -- not allowed in package spec. This message never gets changed. - else - Error_Msg_SC ("statement not allowed in declarative part"); - end if; + if In_Spec then + Error_Msg_SC ("statement not allowed in package spec"); - -- Capture message Id. This is used for two purposes, first to - -- stop multiple messages, see test above, and second, to allow - -- the replacement of the message in the declarative part case. + -- If in declarative part, then we give the message complaining + -- about finding a statement when a declaration is expected. This + -- gets changed to a complaint about a missing BEGIN if we later + -- find that no BEGIN is present. - Missing_Begin_Msg := Get_Msg_Id; + else + Error_Msg_SC ("statement not allowed in declarative part"); + end if; + + -- Capture message Id. This is used for two purposes, first to + -- stop multiple messages, see test above, and second, to allow + -- the replacement of the message in the declarative part case. + + Missing_Begin_Msg := Get_Msg_Id; + end if; end if; -- In all cases except the case in which we decided to terminate the