-- --
-- 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- --
-- 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;
------------------------
-- --
-- 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- --
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)
Path => Arguments_Path_Name,
In_Tree => Project_Tree);
- -- If the source is not a source of a project file, check if
- -- this is allowed.
+ -- If the source is not a source of a project file, add the
+ -- recorded arguments. Check will be done later if the source
+ -- need to be compiled that the switch -x has been used.
if Arguments_Project = No_Project then
- if not External_Unit_Compilation_Allowed then
- Make_Failed ("external source (", Source_File_Name,
- ") is not part of any project; cannot be " &
- "compiled without gnatmake switch -x");
- end if;
-
- -- If it is allowed, simply add the saved gcc switches
-
Add_Arguments (The_Saved_Gcc_Switches.all);
- else
+ elsif not Project_Tree.Projects.Table
+ (Arguments_Project).Externally_Built
+ then
-- We get the project directory for the relative path
-- switches and arguments.
begin
if Is_Predefined_File_Name (Fname, False) then
if Check_Readonly_Files then
+ Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) :=
+ Comp_Args (Comp_Args'First + 1 .. Comp_Last);
Comp_Last := Comp_Last + 1;
- Comp_Args (Comp_Last) := GNAT_Flag;
+ Comp_Args (Comp_Args'First + 1) := GNAT_Flag;
else
Make_Failed
elsif not Check_Readonly_Files
and then Full_Lib_File /= No_File
- and then Is_Internal_File_Name (Source_File)
+ and then Is_Internal_File_Name (Source_File, False)
then
if Force_Compilations then
Fail
else
Arguments_Collected := False;
- -- Don't waste any time if we have to recompile anyway
+ -- Do nothing if project of source is externally built
- Obj_Stamp := Empty_Time_Stamp;
- Need_To_Compile := Force_Compilations;
+ Collect_Arguments (Source_File, Source_Index, Args);
- if not Force_Compilations then
- Read_Only :=
- Full_Lib_File /= No_File
- and then not Check_Readonly_Files
- and then Is_Readonly_Library (Full_Lib_File);
- Check (Source_File, Source_Index, Args, Lib_File,
- Read_Only, ALI, Obj_File, Obj_Stamp);
- Need_To_Compile := (ALI = No_ALI_Id);
- end if;
-
- if not Need_To_Compile then
+ if Arguments_Project = No_Project
+ or else not Project_Tree.Projects.Table
+ (Arguments_Project).Externally_Built
+ then
+ -- Don't waste any time if we have to recompile anyway
+
+ Obj_Stamp := Empty_Time_Stamp;
+ Need_To_Compile := Force_Compilations;
+
+ if not Force_Compilations then
+ Read_Only :=
+ Full_Lib_File /= No_File
+ and then not Check_Readonly_Files
+ and then Is_Readonly_Library (Full_Lib_File);
+ Check (Source_File, Source_Index, Args, Lib_File,
+ Read_Only, ALI, Obj_File, Obj_Stamp);
+ Need_To_Compile := (ALI = No_ALI_Id);
+ end if;
- -- The ALI file is up-to-date. Record its Id
+ if not Need_To_Compile then
+ -- The ALI file is up-to-date. Record its Id
- Record_Good_ALI (ALI);
+ Record_Good_ALI (ALI);
- -- Record the time stamp of the most recent object file
- -- as long as no (re)compilations are needed.
+ -- Record the time stamp of the most recent object
+ -- file as long as no (re)compilations are needed.
- if First_Compiled_File = No_File
- and then (Most_Recent_Obj_File = No_File
- or else Obj_Stamp > Most_Recent_Obj_Stamp)
- then
- Most_Recent_Obj_File := Obj_File;
- Most_Recent_Obj_Stamp := Obj_Stamp;
- end if;
+ if First_Compiled_File = No_File
+ and then (Most_Recent_Obj_File = No_File
+ or else Obj_Stamp > Most_Recent_Obj_Stamp)
+ then
+ Most_Recent_Obj_File := Obj_File;
+ Most_Recent_Obj_Stamp := Obj_Stamp;
+ end if;
- else
- -- Do nothing if project of source is externally built
+ else
+ -- Check that switch -x has been used if a source
+ -- outside of project files need to be compiled.
- if not Arguments_Collected then
- Collect_Arguments (Source_File, Source_Index, Args);
- end if;
+ if Main_Project /= No_Project and then
+ Arguments_Project = No_Project and then
+ not External_Unit_Compilation_Allowed
+ then
+ Make_Failed ("external source (",
+ Get_Name_String (Source_File),
+ ") is not part of any project;"
+ & " cannot be compiled without" &
+ " gnatmake switch -x");
+ end if;
- if Arguments_Project = No_Project
- or else not Project_Tree.Projects.Table
- (Arguments_Project).Externally_Built
- then
-- Is this the first file we have to compile?
if First_Compiled_File = No_File then
Debug_Msg ("Skipping marked file:", Sfile);
elsif not Check_Readonly_Files
- and then Is_Internal_File_Name (Sfile)
+ and then Is_Internal_File_Name (Sfile, False)
then
Debug_Msg ("Skipping internal file:", Sfile);
and then
Project_Tree.Projects.Table
(ALI_Project).Extended_By = No_Project
- and then
- Project_Tree.Projects.Table
- (ALI_Project).Extends = No_Project
+ and then
+ Project_Tree.Projects.Table
+ (ALI_Project).Extends = No_Project
then
- -- First line is the unit name
-
- Get_Name_String (ALI_Unit);
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := ASCII.LF;
- Bytes :=
- Write
- (Mapping_FD,
- Name_Buffer (1)'Address,
- Name_Len);
- OK := Bytes = Name_Len;
-
- exit when not OK;
-
- -- Second line it the ALI file name
-
- Get_Name_String (ALI_Name);
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := ASCII.LF;
- Bytes :=
- Write
- (Mapping_FD,
- Name_Buffer (1)'Address,
- Name_Len);
- OK := Bytes = Name_Len;
-
- exit when not OK;
-
- -- Third line it the ALI path name, concatenation
- -- of either the library directory or the object
- -- directory with the ALI file name.
+ -- First check if the ALI file exists. If it does not,
+ -- do not put the unit in the mapping file.
declare
ALI : constant String :=
Get_Name_String (ALI_Name);
PD : Project_Data renames
- Project_Tree.Projects.Table (ALI_Project);
+ Project_Tree.Projects.Table (ALI_Project);
begin
-- For library projects, use the library directory,
Name_Len :=
Name_Len + ALI'Length + 1;
Name_Buffer (Name_Len) := ASCII.LF;
- Bytes :=
- Write
- (Mapping_FD,
- Name_Buffer (1)'Address,
- Name_Len);
- OK := Bytes = Name_Len;
- end;
- -- If OK is False, it means we were unable
- -- to write a line. No point in continuing
- -- with the other units.
+ declare
+ ALI_Path_Name : constant String :=
+ Name_Buffer (1 .. Name_Len);
- exit when not OK;
+ begin
+ if Is_Regular_File
+ (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
+ then
+
+ -- First line is the unit name
+
+ Get_Name_String (ALI_Unit);
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := ASCII.LF;
+ Bytes :=
+ Write
+ (Mapping_FD,
+ Name_Buffer (1)'Address,
+ Name_Len);
+ OK := Bytes = Name_Len;
+
+ exit when not OK;
+
+ -- Second line it the ALI file name
+
+ Get_Name_String (ALI_Name);
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := ASCII.LF;
+ Bytes :=
+ Write
+ (Mapping_FD,
+ Name_Buffer (1)'Address,
+ Name_Len);
+ OK := Bytes = Name_Len;
+
+ exit when not OK;
+
+ -- Third line it the ALI path name.
+
+ Bytes :=
+ Write
+ (Mapping_FD,
+ ALI_Path_Name (1)'Address,
+ ALI_Path_Name'Length);
+ OK := Bytes = ALI_Path_Name'Length;
+
+ -- If OK is False, it means we were unable
+ -- to write a line. No point in continuing
+ -- with the other units.
+
+ exit when not OK;
+ end if;
+ end;
+ end;
end if;
end if;
end;
Mains.Delete;
-- Add the directory where gnatmake is invoked in front of the
- -- path, if gnatmake is invoked with directory information.
- -- Only do this if the platform is not VMS, where the notion of path
- -- does not really exist.
+ -- path, if gnatmake is invoked from a bin directory or with directory
+ -- information. Only do this if the platform is not VMS, where the
+ -- notion of path does not really exist.
if not OpenVMS then
declare
+ Prefix : constant String := Executable_Prefix_Path;
Command : constant String := Command_Name;
begin
- for Index in reverse Command'Range loop
- if Command (Index) = Directory_Separator then
- declare
- Absolute_Dir : constant String :=
- Normalize_Pathname
- (Command (Command'First .. Index));
-
- PATH : constant String :=
- Absolute_Dir &
- Path_Separator &
- Getenv ("PATH").all;
+ if Prefix'Length > 0 then
+ declare
+ PATH : constant String :=
+ Prefix & Directory_Separator & "bin" &
+ Path_Separator &
+ Getenv ("PATH").all;
+ begin
+ Setenv ("PATH", PATH);
+ end;
- begin
- Setenv ("PATH", PATH);
- end;
+ else
+ for Index in reverse Command'Range loop
+ if Command (Index) = Directory_Separator then
+ declare
+ Absolute_Dir : constant String :=
+ Normalize_Pathname
+ (Command (Command'First .. Index));
+ PATH : constant String :=
+ Absolute_Dir &
+ Path_Separator &
+ Getenv ("PATH").all;
+ begin
+ Setenv ("PATH", PATH);
+ end;
- exit;
- end if;
- end loop;
+ exit;
+ end if;
+ end loop;
+ end if;
end;
end if;
-- in its object directory. If it is not, return False, so that
-- the ALI file will not be skipped.
- -- If the source is not in an extending project, we fall back to
- -- the general case and return True at the end of the function.
-
- if Project /= No_Project
- and then Project_Tree.Projects.Table
- (Project).Extends /= No_Project
- then
+ if Project /= No_Project then
Data := Project_Tree.Projects.Table (Project);
declare
-------------------
procedure Scan_Make_Arg (Argv : String; And_Save : Boolean) is
+ Success : Boolean;
+
begin
pragma Assert (Argv'First = 1);
end if;
else
- Make_Failed ("unknown switch: ", Argv);
+ Scan_Make_Switches (Argv, Success);
end if;
-- If we have seen a regular switch process it
if Argv'Length = 1 then
Make_Failed ("switch character cannot be followed by a blank");
+ -- Incorrect switches that should start with "--"
+
+ elsif (Argv'Length > 5 and then Argv (1 .. 5) = "-RTS=")
+ or else (Argv'Length > 5 and then Argv (1 .. 5) = "-GCC=")
+ or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATLINK=")
+ or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATBIND=")
+ then
+ Make_Failed ("option ", Argv, " should start with '--'");
+
-- -I-
elsif Argv (2 .. Argv'Last) = "I-" then
"project file");
else
- Scan_Make_Switches (Argv);
+ Scan_Make_Switches (Argv, Success);
end if;
-- -d
"project file");
else
- Scan_Make_Switches (Argv);
+ Scan_Make_Switches (Argv, Success);
end if;
-- -j (need to save the result)
elsif Argv (2) = 'j' then
- Scan_Make_Switches (Argv);
+ Scan_Make_Switches (Argv, Success);
if And_Save then
Saved_Maximum_Processes := Maximum_Processes;
Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Binder, And_Save => And_Save);
- -- By default all switches with more than one character or one
- -- character switches are passed to the compiler with the
- -- exception of those tested below, which belong to make.
-
- elsif Argv (2) /= 'd'
- and then Argv (2) /= 'e'
- and then Argv (2 .. Argv'Last) /= "B"
- and then Argv (2 .. Argv'Last) /= "C"
- and then Argv (2 .. Argv'Last) /= "F"
- and then Argv (2 .. Argv'Last) /= "M"
- and then Argv (2 .. Argv'Last) /= "R"
- and then Argv (2 .. Argv'Last) /= "S"
- and then Argv (2 .. Argv'Last) /= "vl"
- and then Argv (2 .. Argv'Last) /= "vm"
- and then Argv (2 .. Argv'Last) /= "vh"
- and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z')
- then
- Add_Switch (Argv, Compiler, And_Save => And_Save);
-
- -- All other options are handled by Scan_Make_Switches
+ -- All other switches are processed by Scan_Make_Switches.
+ -- If the call returns with Success = False, then the switch is
+ -- passed to the compiler.
else
- Scan_Make_Switches (Argv);
+ Scan_Make_Switches (Argv, Success);
+
+ if not Success then
+ Add_Switch (Argv, Compiler, And_Save => And_Save);
+ end if;
end if;
-- If not a switch it must be a file name
with Csets;
with Gnatvsn;
+with Hostparm; use Hostparm;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Dynamic_Tables;
package body Makegpr is
+ On_Windows : constant Boolean := Directory_Separator = '\';
+ -- True when on Windows. Used in Check_Compilation_Needed when processing
+ -- C/C++ dependency files for backslash handling.
+
Max_In_Archives : constant := 50;
-- The maximum number of arguments for a single invocation of the
-- Archive Indexer (ar).
Start : Natural;
Finish : Natural;
+ Looping : Boolean := False;
+ -- Set to True at the end of the first Big_Loop
+
begin
-- Assume the worst, so that statement "return;" may be used if there
-- is any problem.
return;
end if;
- declare
- End_Of_File_Reached : Boolean := False;
+ -- Loop Big_Loop is executed several times only when the dependency file
+ -- contains several times
+ -- <object file>: <source1> ...
+ -- When there is only one of such occurence, Big_Loop is exited
+ -- successfully at the beginning of the second loop.
- begin
- loop
- if End_Of_File (Dep_File) then
- End_Of_File_Reached := True;
- exit;
- end if;
+ Big_Loop :
+ loop
+ declare
+ End_Of_File_Reached : Boolean := False;
- Get_Line (Dep_File, Name_Buffer, Name_Len);
+ begin
+ loop
+ if End_Of_File (Dep_File) then
+ End_Of_File_Reached := True;
+ exit;
+ end if;
- exit when Name_Len > 0 and then Name_Buffer (1) /= '#';
- end loop;
+ Get_Line (Dep_File, Name_Buffer, Name_Len);
+
+ exit when Name_Len > 0 and then Name_Buffer (1) /= '#';
+ end loop;
- -- If dependency file contains only empty lines or comments, then
- -- dependencies are unknown, and the source needs to be recompiled.
+ -- If dependency file contains only empty lines or comments, then
+ -- dependencies are unknown, and the source needs to be
+ -- recompiled.
- if End_Of_File_Reached then
+ if End_Of_File_Reached then
+ -- If we have reached the end of file after the first loop,
+ -- there is nothing else to do.
+
+ exit Big_Loop when Looping;
+
+ if Verbose_Mode then
+ Write_Str (" -> dependency file ");
+ Write_Str (Dep_Name);
+ Write_Line (" is empty");
+ end if;
+
+ Close (Dep_File);
+ return;
+ end if;
+ end;
+
+ Start := 1;
+ Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
+
+ -- First line must start with name of object file, followed by colon
+
+ if Finish = 0 or else
+ Name_Buffer (1 .. Finish - 1) /= Object_Name
+ then
if Verbose_Mode then
Write_Str (" -> dependency file ");
Write_Str (Dep_Name);
- Write_Line (" is empty");
+ Write_Line (" has wrong format");
end if;
Close (Dep_File);
return;
- end if;
- end;
- Start := 1;
- Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
-
- -- First line must start with name of object file, followed by colon
-
- if Finish = 0 or else Name_Buffer (1 .. Finish - 1) /= Object_Name then
- if Verbose_Mode then
- Write_Str (" -> dependency file ");
- Write_Str (Dep_Name);
- Write_Line (" has wrong format");
- end if;
-
- Close (Dep_File);
- return;
+ else
+ Start := Finish + 2;
- else
- Start := Finish + 2;
+ -- Process each line
- -- Process each line
+ Line_Loop : loop
+ declare
+ Line : String := Name_Buffer (1 .. Name_Len);
+ Last : Natural := Name_Len;
- Line_Loop : loop
- declare
- Line : String := Name_Buffer (1 .. Name_Len);
- Last : Natural := Name_Len;
+ begin
+ Name_Loop : loop
- begin
- Name_Loop : loop
+ -- Find the beginning of the next source path name
- -- Find the beginning of the next source path name
+ while Start < Last and then Line (Start) = ' ' loop
+ Start := Start + 1;
+ end loop;
- while Start < Last and then Line (Start) = ' ' loop
- Start := Start + 1;
- end loop;
+ -- Go to next line when there is a continuation character
+ -- \ at the end of the line.
- -- Go to next line when there is a continuation character \
- -- at the end of the line.
+ exit Name_Loop when Start = Last
+ and then Line (Start) = '\';
- exit Name_Loop when Start = Last
- and then Line (Start) = '\';
+ -- We should not be at the end of the line, without
+ -- a continuation character \.
- -- We should not be at the end of the line, without
- -- a continuation character \.
+ if Start = Last then
+ if Verbose_Mode then
+ Write_Str (" -> dependency file ");
+ Write_Str (Dep_Name);
+ Write_Line (" has wrong format");
+ end if;
- if Start = Last then
- if Verbose_Mode then
- Write_Str (" -> dependency file ");
- Write_Str (Dep_Name);
- Write_Line (" has wrong format");
+ Close (Dep_File);
+ return;
end if;
- Close (Dep_File);
- return;
- end if;
-
- -- Look for the end of the source path name
-
- Finish := Start;
- while Finish < Last loop
- if Line (Finish) = '\' then
-
- -- When we are getting a '\' that is not the last
- -- character of the line, the next character is part
- -- of the path name, even if it is a space.
+ -- Look for the end of the source path name
+
+ Finish := Start;
+ while Finish < Last loop
+ if Line (Finish) = '\' then
+
+ -- On Windows, a '\' is part of the path name,
+ -- except when it is followed by another '\' or by
+ -- a space. On other platforms, when we are getting
+ -- a '\' that is not the last character of the
+ -- line, the next character is part of the path
+ -- name, even if it is a space.
+
+ if On_Windows and then
+ Line (Finish + 1) /= '\' and then
+ Line (Finish + 1) /= ' '
+ then
+ Finish := Finish + 1;
+
+ else
+ Line (Finish .. Last - 1) :=
+ Line (Finish + 1 .. Last);
+ Last := Last - 1;
+ end if;
- Line (Finish .. Last - 1) := Line (Finish + 1 .. Last);
- Last := Last - 1;
+ else
+ -- A space that is not preceded by '\' indicates
+ -- the end of the path name.
- else
- -- A space that is not preceded by '\' indicates the
- -- end of the path name.
+ exit when Line (Finish + 1) = ' ';
- exit when Line (Finish + 1) = ' ';
+ Finish := Finish + 1;
+ end if;
+ end loop;
- Finish := Finish + 1;
- end if;
- end loop;
+ -- Check this source
- -- Check this source
+ declare
+ Src_Name : constant String :=
+ Normalize_Pathname
+ (Name =>
+ Line (Start .. Finish),
+ Resolve_Links => False,
+ Case_Sensitive => False);
+ Src_TS : Time_Stamp_Type;
- declare
- Src_Name : constant String :=
- Normalize_Pathname
- (Name => Line (Start .. Finish),
- Resolve_Links => False,
- Case_Sensitive => False);
- Src_TS : Time_Stamp_Type;
+ begin
+ -- If it is original source, set
+ -- Source_In_Dependencies.
- begin
- -- If it is original source, set Source_In_Dependencies
+ if Src_Name = Source_Path then
+ Source_In_Dependencies := True;
+ end if;
- if Src_Name = Source_Path then
- Source_In_Dependencies := True;
- end if;
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Src_Name);
+ Src_TS := File_Stamp (Name_Find);
- Name_Len := 0;
- Add_Str_To_Name_Buffer (Src_Name);
- Src_TS := File_Stamp (Name_Find);
+ -- If the source does not exist, we need to recompile
- -- If the source does not exist, we need to recompile
+ if Src_TS = Empty_Time_Stamp then
+ if Verbose_Mode then
+ Write_Str (" -> source ");
+ Write_Str (Src_Name);
+ Write_Line (" does not exist");
+ end if;
- if Src_TS = Empty_Time_Stamp then
- if Verbose_Mode then
- Write_Str (" -> source ");
- Write_Str (Src_Name);
- Write_Line (" does not exist");
- end if;
+ Close (Dep_File);
+ return;
- Close (Dep_File);
- return;
+ -- If the source has been modified after the object
+ -- file, we need to recompile.
- -- If the source has been modified after the object file,
- -- we need to recompile.
+ elsif Src_TS > Source.Object_TS then
+ if Verbose_Mode then
+ Write_Str (" -> source ");
+ Write_Str (Src_Name);
+ Write_Line
+ (" has time stamp later than object file");
+ end if;
- elsif Src_TS > Source.Object_TS then
- if Verbose_Mode then
- Write_Str (" -> source ");
- Write_Str (Src_Name);
- Write_Line
- (" has time stamp later than object file");
+ Close (Dep_File);
+ return;
end if;
+ end;
- Close (Dep_File);
- return;
- end if;
- end;
+ -- If the source path name ends the line, we are done
- -- If the source path name ends the line, we are done
+ exit Line_Loop when Finish = Last;
- exit Line_Loop when Finish = Last;
+ -- Go get the next source on the line
- -- Go get the next source on the line
+ Start := Finish + 1;
+ end loop Name_Loop;
+ end;
- Start := Finish + 1;
- end loop Name_Loop;
- end;
+ -- If we are here, we had a continuation character \ at the end
+ -- of the line, so we continue with the next line.
- -- If we are here, we had a continuation character \ at the end
- -- of the line, so we continue with the next line.
+ Get_Line (Dep_File, Name_Buffer, Name_Len);
+ Start := 1;
+ end loop Line_Loop;
+ end if;
- Get_Line (Dep_File, Name_Buffer, Name_Len);
- Start := 1;
- end loop Line_Loop;
- end if;
+ -- Set Looping at the end of the first loop
+ Looping := True;
+ end loop Big_Loop;
Close (Dep_File);
Prj.Initialize (Project_Tree);
Mains.Delete;
+ -- Add the directory where gprmake is invoked in front of the path,
+ -- if gprmake is invoked from a bin directory or with directory
+ -- information. information. Only do this if the platform is not VMS,
+ -- where the notion of path does not really exist.
+
+ -- Below code shares nasty code duplication with make.adb code???
+
+ if not OpenVMS then
+ declare
+ Prefix : constant String := Executable_Prefix_Path;
+ Command : constant String := Command_Name;
+
+ begin
+ if Prefix'Length > 0 then
+ declare
+ PATH : constant String :=
+ Prefix & Directory_Separator & "bin" &
+ Path_Separator &
+ Getenv ("PATH").all;
+ begin
+ Setenv ("PATH", PATH);
+ end;
+
+ else
+ for Index in reverse Command'Range loop
+ if Command (Index) = Directory_Separator then
+ declare
+ Absolute_Dir : constant String :=
+ Normalize_Pathname
+ (Command (Command'First .. Index));
+ PATH : constant String :=
+ Absolute_Dir &
+ Path_Separator &
+ Getenv ("PATH").all;
+ begin
+ Setenv ("PATH", PATH);
+ end;
+
+ exit;
+ end if;
+ end loop;
+ end if;
+ end;
+ end if;
+
-- Set Name_Ide and Name_Compiler_Command
Name_Len := 0;
Project_File_Name := new String'(Arg (3 .. Arg'Last));
end if;
+ elsif Arg = "-p" or else Arg = "--create-missing-dirs" then
+ Setup_Projects := True;
+
elsif Arg = "-q" then
Quiet_Output := True;
Write_Str ("Usage: ");
Osint.Write_Program_Name;
Write_Str (" -P<project file> [opts] [name] {");
-
- for Lang in First_Language_Indexes loop
- Write_Str ("[-cargs:lang opts] ");
- end loop;
-
+ Write_Str ("[-cargs:lang opts] ");
Write_Str ("[-largs opts] [-gargs opts]}");
Write_Eol;
Write_Eol;
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");
"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");
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");
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");
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 " &
-- --
------------------------------------------------------------------------------
+with Ada.Command_Line; use Ada.Command_Line;
+
with Namet; use Namet;
with Osint; use Osint;
with Prj.Ext;
with Snames; use Snames;
with Table;
+with System.Case_Util; use System.Case_Util;
with System.HTable;
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 --
----------
-- --
-- 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- --
-- 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
--
-- 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.
-- 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;
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",
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;
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",
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;
-------------------------------
(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 ("""");
C := Switch_Chars (Ptr);
Ptr := Ptr + 1;
- -- 'w' should be skipped in -gnatw
+ -- -gnatyMxxx
- if C /= 'w' or else Storing (First_Stored) /= 'w' then
-
- -- -gnatyMxxx
-
- if C = 'M'
- and then Storing (First_Stored) = 'y' then
- Last_Stored := First_Stored + 1;
- Storing (Last_Stored) := 'M';
-
- while Ptr <= Max loop
- C := Switch_Chars (Ptr);
- exit when C not in '0' .. '9';
- Last_Stored := Last_Stored + 1;
- Storing (Last_Stored) := C;
- Ptr := Ptr + 1;
- end loop;
-
- -- If there is no digit after -gnatyM,
- -- the switch is invalid.
+ if C = 'M' and then
+ Storing (First_Stored) = 'y'
+ then
+ Last_Stored := First_Stored + 1;
+ Storing (Last_Stored) := 'M';
- if Last_Stored = First_Stored + 1 then
- Last := 0;
- return;
+ while Ptr <= Max loop
+ C := Switch_Chars (Ptr);
+ exit when C not in '0' .. '9';
+ Last_Stored := Last_Stored + 1;
+ Storing (Last_Stored) := C;
+ Ptr := Ptr + 1;
+ end loop;
- else
- Add_Switch_Component
- (Storing (Storing'First .. Last_Stored));
- end if;
+ -- If there is no digit after -gnatyM,
+ -- the switch is invalid.
- -- All other switches are -gnatxx
+ if Last_Stored = First_Stored + 1 then
+ Last := 0;
+ return;
else
- Storing (First_Stored + 1) := C;
Add_Switch_Component
- (Storing (Storing'First .. First_Stored + 1));
+ (Storing (Storing'First .. Last_Stored));
end if;
+
+ -- All other switches are -gnatxx
+
+ else
+ Storing (First_Stored + 1) := C;
+ Add_Switch_Component
+ (Storing (Storing'First .. First_Stored + 1));
end if;
end loop;
-- Scan_Make_Switches --
------------------------
- procedure Scan_Make_Switches (Switch_Chars : String) is
+ procedure Scan_Make_Switches
+ (Switch_Chars : String;
+ Success : out Boolean)
+ is
Ptr : Integer := Switch_Chars'First;
Max : constant Integer := Switch_Chars'Last;
C : Character := ' ';
begin
+ -- Assume a good switch
+
+ Success := True;
+
-- Skip past the initial character (must be the switch character)
if Ptr = Max then
Ptr := Ptr + 1;
end if;
- -- A little check, "gnat" at the start of a switch is not allowed
- -- except for the compiler (where it was already removed)
+ -- A little check, "gnat" at the start of a switch is for the compiler
if Switch_Chars'Length >= Ptr + 3
and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
then
- Osint.Fail
- ("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
+ Success := False;
+ return;
end if;
- -- Loop to scan through switches given in switch string
-
- Check_Switch : begin
- C := Switch_Chars (Ptr);
-
- -- Processing for a switch
-
- case C is
-
- when 'a' =>
- Ptr := Ptr + 1;
- Check_Readonly_Files := True;
-
- -- Processing for b switch
-
- when 'b' =>
- Ptr := Ptr + 1;
- Bind_Only := True;
- Make_Steps := True;
-
- -- Processing for B switch
+ C := Switch_Chars (Ptr);
- when 'B' =>
- Ptr := Ptr + 1;
- Build_Bind_And_Link_Full_Project := True;
-
- -- Processing for c switch
-
- when 'c' =>
- Ptr := Ptr + 1;
- Compile_Only := True;
- Make_Steps := True;
+ -- Multiple character switches
- -- Processing for C switch
+ if Switch_Chars'Length > 2 then
+ if Switch_Chars = "--create-missing-dirs" then
+ Setup_Projects := True;
- when 'C' =>
+ elsif C = 'v' and then Switch_Chars'Length = 3 then
Ptr := Ptr + 1;
- Create_Mapping_File := True;
-
- -- Processing for D switch
+ Verbose_Mode := True;
- when 'D' =>
- Ptr := Ptr + 1;
+ case Switch_Chars (Ptr) is
+ when 'l' =>
+ Verbosity_Level := Opt.Low;
- if Object_Directory_Present then
- Osint.Fail ("duplicate -D switch");
+ when 'm' =>
+ Verbosity_Level := Opt.Medium;
- else
- Object_Directory_Present := True;
- end if;
+ when 'h' =>
+ Verbosity_Level := Opt.High;
- -- Processing for d switch
+ when others =>
+ Success := False;
+ end case;
- when 'd' =>
+ elsif C = 'd' then
-- Note: for the debug switch, the remaining characters in this
-- switch field must all be debug flags, since all valid switch
end if;
end loop;
- return;
-
- -- Processing for e switch
-
- when 'e' =>
+ elsif C = 'e' then
Ptr := Ptr + 1;
- if Ptr > Max then
- Bad_Switch (Switch_Chars);
- end if;
-
case Switch_Chars (Ptr) is
-- Processing for eI switch
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C);
+ if Ptr <= Max then
+ Bad_Switch (Switch_Chars);
+ end if;
+
-- Processing for eL switch
when 'L' =>
- Ptr := Ptr + 1;
- Follow_Links := True;
+ if Ptr /= Max then
+ Bad_Switch (Switch_Chars);
+
+ else
+ Follow_Links := True;
+ end if;
+
+ -- Processing for eS switch
+
+ when 'S' =>
+ if Ptr /= Max then
+ Bad_Switch (Switch_Chars);
+
+ else
+ Commands_To_Stdout := True;
+ end if;
when others =>
Bad_Switch (Switch_Chars);
end case;
- -- Processing for f switch
-
- when 'f' =>
+ elsif C = 'j' then
Ptr := Ptr + 1;
- Force_Compilations := True;
- -- Processing for F switch
+ declare
+ Max_Proc : Pos;
+ begin
+ Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C);
- when 'F' =>
- Ptr := Ptr + 1;
- Full_Path_Name_For_Brief_Errors := True;
+ if Ptr <= Max then
+ Bad_Switch (Switch_Chars);
- -- Processing for h switch
+ else
+ Maximum_Processes := Positive (Max_Proc);
+ end if;
+ end;
- when 'h' =>
+ elsif C = 'w' and then Switch_Chars'Length = 3 then
Ptr := Ptr + 1;
- Usage_Requested := True;
- -- Processing for i switch
+ if Switch_Chars = "-we" then
+ Warning_Mode := Treat_As_Error;
- when 'i' =>
- Ptr := Ptr + 1;
- In_Place_Mode := True;
+ elsif Switch_Chars = "-wn" then
+ Warning_Mode := Normal;
- -- Processing for j switch
+ elsif Switch_Chars = "-ws" then
+ Warning_Mode := Suppress;
- when 'j' =>
- if Ptr = Max then
- Bad_Switch (Switch_Chars);
+ else
+ Success := False;
end if;
- Ptr := Ptr + 1;
+ else
+ Success := False;
+ end if;
- declare
- Max_Proc : Pos;
- begin
- Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C);
- Maximum_Processes := Positive (Max_Proc);
- end;
+ -- Single-character switches
- -- Processing for k switch
+ else
+ Check_Switch : begin
- when 'k' =>
- Ptr := Ptr + 1;
- Keep_Going := True;
+ case C is
- -- Processing for l switch
+ when 'a' =>
+ Check_Readonly_Files := True;
- when 'l' =>
- Ptr := Ptr + 1;
- Link_Only := True;
- Make_Steps := True;
+ -- Processing for b switch
- when 'M' =>
- Ptr := Ptr + 1;
- List_Dependencies := True;
+ when 'b' =>
+ Bind_Only := True;
+ Make_Steps := True;
- -- Processing for n switch
+ -- Processing for B switch
- when 'n' =>
- Ptr := Ptr + 1;
- Do_Not_Execute := True;
+ when 'B' =>
+ Build_Bind_And_Link_Full_Project := True;
- -- Processing for o switch
+ -- Processing for c switch
- when 'o' =>
- Ptr := Ptr + 1;
+ when 'c' =>
+ Compile_Only := True;
+ Make_Steps := True;
- if Output_File_Name_Present then
- Osint.Fail ("duplicate -o switch");
- else
- Output_File_Name_Present := True;
- end if;
+ -- Processing for C switch
- -- Processing for q switch
+ when 'C' =>
+ Create_Mapping_File := True;
- when 'q' =>
- Ptr := Ptr + 1;
- Quiet_Output := True;
+ -- Processing for D switch
- -- Processing for R switch
+ when 'D' =>
+ if Object_Directory_Present then
+ Osint.Fail ("duplicate -D switch");
- when 'R' =>
- Ptr := Ptr + 1;
- Run_Path_Option := False;
+ else
+ Object_Directory_Present := True;
+ end if;
- -- Processing for s switch
+ -- Processing for f switch
- when 's' =>
- Ptr := Ptr + 1;
- Check_Switches := True;
+ when 'f' =>
+ Force_Compilations := True;
- -- Processing for S switch
+ -- Processing for F switch
- when 'S' =>
- Ptr := Ptr + 1;
- Commands_To_Stdout := True;
+ when 'F' =>
+ Full_Path_Name_For_Brief_Errors := True;
- -- Processing for v switch
+ -- Processing for h switch
- when 'v' =>
- Ptr := Ptr + 1;
- Verbose_Mode := True;
- Verbosity_Level := Opt.High;
+ when 'h' =>
+ Usage_Requested := True;
- if Ptr <= Max then
- case Switch_Chars (Ptr) is
- when 'l' =>
- Verbosity_Level := Opt.Low;
+ -- Processing for i switch
- when 'm' =>
- Verbosity_Level := Opt.Medium;
+ when 'i' =>
+ In_Place_Mode := True;
- when 'h' =>
- Verbosity_Level := Opt.High;
+ -- Processing for j switch
- when others =>
- Bad_Switch (Switch_Chars);
- end case;
+ when 'j' =>
+ -- -j not followed by a number is an error
- Ptr := Ptr + 1;
- end if;
+ Bad_Switch (Switch_Chars);
- -- Processing for x switch
+ -- Processing for k switch
- when 'x' =>
- Ptr := Ptr + 1;
- External_Unit_Compilation_Allowed := True;
+ when 'k' =>
+ Keep_Going := True;
- -- Processing for z switch
+ -- Processing for l switch
- when 'z' =>
- Ptr := Ptr + 1;
- No_Main_Subprogram := True;
+ when 'l' =>
+ Link_Only := True;
+ Make_Steps := True;
- -- Anything else is an error (illegal switch character)
+ -- Processing for M switch
- when others =>
- Bad_Switch (Switch_Chars);
+ when 'M' =>
+ List_Dependencies := True;
- end case;
+ -- Processing for n switch
- if Ptr <= Max then
- Bad_Switch (Switch_Chars);
- end if;
+ when 'n' =>
+ Do_Not_Execute := True;
+
+ -- Processing for o switch
+
+ when 'o' =>
+ if Output_File_Name_Present then
+ Osint.Fail ("duplicate -o switch");
+ else
+ Output_File_Name_Present := True;
+ end if;
+
+ -- Processing for p switch
+
+ when 'p' =>
+ Setup_Projects := True;
+
+ -- Processing for q switch
+
+ when 'q' =>
+ Quiet_Output := True;
+
+ -- Processing for R switch
+
+ when 'R' =>
+ Run_Path_Option := False;
- end Check_Switch;
+ -- Processing for s switch
+ when 's' =>
+ Ptr := Ptr + 1;
+ Check_Switches := True;
+
+ -- Processing for v switch
+
+ when 'v' =>
+ Verbose_Mode := True;
+ Verbosity_Level := Opt.High;
+
+ -- Processing for x switch
+
+ when 'x' =>
+ External_Unit_Compilation_Allowed := True;
+
+ -- Processing for z switch
+
+ when 'z' =>
+ No_Main_Subprogram := True;
+
+ -- Any other small letter is an illegal switch
+
+ when others =>
+ if C in 'a' .. 'z' then
+ Bad_Switch (Switch_Chars);
+
+ else
+ Success := False;
+ end if;
+
+ end case;
+ end Check_Switch;
+ end if;
end Scan_Make_Switches;
end Switch.M;
-- --
-- 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- --
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;
"-gnaty9 " &
"ATTRIBUTE " &
"-gnatya " &
+ "ARRAY_INDEXES " &
+ "-gnatyA " &
"BLANKS " &
"-gnatyb " &
"COMMENTS " &
-- underscore must be uppercase.
-- All other letters must be lowercase.
--
+ -- ARRAY_INDEXES Check indexes of array attributes.
+ -- For array attributes First, Last, Range,
+ -- or Length, the index number must be omitted
+ -- for one-dimensional arrays and is required
+ -- for multi-dimensional arrays.
+ --
-- BLANKS Blanks not allowed at statement end.
-- Trailing blanks are not allowed at the end of
-- statements. The purpose of this rule, together
-- when the only modifications to a source file consist in
-- adding/removing comments, empty lines, spaces or tabs.
+ S_Make_Missing : aliased constant S := "/CREATE_MISSING_DIRS " &
+ "-p";
+ -- /NOCREATE_MISSING_DIRS (D)
+ -- /CREATE_MISSING_DIRS
+ --
+ -- When an object directory, a library directory or an exec directory
+ -- in missing, attempt to create the directory.
+
S_Make_Nolink : aliased constant S := "/NOLINK " &
"-c";
-- /NOLINK
-- When looking for source files also look in the specified directories.
S_Make_Stand : aliased constant S := "/STANDARD_OUTPUT_FOR_COMMANDS " &
- "-S";
+ "-eS";
-- /NOSTANDARD_OUTPUT_FOR_COMMANDS (D)
-- /STANDARD_OUTPUT_FOR_COMMANDS
--
S_Make_Med_Verb'Access,
S_Make_Mess 'Access,
S_Make_Minimal 'Access,
+ S_Make_Missing 'Access,
S_Make_Nolink 'Access,
S_Make_Nomain 'Access,
S_Make_Nonpro 'Access,
-- used in the default dictionary file, are defined in the GNAT User's
-- Guide.
+ S_Pretty_Encoding : aliased constant S := "/RESULT_ENCODING=" &
+ "BRACKETS " &
+ "-Wb " &
+ "HEX_ESC " &
+ "-Wh " &
+ "UPPER_HALF " &
+ "-Wu " &
+ "SHIFT_JIS " &
+ "-Ws " &
+ "EUC " &
+ "-We " &
+ "UTF_8 " &
+ "-W8";
+ -- /RESULT_ENCODING[=encoding-option]
+ --
+ -- Specify the wide character encoding of the result file.
+ -- '=encoding-option' may be one of:
+ --
+ -- BRACKETS (D) Brackets encoding.
+ --
+ -- HEX_ESC Hex ESC encoding.
+ --
+ -- UPPER_HALF Upper half encoding.
+ --
+ -- SHIFT_JIS Shift-JIS encoding.
+ --
+ -- EUC EUC Encoding.
+ --
+ -- UTF_8 UTF-8 encoding.
+
S_Pretty_Files : aliased constant S := "/FILES=@" &
"-files=@";
-- /FILES=filename
S_Pretty_Dico 'Access,
S_Pretty_Eol 'Access,
S_Pretty_Ext 'Access,
+ S_Pretty_Encoding 'Access,
S_Pretty_Files 'Access,
S_Pretty_Forced 'Access,
S_Pretty_Formfeed 'Access,
S_Pretty_Verbose 'Access,
S_Pretty_Warnings 'Access);
- -----------------------------
- -- Switches for GNAT SETUP --
- -----------------------------
-
- S_Setup_Ext : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' &
- "-X" & '"';
- -- /EXTERNAL_REFERENCE="name=val"
- --
- -- Specifies an external reference to the project manager. Useful only if
- -- /PROJECT_FILE is used.
- --
- -- Example:
- -- /EXTERNAL_REFERENCE="DEBUG=TRUE"
-
- S_Setup_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" &
- "DEFAULT " &
- "-vP0 " &
- "MEDIUM " &
- "-vP1 " &
- "HIGH " &
- "-vP2";
- -- /MESSAGES_PROJECT_FILE[=messages-option]
- --
- -- Specifies the "verbosity" of the parsing of project files.
- -- messages-option may be one of the following:
- --
- -- DEFAULT (D) No messages are output if there is no error or warning.
- --
- -- MEDIUM A small number of messages are output.
- --
- -- HIGH A great number of messages are output, most of them not
- -- being useful for the user.
-
- S_Setup_Project : aliased constant S := "/PROJECT_FILE=<" &
- "-P>";
- -- /PROJECT_FILE=filename
- --
- -- Specifies the main project file to be used. The project files rooted
- -- at the main project file are parsed and non existing object
- -- directories, library directories and exec directories are created.
-
- S_Setup_Quiet : aliased constant S := "/QUIET " &
- "-q";
- -- /NOQUIET (D)
- -- /QUIET
- --
- -- Work quietly, only output warnings and errors.
-
- S_Setup_Verbose : aliased constant S := "/VERBOSE " &
- "-v";
- -- /NOVERBOSE (D)
- -- /VERBOSE
- --
- -- Verbose mode; GNAT PRETTY generates version information and then a
- -- trace of the actions it takes to produce or obtain the ASIS tree.
-
- Setup_Switches : aliased constant Switches :=
- (S_Setup_Ext 'Access,
- S_Setup_Mess 'Access,
- S_Setup_Project 'Access,
- S_Setup_Quiet 'Access,
- S_Setup_Verbose 'Access);
-
------------------------------
-- Switches for GNAT SHARED --
------------------------------
S_Shared_Verb 'Access,
S_Shared_ZZZZZ 'Access);
+ -----------------------------
+ -- Switches for GNAT STACK --
+ -----------------------------
+
+ S_Stack_All : aliased constant S := "/ALL_SUBPROGRAMS " &
+ "-a";
+ -- /NOALL_SUBPROGRAMS (D)
+ -- /ALL_SUBPROGRAMS
+ --
+ -- Consider all subprograms as entry points.
+
+ S_Stack_All_Cycles : aliased constant S := "/ALL_CYCLES " &
+ "-ca";
+ -- /NOALL_CYCLES (D)
+ -- /ALL_CYCLES
+ --
+ -- Extract all possible cycles in the call graph.
+
+ S_Stack_All_Prjs : aliased constant S := "/ALL_PROJECTS " &
+ "-U";
+ -- /NOALL_PROJECTS (D)
+ -- /ALL_PROJECTS
+ --
+ -- When GNAT STACK is used with a Project File and no source is
+ -- specified, the underlying tool gnatstack is called for all the
+ -- units of all the Project Files in the project tree.
+
+ S_Stack_Debug : aliased constant S := "/DEBUG " &
+ "-g";
+ -- /NODEBUG (D)
+ -- /DEBUG
+ --
+ -- Generate internal debug information.
+
+ S_Stack_Directory : aliased constant S := "/DIRECTORY=*" &
+ "-aO*";
+ -- /DIRECTORY=(direc[,...])
+ --
+ -- When looking for .ci files look also in directories specified.
+
+ S_Stack_Entries : aliased constant S := "/ENTRIES=*" &
+ "-e*";
+ --
+ -- /ENTRY=(entry_point[,...])
+ --
+ -- Name of symbol to be used as entry point for the analysis.
+
+ S_Stack_Files : aliased constant S := "/FILES=@" &
+ "-files=@";
+ -- /FILES=filename
+ --
+ -- Take as arguments the files that are listed in the specified
+ -- text file.
+
+ S_Stack_Help : aliased constant S := "/HELP " &
+ "-h";
+ -- /NOHELP (D)
+ -- /HELP
+ --
+ -- Output a message explaining the usage of gnatstack.
+
+ S_Stack_List : aliased constant S := "/LIST=#" &
+ "-l#";
+ -- /LIST=nnn
+ --
+ -- Print the nnn subprograms requiring the biggest local stack usage. By
+ -- default none will be displayed.
+
+ S_Stack_Order : aliased constant S := "/ORDER=" &
+ "STACK " &
+ "-os " &
+ "ALPHABETICAL " &
+ "-oa";
+ -- /ORDER[=order-option]
+ --
+ -- Specifies the order for displaying the different call graphs.
+ -- order-option may be one of the following:
+ --
+ -- STACK (D) Select stack usage order
+ --
+ -- ALPHABETICAL Select alphabetical order
+
+ S_Stack_Path : aliased constant S := "/PATH " &
+ "-p";
+ -- /NOPATH (D)
+ -- /PATH
+ --
+ -- Print all the subprograms that make up the worst-case path for every
+ -- entry point.
+
+ S_Stack_Project : aliased constant S := "/PROJECT_FILE=<" &
+ "-P>";
+ -- /PROJECT_FILE=filename
+ --
+ -- Specifies the main project file to be used. The project files rooted
+ -- at the main project file will be parsed before the invocation of
+ -- gnatstack.
+
+ S_Stack_Output : aliased constant S := "/OUTPUT=@" &
+ "-f@";
+ -- /OUTPUT=filename
+ --
+ -- Name of the file containing the generated graph (VCG format).
+
+ S_Stack_Regexp : aliased constant S := "/EXPRESSION=|" &
+ "-r|";
+ --
+ -- /EXPRESSION=regular-expression
+ --
+ -- Any symbol matching the regular expression will be considered as a
+ -- potential entry point for the analysis.
+
+ S_Stack_Unbounded : aliased constant S := "/UNBOUNDED=#" &
+ "-d#";
+ -- /UNBOUNDED=nnn
+ --
+ -- Default stack size to be used for unbounded (dynamic) frames.
+
+ S_Stack_Unknown : aliased constant S := "/UNKNOWN=#" &
+ "-u#";
+ -- /UNKNOWN=nnn
+ --
+ -- Default stack size to be used for unknown (external) calls.
+
+ S_Stack_Verbose : aliased constant S := "/VERBOSE " &
+ "-v";
+ -- /NOVERBOSE (D)
+ -- /VERBOSE
+ --
+ -- Specifies the amount of information to be displayed about the
+ -- different subprograms. In verbose mode the full location of the
+ -- subprogram will be part of the output, as well as detailed information
+ -- about inaccurate data.
+
+ S_Stack_Warnings : aliased constant S := "/WARNINGS=" &
+ "ALL " &
+ "-Wa " &
+ "CYCLES " &
+ "-Wc " &
+ "UNBOUNDED " &
+ "-Wu " &
+ "EXTERNAL " &
+ "-We " &
+ "INDIRECT " &
+ "-Wi";
+ -- /WARNINGS[=(keyword[,...])]
+ --
+ -- The following keywords are supported:
+ --
+ -- ALL Turn on all optional warnings
+ --
+ -- CYCLES Turn on warnings for cycles
+ --
+ -- UNBOUNDED Turn on warnings for unbounded frames
+ --
+ -- EXTERNAL Turn on warnings for external calls
+ --
+ -- INDIRECT Turn on warnings for indirect calls
+
+ Stack_Switches : aliased constant Switches :=
+ (S_Stack_All 'Access,
+ S_Stack_All_Cycles 'Access,
+ S_Stack_All_Prjs 'Access,
+ S_Stack_Debug 'Access,
+ S_Stack_Directory 'Access,
+ S_Stack_Entries 'Access,
+ S_Stack_Files 'Access,
+ S_Stack_Help 'Access,
+ S_Stack_List 'Access,
+ S_Stack_Order 'Access,
+ S_Stack_Path 'Access,
+ S_Stack_Project 'Access,
+ S_Stack_Output 'Access,
+ S_Stack_Regexp 'Access,
+ S_Stack_Unbounded 'Access,
+ S_Stack_Unknown 'Access,
+ S_Stack_Verbose 'Access,
+ S_Stack_Warnings 'Access);
+
----------------------------
-- Switches for GNAT STUB --
----------------------------
OSDN Git Service
