Commit 3cebfcc5 by Eric Botcazou Committed by Eric Botcazou

Revert

	2009-04-29  Vincent Celier  <celier@adacore.com>

	* sinput-l.adb (Load_File): When preprocessing, set temporarily the
	Source_File_Index_Table entries for the source, to avoid crash when
	reporting an error.

	* gnatcmd.adb (Test_If_Relative_Path): Use
	Makeutl.Test_If_Relative_Path.
	
	* makeutl.adb:(Test_If_Relative_Path): Process switches --RTS= only if
	Including_RTS is True.

	* makeutl.ads (Test_If_Relative_Path): New Boolean parameter
	Including_RTS defaulted to False.

	* sinput.ads, scans.ads, err_vars.ads: Initialize some variables with
	a default value.

From-SVN: r146991
parent 9933b56a
2009-04-29 Eric Botcazou <ebotcazou@adacore.com>
Revert
2009-04-29 Vincent Celier <celier@adacore.com>
* sinput-l.adb (Load_File): When preprocessing, set temporarily the
Source_File_Index_Table entries for the source, to avoid crash when
reporting an error.
* gnatcmd.adb (Test_If_Relative_Path): Use
Makeutl.Test_If_Relative_Path.
* makeutl.adb:(Test_If_Relative_Path): Process switches --RTS= only if
Including_RTS is True.
* makeutl.ads (Test_If_Relative_Path): New Boolean parameter
Including_RTS defaulted to False.
* sinput.ads, scans.ads, err_vars.ads: Initialize some variables with
a default value.
2009-04-29 Ed Schonberg <schonberg@adacore.com> 2009-04-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming): Improve error message on * sem_ch8.adb (Analyze_Subprogram_Renaming): Improve error message on
......
...@@ -32,31 +32,24 @@ with Uintp; use Uintp; ...@@ -32,31 +32,24 @@ with Uintp; use Uintp;
package Err_Vars is package Err_Vars is
-- All of these variables are set when needed, so they do not need to be
-- initialized. However, there is code that saves and restores existing
-- values, which may malfunction in -gnatVa mode if the variable has never
-- been iniitalized, so we initialize some variables to avoid exceptions
-- from invalid values in such cases.
------------------ ------------------
-- Error Counts -- -- Error Counts --
------------------ ------------------
Serious_Errors_Detected : Nat := 0; Serious_Errors_Detected : Nat;
-- This is a count of errors that are serious enough to stop expansion, -- This is a count of errors that are serious enough to stop expansion,
-- and hence to prevent generation of an object file even if the -- and hence to prevent generation of an object file even if the
-- switch -gnatQ is set. Initialized to zero at the start of compilation. -- switch -gnatQ is set. Initialized to zero at the start of compilation.
-- Initialized for -gnatVa use, see comment above.
Total_Errors_Detected : Nat := 0; Total_Errors_Detected : Nat;
-- Number of errors detected so far. Includes count of serious errors and -- Number of errors detected so far. Includes count of serious errors and
-- non-serious errors, so this value is always greater than or equal to the -- non-serious errors, so this value is always greater than or equal to the
-- Serious_Errors_Detected value. Initialized to zero at the start of -- Serious_Errors_Detected value. Initialized to zero at the start of
-- compilation. Initialized for -gnatVa use, see comment above. -- compilation.
Warnings_Detected : Nat := 0; Warnings_Detected : Nat;
-- Number of warnings detected. Initialized to zero at the start of -- Number of warnings detected. Initialized to zero at the start of
-- compilation. Initialized for -gnatVa use, see comment above. -- compilation.
---------------------------------- ----------------------------------
-- Error Message Mode Variables -- -- Error Message Mode Variables --
...@@ -82,7 +75,7 @@ package Err_Vars is ...@@ -82,7 +75,7 @@ package Err_Vars is
-- generated on the instantiation (referring to the template) rather -- generated on the instantiation (referring to the template) rather
-- than on the template itself. -- than on the template itself.
Raise_Exception_On_Error : Nat := 0; Raise_Exception_On_Error : Nat;
-- If this value is non-zero, then any attempt to generate an error -- If this value is non-zero, then any attempt to generate an error
-- message raises the exception Error_Msg_Exception, and the error -- message raises the exception Error_Msg_Exception, and the error
-- message is not output. This is used for defending against junk -- message is not output. This is used for defending against junk
......
...@@ -26,7 +26,6 @@ ...@@ -26,7 +26,6 @@
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Csets; with Csets;
with Makeutl;
with MLib.Tgt; use MLib.Tgt; with MLib.Tgt; use MLib.Tgt;
with MLib.Utl; with MLib.Utl;
with MLib.Fil; with MLib.Fil;
...@@ -1266,8 +1265,61 @@ procedure GNATCmd is ...@@ -1266,8 +1265,61 @@ procedure GNATCmd is
Parent : String) Parent : String)
is is
begin begin
Makeutl.Test_If_Relative_Path if Switch /= null then
(Switch, Parent, Including_Non_Switch => False, Including_RTS => True);
declare
Sw : String (1 .. Switch'Length);
Start : Positive := 1;
begin
Sw := Switch.all;
if Sw (1) = '-' then
if Sw'Length >= 3
and then (Sw (2) = 'A' or else
Sw (2) = 'I' or else
Sw (2) = 'L')
then
Start := 3;
if Sw = "-I-" then
return;
end if;
elsif Sw'Length >= 4
and then (Sw (2 .. 3) = "aL" or else
Sw (2 .. 3) = "aO" or else
Sw (2 .. 3) = "aI")
then
Start := 4;
elsif Sw'Length >= 7
and then Sw (2 .. 6) = "-RTS="
then
Start := 7;
else
return;
end if;
end if;
-- If the path is relative, test if it includes directory
-- information. If it does, prepend Parent to the path.
if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
for J in Start .. Sw'Last loop
if Sw (J) = Directory_Separator then
Switch :=
new String'
(Sw (1 .. Start - 1) &
Parent &
Directory_Separator &
Sw (Start .. Sw'Last));
return;
end if;
end loop;
end if;
end;
end if;
end Test_If_Relative_Path; end Test_If_Relative_Path;
------------------- -------------------
......
...@@ -598,8 +598,7 @@ package body Makeutl is ...@@ -598,8 +598,7 @@ package body Makeutl is
(Switch : in out String_Access; (Switch : in out String_Access;
Parent : String; Parent : String;
Including_L_Switch : Boolean := True; Including_L_Switch : Boolean := True;
Including_Non_Switch : Boolean := True; Including_Non_Switch : Boolean := True)
Including_RTS : Boolean := False)
is is
begin begin
if Switch /= null then if Switch /= null then
...@@ -629,20 +628,13 @@ package body Makeutl is ...@@ -629,20 +628,13 @@ package body Makeutl is
then then
Start := 4; Start := 4;
elsif Including_RTS
and then Sw'Length >= 7
and then Sw (2 .. 6) = "-RTS="
then
Start := 7;
else else
return; return;
end if; end if;
-- Because relative path arguments to --RTS= may be relative -- Because relative path arguments to --RTS= may be relative
-- to the search directory prefix, those relative path -- to the search directory prefix, those relative path
-- arguments are converted only when they include directory -- arguments are not converted.
-- information.
if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
if Parent'Length = 0 then if Parent'Length = 0 then
...@@ -651,19 +643,6 @@ package body Makeutl is ...@@ -651,19 +643,6 @@ package body Makeutl is
& Sw & Sw
& """) are not allowed"); & """) are not allowed");
elsif Including_RTS then
for J in Start .. Sw'Last loop
if Sw (J) = Directory_Separator then
Switch :=
new String'
(Sw (1 .. Start - 1) &
Parent &
Directory_Separator &
Sw (Start .. Sw'Last));
return;
end if;
end loop;
else else
Switch := Switch :=
new String' new String'
......
...@@ -130,14 +130,12 @@ package Makeutl is ...@@ -130,14 +130,12 @@ package Makeutl is
(Switch : in out String_Access; (Switch : in out String_Access;
Parent : String; Parent : String;
Including_L_Switch : Boolean := True; Including_L_Switch : Boolean := True;
Including_Non_Switch : Boolean := True; Including_Non_Switch : Boolean := True);
Including_RTS : Boolean := False);
-- Test if Switch is a relative search path switch. -- Test if Switch is a relative search path switch.
-- If it is, fail if Parent is the empty string, otherwise prepend the path -- If it is, fail if Parent is the empty string, otherwise prepend the path
-- with Parent. This subprogram is only called when using project files. -- with Parent. This subprogram is only called when using project files.
-- For gnatbind switches, Including_L_Switch is False, because the -- For gnatbind switches, Including_L_Switch is False, because the
-- argument of the -L switch is not a path. If Including_RTS is True, -- argument of the -L switch is not a path.
-- process also switches --RTS=.
function Path_Or_File_Name (Path : Path_Name_Type) return String; function Path_Or_File_Name (Path : Path_Name_Type) return String;
-- Returns a file name if -df is used, otherwise return a path name -- Returns a file name if -df is used, otherwise return a path name
......
...@@ -345,43 +345,36 @@ package Scans is ...@@ -345,43 +345,36 @@ package Scans is
-- Note: these variables can only be referenced during the parsing of a -- Note: these variables can only be referenced during the parsing of a
-- file. Reference to any of them from Sem or the expander is wrong. -- file. Reference to any of them from Sem or the expander is wrong.
-- These variables are initialized as required by Scn.Initialize_Scanner, Scan_Ptr : Source_Ptr;
-- and should not be referenced before such a call. However, there are
-- situations in which these variables are saved and restored, and this
-- may happen before the first Initialize_Scanner call, resulting in the
-- assignment of invalid values. To avoid this, and allow building with
-- the -gnatVa switch, we initialize some variables to known valid values.
Scan_Ptr : Source_Ptr := No_Location; -- init for -gnatVa
-- Current scan pointer location. After a call to Scan, this points -- Current scan pointer location. After a call to Scan, this points
-- just past the end of the token just scanned. -- just past the end of the token just scanned.
Token : Token_Type := No_Token; -- init for -gnatVa Token : Token_Type;
-- Type of current token -- Type of current token
Token_Ptr : Source_Ptr := No_Location; -- init for -gnatVa Token_Ptr : Source_Ptr;
-- Pointer to first character of current token -- Pointer to first character of current token
Current_Line_Start : Source_Ptr := No_Location; -- init for -gnatVa Current_Line_Start : Source_Ptr;
-- Pointer to first character of line containing current token. -- Pointer to first character of line containing current token
Start_Column : Column_Number := No_Column_Number; -- init for -gnatVa Start_Column : Column_Number;
-- Starting column number (zero origin) of the first non-blank character -- Starting column number (zero origin) of the first non-blank character
-- on the line containing the current token. This is used for error -- on the line containing the current token. This is used for error
-- recovery circuits which depend on looking at the column line up. -- recovery circuits which depend on looking at the column line up.
Type_Token_Location : Source_Ptr := No_Location; -- init for -gnatVa Type_Token_Location : Source_Ptr;
-- Within a type declaration, gives the location of the TYPE keyword that -- Within a type declaration, gives the location of the TYPE keyword that
-- opened the type declaration. Used in checking the end column of a record -- opened the type declaration. Used in checking the end column of a record
-- declaration, which can line up either with the TYPE keyword, or with the -- declaration, which can line up either with the TYPE keyword, or with the
-- start of the line containing the RECORD keyword. -- start of the line containing the RECORD keyword.
Checksum : Word := 0; -- init for -gnatVa Checksum : Word;
-- Used to accumulate a CRC representing the tokens in the source -- Used to accumulate a CRC representing the tokens in the source
-- file being compiled. This CRC includes only program tokens, and -- file being compiled. This CRC includes only program tokens, and
-- excludes comments. -- excludes comments.
First_Non_Blank_Location : Source_Ptr := No_Location; -- init for -gnatVa First_Non_Blank_Location : Source_Ptr;
-- Location of first non-blank character on the line containing the -- Location of first non-blank character on the line containing the
-- current token (i.e. the location of the character whose column number -- current token (i.e. the location of the character whose column number
-- is stored in Start_Column). -- is stored in Start_Column).
......
...@@ -453,11 +453,6 @@ package body Sinput.L is ...@@ -453,11 +453,6 @@ package body Sinput.L is
-- Preprocess the source if it needs to be preprocessed -- Preprocess the source if it needs to be preprocessed
if Preprocessing_Needed then if Preprocessing_Needed then
-- Set temporarily the Source_File_Index_Table entries for the
-- source, to avoid crash when reporting an error.
Set_Source_File_Index_Table (X);
if Opt.List_Preprocessing_Symbols then if Opt.List_Preprocessing_Symbols then
Get_Name_String (N); Get_Name_String (N);
......
...@@ -423,10 +423,8 @@ package Sinput is ...@@ -423,10 +423,8 @@ package Sinput is
-- Global Data -- -- Global Data --
----------------- -----------------
Current_Source_File : Source_File_Index := No_Source_File; Current_Source_File : Source_File_Index;
-- Source_File table index of source file currently being scanned. -- Source_File table index of source file currently being scanned
-- Initialized so that some tools (such as gprbuild) can be built with
-- -gnatVa and pragma Initialized_Scalars without problems.
Current_Source_Unit : Unit_Number_Type; Current_Source_Unit : Unit_Number_Type;
-- Unit number of source file currently being scanned. The special value -- Unit number of source file currently being scanned. The special value
......
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