X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fpar.adb;h=2d86577a48c230b095e44d4e4f618a6500c550f8;hb=2440d8dd25f6284415b1ed2e6cbd908748f0de79;hp=958a8a7d0af1fabdfd898b435ce8e3203ef46990;hpb=37d8f03021b8db774195e4e576067f249bbd651d;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 958a8a7d0af..2d86577a48c 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -6,9 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision$ --- -- --- Copyright (C) 1992-2001 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- -- @@ -22,13 +20,12 @@ -- MA 02111-1307, USA. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- --- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Atree; use Atree; with Casing; use Casing; -with Csets; use Csets; with Debug; use Debug; with Elists; use Elists; with Errout; use Errout; @@ -47,6 +44,11 @@ with Sinfo; use Sinfo; with Snames; use Snames; with Style; with Table; +with Tbuild; use Tbuild; + +--------- +-- Par -- +--------- function Par (Configuration_Pragmas : Boolean) return List_Id is @@ -54,9 +56,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- Count number of units parsed (relevant only in syntax check only mode, -- since in semantics check mode only a single unit is permitted anyway) - Unit_Node : Node_Id; - -- Stores compilation unit node for current unit - Save_Config_Switches : Config_Switches_Type; -- Variable used to save values of config switches while we parse the -- new unit, to be restored on exit for proper recursive behavior. @@ -193,6 +192,73 @@ 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 of Reserved Words Used as Identifiers -- + ---------------------------------------------------- + + -- Note: throughout the parser, the terms reserved word and keyword + -- are used interchangably to refer to the same set of reserved + -- keywords (including until, protected, etc). + + -- If a reserved word is used in place of an identifier, the parser + -- where possible tries to recover gracefully. In particular, if the + -- keyword is clearly spelled using identifier casing, e.g. Until in + -- a source program using mixed case identifiers and lower case keywords, + -- then the keyword is treated as an identifier if it appears in a place + -- where an identifier is required. + + -- The situation is more complex if the keyword is spelled with normal + -- keyword casing. In this case, the parser is more reluctant to + -- consider it to be intended as an identifier, unless it has some + -- further confirmation. + + -- In the case of an identifier appearing in the identifier list of a + -- declaration, the appearence of a comma or colon right after the + -- keyword on the same line is taken as confirmation. For an enumeration + -- literal, a comma or right paren right after the identifier is also + -- treated as adequate confirmation. + + -- The following type is used in calls to Is_Reserved_Identifier and + -- also to P_Defining_Identifier and P_Identifier. The default for all + -- these functins is that reserved words in reserved word case are not + -- considered to be reserved identifiers. The Id_Check value indicates + -- tokens, which if they appear immediately after the identifier, are + -- taken as confirming that the use of an identifier was expected + + type Id_Check is + (None, + -- Default, no special token test + + C_Comma_Right_Paren, + -- Consider as identifier if followed by comma or right paren + + C_Comma_Colon, + -- Consider as identifier if followed by comma or colon + + C_Do, + -- Consider as identifier if followed by DO + + C_Dot, + -- Consider as identifier if followed by period + + C_Greater_Greater, + -- Consider as identifier if followed by >> + + C_In, + -- Consider as identifier if followed by IN + + C_Is, + -- Consider as identifier if followed by IS + + C_Left_Paren_Semicolon, + -- Consider as identifier if followed by left paren or semicolon + + C_Use, + -- Consider as identifier if followed by USE + + C_Vertical_Bar_Arrow); + -- Consider as identifier if followed by | or => + -------------------------------------------- -- Handling IS Used in Place of Semicolon -- -------------------------------------------- @@ -453,10 +519,17 @@ 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_Identifier return Node_Id; function P_Pragma return Node_Id; + function P_Identifier (C : Id_Check := None) return Node_Id; + -- Scans out an identifier. The parameter C determines the treatment + -- of reserved identifiers. See declaration of Id_Check for details. + function P_Pragmas_Opt return List_Id; -- This function scans for a sequence of pragmas in other than a -- declaration sequence or statement sequence context. All pragmas @@ -470,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 @@ -486,7 +563,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is function P_Basic_Declarative_Items return List_Id; function P_Constraint_Opt return Node_Id; function P_Declarative_Part return List_Id; - function P_Defining_Identifier return Node_Id; function P_Discrete_Choice_List return List_Id; function P_Discrete_Range return Node_Id; function P_Discrete_Subtype_Definition return Node_Id; @@ -496,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; @@ -507,6 +582,20 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- case where the source has a single declaration with multiple -- defining identifiers. + function P_Defining_Identifier (C : Id_Check := None) return Node_Id; + -- Scan out a defining identifier. The parameter C controls the + -- 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 @@ -521,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; @@ -549,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. @@ -565,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; @@ -585,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 @@ -595,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; @@ -612,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 @@ -623,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; @@ -633,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; @@ -661,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 @@ -696,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 @@ -714,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 @@ -735,6 +863,10 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- starts a declaration (but we make sure to skip at least one token -- in this case, to avoid getting stuck in a loop). + procedure Resync_To_Semicolon; + -- Similar to Resync_Past_Semicolon, except that the scan pointer is + -- left pointing to the semicolon rather than past it. + procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then; -- Used if an error occurs while scanning a sequence of statements. -- The scan pointer is positioned past the next semicolon, or to the @@ -755,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 @@ -827,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 @@ -908,10 +1037,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- past it, otherwise the call has no effect at all. T may be any -- reserved word token, or comma, left or right paren, or semicolon. - function Is_Reserved_Identifier return Boolean; + function Is_Reserved_Identifier (C : Id_Check := None) return Boolean; -- Test if current token is a reserved identifier. This test is based -- on the token being a keyword and being spelled in typical identifier - -- style (i.e. starting with an upper case letter). + -- style (i.e. starting with an upper case letter). The parameter C + -- determines the special treatment if a reserved word is encountered + -- that has the normal casing of a reserved word. procedure Merge_Identifier (Prev : Node_Id; Nxt : Token_Type); -- Called when the previous token is an identifier (whose Token_Node @@ -958,11 +1089,15 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is pragma Inline (Token_Is_At_Start_Of_Line); -- Determines if the current token is the first token on the line + 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. @@ -974,11 +1109,16 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- of implementation defined pragmas. The second parameter records the -- location of the semicolon following the pragma (this is needed for -- correct processing of the List and Page pragmas). The returned value - -- is a copy of Pragma_Node, or Error if an error is found. + -- is a copy of Pragma_Node, or Error if an error is found. Note that + -- at the point where Prag is called, the right paren ending the pragma + -- has been scanned out, and except in the case of pragma Style_Checks, + -- so has the following semicolon. For Style_Checks, the caller delays + -- 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 @@ -988,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 @@ -1042,20 +1186,16 @@ 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 declare - Ecount : constant Int := Errors_Detected; - Pragmas : List_Id := Empty_List; + Ecount : constant Int := Serious_Errors_Detected; + Pragmas : constant List_Id := Empty_List; P_Node : Node_Id; begin @@ -1070,7 +1210,7 @@ begin else P_Node := P_Pragma; - if Errors_Detected > Ecount then + if Serious_Errors_Detected > Ecount then return Error_List; end if; @@ -1093,43 +1233,12 @@ begin else Save_Opt_Config_Switches (Save_Config_Switches); - -- Special processing for language defined units. For this purpose - -- we do NOT consider the renamings in annex J as predefined. That - -- allows users to compile their own versions of these files, and - -- in particular, in the VMS implementation, the DEC versions can - -- be substituted for the standard Ada 95 versions. - - if Is_Predefined_File_Name - (Fname => File_Name (Current_Source_File), - Renamings_Included => False) - then - Set_Opt_Config_Switches - (Is_Internal_File_Name (File_Name (Current_Source_File))); - - -- If this is the main unit, disallow compilation unless the -gnatg - -- (GNAT mode) switch is set (from a user point of view, the rule is - -- 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. - - Get_Name_String (File_Name (Current_Source_File)); - - if (Name_Len < 3 or else Name_Buffer (1 .. 3) /= "s-r") - and then Current_Source_Unit = Main_Unit - and then not GNAT_Mode - and then Operating_Mode = Generate_Code - then - Error_Msg_SC ("language defined units may not be recompiled"); - 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))); @@ -1143,15 +1252,120 @@ begin Last_Resync_Point := No_Location; Label_List := New_Elmt_List; - Unit_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; + + Save_Style_Check : constant Boolean := Style_Check; + + + begin + Operating_Mode := Check_Syntax; + Style_Check := False; + Discard_Node (P_Compilation_Unit); + Operating_Mode := Save_Operating_Mode; + Style_Check := Save_Style_Check; + + -- 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 + declare + Comp_Unit_Node : constant Node_Id := P_Compilation_Unit; + + begin + -- If parsing was successful and we are not in check syntax + -- mode, check that language defined units are compiled in + -- GNAT mode. For this purpose we do NOT consider renamings + -- in annex J as predefined. That allows users to compile + -- their own versions of these files, and in particular, + -- in the VMS implementation, the DEC versions can be + -- substituted for the standard Ada 95 versions. Another + -- exception is System.RPC and its children. This allows + -- a user to supply their own communication layer. + + if Comp_Unit_Node /= Error + and then Operating_Mode = Generate_Code + and then Current_Source_Unit = Main_Unit + and then not GNAT_Mode + then + declare + Uname : constant String := + Get_Name_String + (Unit_Name (Current_Source_Unit)); + Name : String (1 .. Uname'Length - 2); + + begin + -- Because Unit_Name includes "%s" or "%b", we need to + -- strip the last two characters to get the real unit + -- name. + + Name := Uname (Uname'First .. Uname'Last - 2); + + if (Name = "ada" or else + Name = "calendar" or else + Name = "interfaces" or else + Name = "system" or else + Name = "machine_code" or else + Name = "unchecked_conversion" or else + Name = "unchecked_deallocation" + or else (Name'Length > 4 + and then + Name (Name'First .. Name'First + 3) = + "ada.") + or else (Name'Length > 11 + and then + Name (Name'First .. Name'First + 10) = + "interfaces.") + or else (Name'Length > 7 + and then + Name (Name'First .. Name'First + 6) = + "system.")) + and then Name /= "system.rpc" + and then + (Name'Length < 11 + or else Name (Name'First .. Name'First + 10) /= + "system.rpc.") + then + Error_Msg + ("language defined units may not be recompiled", + Sloc (Unit (Comp_Unit_Node))); + end if; + end; + end if; + end; + + -- 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); - Set_Comes_From_Source_Default (False); end loop; -- Now that we have completely parsed the source file, we can @@ -1178,5 +1392,4 @@ begin Set_Comes_From_Source_Default (False); return Empty_List; end if; - end Par;