Skip to content

R
riscv-gcc-1
Commit 107cd232 by Robert Dewar Committed by Arnaud Charlet
Options

comperr.adb (Compiler_Abort): New Finalize/Output_Messages interface for Errout 

2007-04-20  Robert Dewar  <dewar@adacore.com>

	* comperr.adb (Compiler_Abort): New Finalize/Output_Messages interface
	for Errout

	* errout.adb: New Finalize/Compilation_Errors/Output_Messages
	implementation

	* errout.ads (Finalize): Changed interface
	(Output_Messages): New procedure
	(Compilation_Errors): New Interface

	* prepcomp.ads, prepcomp.adb (Parse_Preprocessing_Data_File): New
	Finalize/Output_Messages interface for Errout
	(Prepare_To_Preprocess): New Finalize/Output_Messages interface for
	Errout.

From-SVN: r125374
parent 4378d234
Showing with 68 additions and 35 deletions
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");
......
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
......
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),
"""");
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment