diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/comperr.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 540 | ||||
| -rw-r--r-- | gcc/ada/errout.ads | 63 | ||||
| -rw-r--r-- | gcc/ada/prepcomp.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/prepcomp.ads | 4 |
5 files changed, 364 insertions, 279 deletions
diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index e8a502c..9b89852 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -121,6 +121,7 @@ package body Comperr is if Serious_Errors_Detected /= 0 and then not Debug_Flag_K then Errout.Finalize; + Errout.Output_Messages; Set_Standard_Error; Write_Str ("compilation abandoned due to previous error"); diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 6e05ec9..cfadbd8 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -40,7 +40,6 @@ with Fname; use Fname; with Gnatvsn; use Gnatvsn; with Hostparm; use Hostparm; with Lib; use Lib; -with Namet; use Namet; with Opt; use Opt; with Nlists; use Nlists; with Output; use Output; @@ -61,6 +60,9 @@ package body Errout is -- error message procedures should be ignored (when parsing irrelevant -- text in sources being preprocessed). + Finalize_Called : Boolean := False; + -- Set True if the Finalize routine has been called + Warn_On_Instance : Boolean; -- Flag set true for warning message to be posted on instance @@ -138,8 +140,9 @@ package body Errout is -- location of the flag, which is provided for the internal call to -- Set_Msg_Insertion_Line_Number, - procedure Set_Msg_Insertion_Unit_Name; - -- Handle unit name insertion ($ insertion character) + procedure Set_Msg_Insertion_Unit_Name (Suffix : Boolean := True); + -- Handle unit name insertion ($ insertion character). Depending on Boolean + -- parameter Suffix, (spec) or (body) is appended after the unit name. procedure Set_Msg_Node (Node : Node_Id); -- Add the sequence of characters for the name associated with the @@ -224,6 +227,19 @@ package body Errout is end if; end Change_Error_Text; + ------------------------ + -- Compilation_Errors -- + ------------------------ + + function Compilation_Errors return Boolean is + begin + if not Finalize_Called then + raise Program_Error; + else + return Erroutc.Compilation_Errors; + end if; + end Compilation_Errors; + --------------- -- Error_Msg -- --------------- @@ -1163,9 +1179,252 @@ package body Errout is -------------- procedure Finalize is - Cur : Error_Msg_Id; - Nxt : Error_Msg_Id; - E, F : Error_Msg_Id; + Cur : Error_Msg_Id; + Nxt : Error_Msg_Id; + F : Error_Msg_Id; + + begin + -- Eliminate any duplicated error messages from the list. This is + -- done after the fact to avoid problems with Change_Error_Text. + + Cur := First_Error_Msg; + while Cur /= No_Error_Msg loop + Nxt := Errors.Table (Cur).Next; + + F := Nxt; + while F /= No_Error_Msg + and then Errors.Table (F).Sptr = Errors.Table (Cur).Sptr + loop + Check_Duplicate_Message (Cur, F); + F := Errors.Table (F).Next; + end loop; + + Cur := Nxt; + end loop; + + -- Mark any messages suppressed by specific warnings as Deleted + + Cur := First_Error_Msg; + while Cur /= No_Error_Msg loop + if not Errors.Table (Cur).Deleted + and then Warning_Specifically_Suppressed + (Errors.Table (Cur).Sptr, + Errors.Table (Cur).Text) + then + Errors.Table (Cur).Deleted := True; + Warnings_Detected := Warnings_Detected - 1; + end if; + + Cur := Errors.Table (Cur).Next; + end loop; + + -- Remaining processing should only be done once in the case where + -- Finalize has been called more than once. + + if Finalize_Called then + return; + else + Finalize_Called := True; + end if; + + -- Check consistency of specific warnings (may add warnings) + + Validate_Specific_Warnings (Error_Msg'Access); + end Finalize; + + ---------------- + -- First_Node -- + ---------------- + + function First_Node (C : Node_Id) return Node_Id is + L : constant Source_Ptr := Sloc (Original_Node (C)); + Sfile : constant Source_File_Index := Get_Source_File_Index (L); + Earliest : Node_Id; + Eloc : Source_Ptr; + Discard : Traverse_Result; + + pragma Warnings (Off, Discard); + + function Test_Earlier (N : Node_Id) return Traverse_Result; + -- Function applied to every node in the construct + + function Search_Tree_First is new Traverse_Func (Test_Earlier); + -- Create traversal function + + ------------------ + -- Test_Earlier -- + ------------------ + + function Test_Earlier (N : Node_Id) return Traverse_Result is + Loc : constant Source_Ptr := Sloc (Original_Node (N)); + + begin + -- Check for earlier. The tests for being in the same file ensures + -- against strange cases of foreign code somehow being present. We + -- don't want wild placement of messages if that happens, so it is + -- best to just ignore this situation. + + if Loc < Eloc + and then Get_Source_File_Index (Loc) = Sfile + then + Earliest := Original_Node (N); + Eloc := Loc; + end if; + + return OK_Orig; + end Test_Earlier; + + -- Start of processing for First_Node + + begin + Earliest := Original_Node (C); + Eloc := Sloc (Earliest); + Discard := Search_Tree_First (Original_Node (C)); + return Earliest; + end First_Node; + + ---------------- + -- First_Sloc -- + ---------------- + + function First_Sloc (N : Node_Id) return Source_Ptr is + SI : constant Source_File_Index := Source_Index (Get_Source_Unit (N)); + SF : constant Source_Ptr := Source_First (SI); + F : Node_Id; + S : Source_Ptr; + + begin + F := First_Node (N); + S := Sloc (F); + + -- The following circuit is a bit subtle. When we have parenthesized + -- expressions, then the Sloc will not record the location of the + -- paren, but we would like to post the flag on the paren. So what + -- we do is to crawl up the tree from the First_Node, adjusting the + -- Sloc value for any parentheses we know are present. Yes, we know + -- this circuit is not 100% reliable (e.g. because we don't record + -- all possible paren level values), but this is only for an error + -- message so it is good enough. + + Node_Loop : loop + Paren_Loop : for J in 1 .. Paren_Count (F) loop + + -- We don't look more than 12 characters behind the current + -- location, and in any case not past the front of the source. + + Search_Loop : for K in 1 .. 12 loop + exit Search_Loop when S = SF; + + if Source_Text (SI) (S - 1) = '(' then + S := S - 1; + exit Search_Loop; + + elsif Source_Text (SI) (S - 1) <= ' ' then + S := S - 1; + + else + exit Search_Loop; + end if; + end loop Search_Loop; + end loop Paren_Loop; + + exit Node_Loop when F = N; + F := Parent (F); + exit Node_Loop when Nkind (F) not in N_Subexpr; + end loop Node_Loop; + + return S; + end First_Sloc; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize is + begin + Errors.Init; + First_Error_Msg := No_Error_Msg; + Last_Error_Msg := No_Error_Msg; + Serious_Errors_Detected := 0; + Total_Errors_Detected := 0; + Warnings_Detected := 0; + Cur_Msg := No_Error_Msg; + List_Pragmas.Init; + + -- Initialize warnings table, if all warnings are suppressed, supply + -- an initial dummy entry covering all possible source locations. + + Warnings.Init; + Specific_Warnings.Init; + + if Warning_Mode = Suppress then + Warnings.Increment_Last; + Warnings.Table (Warnings.Last).Start := Source_Ptr'First; + Warnings.Table (Warnings.Last).Stop := Source_Ptr'Last; + end if; + end Initialize; + + ----------------- + -- No_Warnings -- + ----------------- + + function No_Warnings (N : Node_Or_Entity_Id) return Boolean is + begin + if Error_Posted (N) then + return True; + + elsif Nkind (N) in N_Entity and then Warnings_Off (N) then + return True; + + elsif Is_Entity_Name (N) + and then Present (Entity (N)) + and then Warnings_Off (Entity (N)) + then + return True; + + else + return False; + end if; + end No_Warnings; + + ------------- + -- OK_Node -- + ------------- + + function OK_Node (N : Node_Id) return Boolean is + K : constant Node_Kind := Nkind (N); + + begin + if Error_Posted (N) then + return False; + + elsif K in N_Has_Etype + and then Present (Etype (N)) + and then Error_Posted (Etype (N)) + then + return False; + + elsif (K in N_Op + or else K = N_Attribute_Reference + or else K = N_Character_Literal + or else K = N_Expanded_Name + or else K = N_Identifier + or else K = N_Operator_Symbol) + and then Present (Entity (N)) + and then Error_Posted (Entity (N)) + then + return False; + else + return True; + end if; + end OK_Node; + + --------------------- + -- Output_Messages -- + --------------------- + + procedure Output_Messages is + E : Error_Msg_Id; Err_Flag : Boolean; procedure Write_Error_Summary; @@ -1297,56 +1556,25 @@ package body Errout is end if; end Write_Max_Errors; - -- Start of processing for Finalize + -- Start of processing for Output_Messages begin + -- Error if Finalize has not been called + + if not Finalize_Called then + raise Program_Error; + end if; + -- Reset current error source file if the main unit has a pragma -- Source_Reference. This ensures outputting the proper name of -- the source file in this situation. - if Main_Source_File = No_Source_File or else - Num_SRef_Pragmas (Main_Source_File) /= 0 + if Main_Source_File = No_Source_File + or else Num_SRef_Pragmas (Main_Source_File) /= 0 then Current_Error_Source_File := No_Source_File; end if; - -- Eliminate any duplicated error messages from the list. This is - -- done after the fact to avoid problems with Change_Error_Text. - - Cur := First_Error_Msg; - while Cur /= No_Error_Msg loop - Nxt := Errors.Table (Cur).Next; - - F := Nxt; - while F /= No_Error_Msg - and then Errors.Table (F).Sptr = Errors.Table (Cur).Sptr - loop - Check_Duplicate_Message (Cur, F); - F := Errors.Table (F).Next; - end loop; - - Cur := Nxt; - end loop; - - -- Mark any messages suppressed by specific warnings as Deleted - - Cur := First_Error_Msg; - while Cur /= No_Error_Msg loop - if Warning_Specifically_Suppressed - (Errors.Table (Cur).Sptr, - Errors.Table (Cur).Text) - then - Errors.Table (Cur).Deleted := True; - Warnings_Detected := Warnings_Detected - 1; - end if; - - Cur := Errors.Table (Cur).Next; - end loop; - - -- Check consistency of specific warnings (may add warnings) - - Validate_Specific_Warnings (Error_Msg'Access); - -- Brief Error mode if Brief_Output or (not Full_List and not Verbose_Mode) then @@ -1544,194 +1772,7 @@ package body Errout is Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected; Warnings_Detected := 0; end if; - end Finalize; - - ---------------- - -- First_Node -- - ---------------- - - function First_Node (C : Node_Id) return Node_Id is - L : constant Source_Ptr := Sloc (Original_Node (C)); - Sfile : constant Source_File_Index := Get_Source_File_Index (L); - Earliest : Node_Id; - Eloc : Source_Ptr; - Discard : Traverse_Result; - - pragma Warnings (Off, Discard); - - function Test_Earlier (N : Node_Id) return Traverse_Result; - -- Function applied to every node in the construct - - function Search_Tree_First is new Traverse_Func (Test_Earlier); - -- Create traversal function - - ------------------ - -- Test_Earlier -- - ------------------ - - function Test_Earlier (N : Node_Id) return Traverse_Result is - Loc : constant Source_Ptr := Sloc (Original_Node (N)); - - begin - -- Check for earlier. The tests for being in the same file ensures - -- against strange cases of foreign code somehow being present. We - -- don't want wild placement of messages if that happens, so it is - -- best to just ignore this situation. - - if Loc < Eloc - and then Get_Source_File_Index (Loc) = Sfile - then - Earliest := Original_Node (N); - Eloc := Loc; - end if; - - return OK_Orig; - end Test_Earlier; - - -- Start of processing for First_Node - - begin - Earliest := Original_Node (C); - Eloc := Sloc (Earliest); - Discard := Search_Tree_First (Original_Node (C)); - return Earliest; - end First_Node; - - ---------------- - -- First_Sloc -- - ---------------- - - function First_Sloc (N : Node_Id) return Source_Ptr is - SI : constant Source_File_Index := Source_Index (Get_Source_Unit (N)); - SF : constant Source_Ptr := Source_First (SI); - F : Node_Id; - S : Source_Ptr; - - begin - F := First_Node (N); - S := Sloc (F); - - -- The following circuit is a bit subtle. When we have parenthesized - -- expressions, then the Sloc will not record the location of the - -- paren, but we would like to post the flag on the paren. So what - -- we do is to crawl up the tree from the First_Node, adjusting the - -- Sloc value for any parentheses we know are present. Yes, we know - -- this circuit is not 100% reliable (e.g. because we don't record - -- all possible paren level valoues), but this is only for an error - -- message so it is good enough. - - Node_Loop : loop - Paren_Loop : for J in 1 .. Paren_Count (F) loop - - -- We don't look more than 12 characters behind the current - -- location, and in any case not past the front of the source. - - Search_Loop : for K in 1 .. 12 loop - exit Search_Loop when S = SF; - - if Source_Text (SI) (S - 1) = '(' then - S := S - 1; - exit Search_Loop; - - elsif Source_Text (SI) (S - 1) <= ' ' then - S := S - 1; - - else - exit Search_Loop; - end if; - end loop Search_Loop; - end loop Paren_Loop; - - exit Node_Loop when F = N; - F := Parent (F); - exit Node_Loop when Nkind (F) not in N_Subexpr; - end loop Node_Loop; - - return S; - end First_Sloc; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize is - begin - Errors.Init; - First_Error_Msg := No_Error_Msg; - Last_Error_Msg := No_Error_Msg; - Serious_Errors_Detected := 0; - Total_Errors_Detected := 0; - Warnings_Detected := 0; - Cur_Msg := No_Error_Msg; - List_Pragmas.Init; - - -- Initialize warnings table, if all warnings are suppressed, supply - -- an initial dummy entry covering all possible source locations. - - Warnings.Init; - Specific_Warnings.Init; - - if Warning_Mode = Suppress then - Warnings.Increment_Last; - Warnings.Table (Warnings.Last).Start := Source_Ptr'First; - Warnings.Table (Warnings.Last).Stop := Source_Ptr'Last; - end if; - end Initialize; - - ----------------- - -- No_Warnings -- - ----------------- - - function No_Warnings (N : Node_Or_Entity_Id) return Boolean is - begin - if Error_Posted (N) then - return True; - - elsif Nkind (N) in N_Entity and then Warnings_Off (N) then - return True; - - elsif Is_Entity_Name (N) - and then Present (Entity (N)) - and then Warnings_Off (Entity (N)) - then - return True; - - else - return False; - end if; - end No_Warnings; - - ------------- - -- OK_Node -- - ------------- - - function OK_Node (N : Node_Id) return Boolean is - K : constant Node_Kind := Nkind (N); - - begin - if Error_Posted (N) then - return False; - - elsif K in N_Has_Etype - and then Present (Etype (N)) - and then Error_Posted (Etype (N)) - then - return False; - - elsif (K in N_Op - or else K = N_Attribute_Reference - or else K = N_Character_Literal - or else K = N_Expanded_Name - or else K = N_Identifier - or else K = N_Operator_Symbol) - and then Present (Entity (N)) - and then Error_Posted (Entity (N)) - then - return False; - else - return True; - end if; - end OK_Node; + end Output_Messages; ------------------------ -- Output_Source_Line -- @@ -2277,17 +2318,17 @@ package body Errout is -- Set_Msg_Insertion_Unit_Name -- --------------------------------- - procedure Set_Msg_Insertion_Unit_Name is + procedure Set_Msg_Insertion_Unit_Name (Suffix : Boolean := True) is begin - if Error_Msg_Unit_1 = No_Name then + if Error_Msg_Unit_1 = No_Unit_Name then null; - elsif Error_Msg_Unit_1 = Error_Name then + elsif Error_Msg_Unit_1 = Error_Unit_Name then Set_Msg_Blank; Set_Msg_Str ("<error>"); else - Get_Unit_Name_String (Error_Msg_Unit_1); + Get_Unit_Name_String (Error_Msg_Unit_1, Suffix); Set_Msg_Blank; Set_Msg_Quote; Set_Msg_Name_Buffer; @@ -2457,8 +2498,8 @@ package body Errout is ------------------ procedure Set_Msg_Text (Text : String; Flag : Source_Ptr) is - C : Character; -- Current character - P : Natural; -- Current index; + C : Character; -- Current character + P : Natural; -- Current index; begin Manual_Quote_Mode := False; @@ -2471,14 +2512,25 @@ package body Errout is C := Text (P); P := P + 1; - -- Check for insertion character + -- Check for insertion character or sequence case C is when '%' => - Set_Msg_Insertion_Name; + if P <= Text'Last and then Text (P) = '%' then + P := P + 1; + Set_Msg_Insertion_Name_Literal; + else + Set_Msg_Insertion_Name; + end if; when '$' => - Set_Msg_Insertion_Unit_Name; + if P <= Text'Last and then Text (P) = '$' then + P := P + 1; + Set_Msg_Insertion_Unit_Name (Suffix => False); + + else + Set_Msg_Insertion_Unit_Name; + end if; when '{' => Set_Msg_Insertion_File_Name; diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index f4644c2..9992cb4 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -31,9 +31,10 @@ with Err_Vars; with Erroutc; +with Namet; use Namet; with Table; -with Types; use Types; -with Uintp; use Uintp; +with Types; use Types; +with Uintp; use Uintp; with System; @@ -147,7 +148,15 @@ package Errout is -- message, similarly replaced by the names which are specified by the -- Name_Id values stored in Error_Msg_Name_2 and Error_Msg_Name_3. The -- names are decoded and cased according to the current identifier - -- casing mode. + -- casing mode. Note: if a unit name ending with %b or %s is passed + -- for this kind of insertion, this suffix is simply stripped. Use a + -- unit name insertion ($) to process the suffix. + + -- Insertion character %% (Double percent: insert literal name) + -- The character sequence %% acts as described above for %, except + -- that the name is simply obtained with Get_Name_String and is not + -- decoded or cased, it is inserted literally from the names table. + -- A trailing %b or %s is not treated specially. -- Insertion character $ (Dollar: insert unit name from Names table) -- The character $ is treated similarly to %, except that the name is @@ -157,11 +166,13 @@ package Errout is -- strings. If this postfix is not required, use the normal % -- insertion for the unit name. - -- Insertion character { (Left brace: insert literally from names table) - -- The character { is treated similarly to %, except that the name is - -- output literally as stored in the names table without adjusting the - -- casing. This can be used for file names and in other situations - -- where the name string is to be output unchanged. + -- Insertion character { (Left brace: insert file name from names table) + -- The character { is treated similarly to %, except that the input + -- value is a File_Name_Type value stored in Error_Msg_File_1 or + -- Error_Msg_File_2 or Error_Msg_File_3. The value is output literally, + -- enclosed in quotes as for %, but the case is not modified, the + -- insertion is the exact string stored in the names table without + -- adjusting the casing. -- Insertion character * (Asterisk, insert reserved word name) -- The insertion character * is treated exactly like % except that the @@ -384,9 +395,14 @@ package Errout is Error_Msg_Name_3 : Name_Id renames Err_Vars.Error_Msg_Name_3; -- Name_Id values for % insertion characters in message - Error_Msg_Unit_1 : Name_Id renames Err_Vars.Error_Msg_Unit_1; - Error_Msg_Unit_2 : Name_Id renames Err_Vars.Error_Msg_Unit_2; - -- Name_Id values for $ insertion characters in message + Error_Msg_File_1 : File_Name_Type renames Err_Vars.Error_Msg_File_1; + Error_Msg_File_2 : File_Name_Type renames Err_Vars.Error_Msg_File_2; + Error_Msg_File_3 : File_Name_Type renames Err_Vars.Error_Msg_File_3; + -- File_Name_Type values for { insertion characters in message + + Error_Msg_Unit_1 : Unit_Name_Type renames Err_Vars.Error_Msg_Unit_1; + Error_Msg_Unit_2 : Unit_Name_Type renames Err_Vars.Error_Msg_Unit_2; + -- Unit_Name_Type values for $ insertion characters in message Error_Msg_Node_1 : Node_Id renames Err_Vars.Error_Msg_Node_1; Error_Msg_Node_2 : Node_Id renames Err_Vars.Error_Msg_Node_2; @@ -545,8 +561,21 @@ package Errout is -- source file before using any of the other routines in the package. procedure Finalize; - -- Finalize processing of error messages for one file and output message - -- indicating the number of detected errors. + -- Finalize processing of error message list. Includes processing for + -- duplicated error messages, and other similar final adjustment of the + -- list of error messages. Note that this procedure must be called before + -- calling Compilation_Errors to determine if there were any errors. It + -- is perfectly fine to call Finalize more than once. Indeed this can + -- make good sense. For example, do some processing that may generate + -- messages. Call Finalize to eliminate duplicates and remove deleted + -- warnings. Test for compilation errors using Compilation_Errors, then + -- generate some more errors/warnings, call Finalize again to make sure + -- that all duplicates in these new messages are dealt with, then finally + -- call Output_Messages to output the final list of messages. + + procedure Output_Messages; + -- Output list of messages, including messages giving number of detected + -- errors and warnings. procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr); -- Output a message at specified location. Can be called from the parser @@ -687,10 +716,10 @@ package Errout is -- the pragma. Err is set to True on return to report the error of no -- matching Warnings Off pragma preceding this one. - function Compilation_Errors return Boolean - renames Erroutc.Compilation_Errors; + function Compilation_Errors return Boolean; -- Returns true if errors have been detected, or warnings in -gnatwe - -- (treat warnings as errors) mode. + -- (treat warnings as errors) mode. Note that it is mandatory to call + -- Finalize before calling this routine. procedure Error_Msg_CRT (Feature : String; N : Node_Id); -- Posts a non-fatal message on node N saying that the feature identified diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb index 763654c..4a590e4 100644 --- a/gcc/ada/prepcomp.adb +++ b/gcc/ada/prepcomp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2007, 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- -- @@ -27,7 +27,6 @@ with Ada.Unchecked_Deallocation; with Errout; use Errout; -with Namet; use Namet; with Lib.Writ; use Lib.Writ; with Opt; use Opt; with Osint; use Osint; @@ -37,6 +36,7 @@ with Scn; use Scn; with Sinput.L; use Sinput.L; with Stringt; use Stringt; with Table; +with Types; use Types; package body Prepcomp is @@ -69,20 +69,20 @@ package body Prepcomp is type Preproc_Data is record Mapping : Symbol_Table.Instance; - File_Name : Name_Id := No_Name; - Deffile : String_Id := No_String; - Undef_False : Boolean := False; - Always_Blank : Boolean := False; - Comments : Boolean := False; - List_Symbols : Boolean := False; - Processed : Boolean := False; + File_Name : File_Name_Type := No_File; + Deffile : String_Id := No_String; + Undef_False : Boolean := False; + Always_Blank : Boolean := False; + Comments : Boolean := False; + List_Symbols : Boolean := False; + Processed : Boolean := False; end record; -- Structure to keep the preprocessing data for a file name or for the -- default (when Name_Id = No_Name). No_Preproc_Data : constant Preproc_Data := (Mapping => No_Mapping, - File_Name => No_Name, + File_Name => No_File, Deffile => No_String, Undef_False => False, Always_Blank => False, @@ -295,7 +295,7 @@ package body Prepcomp is if Current_Data.File_Name = Preproc_Data_Table.Table (Index).File_Name then - Error_Msg_Name_1 := Current_Data.File_Name; + Error_Msg_File_1 := Current_Data.File_Name; Error_Msg ("multiple preprocessing data for{", Token_Ptr); OK := False; @@ -544,7 +544,7 @@ package body Prepcomp is -- Record Current_Data - if Current_Data.File_Name = No_Name then + if Current_Data.File_Name = No_File then Default_Data := Current_Data; else @@ -561,6 +561,7 @@ package body Prepcomp is if Total_Errors_Detected > T then Errout.Finalize; + Errout.Output_Messages; Fail ("errors found in preprocessing data file """, Get_Name_String (N), """"); @@ -648,10 +649,11 @@ package body Prepcomp is String_To_Name_Buffer (Current_Data.Deffile); declare - N : constant Name_Id := Name_Find; - Deffile : constant Source_File_Index := Load_Definition_File (N); - Add_Deffile : Boolean := True; - T : constant Nat := Total_Errors_Detected; + N : constant File_Name_Type := Name_Find; + Deffile : constant Source_File_Index := + Load_Definition_File (N); + Add_Deffile : Boolean := True; + T : constant Nat := Total_Errors_Detected; begin if Deffile = No_Source_File then @@ -686,6 +688,7 @@ package body Prepcomp is if T /= Total_Errors_Detected then Errout.Finalize; + Errout.Output_Messages; Fail ("errors found in definition file """, Get_Name_String (N), """"); diff --git a/gcc/ada/prepcomp.ads b/gcc/ada/prepcomp.ads index 9c74df8..c9b6b38 100644 --- a/gcc/ada/prepcomp.ads +++ b/gcc/ada/prepcomp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2007, 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- -- @@ -26,7 +26,7 @@ -- This package stores all preprocessing data for the compiler -with Types; use Types; +with Namet; use Namet; package Prepcomp is |