From fa7497e853a70dd5d253a1313d0dfa7ddbc02eec Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 29 Mar 2004 12:03:27 +0000 Subject: 2004-03-29 Javier Miranda * checks.adb (Null_Exclusion_Static_Checks): New subprogram (Install_Null_Excluding_Check): Local subprogram that determines whether an access node requires a runtime access check and if so inserts the appropriate run-time check. (Apply_Access_Check): Call Install_Null_Excluding check if required (Apply_Constraint_Check): Call Install_Null_Excluding check if required * checks.ads: (Null_Exclusion_Static_Checks): New subprogram * einfo.ads: Fix typo in comment * exp_ch3.adb (Build_Assignment): Generate conversion to the null-excluding type to force the corresponding run-time check. (Expand_N_Object_Declaration): Generate conversion to the null-excluding type to force the corresponding run-time check. * exp_ch5.adb (Expand_N_Assignment_Statement): Generate conversion to the null-excluding type to force the corresponding run-time check. * exp_ch6.adb (Expand_Call): Do not generate the run-time check in case of access types unless they have the null-excluding attribute. * sprint.adb (Sprint_Node_Actual): Give support to the null-exclusing part. * exp_util.ads: Fix typo in comment * par.adb (P_Null_Exclusion): New subprogram (P_Subtype_Indication): New formal that indicates if the null-excluding part has been scanned-out and it was present * par-ch3.adb, par-ch4.adb, par-ch6.adb: Give support to AI-231 * sem_aggr.adb: (Check_Can_Never_Be_Null): New subprogram (Aggregate_Constraint_Checks): Generate conversion to the null-excluding type to force the corresponding run-time check (Resolve_Aggregate): Propagate the null-excluding attribute to the array components (Resolve_Array_Aggregate): Carry out some static checks (Resolve_Record_Aggregate.Get_Value): Carry out some static check * sem_ch3.adb (Access_Definition): In Ada 0Y the Can_Never_Be_Null attribute must be set only if specified by means of the null-excluding part. In addition, we must also propagate the access-constant attribute if present. (Access_Subprogram_Declaration, Access_Type_Declaration, Analyze_Component_Declaration, Analyze_Object_Declaration, Array_Type_Declaration, Process_Discriminants, Analyze_Subtype_Declaration): Propagate the null-excluding attribute and carry out some static checks. (Build_Derived_Access_Type): Set the null-excluding attribute (Derived_Type_Declaration, Process_Subtype): Carry out some static checks. * sem_ch4.adb (Analyze_Allocator): Carry out some static checks * sem_ch5.adb (Analyze_Assignment): Carry out some static checks * sem_ch6.adb (Process_Formals): Carry out some static checks. (Set_Actual_Subtypes): Generate null-excluding subtype if the null-excluding part was present; it is not required to be done here in case of anonymous access types. (Set_Formal_Mode): Ada 0Y allows anonymous access to have the null value. * sem_res.adb (Resolve_Actuals): Carry out some static check (Resolve_Null): Allow null in anonymous access * sinfo.adb: New subprogram Null_Exclusion_Present All_Present and Constant_Present available on access_definition nodes * sinfo.ads: New flag Null_Exclusion_Present on subtype_declaration, object_declaration, derived_type_definition, component_definition, discriminant_specification, access_to_object_definition, access_function_definition, allocator, access_procedure_definition, access_definition, parameter_specification, All_Present and Constant_Present flags available on access_definition nodes. 2004-03-29 Robert Dewar * fname.adb, fname.ads, fname-sf.adb, fname-uf.adb, fname-uf.ads, gnat1drv.adb, lib.adb, lib.ads, lib-load.adb, lib-writ.adb, opt.ads, osint.adb, osint.ads, osint-c.adb, par.adb, par-ch10.adb, par-load.adb, par-prag.adb, sfn_scan.adb, sfn_scan.ads, sinput-l.adb, sinput-l.ads, switch-c.adb, sem_prag.adb: Updates to handle multiple units/file * par.adb: Change test for s-rpc to s-rp for detecting rpc and children * par.adb, memtrack.adb, prj-makr.adb, prj-part.adb, sem_util.adb: Minor reformatting * sem_ch12.adb: Add comment for previous change 2004-03-29 Laurent Pautet * osint.adb (Executable_Prefix): Set Exec_Name to the current executable name when not initialized. Otherwise, use its current value. * osint.ads (Exec_Name): Move Exec_Name from body to spec in order to initialize it to another executable name than the current one. This allows to configure paths for an executable name (gnatmake) different from the current one (gnatdist). 2004-03-29 Ed Schonberg * exp_ch6.adb (Expand_Call): A call to a function declared in the current unit cannot be inlined if it appears in the body of a withed unit, to avoid order of elaboration problems in gigi. * exp_ch9.adb (Build_Protected_Sub_Specification): Generate debugging information for protected (wrapper) operation as well, to simplify gdb use. * sem_ch6.adb (Analyze_Subprogram_Body): For a private operation in a protected body, indicate that the entity for the generated spec comes from source, to ensure that references are properly generated for it. (Build_Body_To_Inline): Do not inline a function that returns a controlled type. * sem_prag.adb (Process_Convention): If subprogram is overloaded, only apply convention to homonyms that are declared explicitly. * sem_res.adb (Make_Call_Into_Operator): If the operation is a function that renames an equality operator and the operands are overloaded, resolve them with the declared formal types, before rewriting as an operator. 2004-03-29 GNAT Script * Make-lang.in: Makefile automatically updated git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@80055 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/par.adb | 201 +++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 148 insertions(+), 53 deletions(-) (limited to 'gcc/ada/par.adb') diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 56629ef436f..1a1d9750a96 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; -- cgit v1.2.1