diff options
Diffstat (limited to 'gcc/ada/par.adb')
| -rw-r--r-- | gcc/ada/par.adb | 201 |
1 files changed, 148 insertions, 53 deletions
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 56629ef..1a1d975 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -46,6 +46,10 @@ with Style; with Table; with Tbuild; use Tbuild; +--------- +-- Par -- +--------- + function Par (Configuration_Pragmas : Boolean) return List_Id is Num_Library_Units : Natural := 0; @@ -515,6 +519,10 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- corresponding to their name, and return an ID value for the Node or -- List that is created. + ------------- + -- Par.Ch2 -- + ------------- + package Ch2 is function P_Pragma return Node_Id; @@ -535,6 +543,10 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- Parses optional pragmas and appends them to the List end Ch2; + ------------- + -- Par.Ch3 -- + ------------- + package Ch3 is Missing_Begin_Msg : Error_Msg_Id; -- This variable is set by a call to P_Declarative_Part. Normally it @@ -560,7 +572,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is function P_Range_Or_Subtype_Mark return Node_Id; function P_Range_Constraint return Node_Id; function P_Record_Definition return Node_Id; - function P_Subtype_Indication return Node_Id; function P_Subtype_Mark return Node_Id; function P_Subtype_Mark_Resync return Node_Id; function P_Unknown_Discriminant_Part_Opt return Boolean; @@ -576,6 +587,15 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- treatment of errors in case a reserved word is scanned. See the -- declaration of this type for details. + function P_Null_Exclusion return Boolean; + -- Ada 0Y (AI-231): Parse the null-excluding part. True indicates + -- that the null-excluding part was present. + + function P_Subtype_Indication + (Not_Null_Present : Boolean := False) return Node_Id; + -- Ada 0Y (AI-231): The flag Not_Null_Present indicates that the + -- null-excluding part has been scanned out and it was present. + function Init_Expr_Opt (P : Boolean := False) return Node_Id; -- If an initialization expression is present (:= expression), then -- it is scanned out and returned, otherwise Empty is returned if no @@ -590,17 +610,24 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- Token is known to be a declaration token (in Token_Class_Declk) -- on entry, so there definition is a declaration to be scanned. - function P_Subtype_Indication (Subtype_Mark : Node_Id) return Node_Id; + function P_Subtype_Indication + (Subtype_Mark : Node_Id; + Not_Null_Present : Boolean := False) return Node_Id; -- This version of P_Subtype_Indication is called when the caller has -- already scanned out the subtype mark which is passed as a parameter. + -- Ada 0Y (AI-231): The flag Not_Null_Present indicates that the + -- null-excluding part has been scanned out and it was present. function P_Subtype_Mark_Attribute (Type_Node : Node_Id) return Node_Id; -- Parse a subtype mark attribute. The caller has already parsed the -- subtype mark, which is passed in as the argument, and has checked -- that the current token is apostrophe. - end Ch3; + ------------- + -- Par.Ch4 -- + ------------- + package Ch4 is function P_Aggregate return Node_Id; function P_Expression return Node_Id; @@ -618,11 +645,13 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is return Node_Id; -- This routine scans out a qualified expression when the caller has -- already scanned out the name and apostrophe of the construct. - end Ch4; - package Ch5 is + ------------- + -- Par.Ch5 -- + ------------- + package Ch5 is function P_Statement_Name (Name_Node : Node_Id) return Node_Id; -- Given a node representing a name (which is a call), converts it -- to the syntactically corresponding procedure call statement. @@ -634,9 +663,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is procedure Parse_Decls_Begin_End (Parent : Node_Id); -- Parses declarations and handled statement sequence, setting -- fields of Parent node appropriately. - end Ch5; + ------------- + -- Par.Ch6 -- + ------------- + package Ch6 is function P_Designator return Node_Id; function P_Defining_Program_Unit_Name return Node_Id; @@ -654,9 +686,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- PROCEDURE or FUNCTION. The parameter indicates which possible -- possible kinds of construct (body, spec, instantiation etc.) -- are permissible in the current context. - end Ch6; + ------------- + -- Par.Ch7 -- + ------------- + package Ch7 is function P_Package (Pf_Flags : Pf_Rec) return Node_Id; -- Scans out any construct starting with the keyword PACKAGE. The @@ -664,10 +699,18 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- instantiation etc.) are permissible in the current context. end Ch7; + ------------- + -- Par.Ch8 -- + ------------- + package Ch8 is function P_Use_Clause return Node_Id; end Ch8; + ------------- + -- Par.Ch9 -- + ------------- + package Ch9 is function P_Abort_Statement return Node_Id; function P_Abortable_Part return Node_Id; @@ -681,6 +724,10 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is function P_Terminate_Alternative return Node_Id; end Ch9; + -------------- + -- Par.Ch10 -- + -------------- + package Ch10 is function P_Compilation_Unit return Node_Id; -- Note: this function scans a single compilation unit, and @@ -692,8 +739,16 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- for end of file and there may be more compilation units to -- scan. The caller can uniquely detect this situation by the -- fact that Token is not set to Tok_EOF on return. + -- + -- The Ignore parameter is normally set False. It is set True + -- in multiple unit per file mode if we are skipping past a unit + -- that we are not interested in. end Ch10; + -------------- + -- Par.Ch11 -- + -------------- + package Ch11 is function P_Handled_Sequence_Of_Statements return Node_Id; function P_Raise_Statement return Node_Id; @@ -702,14 +757,21 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- Parses the partial construct EXCEPTION followed by a list of -- exception handlers which appears in a number of productions, -- and returns the list of exception handlers. - end Ch11; + -------------- + -- Par.Ch12 -- + -------------- + package Ch12 is function P_Generic return Node_Id; function P_Generic_Actual_Part_Opt return List_Id; end Ch12; + -------------- + -- Par.Ch13 -- + -------------- + package Ch13 is function P_Representation_Clause return Node_Id; @@ -730,14 +792,13 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- At clause is parsed by P_At_Clause (13.1) -- Mod clause is parsed by P_Mod_Clause (13.5.1) - ------------------ - -- End Handling -- - ------------------ + -------------- + -- Par.Endh -- + -------------- -- Routines for handling end lines, including scope recovery package Endh is - function Check_End return Boolean; -- Called when an end sequence is required. In the absence of an error -- situation, Token contains Tok_End on entry, but in a missing end @@ -765,12 +826,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- only be used in cases where the only appropriate terminator is end. -- If Parent is non-empty, then if a correct END line is encountered, -- the End_Label field of Parent is set appropriately. - end Endh; - ------------------------------------ - -- Resynchronization After Errors -- - ------------------------------------ + -------------- + -- Par.Sync -- + -------------- -- These procedures are used to resynchronize after errors. Following an -- error which is not immediately locally recoverable, the exception @@ -783,7 +843,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- Multiple_Errors_Per_Line is set in Options. package Sync is - procedure Resync_Choice; -- Used if an error occurs scanning a choice. The scan pointer is -- advanced to the next vertical bar, arrow, or semicolon, whichever @@ -828,12 +887,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is procedure Resync_Cunit; -- Synchronize to next token which could be the start of a compilation -- unit, or to the end of file token. - end Sync; - ------------------------- - -- Token Scan Routines -- - ------------------------- + -------------- + -- Par.Tchk -- + -------------- -- Routines to check for expected tokens @@ -900,15 +958,13 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is procedure TF_Semicolon; procedure TF_Then; procedure TF_Use; - end Tchk; - ---------------------- - -- Utility Routines -- - ---------------------- + -------------- + -- Par.Util -- + -------------- package Util is - function Bad_Spelling_Of (T : Token_Type) return Boolean; -- This function is called in an error situation. It checks if the -- current token is an identifier whose name is a plausible bad @@ -1035,12 +1091,13 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is function Token_Is_At_End_Of_Line return Boolean; -- Determines if the current token is the last token on the line - end Util; - --------------------------------------- - -- Specialized Syntax Check Routines -- - --------------------------------------- + -------------- + -- Par.Prag -- + -------------- + + -- The processing for pragmas is split off from chapter 2 function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id; -- This function is passed a tree for a pragma that has been scanned out. @@ -1059,9 +1116,9 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- the scanning of the semicolon so that it will be scanned using the -- settings from the Style_Checks pragma preceding it. - ------------------------- - -- Subsidiary Routines -- - ------------------------- + -------------- + -- Par.Labl -- + -------------- procedure Labl; -- This procedure creates implicit label declarations for all label that @@ -1071,6 +1128,10 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- label is declared (e.g. a sequence of statements is not yet attached -- to its containing scope at the point a label in the sequence is found) + -------------- + -- Par.Load -- + -------------- + procedure Load; -- This procedure loads all subsidiary units that are required by this -- unit, including with'ed units, specs for bodies, and parents for child @@ -1125,14 +1186,10 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is procedure Labl is separate; procedure Load is separate; - --------- - -- Par -- - --------- - --- This function is the parse routine called at the outer level. It parses --- the current compilation unit and adds implicit label declarations. +-- Start of processing for Par begin + -- Deal with configuration pragmas case first if Configuration_Pragmas then @@ -1194,13 +1251,12 @@ begin -- that language defined units cannot be recompiled). -- However, an exception is s-rpc, and its children. We test this - -- by looking at the character after the minus, the rule is that - -- System.RPC and its children are the only children in System - -- whose second level name can start with the letter r. + -- by looking at the characters after the minus. The rule is that + -- only s-rpc and its children have names starting s-rp. Get_Name_String (File_Name (Current_Source_File)); - if (Name_Len < 3 or else Name_Buffer (1 .. 3) /= "s-r") + if (Name_Len < 5 or else Name_Buffer (1 .. 4) /= "s-rp") and then Current_Source_Unit = Main_Unit and then not GNAT_Mode and then Operating_Mode = Generate_Code @@ -1209,10 +1265,12 @@ begin end if; end if; - -- The following loop runs more than once only in syntax check mode - -- where we allow multiple compilation units in the same file. + -- The following loop runs more than once in syntax check mode + -- where we allow multiple compilation units in the same file + -- and in Multiple_Unit_Per_file mode where we skip units till + -- we get to the unit we want. - loop + for Ucount in Pos loop Set_Opt_Config_Switches (Is_Internal_File_Name (File_Name (Current_Source_File))); @@ -1226,13 +1284,51 @@ begin Last_Resync_Point := No_Location; Label_List := New_Elmt_List; - Discard_Node (P_Compilation_Unit); - -- If we are not at an end of file, then this means that we are - -- in syntax scan mode, and we can have another compilation unit, - -- otherwise we will exit from the loop. + -- If in multiple unit per file mode, skip past ignored unit + + if Ucount < Multiple_Unit_Index then + + -- We skip in syntax check only mode, since we don't want + -- to do anything more than skip past the unit and ignore it. + -- This causes processing like setting up a unit table entry + -- to be skipped. + + declare + Save_Operating_Mode : constant Operating_Mode_Type := + Operating_Mode; + + begin + Operating_Mode := Check_Syntax; + Discard_Node (P_Compilation_Unit); + Operating_Mode := Save_Operating_Mode; + + -- If we are at an end of file, and not yet at the right + -- unit, then we have a fatal error. The unit is missing. + + if Token = Tok_EOF then + Error_Msg_SC ("file has too few compilation units"); + raise Unrecoverable_Error; + end if; + end; + + -- Here if we are not skipping a file in multiple unit per file + -- mode. Parse the unit that we are interested in. Note that in + -- check syntax mode we are interested in all units in the file. + + else + Discard_Node (P_Compilation_Unit); + + -- All done if at end of file + + exit when Token = Tok_EOF; + + -- If we are not at an end of file, it means we are in syntax + -- check only mode, and we keep the loop going to parse all + -- remaining units in the file. + + end if; - exit when Token = Tok_EOF; Restore_Opt_Config_Switches (Save_Config_Switches); end loop; @@ -1260,5 +1356,4 @@ begin Set_Comes_From_Source_Default (False); return Empty_List; end if; - end Par; |