Commit 958a816e by Vincent Celier Committed by Arnaud Charlet

errutil.adb (Initialize): Initialize warnings table...

2007-04-06  Vincent Celier  <celier@adacore.com>

	* errutil.adb (Initialize): Initialize warnings table, if all warnings
	are suppressed, supply an initial dummy entry covering all possible
	source locations.

	* make.adb (Scan_Make_Arg): Reject options that should start with "--"
	and start with only one, such as "-RTS=none".
	(Collect_Arguments): Do not check for sources outside of projects.
	Do not collect arguments if project is externally built.
	(Compile_Sources): Do nothing, not even check if the source is up to
	date, if its project is externally built.
	(Compile): When compiling a predefined source, add -gnatpg
	as the second switch, after -c.
	(Compile_Sources): Allow compilation of Annex J renames without -a
	(Is_In_Object_Directory): Check if the ALI file is in the object
	even if there is no project extension.
	(Create_Binder_Mapping_File): Only put a unit in the mapping file for
	gnatbind if the ALI file effectively exists.
	(Initialize): Add the directory where gnatmake is invoked in front of
	the path if it is invoked from a bin directory, even without directory
	information, so that the correct GNAT tools will be used when spawned
	without directory information.

	* makeusg.adb: Change switch -S to -eS
	Add lines for new switches -we, -wn and -ws
	Add line for new switch -p

	* prj-proc.adb (Process): Set Success to False when Warning_Mode is
	Treat_As_Error and there are warnings.

	* switch-m.ads, switch-m.adb (Normalize_Compiler_Switches): Do not skip
	-gnatww Change gnatmake switch -S to -eS
	(Scan_Make_Switches): Code reorganisation. Process separately multi
	character switches and single character switches.
	(Scan_Make_Switches): New Boolean out parameter Success. Set Success to
	False when switch is not recognized by gnatmake.
	(Scan_Make_Switches): Set Setup_Projects True when -p or
	--create-missing-dirs is specified.

	* fname.adb (Is_Predefined_File_Name): Return True for annex J
	renamings Calendar, Machine_Code, Unchecked_Conversion and
	Unchecked_Deallocation only when Renamings_Included is True.

	* par.adb: Allow library units Calendar, Machine_Code,
	Unchecked_Conversion and Unchecked_Deallocation to be recompiled even
	when -gnatg is not specified.
	(P_Interface_Type_Definition): Remove the formal Is_Synchronized because
	there is no need to generate always a record_definition_node in case
	of synchronized interface types.
	(SIS_Entry_Active): Initialize global variable to False
	(P_Null_Exclusion): For AI-447: Add parameter Allow_Anonymous_In_95 to
	indicate cases where AI-447 says "not null" is legal.

	* makeutl.ads, makeutil.adb (Executable_Prefix_Path): New function

	* makegpr.adb (Check_Compilation_Needed): Take into account dependency
	files with with several lines starting with the object fileb name.
	(Scan_Arg): Set Setup_Projects True when -p or --create-missing-dirs
	is specified.
	(Initialize): Add the directory where gprmake is invoked in front of the
	path, if it is invoked from a bin directory or with directory
	information, so that the correct GNAT tools will be used when invoked
	directly.
	(Check_Compilation_Needed): Process correctly backslashes on Windows.

	* vms_data.ads: Update switches/qualifiers

From-SVN: r123560
parent fea9e956
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2006, 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- --
......@@ -582,6 +582,12 @@ package body Errutil is
-- an initial dummy entry covering all possible source locations.
Warnings.Init;
if Warning_Mode = Suppress then
Warnings.Increment_Last;
Warnings.Table (Warnings.Last).Start := Source_Ptr'First;
Warnings.Table (Warnings.Last).Stop := Source_Ptr'Last;
end if;
end Initialize;
------------------------
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -120,22 +120,22 @@ package body Fname is
Predef_Names : constant array (1 .. 11) of Str8 :=
("ada ", -- Ada
"calendar", -- Calendar
"interfac", -- Interfaces
"system ", -- System
"machcode", -- Machine_Code
"unchconv", -- Unchecked_Conversion
"unchdeal", -- Unchecked_Deallocation
-- Remaining entries are only considered if Renamings_Included true
"calendar", -- Calendar
"machcode", -- Machine_Code
"unchconv", -- Unchecked_Conversion
"unchdeal", -- Unchecked_Deallocation
"directio", -- Direct_IO
"ioexcept", -- IO_Exceptions
"sequenio", -- Sequential_IO
"text_io "); -- Text_IO
Num_Entries : constant Natural :=
7 + 4 * Boolean'Pos (Renamings_Included);
3 + 8 * Boolean'Pos (Renamings_Included);
begin
-- Remove extension (if present)
......
......@@ -99,6 +99,11 @@ begin
"project files");
Write_Eol;
-- Line for -eS
Write_Str (" -eS Echo commands to stdout instead of stderr");
Write_Eol;
-- Line for -f
Write_Str (" -f Force recompilations of non predefined units");
......@@ -151,6 +156,11 @@ begin
Write_Str (" -o name Choose an alternate executable name");
Write_Eol;
-- Line for -p
Write_Str (" -p Create missing obj, lib and exec dirs");
Write_Eol;
-- Line for -P
Write_Str (" -Pproj Use GNAT Project File proj");
......@@ -171,10 +181,6 @@ begin
Write_Str (" -s Recompile if compiler switches have changed");
Write_Eol;
-- Line for -S
Write_Str (" -S Echo commands to stdout instead of stderr");
-- Line for -u
Write_Str (" -u Unique compilation, only compile the given files");
......@@ -195,6 +201,21 @@ begin
Write_Str (" -vPx Specify verbosity when parsing GNAT Project Files");
Write_Eol;
-- Line for -we
Write_Str (" -we treat all Warnings as Errors");
Write_Eol;
-- Line for -wn
Write_Str (" -wn Normal Warning mode (cancels -we/-ws)");
Write_Eol;
-- Line for -ws
Write_Str (" -ws Suppress all Warnings");
Write_Eol;
-- Line for -x
Write_Str (" -x " &
......
......@@ -24,6 +24,8 @@
-- --
------------------------------------------------------------------------------
with Ada.Command_Line; use Ada.Command_Line;
with Namet; use Namet;
with Osint; use Osint;
with Prj.Ext;
......@@ -31,6 +33,7 @@ with Prj.Util;
with Snames; use Snames;
with Table;
with System.Case_Util; use System.Case_Util;
with System.HTable;
package body Makeutl is
......@@ -117,6 +120,68 @@ package body Makeutl is
Marks.Reset;
end Delete_All_Marks;
----------------------------
-- Executable_Prefix_Path --
----------------------------
function Executable_Prefix_Path return String is
Exec_Name : constant String := Command_Name;
function Get_Install_Dir (S : String) return String;
-- S is the executable name preceeded by the absolute or relative
-- path, e.g. "c:\usr\bin\gcc.exe". Returns the absolute directory
-- where "bin" lies (in the example "C:\usr").
-- If the executable is not in a "bin" directory, return "".
---------------------
-- Get_Install_Dir --
---------------------
function Get_Install_Dir (S : String) return String is
Exec : String := S;
Path_Last : Integer := 0;
begin
for J in reverse Exec'Range loop
if Exec (J) = Directory_Separator then
Path_Last := J - 1;
exit;
end if;
end loop;
if Path_Last >= Exec'First + 2 then
To_Lower (Exec (Path_Last - 2 .. Path_Last));
end if;
if Path_Last < Exec'First + 2
or else Exec (Path_Last - 2 .. Path_Last) /= "bin"
or else (Path_Last - 3 >= Exec'First
and then Exec (Path_Last - 3) /= Directory_Separator)
then
return "";
end if;
return Normalize_Pathname (Exec (Exec'First .. Path_Last - 4));
end Get_Install_Dir;
-- Beginning of Executable_Prefix_Path
begin
-- First determine if a path prefix was placed in front of the
-- executable name.
for J in reverse Exec_Name'Range loop
if Exec_Name (J) = Directory_Separator then
return Get_Install_Dir (Exec_Name);
end if;
end loop;
-- If we get here, the user has typed the executable name with no
-- directory prefix.
return Get_Install_Dir (Locate_Exec_On_Path (Exec_Name).all);
end Executable_Prefix_Path;
----------
-- Hash --
----------
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- Copyright (C) 2004-2006 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- --
......@@ -43,6 +43,11 @@ package Makeutl is
-- Find the index of a unit in a source file. Return zero if the file
-- is not a multi-unit source file.
function Executable_Prefix_Path return String;
-- Return the absolute path parent directory of the directory where the
-- current executable resides, if its directory is named "bin", otherwise
-- return an empty string.
function Is_External_Assignment (Argv : String) return Boolean;
-- Verify that an external assignment switch is syntactically correct
--
......
......@@ -142,7 +142,7 @@ is
-- whose body is required and has not yet been found. The prefix SIS
-- stands for "Subprogram IS" handling.
SIS_Entry_Active : Boolean;
SIS_Entry_Active : Boolean := False;
-- Set True to indicate that an entry is active (i.e. that a subprogram
-- declaration has been encountered, and no body for this subprogram has
-- been encountered). The remaining fields are valid only if this is True.
......@@ -605,22 +605,22 @@ is
-- declaration of this type for details.
function P_Interface_Type_Definition
(Abstract_Present : Boolean;
Is_Synchronized : Boolean) return Node_Id;
(Abstract_Present : Boolean) return Node_Id;
-- Ada 2005 (AI-251): Parse the interface type definition part. Abstract
-- Present indicates if the reserved word "abstract" has been previously
-- found. It is used to report an error message because interface types
-- are by definition abstract tagged. Is_Synchronized is True in case of
-- task interfaces, protected interfaces, and synchronized interfaces;
-- it is used to generate a record_definition node. In the rest of cases
-- (limited interfaces and interfaces) we generate a record_definition
-- are by definition abstract tagged. We generate a record_definition
-- node if the list of interfaces is empty; otherwise we generate a
-- derived_type_definition node (the first interface in this list is the
-- ancestor interface).
function P_Null_Exclusion return Boolean;
-- Ada 2005 (AI-231): Parse the null-excluding part. True indicates
-- that the null-excluding part was present.
function P_Null_Exclusion
(Allow_Anonymous_In_95 : Boolean := False) return Boolean;
-- Ada 2005 (AI-231): Parse the null-excluding part. A True result
-- indicates that the null-excluding part was present.
-- Allow_Anonymous_In_95 is True if we are in a context that allows
-- anonymous access types in Ada 95, in which case "not null" is legal
-- if it precedes "access".
function P_Subtype_Indication
(Not_Null_Present : Boolean := False) return Node_Id;
......@@ -1362,13 +1362,9 @@ begin
Name := Uname (Uname'First .. Uname'Last - 2);
if Name = "ada" or else
Name = "calendar" or else
Name = "interfaces" or else
Name = "system" or else
Name = "machine_code" or else
Name = "unchecked_conversion" or else
Name = "unchecked_deallocation"
if Name = "ada" or else
Name = "interfaces" or else
Name = "system"
then
Error_Msg
("language defined units may not be recompiled",
......
......@@ -26,7 +26,7 @@
with Err_Vars; use Err_Vars;
with Namet; use Namet;
with Opt;
with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
with Prj.Attr; use Prj.Attr;
......@@ -950,7 +950,7 @@ package body Prj.Proc is
Value := Prj.Ext.Value_Of (Name, Default);
if Value = No_Name then
if not Opt.Quiet_Output then
if not Quiet_Output then
if Error_Report = null then
Error_Msg
("?undefined external reference",
......@@ -1268,7 +1268,10 @@ package body Prj.Proc is
end loop;
end if;
Success := Total_Errors_Detected = 0;
Success :=
Total_Errors_Detected = 0
and then
(Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
end Process;
-------------------------------
......@@ -2295,7 +2298,7 @@ package body Prj.Proc is
(Imported_Project_List).Next;
end loop;
if Opt.Verbose_Mode then
if Verbose_Mode then
Write_Str ("Checking project file """);
Write_Str (Get_Name_String (Data.Name));
Write_Line ("""");
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -34,14 +34,14 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
package Switch.M is
procedure Scan_Make_Switches (Switch_Chars : String);
-- Procedures to scan out binder switches stored in the given string.
-- The first character is known to be a valid switch character, and there
-- are no blanks or other switch terminator characters in the string, so
-- the entire string should consist of valid switch characters, except that
-- an optional terminating NUL character is allowed. A bad switch causes
-- a fatal error exit and control does not return. The call also sets
-- Usage_Requested to True if a ? switch is encountered.
procedure Scan_Make_Switches
(Switch_Chars : String;
Success : out Boolean);
-- Scan a gnatmake switch and act accordingly. For switches that are
-- recognized, Success is set to True. A switch that is not recognized and
-- consists of one small letter causes a fatal error exit and control does
-- not return. For all other not recognized switches, Success is set to
-- False, so that the switch may be passed to the compiler.
procedure Normalize_Compiler_Switches
(Switch_Chars : String;
......
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