From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/ada/prj-err.adb | 125 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 125 insertions(+) create mode 100644 gcc/ada/prj-err.adb (limited to 'gcc/ada/prj-err.adb') diff --git a/gcc/ada/prj-err.adb b/gcc/ada/prj-err.adb new file mode 100644 index 000000000..4f5aea10b --- /dev/null +++ b/gcc/ada/prj-err.adb @@ -0,0 +1,125 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- P R J . E R R -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2002-2010, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Err_Vars; +with Output; use Output; +with Stringt; use Stringt; + +package body Prj.Err is + + --------------- + -- Post_Scan -- + --------------- + + procedure Post_Scan is + Debug_Tokens : constant Boolean := False; + + begin + -- Change operator symbol to literal strings, since that's the way + -- we treat all strings in a project file. + + if Token = Tok_Operator_Symbol + or else Token = Tok_String_Literal + then + Token := Tok_String_Literal; + String_To_Name_Buffer (String_Literal_Id); + Token_Name := Name_Find; + end if; + + if Debug_Tokens then + Write_Line (Token_Type'Image (Token)); + + if Token = Tok_Identifier + or else Token = Tok_String_Literal + then + Write_Line (" " & Get_Name_String (Token_Name)); + end if; + end if; + end Post_Scan; + + --------------- + -- Error_Msg -- + --------------- + + procedure Error_Msg + (Flags : Processing_Flags; + Msg : String; + Location : Source_Ptr := No_Location; + Project : Project_Id := null) + is + Real_Location : Source_Ptr := Location; + + begin + -- Display the error message in the traces so that it appears in the + -- correct location in the traces (otherwise error messages are only + -- displayed at the end and it is difficult to see when they were + -- triggered) + + if Current_Verbosity = High then + Write_Line ("ERROR: " & Msg); + end if; + + -- If location of error is unknown, use the location of the project + + if Real_Location = No_Location + and then Project /= null + then + Real_Location := Project.Location; + end if; + + if Real_Location = No_Location then + + -- If still null, we are parsing a project that was created in-memory + -- so we shouldn't report errors for projects that the user has no + -- access to in any case. + + if Current_Verbosity = High then + Write_Line ("Error in in-memory project, ignored"); + end if; + + return; + end if; + + -- Report the error through Errutil, so that duplicate errors are + -- properly removed, messages are sorted, and correctly interpreted,... + + Errutil.Error_Msg (Msg, Real_Location); + + -- Let the application know there was an error + + if Flags.Report_Error /= null then + Flags.Report_Error + (Project, + Is_Warning => + Msg (Msg'First) = '?' + or else (Msg (Msg'First) = '<' + and then Err_Vars.Error_Msg_Warn) + or else (Msg (Msg'First) = '\' + and then Msg (Msg'First + 1) = '<' + and then Err_Vars.Error_Msg_Warn)); + end if; + end Error_Msg; + +end Prj.Err; -- cgit v1.2.3