1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R J . E R R -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2002-2014, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Err_Vars; 27with Output; use Output; 28with Stringt; use Stringt; 29 30package body Prj.Err is 31 32 --------------- 33 -- Post_Scan -- 34 --------------- 35 36 procedure Post_Scan is 37 Debug_Tokens : constant Boolean := False; 38 39 begin 40 -- Change operator symbol to literal strings, since that's the way 41 -- we treat all strings in a project file. 42 43 if Token = Tok_Operator_Symbol 44 or else Token = Tok_String_Literal 45 then 46 Token := Tok_String_Literal; 47 String_To_Name_Buffer (String_Literal_Id); 48 Token_Name := Name_Find; 49 end if; 50 51 if Debug_Tokens then 52 Write_Line (Token_Type'Image (Token)); 53 54 if Token = Tok_Identifier 55 or else Token = Tok_String_Literal 56 then 57 Write_Line (" " & Get_Name_String (Token_Name)); 58 end if; 59 end if; 60 end Post_Scan; 61 62 --------------- 63 -- Error_Msg -- 64 --------------- 65 66 procedure Error_Msg 67 (Flags : Processing_Flags; 68 Msg : String; 69 Location : Source_Ptr := No_Location; 70 Project : Project_Id := null) 71 is 72 Real_Location : Source_Ptr := Location; 73 74 begin 75 -- Don't post message if incompleted with's (avoid junk cascaded errors) 76 77 if Flags.Incomplete_Withs then 78 return; 79 end if; 80 81 -- Display the error message in the traces so that it appears in the 82 -- correct location in the traces (otherwise error messages are only 83 -- displayed at the end and it is difficult to see when they were 84 -- triggered) 85 86 if Current_Verbosity = High then 87 Debug_Output ("ERROR: " & Msg); 88 end if; 89 90 -- If location of error is unknown, use the location of the project 91 92 if Real_Location = No_Location 93 and then Project /= null 94 then 95 Real_Location := Project.Location; 96 end if; 97 98 if Real_Location = No_Location then 99 100 -- If still null, we are parsing a project that was created in-memory 101 -- so we shouldn't report errors for projects that the user has no 102 -- access to in any case. 103 104 if Current_Verbosity = High then 105 Debug_Output ("Error in in-memory project, ignored"); 106 end if; 107 108 return; 109 end if; 110 111 -- Report the error through Errutil, so that duplicate errors are 112 -- properly removed, messages are sorted, and correctly interpreted,... 113 114 Errutil.Error_Msg (Msg, Real_Location); 115 116 -- Let the application know there was an error 117 118 if Flags.Report_Error /= null then 119 Flags.Report_Error 120 (Project, 121 Is_Warning => 122 Msg (Msg'First) = '?' 123 or else (Msg (Msg'First) = '<' 124 and then Err_Vars.Error_Msg_Warn) 125 or else (Msg (Msg'First) = '\' 126 and then Msg (Msg'First + 1) = '<' 127 and then Err_Vars.Error_Msg_Warn)); 128 end if; 129 end Error_Msg; 130 131end Prj.Err; 132