Commit 4ecc031c by Robert Dewar Committed by Arnaud Charlet

errout.ads, errout.adb (Finalize): Implement switch -gnatd.m Avoid abbreviation Creat

2006-10-31  Robert Dewar  <dewar@adacore.com>

	* errout.ads, errout.adb (Finalize): Implement switch -gnatd.m
	Avoid abbreviation Creat
	(Finalize): List all sources in extended mail source if -gnatl
	switch is active.
	Suppress copyright notice to file in -gnatl=f mode if -gnatd7 set
	(Finalize): Implement new -gnatl=xxx switch to output listing to file
	(Set_Specific_Warning_On): New procedure
	(Set_Specific_Warning_Off): New procedure
	Add implementation of new insertion \\
	(Error_Msg_Internal): Add handling for Error_Msg_Line_Length
	(Unwind_Internal_Type): Improve report on anonymous access_to_subprogram
	types.
	(Error_Msg_Internal): Make sure that we set Last_Killed to
	True when a message from another package is suppressed.
	Implement insertion character ~ (insert string)
	(First_Node): Minor adjustments to get better placement.

	* frontend.adb: 
	Implement new -gnatl=xxx switch to output listing to file

	* gnat1drv.adb: 
	Implement new -gnatl=xxx switch to output listing to file

        * opt.ads: (Warn_On_Questionable_Missing_Paren): New switch
	(Commands_To_Stdout): New flag
	Implement new -gnatl=xxx switch to output listing to file
	New switch Dump_Source_Text
	(Warn_On_Deleted_Code): New warning flag for -gnatwt
	Define Error_Msg_Line_Length
	(Warn_On_Assumed_Low_Bound): New switch

	* osint.ads, osint.adb
	(Normalize_Directory_Name): Fix bug.
	Implement new -gnatl=xxx switch to output listing to file
	(Concat): Removed, replaced by real concatenation
	Make use of concatenation now allowed in compiler
	(Executable_Prefix.Get_Install_Dir): First get the full path, so that
	we find the 'lib' or 'bin' directory even when the tool has been
	invoked with a relative path.
	(Executable_Name): New function taking string parameters.

	* osint-c.ads, osint-c.adb: 
	Implement new -gnatl=xxx switch to output listing to file

	* sinput-d.adb: Change name Creat_Debug_File to Create_Debug_File

	* switch-c.adb: 
	Implement new -gnatl=xxx switch to output listing to file
	Recognize new -gnatL switch
	(no longer keep in old warning about old style usage)
	Use concatenation to simplify code
	Recognize -gnatjnn switch
	(Scan_Front_End_Switches): Clean up handling of -gnatW
	(Scan_Front_End_Switches): Include Warn_On_Assumed_Low_Bound for -gnatg

From-SVN: r118251
parent 6e443c90
...@@ -235,9 +235,18 @@ package Errout is ...@@ -235,9 +235,18 @@ package Errout is
-- of the cases in which messages are normally suppressed. Note that -- of the cases in which messages are normally suppressed. Note that
-- warnings are never suppressed, so the use of the ! character in a -- warnings are never suppressed, so the use of the ! character in a
-- warning message is never useful. -- warning message is never useful.
--
-- Note: the presence of ! is ignored in continuation messages (i.e.
-- messages starting with the \ insertion character). The effect of the
-- use of ! in a parent message automatically applies to all of its
-- continuation messages (since we clearly don't want any case in which
-- continuations are separated from the parent message. It is allowable
-- to put ! in continuation messages, and the usual style is to include
-- it, since it makes it clear that the continuation is part of an
-- unconditional message.
-- Insertion character ? (Question: warning message) -- Insertion character ? (Question: warning message)
-- The character ? appearing anywhere in a message makes the message a -- The character ? appearing anywhere in a message makes the message
-- warning instead of a normal error message, and the text of the -- warning instead of a normal error message, and the text of the
-- message will be preceded by "Warning:" instead of "Error:" in the -- message will be preceded by "Warning:" instead of "Error:" in the
-- normal case. The handling of warnings if further controlled by the -- normal case. The handling of warnings if further controlled by the
...@@ -247,6 +256,13 @@ package Errout is ...@@ -247,6 +256,13 @@ package Errout is
-- the parser), but currently all relevant warnings are posted by the -- the parser), but currently all relevant warnings are posted by the
-- semantic phase anyway. Messages starting with (style) are also -- semantic phase anyway. Messages starting with (style) are also
-- treated as warning messages. -- treated as warning messages.
--
-- Note: the presence of ? is ignored in continuation messages (i.e.
-- messages starting with the \ insertion character). The warning
-- status of continuations is determined only by the parent message
-- which is being continued. It is allowable to put ? in continuation
-- messages, and the usual style is to include it, since it makes it
-- clear that the continuation is part of a warning message.
-- Insertion character < (Less Than: conditional warning message) -- Insertion character < (Less Than: conditional warning message)
-- The character < appearing anywhere in a message is used for a -- The character < appearing anywhere in a message is used for a
...@@ -262,7 +278,7 @@ package Errout is ...@@ -262,7 +278,7 @@ package Errout is
-- Insertion character ` (Backquote: set manual quotation mode) -- Insertion character ` (Backquote: set manual quotation mode)
-- The backquote character always appears in pairs. Each backquote of -- The backquote character always appears in pairs. Each backquote of
-- the pair is replaced by a double quote character. In addition, Any -- the pair is replaced by a double quote character. In addition, any
-- reserved keywords, or name insertions between these backquotes are -- reserved keywords, or name insertions between these backquotes are
-- not surrounded by the usual automatic double quotes. See the -- not surrounded by the usual automatic double quotes. See the
-- section below on manual quotation mode for further details. -- section below on manual quotation mode for further details.
...@@ -280,7 +296,12 @@ package Errout is ...@@ -280,7 +296,12 @@ package Errout is
-- messages are treated as a unit. The \ character must be the first -- messages are treated as a unit. The \ character must be the first
-- character of the message text. -- character of the message text.
-- Insertion character | (vertical bar, non-serious error) -- Insertion character \\ (Two backslashes, continuation with new line)
-- This differs from \ only in -gnatjnn mode (Error_Message_Line_Length
-- set non-zero). This sequence forces a new line to start even when
-- continuations are being gathered into a single message.
-- Insertion character | (Vertical bar: non-serious error)
-- By default, error messages (other than warning messages) are -- By default, error messages (other than warning messages) are
-- considered to be fatal error messages which prevent expansion or -- considered to be fatal error messages which prevent expansion or
-- generation of code in the presence of the -gnatQ switch. If the -- generation of code in the presence of the -gnatQ switch. If the
...@@ -288,6 +309,11 @@ package Errout is ...@@ -288,6 +309,11 @@ package Errout is
-- non-serious, and does not cause Serious_Errors_Detected to be -- non-serious, and does not cause Serious_Errors_Detected to be
-- incremented (so expansion is not prevented by such a msg). -- incremented (so expansion is not prevented by such a msg).
-- Insertion character ~ (Tilde: insert string)
-- Indicates that Error_Msg_String (1 .. Error_Msg_Strlen) is to be
-- inserted to replace the ~ character. The string is inserted in the
-- literal form it appears, without any action on special characters.
---------------------------------------- ----------------------------------------
-- Specialization of Messages for VMS -- -- Specialization of Messages for VMS --
---------------------------------------- ----------------------------------------
...@@ -376,6 +402,11 @@ package Errout is ...@@ -376,6 +402,11 @@ package Errout is
-- Used if current message contains a < insertion character to indicate -- Used if current message contains a < insertion character to indicate
-- if the current message is a warning message. -- if the current message is a warning message.
Error_Msg_String : String renames Err_Vars.Error_Msg_String;
Error_Msg_Strlen : Natural renames Err_Vars.Error_Msg_Strlen;
-- Used if current message contains a ~ insertion character to indicate
-- insertion of the string Error_Msg_String (1 .. Error_Msg_Strlen).
----------------------------------------------------- -----------------------------------------------------
-- Format of Messages and Manual Quotation Control -- -- Format of Messages and Manual Quotation Control --
----------------------------------------------------- -----------------------------------------------------
...@@ -636,6 +667,26 @@ package Errout is ...@@ -636,6 +667,26 @@ package Errout is
-- Called in response to a pragma Warnings (On) to record the source -- Called in response to a pragma Warnings (On) to record the source
-- location from which warnings are to be turned back on. -- location from which warnings are to be turned back on.
procedure Set_Specific_Warning_Off (Loc : Source_Ptr; Msg : String)
renames Erroutc.Set_Specific_Warning_Off;
-- This is called in response to the two argument form of pragma Warnings
-- where the first argument is OFF, and the second argument is the prefix
-- of a specific warning to be suppressed. The first argument is the start
-- of the suppression range, and the second argument is the string from
-- the pragma.
procedure Set_Specific_Warning_On
(Loc : Source_Ptr;
Msg : String;
Err : out Boolean)
renames Erroutc.Set_Specific_Warning_On;
-- This is called in response to the two argument form of pragma Warnings
-- where the first argument is ON, and the second argument is the prefix
-- of a specific warning to be suppressed. The first argument is the end
-- of the suppression range, and the second argument is the string from
-- 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 function Compilation_Errors return Boolean
renames Erroutc.Compilation_Errors; renames Erroutc.Compilation_Errors;
-- Returns true if errors have been detected, or warnings in -gnatwe -- Returns true if errors have been detected, or warnings in -gnatwe
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -43,7 +43,6 @@ with Namet; use Namet; ...@@ -43,7 +43,6 @@ with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Opt; use Opt; with Opt; use Opt;
with Osint; with Osint;
with Output; use Output;
with Par; with Par;
with Prepcomp; with Prepcomp;
with Rtsfind; with Rtsfind;
...@@ -215,28 +214,6 @@ begin ...@@ -215,28 +214,6 @@ begin
Initialize_Scanner (Main_Unit, Source_Index (Main_Unit)); Initialize_Scanner (Main_Unit, Source_Index (Main_Unit));
-- Output header if in verbose mode or full list mode
if Verbose_Mode or Full_List then
Write_Eol;
if Operating_Mode = Generate_Code then
Write_Str ("Compiling: ");
else
Write_Str ("Checking: ");
end if;
Write_Name (Full_File_Name (Current_Source_File));
if not Debug_Flag_7 then
Write_Str (" (source file time stamp: ");
Write_Time_Stamp (Current_Source_File);
Write_Char (')');
end if;
Write_Eol;
end if;
-- Here we call the parser to parse the compilation unit (or units in -- Here we call the parser to parse the compilation unit (or units in
-- the check syntax mode, but in that case we won't go on to the -- the check syntax mode, but in that case we won't go on to the
-- semantics in any case). -- semantics in any case).
......
...@@ -170,10 +170,11 @@ begin ...@@ -170,10 +170,11 @@ begin
List_Representation_Info_Mechanisms := True; List_Representation_Info_Mechanisms := True;
end if; end if;
-- Output copyright notice if full list mode -- Output copyright notice if full list mode unless we have a list
-- file, in which case we defer this so that it is output in the file
if (Verbose_Mode or Full_List) if (Verbose_Mode or else (Full_List and Full_List_File_Name = null))
and then (not Debug_Flag_7) and then not Debug_Flag_7
then then
Write_Eol; Write_Eol;
Write_Str ("GNAT "); Write_Str ("GNAT ");
......
...@@ -127,7 +127,7 @@ package Opt is ...@@ -127,7 +127,7 @@ package Opt is
-- GNAT -- GNAT
-- Flag set to force display of multiple errors on a single line and -- Flag set to force display of multiple errors on a single line and
-- also repeated error messages for references to undefined identifiers -- also repeated error messages for references to undefined identifiers
-- and certain other repeated error messages. -- and certain other repeated error messages. Set by use of -gnatf.
All_Sources : Boolean := False; All_Sources : Boolean := False;
-- GNATBIND -- GNATBIND
...@@ -239,6 +239,10 @@ package Opt is ...@@ -239,6 +239,10 @@ package Opt is
-- Set to True to enable checking for unused withs, and also the case -- Set to True to enable checking for unused withs, and also the case
-- of withing a package and using none of the entities in the package. -- of withing a package and using none of the entities in the package.
Commands_To_Stdout : Boolean := False;
-- GNATMAKE
-- True if echoed commands to be written to stdout instead of stderr
Comment_Deleted_Lines : Boolean := False; Comment_Deleted_Lines : Boolean := False;
-- GNATPREP -- GNATPREP
-- True if source lines removed by the preprocessor should be commented -- True if source lines removed by the preprocessor should be commented
...@@ -344,6 +348,11 @@ package Opt is ...@@ -344,6 +348,11 @@ package Opt is
-- GNATMAKE -- GNATMAKE
-- Set to True if no actual compilations should be undertaken. -- Set to True if no actual compilations should be undertaken.
Dump_Source_Text : Boolean := False;
-- GNAT
-- Set to True (by -gnatL) to dump source text intermingled with generated
-- code. Effective only if either of Debug/Print_Generated_Code is true.
Dynamic_Elaboration_Checks : Boolean := False; Dynamic_Elaboration_Checks : Boolean := False;
-- GNAT -- GNAT
-- Set True for dynamic elaboration checking mode, as set by the -gnatE -- Set True for dynamic elaboration checking mode, as set by the -gnatE
...@@ -377,6 +386,15 @@ package Opt is ...@@ -377,6 +386,15 @@ package Opt is
-- Set to True if -gnato (enable overflow checks) switch is set, -- Set to True if -gnato (enable overflow checks) switch is set,
-- but not -gnatp. -- but not -gnatp.
Error_Msg_Line_Length : Nat := 0;
-- GNAT
-- Records the error message line length limit. If this is set to zero,
-- then we get the old style behavior, in which each call to the error
-- message routines generates one line of output as a separate message.
-- If it is set to a non-zero value, then continuation lines are folded
-- to make a single long message, and then this message is split up into
-- multiple lines not exceeding the specified length. Set by -gnatLnnn.
Exception_Locations_Suppressed : Boolean := False; Exception_Locations_Suppressed : Boolean := False;
-- GNAT -- GNAT
-- This flag is set True if a Suppress_Exception_Locations configuration -- This flag is set True if a Suppress_Exception_Locations configuration
...@@ -485,6 +503,12 @@ package Opt is ...@@ -485,6 +503,12 @@ package Opt is
-- GNAT -- GNAT
-- Set True to generate full source listing with embedded errors -- Set True to generate full source listing with embedded errors
Full_List_File_Name : String_Ptr := null;
-- GNAT
-- Set to file name to generate full source listing to named file (or if
-- the name is of the form .xxx, then to name.xxx where name is the source
-- file name with extension stripped.
function get_gcc_version return Int; function get_gcc_version return Int;
pragma Import (C, get_gcc_version, "get_gcc_version"); pragma Import (C, get_gcc_version, "get_gcc_version");
...@@ -643,22 +667,38 @@ package Opt is ...@@ -643,22 +667,38 @@ package Opt is
-- before preprocessing occurs. Set to True by switch -s of gnatprep -- before preprocessing occurs. Set to True by switch -s of gnatprep
-- or -s in preprocessing data file for the compiler. -- or -s in preprocessing data file for the compiler.
type Creat_Repinfo_File_Proc is access procedure (Src : File_Name_Type); type Create_Repinfo_File_Proc is access procedure (Src : File_Name_Type);
type Write_Repinfo_Line_Proc is access procedure (Info : String); type Write_Repinfo_Line_Proc is access procedure (Info : String);
type Close_Repinfo_File_Proc is access procedure; type Close_Repinfo_File_Proc is access procedure;
-- Types used for procedure addresses below -- Types used for procedure addresses below
Creat_Repinfo_File_Access : Creat_Repinfo_File_Proc := null; Create_Repinfo_File_Access : Create_Repinfo_File_Proc := null;
Write_Repinfo_Line_Access : Write_Repinfo_Line_Proc := null; Write_Repinfo_Line_Access : Write_Repinfo_Line_Proc := null;
Close_Repinfo_File_Access : Close_Repinfo_File_Proc := null; Close_Repinfo_File_Access : Close_Repinfo_File_Proc := null;
-- GNAT -- GNAT
-- These three locations are left null when operating in non-compiler -- These three locations are left null when operating in non-compiler
-- (e.g. ASIS mode), but when operating in compiler mode, they are -- (e.g. ASIS mode), but when operating in compiler mode, they are
-- set to point to the three corresponding procedures in Osint. The -- set to point to the three corresponding procedures in Osint-C. The
-- reason for this slightly strange interface is to prevent Repinfo -- reason for this slightly strange interface is to prevent Repinfo
-- from dragging in Osint in ASIS mode, which would include a lot of -- from dragging in Osint in ASIS mode, which would include a lot of
-- unwanted units in the ASIS build. -- unwanted units in the ASIS build.
type Create_List_File_Proc is access procedure (S : String);
type Write_List_Info_Proc is access procedure (S : String);
type Close_List_File_Proc is access procedure;
-- Types used for procedure addresses below
Create_List_File_Access : Create_List_File_Proc := null;
Write_List_Info_Access : Write_List_Info_Proc := null;
Close_List_File_Access : Close_List_File_Proc := null;
-- GNAT
-- These three locations are left null when operating in non-compiler
-- (e.g. from the binder), but when operating in compiler mode, they are
-- set to point to the three corresponding procedures in Osint-C. The
-- reason for this slightly strange interface is to prevent Repinfo
-- from dragging in Osint-C in the binder, which would include unwanted
-- units in the binder.
Locking_Policy : Character := ' '; Locking_Policy : Character := ' ';
-- GNAT, GNATBIND -- GNAT, GNATBIND
-- Set to ' ' for the default case (no locking policy specified). -- Set to ' ' for the default case (no locking policy specified).
...@@ -1070,10 +1110,16 @@ package Opt is ...@@ -1070,10 +1110,16 @@ package Opt is
Warn_On_Ada_2005_Compatibility : Boolean := True; Warn_On_Ada_2005_Compatibility : Boolean := True;
-- GNAT -- GNAT
-- Set to True to active all warnings on Ada 2005 compatibility issues, -- Set to True to generate all warnings on Ada 2005 compatibility issues,
-- including warnings on Ada 2005 obsolescent features used in Ada 2005 -- including warnings on Ada 2005 obsolescent features used in Ada 2005
-- mode. Set False by -gnatwY. -- mode. Set False by -gnatwY.
Warn_On_Assumed_Low_Bound : Boolean := True;
-- GNAT
-- Set to True to activate warnings for string parameters that are indexed
-- with literals or S'Length, presumably assuming a lower bound of one. Set
-- False by -gnatwW.
Warn_On_Bad_Fixed_Value : Boolean := False; Warn_On_Bad_Fixed_Value : Boolean := False;
-- GNAT -- GNAT
-- Set to True to generate warnings for static fixed-point expression -- Set to True to generate warnings for static fixed-point expression
...@@ -1084,6 +1130,12 @@ package Opt is ...@@ -1084,6 +1130,12 @@ package Opt is
-- Set to True to generate warnings for variables that could be declared -- Set to True to generate warnings for variables that could be declared
-- as constants. Modified by use of -gnatwk/K. -- as constants. Modified by use of -gnatwk/K.
Warn_On_Deleted_Code : Boolean := False;
-- GNAT
-- Set to True to generate warnings for code deleted by the front end
-- for conditional statements whose outcome is known at compile time.
-- Modified by use of -gnatwt/T.
Warn_On_Dereference : Boolean := False; Warn_On_Dereference : Boolean := False;
-- GNAT -- GNAT
-- Set to True to generate warnings for implicit dereferences for array -- Set to True to generate warnings for implicit dereferences for array
...@@ -1102,7 +1154,8 @@ package Opt is ...@@ -1102,7 +1154,8 @@ package Opt is
Warn_On_Modified_Unread : Boolean := False; Warn_On_Modified_Unread : Boolean := False;
-- GNAT -- GNAT
-- Set to True to generate warnings if a variable is assigned but is never -- Set to True to generate warnings if a variable is assigned but is never
-- read. The default is that this warning is suppressed. -- read. The default is that this warning is suppressed. Also controls
-- warnings about assignments whose value is never read.
Warn_On_No_Value_Assigned : Boolean := True; Warn_On_No_Value_Assigned : Boolean := True;
-- GNAT -- GNAT
...@@ -1115,6 +1168,11 @@ package Opt is ...@@ -1115,6 +1168,11 @@ package Opt is
-- Set to True to generate warnings on use of any feature in Annex or if a -- Set to True to generate warnings on use of any feature in Annex or if a
-- subprogram is called for which a pragma Obsolescent applies. -- subprogram is called for which a pragma Obsolescent applies.
Warn_On_Questionable_Missing_Parens : Boolean := False;
-- GNAT
-- Set to True to generate warnings for cases where parenthese are missing
-- and the usage is questionable, because the intent is unclear.
Warn_On_Redundant_Constructs : Boolean := False; Warn_On_Redundant_Constructs : Boolean := False;
-- GNAT -- GNAT
-- Set to True to generate warnings for redundant constructs (e.g. useless -- Set to True to generate warnings for redundant constructs (e.g. useless
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- -- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -43,9 +43,10 @@ package body Osint.C is ...@@ -43,9 +43,10 @@ package body Osint.C is
function Create_Auxiliary_File function Create_Auxiliary_File
(Src : File_Name_Type; (Src : File_Name_Type;
Suffix : String) return File_Name_Type; Suffix : String) return File_Name_Type;
-- Common processing for Creat_Repinfo_File and Create_Debug_File. -- Common processing for Create_List_File, Create_Repinfo_File and
-- Src is the file name used to create the required output file and -- Create_Debug_File. Src is the file name used to create the required
-- Suffix is the desired suffic (dg/rep for debug/repinfo file). -- output file and Suffix is the desired suffic (dg/rep/xxx for debug/
-- repinfo/list file where xxx is specified extension.
procedure Set_Library_Info_Name; procedure Set_Library_Info_Name;
-- Sets a default ali file name from the main compiler source name. -- Sets a default ali file name from the main compiler source name.
...@@ -70,6 +71,23 @@ package body Osint.C is ...@@ -70,6 +71,23 @@ package body Osint.C is
end if; end if;
end Close_Debug_File; end Close_Debug_File;
---------------------
-- Close_List_File --
---------------------
procedure Close_List_File is
Status : Boolean;
begin
Close (Output_FD, Status);
if not Status then
Fail
("error while closing list file ",
Get_Name_String (Output_File_Name));
end if;
end Close_List_File;
------------------------------- -------------------------------
-- Close_Output_Library_Info -- -- Close_Output_Library_Info --
------------------------------- -------------------------------
...@@ -110,7 +128,7 @@ package body Osint.C is ...@@ -110,7 +128,7 @@ package body Osint.C is
function Create_Auxiliary_File function Create_Auxiliary_File
(Src : File_Name_Type; (Src : File_Name_Type;
Suffix : String) return File_Name_Type Suffix : String) return File_Name_Type
is is
Result : File_Name_Type; Result : File_Name_Type;
...@@ -128,13 +146,10 @@ package body Osint.C is ...@@ -128,13 +146,10 @@ package body Osint.C is
Name_Len := Name_Len + Suffix'Length; Name_Len := Name_Len + Suffix'Length;
if Output_Object_File_Name /= null then if Output_Object_File_Name /= null then
for Index in reverse Output_Object_File_Name'Range loop for Index in reverse Output_Object_File_Name'Range loop
if Output_Object_File_Name (Index) = Directory_Separator then if Output_Object_File_Name (Index) = Directory_Separator then
declare declare
File_Name : constant String := Name_Buffer (1 .. Name_Len); File_Name : constant String := Name_Buffer (1 .. Name_Len);
begin begin
Name_Len := Index - Output_Object_File_Name'First + 1; Name_Len := Index - Output_Object_File_Name'First + 1;
Name_Buffer (1 .. Name_Len) := Name_Buffer (1 .. Name_Len) :=
...@@ -165,6 +180,24 @@ package body Osint.C is ...@@ -165,6 +180,24 @@ package body Osint.C is
return Create_Auxiliary_File (Src, "dg"); return Create_Auxiliary_File (Src, "dg");
end Create_Debug_File; end Create_Debug_File;
----------------------
-- Create_List_File --
----------------------
procedure Create_List_File (S : String) is
F : File_Name_Type;
pragma Warnings (Off, F);
begin
if S (S'First) = '.' then
F := Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last));
else
Name_Buffer (1 .. S'Length) := S;
Name_Len := S'Length + 1;
Name_Buffer (Name_Len) := ASCII.NUL;
Create_File_And_Check (Output_FD, Text);
end if;
end Create_List_File;
-------------------------------- --------------------------------
-- Create_Output_Library_Info -- -- Create_Output_Library_Info --
-------------------------------- --------------------------------
...@@ -175,17 +208,16 @@ package body Osint.C is ...@@ -175,17 +208,16 @@ package body Osint.C is
Create_File_And_Check (Output_FD, Text); Create_File_And_Check (Output_FD, Text);
end Create_Output_Library_Info; end Create_Output_Library_Info;
-------------------------- -------------------------
-- Creat_Repinfo_File -- -- Create_Repinfo_File --
-------------------------- -------------------------
procedure Creat_Repinfo_File (Src : File_Name_Type) is procedure Create_Repinfo_File (Src : File_Name_Type) is
S : constant File_Name_Type := Create_Auxiliary_File (Src, "rep"); S : constant File_Name_Type := Create_Auxiliary_File (Src, "rep");
pragma Warnings (Off, S); pragma Warnings (Off, S);
begin begin
return; return;
end Creat_Repinfo_File; end Create_Repinfo_File;
--------------------------- ---------------------------
-- Debug_File_Eol_Length -- -- Debug_File_Eol_Length --
...@@ -412,6 +444,15 @@ package body Osint.C is ...@@ -412,6 +444,15 @@ package body Osint.C is
procedure Write_Library_Info (Info : String) renames Write_Info; procedure Write_Library_Info (Info : String) renames Write_Info;
---------------------
-- Write_List_Info --
---------------------
procedure Write_List_Info (S : String) is
begin
Write_With_Check (S'Address, S'Length);
end Write_List_Info;
------------------------ ------------------------
-- Write_Repinfo_Line -- -- Write_Repinfo_Line --
------------------------ ------------------------
...@@ -419,11 +460,15 @@ package body Osint.C is ...@@ -419,11 +460,15 @@ package body Osint.C is
procedure Write_Repinfo_Line (Info : String) renames Write_Info; procedure Write_Repinfo_Line (Info : String) renames Write_Info;
begin begin
Adjust_OS_Resource_Limits; Adjust_OS_Resource_Limits;
Opt.Creat_Repinfo_File_Access := Creat_Repinfo_File'Access;
Opt.Write_Repinfo_Line_Access := Write_Repinfo_Line'Access; Opt.Create_Repinfo_File_Access := Create_Repinfo_File'Access;
Opt.Close_Repinfo_File_Access := Close_Repinfo_File'Access; Opt.Write_Repinfo_Line_Access := Write_Repinfo_Line'Access;
Opt.Close_Repinfo_File_Access := Close_Repinfo_File'Access;
Opt.Create_List_File_Access := Create_List_File'Access;
Opt.Write_List_Info_Access := Write_List_Info'Access;
Opt.Close_List_File_Access := Close_List_File'Access;
Set_Program (Compiler); Set_Program (Compiler);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001 Free Software Foundation, Inc. -- -- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -91,7 +91,7 @@ package Osint.C is ...@@ -91,7 +91,7 @@ package Osint.C is
-- procedures in appropriate variables in Repinfo, so that they can -- procedures in appropriate variables in Repinfo, so that they can
-- be called indirectly without creating a dependence. -- be called indirectly without creating a dependence.
procedure Creat_Repinfo_File (Src : File_Name_Type); procedure Create_Repinfo_File (Src : File_Name_Type);
-- Given the simple name of a source file, this routine creates the -- Given the simple name of a source file, this routine creates the
-- corresponding file to hold representation information -- corresponding file to hold representation information
...@@ -139,6 +139,22 @@ package Osint.C is ...@@ -139,6 +139,22 @@ package Osint.C is
-- text is returned in Text. If the file does not exist, then Text is -- text is returned in Text. If the file does not exist, then Text is
-- set to null. -- set to null.
----------------------
-- List File Output --
----------------------
procedure Create_List_File (S : String);
-- Creates the file whose name is given by S. If the name starts with a
-- period, then the name is xxx & S, where xxx is the name of the main
-- source file without the extension stripped. Information is written to
-- this file using Write_List_File.
procedure Write_List_Info (S : String);
-- Writes given string to the list file created by Create_List_File
procedure Close_List_File;
-- Close file previously opened by Create_List_File
-------------------------------- --------------------------------
-- Semantic Tree Input-Output -- -- Semantic Tree Input-Output --
-------------------------------- --------------------------------
......
...@@ -498,6 +498,7 @@ package body Switch.C is ...@@ -498,6 +498,7 @@ package body Switch.C is
Constant_Condition_Warnings := True; Constant_Condition_Warnings := True;
Implementation_Unit_Warnings := True; Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True; Ineffective_Inline_Warnings := True;
Warn_On_Assumed_Low_Bound := True;
Warn_On_Bad_Fixed_Value := True; Warn_On_Bad_Fixed_Value := True;
Warn_On_Constant := True; Warn_On_Constant := True;
Warn_On_Export_Import := True; Warn_On_Export_Import := True;
...@@ -553,6 +554,19 @@ package body Switch.C is ...@@ -553,6 +554,19 @@ package body Switch.C is
Bad_Switch (C); Bad_Switch (C);
end if; end if;
-- Processing for j switch
when 'j' =>
Ptr := Ptr + 1;
-- There may be an equal sign between -gnatj and the value
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
Ptr := Ptr + 1;
end if;
Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
-- Processing for k switch -- Processing for k switch
when 'k' => when 'k' =>
...@@ -566,12 +580,23 @@ package body Switch.C is ...@@ -566,12 +580,23 @@ package body Switch.C is
Ptr := Ptr + 1; Ptr := Ptr + 1;
Full_List := True; Full_List := True;
-- There may be an equal sign between -gnatl and a file name
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
if Ptr = Max then
Osint.Fail ("file name for -gnatl= is null");
else
Opt.Full_List_File_Name :=
new String'(Switch_Chars (Ptr + 1 .. Max));
Ptr := Max + 1;
end if;
end if;
-- Processing for L switch -- Processing for L switch
when 'L' => when 'L' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
Osint.Fail Dump_Source_Text := True;
("-gnatL is no longer supported: consider using --RTS=sjlj");
-- Processing for m switch -- Processing for m switch
...@@ -584,7 +609,7 @@ package body Switch.C is ...@@ -584,7 +609,7 @@ package body Switch.C is
Ptr := Ptr + 1; Ptr := Ptr + 1;
end if; end if;
Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors, C); Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Errors, C);
-- Processing for n switch -- Processing for n switch
...@@ -805,15 +830,13 @@ package body Switch.C is ...@@ -805,15 +830,13 @@ package body Switch.C is
Bad_Switch (C); Bad_Switch (C);
end if; end if;
for J in WC_Encoding_Method loop begin
if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then Wide_Character_Encoding_Method :=
Wide_Character_Encoding_Method := J; Get_WC_Encoding_Method (Switch_Chars (Ptr));
exit; exception
when Constraint_Error =>
elsif J = WC_Encoding_Method'Last then
Bad_Switch (C); Bad_Switch (C);
end if; end;
end loop;
Upper_Half_Encoding := Upper_Half_Encoding :=
Wide_Character_Encoding_Method in Wide_Character_Encoding_Method in
...@@ -856,15 +879,9 @@ package body Switch.C is ...@@ -856,15 +879,9 @@ package body Switch.C is
(Switch_Chars (Ptr .. Max), OK, Ptr); (Switch_Chars (Ptr .. Max), OK, Ptr);
if not OK then if not OK then
declare Osint.Fail
R : String (1 .. Style_Msg_Len + 20); ("bad -gnaty switch (" &
begin Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
R (1 .. 19) := "bad -gnaty switch (";
R (20 .. R'Last - 1) :=
Style_Msg_Buf (1 .. Style_Msg_Len);
R (R'Last) := ')';
Osint.Fail (R);
end;
end if; end if;
Ptr := First_Char + 1; Ptr := First_Char + 1;
......
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