https://gcc.gnu.org/g:3c3192bcfeecd6f9fdb2a7bd1a044bd9f0a31729
commit r16-2749-g3c3192bcfeecd6f9fdb2a7bd1a044bd9f0a31729
Author: Bob Duff <d...@adacore.com>
Date: Mon Jul 21 09:43:24 2025 -0400
ada: Misc parser cleanup
...which might make it easier to deal with incorrectly shared
subtrees created during parsing.
There were several Idents arrays, with duplicated code and commentary.
And the related code had somewhat diverged -- different comments,
different index subtypes (Pos vs. Int), etc.
DRY: Move at least some of the code into Par.Util. Raise
Program_Error if the array overflows; there is really no
reason not to check, along with several comments saying
we don't check. In the unlikely event that the array
overflows, the compiler will now crash, which seems better
than erroneous execution (which could conceivably cause
bad code to be generated).
Move the block comments titled
"Handling Semicolon Used in Place of IS" and
"Handling IS Used in Place of Semicolon" so they
are together, which seems obviously desirable.
Rewrite the latter comment.
No need to denigrate other parsers.
gcc/ada/ChangeLog:
* par.adb: Move and rewrite some comments.
(Util): Shared code and comments for dealing with
defining_identifier_lists.
* par-util.adb (Append): Shared code for appending
one identifier onto Defining_Identifiers.
(P_Def_Ids): Shared code for parsing a defining_identifier_list.
Unfortunately, this is not used in all cases, because some of
them mix in sophisticated error recovery, which we do not
modify here.
* par-ch12.adb (P_Formal_Object_Declarations):
Use Defining_Identifiers and related code.
* par-ch3.adb (P_Identifier_Declarations): Likewise.
(P_Known_Discriminant_Part_Opt): Likewise.
(P_Component_Items): Likewise.
* par-ch6.adb (P_Formal_Part): Likewise.
Diff:
---
gcc/ada/par-ch12.adb | 29 ++-----
gcc/ada/par-ch3.adb | 208 +++++++++++++++++++++------------------------------
gcc/ada/par-ch6.adb | 30 +++-----
gcc/ada/par-util.adb | 29 +++++++
gcc/ada/par.adb | 169 +++++++++++++++++++++++++----------------
5 files changed, 236 insertions(+), 229 deletions(-)
diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index b539a2992130..5fb6f8c98772 100644
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -420,32 +420,17 @@ package body Ch12 is
procedure P_Formal_Object_Declarations (Decls : List_Id) is
Decl_Node : Node_Id;
- Ident : Pos;
Not_Null_Present : Boolean := False;
- Num_Idents : Pos;
Scan_State : Saved_Scan_State;
- Idents : array (Pos range 1 .. 4096) of Entity_Id;
- -- This array holds the list of defining identifiers. The upper bound
- -- of 4096 is intended to be essentially infinite, and we do not even
- -- bother to check for it being exceeded.
+ Def_Ids : Defining_Identifiers;
+ Ident : Pos;
begin
- Idents (1) := P_Defining_Identifier (C_Comma_Colon);
- Num_Idents := 1;
- while Comma_Present loop
- Num_Idents := Num_Idents + 1;
- Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
- end loop;
-
+ P_Def_Ids (Def_Ids);
T_Colon;
- -- If there are multiple identifiers, we repeatedly scan the
- -- type and initialization expression information by resetting
- -- the scan pointer (so that we get completely separate trees
- -- for each occurrence).
-
- if Num_Idents > 1 then
+ if Def_Ids.Num_Idents > 1 then
Save_Scan_State (Scan_State);
end if;
@@ -454,7 +439,7 @@ package body Ch12 is
Ident := 1;
Ident_Loop : loop
Decl_Node := New_Node (N_Formal_Object_Declaration, Token_Ptr);
- Set_Defining_Identifier (Decl_Node, Idents (Ident));
+ Set_Defining_Identifier (Decl_Node, Def_Ids.Idents (Ident));
P_Mode (Decl_Node);
Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-423)
@@ -488,13 +473,13 @@ package body Ch12 is
Set_Prev_Ids (Decl_Node, True);
end if;
- if Ident < Num_Idents then
+ if Ident < Def_Ids.Num_Idents then
Set_More_Ids (Decl_Node, True);
end if;
Append (Decl_Node, Decls);
- exit Ident_Loop when Ident = Num_Idents;
+ exit Ident_Loop when Ident = Def_Ids.Num_Idents;
Ident := Ident + 1;
Restore_Scan_State (Scan_State);
end loop Ident_Loop;
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index fe727d7c0946..a685812de604 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -1302,19 +1302,13 @@ package body Ch3 is
Ident_Sloc : Source_Ptr;
Scan_State : Saved_Scan_State;
List_OK : Boolean := True;
- Ident : Nat;
Init_Expr : Node_Id;
Init_Loc : Source_Ptr;
Con_Loc : Source_Ptr;
Not_Null_Present : Boolean := False;
- Idents : array (Int range 1 .. 4096) of Entity_Id;
- -- Used to save identifiers in the identifier list. The upper bound
- -- of 4096 is expected to be infinite in practice, and we do not even
- -- bother to check if this upper bound is exceeded.
-
- Num_Idents : Nat := 1;
- -- Number of identifiers stored in Idents
+ Def_Ids : Defining_Identifiers;
+ Ident : Pos;
function Identifier_Starts_Statement return Boolean;
-- Called with Token being an identifier that might start a declaration
@@ -1389,10 +1383,9 @@ package body Ch3 is
procedure No_List is
begin
- if Num_Idents > 1 then
+ if Def_Ids.Num_Idents > 1 then
Error_Msg_N
- ("identifier list not allowed for RENAMES",
- Idents (2));
+ ("identifier list not allowed for RENAMES", Def_Ids.Idents (2));
end if;
List_OK := False;
@@ -1443,7 +1436,7 @@ package body Ch3 is
Ident_Sloc := Token_Ptr;
Save_Scan_State (Scan_State); -- at first identifier
- Idents (1) := P_Defining_Identifier (C_Comma_Colon);
+ Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon));
-- If we have a colon after the identifier, then we can assume that
-- this is in fact a valid identifier declaration and can steam ahead.
@@ -1455,8 +1448,7 @@ package body Ch3 is
elsif Token = Tok_Comma then
while Comma_Present loop
- Num_Idents := Num_Idents + 1;
- Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
+ Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon));
end loop;
Save_Scan_State (Scan_State); -- at colon
@@ -1510,7 +1502,7 @@ package body Ch3 is
Decl_Node :=
New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
Set_Name (Decl_Node, P_Name);
- Set_Defining_Identifier (Decl_Node, Idents (1));
+ Set_Defining_Identifier (Decl_Node, Def_Ids.Idents (1));
P_Aspect_Specifications (Decl_Node, Semicolon => False);
@@ -1917,7 +1909,7 @@ package body Ch3 is
end if;
end if;
- Set_Defining_Identifier (Decl_Node, Idents (Ident));
+ Set_Defining_Identifier (Decl_Node, Def_Ids.Idents (Ident));
P_Aspect_Specifications (Decl_Node, Semicolon => False);
-- Allow initialization expression to follow aspects (note that in
@@ -1945,17 +1937,17 @@ package body Ch3 is
T_Semicolon;
if List_OK then
- if Ident < Num_Idents then
- Set_More_Ids (Decl_Node, True);
- end if;
-
if Ident > 1 then
Set_Prev_Ids (Decl_Node, True);
end if;
+
+ if Ident < Def_Ids.Num_Idents then
+ Set_More_Ids (Decl_Node, True);
+ end if;
end if;
Append (Decl_Node, Decls);
- exit Ident_Loop when Ident = Num_Idents;
+ exit Ident_Loop when Ident = Def_Ids.Num_Idents;
Restore_Scan_State (Scan_State);
T_Colon;
Ident := Ident + 1;
@@ -3191,14 +3183,7 @@ package body Ch3 is
Specification_List : List_Id;
Ident_Sloc : Source_Ptr;
Scan_State : Saved_Scan_State;
- Num_Idents : Nat;
Not_Null_Present : Boolean;
- Ident : Nat;
-
- Idents : array (Int range 1 .. 4096) of Entity_Id;
- -- This array holds the list of defining identifiers. The upper bound
- -- of 4096 is intended to be essentially infinite, and we do not even
- -- bother to check for it being exceeded.
begin
if Token = Tok_Left_Paren then
@@ -3207,97 +3192,91 @@ package body Ch3 is
P_Pragmas_Misplaced;
Specification_Loop : loop
+ declare
+ Def_Ids : Defining_Identifiers;
+ Ident : Pos;
+ begin
+ Ident_Sloc := Token_Ptr;
+ P_Def_Ids (Def_Ids);
- Ident_Sloc := Token_Ptr;
- Idents (1) := P_Defining_Identifier (C_Comma_Colon);
- Num_Idents := 1;
-
- while Comma_Present loop
- Num_Idents := Num_Idents + 1;
- Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
- end loop;
-
- -- If there are multiple identifiers, we repeatedly scan the
- -- type and initialization expression information by resetting
- -- the scan pointer (so that we get completely separate trees
- -- for each occurrence).
+ if Def_Ids.Num_Idents > 1 then
+ Save_Scan_State (Scan_State);
+ end if;
- if Num_Idents > 1 then
- Save_Scan_State (Scan_State);
- end if;
+ T_Colon;
- T_Colon;
+ -- Loop through defining identifiers in list
- -- Loop through defining identifiers in list
+ Ident := 1;
+ Ident_Loop : loop
+ Specification_Node :=
+ New_Node (N_Discriminant_Specification, Ident_Sloc);
+ Set_Defining_Identifier
+ (Specification_Node, Def_Ids.Idents (Ident));
+ Not_Null_Present := -- Ada 2005 (AI-231, AI-447)
+ P_Null_Exclusion (Allow_Anonymous_In_95 => True);
- Ident := 1;
- Ident_Loop : loop
- Specification_Node :=
- New_Node (N_Discriminant_Specification, Ident_Sloc);
- Set_Defining_Identifier (Specification_Node, Idents (Ident));
- Not_Null_Present := -- Ada 2005 (AI-231, AI-447)
- P_Null_Exclusion (Allow_Anonymous_In_95 => True);
+ if Token = Tok_Access then
+ if Ada_Version = Ada_83 then
+ Error_Msg_SC
+ ("(Ada 83) access discriminant not allowed!");
+ end if;
- if Token = Tok_Access then
- if Ada_Version = Ada_83 then
- Error_Msg_SC
- ("(Ada 83) access discriminant not allowed!");
- end if;
+ Set_Discriminant_Type
+ (Specification_Node,
+ P_Access_Definition (Not_Null_Present));
- Set_Discriminant_Type
- (Specification_Node,
- P_Access_Definition (Not_Null_Present));
+ -- Catch ouf-of-order keywords
- -- Catch ouf-of-order keywords
+ elsif Token = Tok_Constant then
+ Scan;
- elsif Token = Tok_Constant then
- Scan;
+ if Token = Tok_Access then
+ Error_Msg_SC -- CODEFIX
+ ("ACCESS must come before CONSTANT");
+ Set_Discriminant_Type
+ (Specification_Node,
+ P_Access_Definition (Not_Null_Present));
- if Token = Tok_Access then
- Error_Msg_SC -- CODEFIX
- ("ACCESS must come before CONSTANT");
- Set_Discriminant_Type
- (Specification_Node,
- P_Access_Definition (Not_Null_Present));
+ else
+ Error_Msg_SC ("misplaced CONSTANT");
+ end if;
else
- Error_Msg_SC ("misplaced CONSTANT");
+ Set_Discriminant_Type
+ (Specification_Node, P_Subtype_Mark);
+ No_Constraint;
+ Set_Null_Exclusion_Present -- Ada 2005 (AI-231)
+ (Specification_Node, Not_Null_Present);
end if;
- else
- Set_Discriminant_Type
- (Specification_Node, P_Subtype_Mark);
- No_Constraint;
- Set_Null_Exclusion_Present -- Ada 2005 (AI-231)
- (Specification_Node, Not_Null_Present);
- end if;
-
- Set_Expression
- (Specification_Node, Init_Expr_Opt (True));
+ Set_Expression
+ (Specification_Node, Init_Expr_Opt (True));
- if Token = Tok_With then
- P_Aspect_Specifications
- (Specification_Node, Semicolon => False);
- end if;
+ if Token = Tok_With then
+ P_Aspect_Specifications
+ (Specification_Node, Semicolon => False);
+ end if;
- if Ident > 1 then
- Set_Prev_Ids (Specification_Node, True);
- end if;
+ if Ident > 1 then
+ Set_Prev_Ids (Specification_Node, True);
+ end if;
- if Ident < Num_Idents then
- Set_More_Ids (Specification_Node, True);
- end if;
+ if Ident < Def_Ids.Num_Idents then
+ Set_More_Ids (Specification_Node, True);
+ end if;
- Append (Specification_Node, Specification_List);
- exit Ident_Loop when Ident = Num_Idents;
- Ident := Ident + 1;
- Restore_Scan_State (Scan_State);
- T_Colon;
- end loop Ident_Loop;
+ Append (Specification_Node, Specification_List);
+ exit Ident_Loop when Ident = Def_Ids.Num_Idents;
+ Ident := Ident + 1;
+ Restore_Scan_State (Scan_State);
+ T_Colon;
+ end loop Ident_Loop;
- exit Specification_Loop when Token /= Tok_Semicolon;
- Scan; -- past ;
- P_Pragmas_Misplaced;
+ exit Specification_Loop when Token /= Tok_Semicolon;
+ Scan; -- past ;
+ P_Pragmas_Misplaced;
+ end;
end loop Specification_Loop;
T_Right_Paren;
@@ -3770,14 +3749,10 @@ package body Ch3 is
Decl_Node : Node_Id := Empty; -- initialize to prevent warning
Scan_State : Saved_Scan_State;
Not_Null_Present : Boolean := False;
- Num_Idents : Nat;
- Ident : Nat;
Ident_Sloc : Source_Ptr;
- Idents : array (Int range 1 .. 4096) of Entity_Id;
- -- This array holds the list of defining identifiers. The upper bound
- -- of 4096 is intended to be essentially infinite, and we do not even
- -- bother to check for it being exceeded.
+ Def_Ids : Defining_Identifiers;
+ Ident : Pos;
begin
if Token /= Tok_Identifier then
@@ -3788,20 +3763,9 @@ package body Ch3 is
Ident_Sloc := Token_Ptr;
Check_Bad_Layout;
- Idents (1) := P_Defining_Identifier (C_Comma_Colon);
- Num_Idents := 1;
-
- while Comma_Present loop
- Num_Idents := Num_Idents + 1;
- Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
- end loop;
-
- -- If there are multiple identifiers, we repeatedly scan the
- -- type and initialization expression information by resetting
- -- the scan pointer (so that we get completely separate trees
- -- for each occurrence).
+ P_Def_Ids (Def_Ids);
- if Num_Idents > 1 then
+ if Def_Ids.Num_Idents > 1 then
Save_Scan_State (Scan_State);
end if;
@@ -3817,7 +3781,7 @@ package body Ch3 is
begin
Decl_Node := New_Node (N_Component_Declaration, Ident_Sloc);
- Set_Defining_Identifier (Decl_Node, Idents (Ident));
+ Set_Defining_Identifier (Decl_Node, Def_Ids.Idents (Ident));
if Token = Tok_Constant then
Error_Msg_SC ("constant component not permitted");
@@ -3876,7 +3840,7 @@ package body Ch3 is
Set_Prev_Ids (Decl_Node, True);
end if;
- if Ident < Num_Idents then
+ if Ident < Def_Ids.Num_Idents then
Set_More_Ids (Decl_Node, True);
end if;
@@ -3890,7 +3854,7 @@ package body Ch3 is
end if;
end;
- exit Ident_Loop when Ident = Num_Idents;
+ exit Ident_Loop when Ident = Def_Ids.Num_Idents;
Ident := Ident + 1;
Restore_Scan_State (Scan_State);
T_Colon;
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 0f7765ba300d..2465108f7abc 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -1384,20 +1384,16 @@ package body Ch6 is
Specification_List : List_Id;
Specification_Node : Node_Id;
Scan_State : Saved_Scan_State;
- Num_Idents : Nat;
- Ident : Nat;
Ident_Sloc : Source_Ptr;
Not_Null_Present : Boolean := False;
Not_Null_Sloc : Source_Ptr;
- Idents : array (Int range 1 .. 4096) of Entity_Id;
- -- This array holds the list of defining identifiers. The upper bound
- -- of 4096 is intended to be essentially infinite, and we do not even
- -- bother to check for it being exceeded.
-
begin
Specification_List := New_List;
Specification_Loop : loop
+ declare
+ Def_Ids : Defining_Identifiers;
+ Ident : Pos;
begin
if Token = Tok_Pragma then
Error_Msg_SC ("pragma not allowed in formal part");
@@ -1406,8 +1402,7 @@ package body Ch6 is
Ignore (Tok_Left_Paren);
Ident_Sloc := Token_Ptr;
- Idents (1) := P_Defining_Identifier (C_Comma_Colon);
- Num_Idents := 1;
+ Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon));
Ident_Loop : loop
exit Ident_Loop when Token = Tok_Colon;
@@ -1457,8 +1452,7 @@ package body Ch6 is
-- Here if a comma is present, or to be assumed
T_Comma;
- Num_Idents := Num_Idents + 1;
- Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
+ Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon));
end loop Ident_Loop;
-- Fall through the loop on encountering a colon, or deciding
@@ -1466,12 +1460,7 @@ package body Ch6 is
T_Colon;
- -- If there are multiple identifiers, we repeatedly scan the
- -- type and initialization expression information by resetting
- -- the scan pointer (so that we get completely separate trees
- -- for each occurrence).
-
- if Num_Idents > 1 then
+ if Def_Ids.Num_Idents > 1 then
Save_Scan_State (Scan_State);
end if;
@@ -1482,7 +1471,8 @@ package body Ch6 is
Ident_List_Loop : loop
Specification_Node :=
New_Node (N_Parameter_Specification, Ident_Sloc);
- Set_Defining_Identifier (Specification_Node, Idents (Ident));
+ Set_Defining_Identifier
+ (Specification_Node, Def_Ids.Idents (Ident));
-- Scan possible ALIASED for Ada 2012 (AI-142)
@@ -1574,12 +1564,12 @@ package body Ch6 is
Set_Prev_Ids (Specification_Node, True);
end if;
- if Ident < Num_Idents then
+ if Ident < Def_Ids.Num_Idents then
Set_More_Ids (Specification_Node, True);
end if;
Append (Specification_Node, Specification_List);
- exit Ident_List_Loop when Ident = Num_Idents;
+ exit Ident_List_Loop when Ident = Def_Ids.Num_Idents;
Ident := Ident + 1;
Restore_Scan_State (Scan_State);
end loop Ident_List_Loop;
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index 78a76b3b1f14..6a6afd0ebb2d 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -34,6 +34,22 @@ with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
separate (Par)
package body Util is
+ ------------
+ -- Append --
+ ------------
+
+ procedure Append
+ (Def_Ids : in out Defining_Identifiers; Def_Id : Entity_Id)
+ is
+ begin
+ if Def_Ids.Num_Idents >= Defining_Identifiers_Array'Last then
+ raise Program_Error;
+ end if;
+
+ Def_Ids.Num_Idents := Def_Ids.Num_Idents + 1;
+ Def_Ids.Idents (Def_Ids.Num_Idents) := Def_Id;
+ end Append;
+
---------------------
-- Bad_Spelling_Of --
---------------------
@@ -691,6 +707,19 @@ package body Util is
end if;
end No_Constraint;
+ ---------------
+ -- P_Def_Ids --
+ ---------------
+
+ procedure P_Def_Ids (Def_Ids : out Defining_Identifiers) is
+ pragma Assert (Def_Ids.Num_Idents = 0);
+ begin
+ loop
+ Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon));
+ exit when not Comma_Present;
+ end loop;
+ end P_Def_Ids;
+
---------------------
-- Pop_Scope_Stack --
---------------------
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index e11ec7e7ff44..99bbed2cfb2c 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -227,6 +227,69 @@ function Par (Configuration_Pragmas : Boolean) return
List_Id is
-- that there is a missing body, but it seems more reasonable to let the
-- later semantic checking discover this.
+ --------------------------------------------
+ -- Handling IS Used in Place of Semicolon --
+ --------------------------------------------
+
+ -- This is a somewhat trickier situation, and we can't catch it in all
+ -- cases, but we do our best to detect common situations resulting from
+ -- a "cut and paste" operation which forgets to change the IS to semicolon.
+ -- Consider the following example:
+
+ -- package body X is
+ -- procedure A;
+ -- procedure B is -- Error: IS should be semicolon
+ -- procedure C;
+ -- ...
+ -- procedure D is
+ -- begin
+ -- ...
+ -- end;
+ -- begin
+ -- ...
+ -- end; -- end of B?
+
+ -- The trouble is that the section of text from PROCEDURE B through the
+ -- END; marked "-- end of B?" constitutes a valid procedure body, and the
+ -- danger is that we find out far too late that something is wrong.
+
+ -- We have two approaches to helping to control this situation. First we
+ -- make every attempt to avoid swallowing the last END; if we can be sure
+ -- that some error will result from doing so. In particular, we won't
+ -- accept the END; unless it is exactly correct (in particular it must not
+ -- have incorrect name tokens), and we won't accept it if it is immediately
+ -- followed by end of file, WITH or SEPARATE (tokens that unmistakeably
+ -- signal the start of a compilation unit, and which therefore allow us to
+ -- reserve the END; for the outer level.) For more details on this aspect
+ -- of the handling, see package Par.Endh.
+
+ -- If we can avoid eating up the END; then the result in the absence of
+ -- any additional steps would be to post a missing END referring back to
+ -- the subprogram with the bogus IS. Similarly, if the enclosing package
+ -- has no BEGIN, then the result is a missing BEGIN message, which again
+ -- refers back to the subprogram header.
+
+ -- Such an error message is not too bad, but it's not ideal, because
+ -- the declarations following the IS have been absorbed into the wrong
+ -- scope. In the above case, this could result for example in a bogus
+ -- complaint that the body of D was missing from the package.
+
+ -- To catch at least some of these cases, we take the following additional
+ -- steps. First, a subprogram body is marked as having a suspicious IS if
+ -- the declaration line is followed by a line that starts with a symbol
+ -- that can start a declaration in the same column, or to the left of the
+ -- column in which the FUNCTION or PROCEDURE starts (normal style is to
+ -- indent any declarations that really belong a subprogram). If such a
+ -- subprogram encounters a missing BEGIN or missing END, then we decide
+ -- that the IS should have been a semicolon, and the subprogram body node
+ -- is marked (by setting the Bad_Is_Detected flag true. Note that we do
+ -- not do this for library level procedures, only for nested procedures,
+ -- since for library level procedures, we must have a body.
+
+ -- The processing for a declarative part checks to see if the last
+ -- declaration scanned is marked in this way, and if it is, the tree
+ -- is modified to reflect the IS being interpreted as a semicolon.
+
----------------------------------------------------
-- Handling of Reserved Words Used as Identifiers --
----------------------------------------------------
@@ -294,71 +357,6 @@ function Par (Configuration_Pragmas : Boolean) return
List_Id is
C_Vertical_Bar_Arrow);
-- Consider as identifier if followed by | or =>
- --------------------------------------------
- -- Handling IS Used in Place of Semicolon --
- --------------------------------------------
-
- -- This is a somewhat trickier situation, and we can't catch it in all
- -- cases, but we do our best to detect common situations resulting from
- -- a "cut and paste" operation which forgets to change the IS to semicolon.
- -- Consider the following example:
-
- -- package body X is
- -- procedure A;
- -- procedure B is
- -- procedure C;
- -- ...
- -- procedure D is
- -- begin
- -- ...
- -- end;
- -- begin
- -- ...
- -- end;
-
- -- The trouble is that the section of text from PROCEDURE B through END;
- -- constitutes a valid procedure body, and the danger is that we find out
- -- far too late that something is wrong (indeed most compilers will behave
- -- uncomfortably on the above example).
-
- -- We have two approaches to helping to control this situation. First we
- -- make every attempt to avoid swallowing the last END; if we can be sure
- -- that some error will result from doing so. In particular, we won't
- -- accept the END; unless it is exactly correct (in particular it must not
- -- have incorrect name tokens), and we won't accept it if it is immediately
- -- followed by end of file, WITH or SEPARATE (all tokens that unmistakeably
- -- signal the start of a compilation unit, and which therefore allow us to
- -- reserve the END; for the outer level.) For more details on this aspect
- -- of the handling, see package Par.Endh.
-
- -- If we can avoid eating up the END; then the result in the absence of
- -- any additional steps would be to post a missing END referring back to
- -- the subprogram with the bogus IS. Similarly, if the enclosing package
- -- has no BEGIN, then the result is a missing BEGIN message, which again
- -- refers back to the subprogram header.
-
- -- Such an error message is not too bad (it's already a big improvement
- -- over what many parsers do), but it's not ideal, because the declarations
- -- following the IS have been absorbed into the wrong scope. In the above
- -- case, this could result for example in a bogus complaint that the body
- -- of D was missing from the package.
-
- -- To catch at least some of these cases, we take the following additional
- -- steps. First, a subprogram body is marked as having a suspicious IS if
- -- the declaration line is followed by a line which starts with a symbol
- -- that can start a declaration in the same column, or to the left of the
- -- column in which the FUNCTION or PROCEDURE starts (normal style is to
- -- indent any declarations which really belong a subprogram). If such a
- -- subprogram encounters a missing BEGIN or missing END, then we decide
- -- that the IS should have been a semicolon, and the subprogram body node
- -- is marked (by setting the Bad_Is_Detected flag true. Note that we do
- -- not do this for library level procedures, only for nested procedures,
- -- since for library level procedures, we must have a body.
-
- -- The processing for a declarative part checks to see if the last
- -- declaration scanned is marked in this way, and if it is, the tree
- -- is modified to reflect the IS being interpreted as a semicolon.
-
---------------------------------------------------
-- Parser Type Definitions and Control Variables --
---------------------------------------------------
@@ -1450,6 +1448,47 @@ function Par (Configuration_Pragmas : Boolean) return
List_Id is
-- the Node N (which is a Defining_Identifier node with the Chars field
-- set) is a renaming of an entity in package Standard.
+ -----------------------------------
+ -- Multiple defining identifiers --
+ -----------------------------------
+
+ -- RM-3.3.1(7) says:
+ --
+ -- Any declaration that includes a defining_identifier_list with
+ -- more than one defining_identifier is equivalent to a series of
+ -- declarations each containing one defining_identifier from the list,
+ -- with the rest of the text of the declaration copied for each
+ -- declaration in the series, in the same order as the list.
+ --
+ -- We parse such declarations by first calling P_Def_Ids (see below).
+ -- Then, if there are multiple identifiers, we repeatedly scan the
+ -- type and initialization expression information by resetting the
+ -- scan pointer (so that we get completely separate trees for each
+ -- occurrence).
+
+ -- Defining_Identifiers is a sequence of identifiers parsed by
+ -- P_Def_Ids. Idents holds the identifiers, and Num_Idents
+ -- points to the last-used array elements. The upper bound
+ -- is intended to be essentially infinite, so we don't bother
+ -- giving a good error message when it is exceeded -- we
+ -- simply raise an exception.
+
+ type Defining_Identifiers_Array is
+ array (Pos range 1 .. 4096) of Entity_Id;
+
+ type Defining_Identifiers is record
+ Num_Idents : Nat := 0;
+ Idents : Defining_Identifiers_Array;
+ end record;
+
+ procedure Append
+ (Def_Ids : in out Defining_Identifiers; Def_Id : Entity_Id);
+ -- Append one defining identifier onto Def_Ids.
+
+ procedure P_Def_Ids (Def_Ids : out Defining_Identifiers);
+ -- Parse a defining_identifier_list, appending the identifiers
+ -- onto Def_Ids, which should be initially empty.
+
end Util;
--------------
