aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/gnatcmd.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2004-06-25 18:39:33 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2004-06-25 18:39:33 +0200
commit0da2c8ac77a61f9149fcbf3da36f7656aff96a4c (patch)
tree7773949d835bb70e525203ff86961e0f04f2c02c /gcc/ada/gnatcmd.adb
parent29357d8b9417cf74ce10fc868e4774d4c77d6889 (diff)
downloadgcc-0da2c8ac77a61f9149fcbf3da36f7656aff96a4c.zip
gcc-0da2c8ac77a61f9149fcbf3da36f7656aff96a4c.tar.gz
gcc-0da2c8ac77a61f9149fcbf3da36f7656aff96a4c.tar.bz2
revert: [multiple changes]
2004-06-25 Pascal Obry <obry@gnat.com> * makegpr.adb (Build_Library): Remove parameter Lib_Address and Relocatable from Build_Dynamic_Library call. * gnat_ugn.texi: Change documentation about Library_Kind. Dynamic and Relocatable are now synonym. * Makefile.in: Use s-parame-mingw.adb on MingW platform. * mlib-prj.adb (Build_Library): Remove DLL_Address constant definition. Remove parameter Lib_Address and Relocatable from Build_Dynamic_Library call. * mlib-tgt.ads, mlib-tgt.adb (Build_Dynamic_Library): Remove parameter Lib_Address and Relocatable. (Default_DLL_Address): Removed. * mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb, mlib-tgt-hpux.adb, mlib-tgt-linux.adb, mlib-tgt-solaris.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, mlib-tgt-vxworks.adb: (Build_Dynamic_Library): Remove parameter Lib_Address and Relocatable. (Default_DLL_Address): Removed. * mlib-tgt-mingw.adb: Ditto. (Build_Dynamic_Library): Do not add "lib" prefix to the DLL name. * s-taprop-mingw.adb (Create_Task): Use Adjust_Storage_Size to compute the initial thread stack size. * a-strmap.ads: Move package L to private part as it is not used in the spec. Found while reading code. 2004-06-25 Olivier Hainque <hainque@act-europe.fr> * tracebak.c: Introduce support for a GCC infrastructure based implementation of __gnat_backtrace. * raise.c: Don't rely on a C mapping of the GNAT_GCC_Exception record any more. Use accessors instead. This eases maintenance and relaxes some alignment constraints. (_GNAT_Exception structure): Remove the Ada specific fields (EID_For, Adjust_N_Cleanups_For): New accessors, exported by a-exexpr.adb. (is_handled_by, __gnat_eh_personality): Replace component references to exception structure by use of the new accessors. * init.c (__gnat_initialize): Adjust comments to match the just reverted meaning of the -static link-time option. * adaint.c (convert_addresses): Arrange not to define a stub for mips-irix any more, as we now want to rely on a real version from a recent libaddr2line. * a-exexpr.adb: Provide new accessors to a GNAT_GCC occurrence, so that the personality routine can use them and not have to rely on a C counterpart of the record anymore. This simplifies maintenance and relaxes the constraint of having Standard'Maximum_Alignment match BIGGEST_ALIGNMENT. Update comments, and add a section on the common header alignment issue. 2004-06-25 Geert Bosch <bosch@gnat.com> * a-ngelfu.adb (Tanh): Use full 20 digit precision for constants in polynomial approximation. Fixes inconsistency with Cody/Waite algorithm. 2004-06-25 Robert Dewar <dewar@gnat.com> * gnat_rm.texi: Fix section on component clauses to indicate that the restriction on byte boundary placement still applies for bit packed arrays. Add comment on stack usage from Initialize_Scalars * gnat_ugn.texi: Add documentation for -gnatyLnnn * stylesw.ads, stylesw.adb: Implement new -gnatyLnnn option for limiting nesting level. * usage.adb: Add line for -gnatyLnnn switch * g-debpoo.ads, xtreeprs.adb, sinput.ads, sem_ch13.ads, sem_ch13.adb, exp_aggr.adb: Minor reformatting * sem_prag.adb (Process_Atomic_Shared_Volatile): Set Is_Atomic on base type as well as on the subtype. This corrects a problem in freeze in setting alignments of atomic types. * sem_eval.ads: Minor comment typo fixed * par-util.adb (Push_Scope_Stack): Check for violation of max nesting level. Minor reformatting. * fname.adb (Is_Predefined_File_Name): Require a letter after the minus sign. This means that file names like a--b.adb will not be considered predefined. * freeze.adb: Propagate new flag Must_Be_On_Byte_Boundary to containing record Test new flag and give diagnostic for bad component clause. (Freeze_Entity): Set alignment of array from component alignment in cases where this is safe to do. * exp_pakd.adb: Set new flag Must_Be_On_Byte_Boundary for large packed arrays. * cstand.adb: (Create_Standard): Set alignment of String to 1 * einfo.ads, einfo.adb: Introduce new flag Must_Be_On_Byte_Boundary * exp_ch4.adb (Expand_Array_Equality): Improve efficiency of generated code in the common constrained array cases. * a-storio.adb: Change implementation to avoid possible alignment problems on machines requiring strict alignment (data should be moved as type Buffer, not type Elmt). * checks.adb (Apply_Array_Size_Check): Improve these checks by killing the overflow checks which we really do not need (64-bits is enough). 2004-06-25 Vincent Celier <celier@gnat.com> * makegpr.adb (Is_Included_In_Global_Archive): New Boolean function (Add_Archives.Recursive_Add_Archives): Call Add_Archive_Path inconditionally for the main project. (Recursive_Add_Archives.Add_Archive_Path): New procedure (Link_Executables.Check_Time_Stamps): New procedure (Link_Executables.Link_Foreign): New procedure Changes made to reduce nesting level of this package (Check): New procedure (Add_Switches): When not in quiet output, check that a switch is not the concatenation of several valid switches. If it is, issue a warning. (Build_Global_Archive): If the global archive is rebuilt, linking need to be done. (Compile_Sources): Rebuilding a library archive does not imply rebuilding the global archive. (Build_Global_Archive): New procedure (Build_Library): New name for Build_Archive, now only for library project (Check_Archive_Builder): New procedure (Create_Global_Archive_Dependency_File): New procedure (Gprmake): Call Build_Global_Archive before linking * makegpr.adb: Use Other_Sources_Present instead of Sources_Present throughout. (Scan_Arg): Display the Copyright notice when -v is used * gnat_ugn.texi: Document new switch -files= (VMS qualifier /FILES=) for gnatls. * vms_data.ads: Add qualifier /MAX_NESTING=nnn (-gnatyLnnn) for GNAT COMPILE. Add new GNAT LIST qualifier /FILES= Added qualifier /DIRECTORY= to GNAT METRIC Added qualifier /FILES= to GNAT METRIC Added qualifier /FILES to GNAT PRETTY * switch.adb (Is_Front_End_Switch): Refine the test for --RTS or -fRTS, to take into account both versions of the switch. * switch-c.adb (Scan_Front_End_Switches): New switch -gnatez. Should always be the last switch to the gcc driver. Disable switch storing so that switches automatically added by the gcc driver are not put in the ALI file. * prj.adb (Project_Empty): Take into account changes in components of Project_Data. * prj.ads (Languages_Processed): New enumaration value All_Languages. * prj.ads (Project_Data): Remove component Lib_Elaboration: never used. Split Boolean component Ada_Sources_Present in two Boolean components Ada_Sources_Present and Other_Sources_Present. Minor reformatting * prj-env.adb (For_All_Source_Dirs.Add): Use Ada_Sources_Present instead of Sources_Present. (Set_Ada_Paths.Add.Recursive_Add): Ditto * prj-nmsc.adb: Minor reformatting (Check_Ada_Naming_Scheme): New name of procedure Check_Naming_Scheme (Check_Ada_Naming_Scheme_Validity): New name of previous procedure Check_Ada_Naming_Scheme. Change Sources_Present to Ada_Sources_Present or Other_Sources_Present throughout. * prj-part.adb (Post_Parse_Context_Clause): New Boolean parameter In_Limited. Make sure that all cycles where there is at least one "limited with" are detected. (Parse_Single_Project): New Boolean parameter In_Limited * prj-proc.adb (Recursive_Check): When Process_Languages is All_Languages, call first Prj.Nmsc.Ada_Check, then Prj.Nmsc.Other_Languages_Check. * prj-proc.adb (Process): Use Ada_Sources_Present or Other_Sources_Present (instead of Sources_Present) depending on Process_Languages. * lang-specs.h: Keep -g and -m switches in the same order, and as the last switches. * lib.adb (Switch_Storing_Enabled): New global Boolean flag (Disable_Switch_Storing): New procedure. Set Switch_Storing_Enabled to False. (Store_Compilation_Switch): Do nothing if Switch_Storing_Enabled is False. * lib.ads (Disable_Switch_Storing): New procedure. * make.adb: Modifications to reduce nesting level of this package. (Check_Standard_Library): New procedure (Gnatmake.Check_Mains): New procedure (Gnatmake.Create_Binder_Mapping_File): New procedure (Compile_Sources.Compile): Add switch -gnatez as the last option (Display): Never display -gnatez * Makefile.generic: When using $(MAIN_OBJECT), always use $(OBJ_DIR)/$(MAIN_OBJECT) * gnatcmd.adb (Check_Project): New function (Process_Link): New procedure to reduce nesting depth (Check_Files): New procedure to reduce the nesting depth. For GNAT METRIC, include the inherited sources in extending projects. (GNATCmd): When GNAT LS is invoked with a project file and no files, add the list of files from the sources of the project file. If this list is too long, put it in a temp text files and use switch -files= (Delete_Temp_Config_Files): Delete the temp text file that contains a list of source for gnatpp or gnatmetric, if one has been created. (GNATCmd): For GNAT METRIC and GNAT PRETTY, if the number of sources in the project file is too large, create a temporary text file that list them and pass it to the tool with "-files=<temp text file>". (GNATCmd): For GNAT METRIC add "-d=<abject dir>" as the first switch * gnatlink.adb (Gnatlink): Do not compile with --RTS= when the generated file is in not in Ada. * gnatls.adb: Remove all parameters And_Save that are no longer used. (Scan_Ls_Arg): Add processing for -files= (Usage): Add line for -files= * g-os_lib.adb (On_Windows): New global constant Boolean flag (Normalize_Pathname): When on Windows and the path starts with a directory separator, make sure that the resulting path will start with a drive letter. * clean.adb (Clean_Archive): New procedure (Clean_Project): When there is non-Ada code, delete the global archive, the archive dependency files, the object files and their dependency files, if they exist. (Gnatclean): Call Prj.Pars.Parse for All_Languages, not for Ada only. 2004-06-25 Thomas Quinot <quinot@act-europe.fr> * sinfo.ads: Fix typo in comment. * sem_dist.adb (Process_Remote_AST_Attribute): Simplify code that uses the TSS for remote access-to-subprogram types, since these TSS are always present once the type has been analyzed. (RAS_E_Dereference): Same. * sem_attr.adb (Analyze_Attribute): When analysis of an attribute reference raises Bad_Attribute, mark the reference as analyzed so the node (and any children resulting from rewrites that could have occurred during the analysis that ultimately failed) is not analyzed again. * exp_ch7.ads (Find_Final_List): Fix misaligned comment. * exp_dist.adb: Minor comment fix. * exp_ch4.adb (Expand_N_Allocator): For an allocator whose expected type is an anonymous access type, no unchecked deallocation of the allocated object can occur. If the object is controlled, attach it with a count of 1. This allows attachment to the Global_Final_List, if no other relevant list is available. (Get_Allocator_Final_List): For an anonymous access type that is the type of a discriminant or record component, the corresponding finalisation list is the one of the scope of the type. 2004-06-25 Ed Schonberg <schonberg@gnat.com> * sem_ch3.adb (Replace_Type): When computing the signature of an inherited subprogram, use the first subtype if the derived type declaration has no constraint. * exp_ch6.adb (Add_Call_By_Copy_Code): Check that formal is an array before applying previous optimization. Minor code cleanup. * exp_util.adb (Is_Possibly_Unaligned_Slice): If the component is placed at the beginning of an unpacked record without explicit alignment, a slice of it will be aligned and does not need a copy when used as an actual. 2004-06-25 Ed Schonberg <schonberg@gnat.com> PR ada/15591 PR ada/15592 * sem_ch8.adb (Attribute_Renaming): Reject renaming if the attribute reference is written with expressions mimicking parameters. 2004-06-25 Hristian Kirtchev <kirtchev@gnat.com> PR ada/15589 * sem_ch3.adb (Build_Derived_Record_Type): Add additional check to STEP 2a. The constraints of a full type declaration of a derived record type are checked for conformance with those declared in the corresponding private extension declaration. The message "not conformant with previous declaration" is emitted if an error is detected. 2004-06-25 Vasiliy Fofanov <fofanov@act-europe.fr> * g-traceb.ads: Document the need for -E binder switch in the spec. * g-trasym.ads: Document the need for -E binder switch in the spec. 2004-06-25 Jose Ruiz <ruiz@act-europe.fr> * sem_prag.adb: Add handling of pragma Detect_Blocking. * snames.h, snames.ads, snames.adb: Add entry for pragma Detect_Blocking. * s-rident.ads: Change reference to pragma Detect_Blocking. * targparm.ads, targparm.adb: Allow pragma Detect_Blocking in system.ads. * opt.ads (Detect_Blocking): New Boolean variable (defaulted to False) to indicate whether pragma Detect_Blocking is active. * par-prag.adb: Add entry for pragma Detect_Blocking. * rtsfind.adb (RTU_Loaded): Fix the temporary kludge to get past bug of not handling WITH. Note that this replaces the previous update which was incorrect. 2004-06-25 Javier Miranda <miranda@gnat.com> * sem_ch10.adb (Re_Install_Use_Clauses): Force the installation of the use-clauses to have a clean environment. * sem_ch8.adb (Install_Use_Clauses): Addition of a new formal to force the installation of the use-clauses to stablish a clean environment in case of compilation of a separate unit; otherwise the call to use_one_package is protected by the barrier Applicable_Use. * sem_ch8.ads (Install_Use_Clauses): Addition of a new formal to force the installation of the use-clauses to stablish a clean environment in case of compilation of a separate unit. (End_Use_Clauses): Minor comment cleanup. 2004-06-25 Sergey Rybin <rybin@act-europe.fr> * gnat_ugn.texi: Add description of the gnatpp 'files' switch From-SVN: r83658
Diffstat (limited to 'gcc/ada/gnatcmd.adb')
-rw-r--r--gcc/ada/gnatcmd.adb892
1 files changed, 551 insertions, 341 deletions
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 0352d7c..3a0e5e4 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -39,6 +39,7 @@ with Prj.Env;
with Prj.Ext; use Prj.Ext;
with Prj.Pars;
with Prj.Util; use Prj.Util;
+with Sinput.P;
with Snames; use Snames;
with Table;
with Types; use Types;
@@ -61,11 +62,17 @@ procedure GNATCmd is
Current_Verbosity : Prj.Verbosity := Prj.Default;
Tool_Package_Name : Name_Id := No_Name;
+ Old_Project_File_Used : Boolean := False;
-- This flag indicates a switch -p (for gnatxref and gnatfind) for
-- an old fashioned project file. -p cannot be used in conjonction
-- with -P.
- Old_Project_File_Used : Boolean := False;
+ Max_Files_On_The_Command_Line : constant := 30; -- Arbitrary
+
+ Temp_File_Name : String_Access := null;
+ -- The name of the temporary text file to put a list of source/object
+ -- files to pass to a tool, when there are more than
+ -- Max_Files_On_The_Command_Line files.
-- A table to keep the switches from the project file
@@ -145,6 +152,19 @@ procedure GNATCmd is
-- Local Subprograms --
-----------------------
+ procedure Check_Files;
+ -- For GNAT LIST, GNAT PRETTY and GNAT METRIC, check if a project
+ -- file is specified, without any file arguments. If it is the case,
+ -- invoke the GNAT tool with the proper list of files, derived from
+ -- the sources of the project.
+
+ function Check_Project
+ (Project : Project_Id;
+ Root_Project : Project_Id) return Boolean;
+ -- Returns True if Project = Root_Project.
+ -- For GNAT METRIC, also returns True if Project is extended by
+ -- Root_Project.
+
procedure Check_Relative_Executable (Name : in out String_Access);
-- Check if an executable is specified as a relative path.
-- If it is, and the path contains directory information, fail.
@@ -168,6 +188,9 @@ procedure GNATCmd is
procedure Non_VMS_Usage;
-- Display usage for platforms other than VMS
+ procedure Process_Link;
+ -- Process GNAT LINK, when there is a project file specified.
+
procedure Set_Library_For
(Project : Project_Id;
There_Are_Libraries : in out Boolean);
@@ -186,6 +209,214 @@ procedure GNATCmd is
-- If it is and it includes directory information, prepend the path with
-- Parent.This subprogram is only called when using project files.
+ -----------------
+ -- Check_Files --
+ -----------------
+
+ procedure Check_Files is
+ Add_Sources : Boolean := True;
+ Unit_Data : Prj.Com.Unit_Data;
+ Subunit : Boolean := False;
+
+ begin
+ -- Check if there is at least one argument that is not a switch
+
+ for Index in 1 .. Last_Switches.Last loop
+ if Last_Switches.Table (Index) (1) /= '-' then
+ Add_Sources := False;
+ exit;
+ end if;
+ end loop;
+
+ -- If all arguments were switches, add the path names of
+ -- all the sources of the main project.
+
+ if Add_Sources then
+ declare
+ Current_Last : constant Integer := Last_Switches.Last;
+ use Prj.Com;
+
+ begin
+ for Unit in 1 .. Prj.Com.Units.Last loop
+ Unit_Data := Prj.Com.Units.Table (Unit);
+
+ -- For gnatls, we only need to put the library units,
+ -- body or spec, but not the subunits.
+
+ if The_Command = List then
+ if
+ Unit_Data.File_Names (Body_Part).Name /= No_Name
+ then
+ -- There is a body; check if it is for this
+ -- project.
+
+ if Unit_Data.File_Names (Body_Part).Project =
+ Project
+ then
+ Subunit := False;
+
+ if Unit_Data.File_Names (Specification).Name =
+ No_Name
+ then
+ -- We have a body with no spec: we need
+ -- to check if this is a subunit, because
+ -- gnatls will complain about subunits.
+
+ declare
+ Src_Ind : Source_File_Index;
+
+ begin
+ Src_Ind := Sinput.P.Load_Project_File
+ (Get_Name_String
+ (Unit_Data.File_Names
+ (Body_Part).Path));
+
+ Subunit :=
+ Sinput.P.Source_File_Is_Subunit
+ (Src_Ind);
+ end;
+ end if;
+
+ if not Subunit then
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'
+ (Get_Name_String
+ (Unit_Data.File_Names
+ (Body_Part).Display_Name));
+ end if;
+ end if;
+
+ elsif Unit_Data.File_Names (Specification).Name /=
+ No_Name
+ then
+ -- We have a spec with no body; check if it is
+ -- for this project.
+
+ if Unit_Data.File_Names (Specification).Project =
+ Project
+ then
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'
+ (Get_Name_String
+ (Unit_Data.File_Names
+ (Specification).Display_Name));
+ end if;
+ end if;
+
+ else
+ -- For gnatpp and gnatmetric, put all sources
+ -- of the project.
+
+ for Kind in Prj.Com.Spec_Or_Body loop
+
+ -- Put only sources that belong to the main
+ -- project.
+
+ if Check_Project
+ (Unit_Data.File_Names (Kind).Project, Project)
+ then
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'
+ (Get_Name_String
+ (Unit_Data.File_Names
+ (Kind).Display_Path));
+ end if;
+ end loop;
+ end if;
+ end loop;
+
+ -- If the list of files is too long, create a temporary
+ -- text file that lists these files, and pass this temp
+ -- file to gnatpp or gnatmetric using switch -files=.
+
+ if Last_Switches.Last - Current_Last >
+ Max_Files_On_The_Command_Line
+ then
+ declare
+ Temp_File_FD : File_Descriptor;
+ Buffer : String (1 .. 1_000);
+ Len : Natural;
+ OK : Boolean := True;
+
+ begin
+ Create_Temp_File (Temp_File_FD, Temp_File_Name);
+
+ if Temp_File_Name /= null then
+ for Index in Current_Last + 1 ..
+ Last_Switches.Last
+ loop
+ Len := Last_Switches.Table (Index)'Length;
+ Buffer (1 .. Len) :=
+ Last_Switches.Table (Index).all;
+ Len := Len + 1;
+ Buffer (Len) := ASCII.LF;
+ Buffer (Len + 1) := ASCII.NUL;
+ OK :=
+ Write (Temp_File_FD,
+ Buffer (1)'Address,
+ Len) = Len;
+ exit when not OK;
+ end loop;
+
+ if OK then
+ Close (Temp_File_FD, OK);
+ else
+ Close (Temp_File_FD, OK);
+ OK := False;
+ end if;
+
+ -- If there were any problem creating the temp
+ -- file, then pass the list of files.
+
+ if OK then
+
+ -- Replace the list of files with
+ -- "-files=<temp file name>".
+
+ Last_Switches.Set_Last (Current_Last + 1);
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'("-files=" & Temp_File_Name.all);
+ end if;
+ end if;
+ end;
+ end if;
+ end;
+ end if;
+ end Check_Files;
+
+ -------------------
+ -- Check_Project --
+ -------------------
+
+ function Check_Project
+ (Project : Project_Id;
+ Root_Project : Project_Id) return Boolean
+ is
+ begin
+ if Project = Root_Project then
+ return True;
+
+ elsif The_Command = Metric then
+ declare
+ Data : Project_Data := Projects.Table (Root_Project);
+
+ begin
+ while Data.Extends /= No_Project loop
+ if Project = Data.Extends then
+ return True;
+ end if;
+
+ Data := Projects.Table (Data.Extends);
+ end loop;
+ end;
+ end if;
+
+ return False;
+ end Check_Project;
+
-------------------------------
-- Check_Relative_Executable --
-------------------------------
@@ -256,6 +487,13 @@ procedure GNATCmd is
end if;
end loop;
end if;
+
+ -- If a temporary text file that contains a list of files for a tool
+ -- has been created, delete this temporary file.
+
+ if Temp_File_Name /= null then
+ Delete_File (Temp_File_Name.all, Success);
+ end if;
end Delete_Temp_Config_Files;
-----------
@@ -273,6 +511,288 @@ procedure GNATCmd is
return 0;
end Index;
+ ------------------
+ -- Process_Link --
+ ------------------
+
+ procedure Process_Link is
+ Look_For_Executable : Boolean := True;
+ There_Are_Libraries : Boolean := False;
+ Path_Option : constant String_Access :=
+ MLib.Linker_Library_Path_Option;
+ Prj : Project_Id := Project;
+ Arg : String_Access;
+ Last : Natural := 0;
+ Skip_Executable : Boolean := False;
+
+ begin
+ -- Add the default search directories, to be able to find
+ -- libgnat in call to MLib.Utl.Lib_Directory.
+
+ Add_Default_Search_Dirs;
+
+ Library_Paths.Set_Last (0);
+
+ -- Check if there are library project files
+
+ if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
+ Set_Libraries (Project, There_Are_Libraries);
+ end if;
+
+ -- If there are, add the necessary additional switches
+
+ if There_Are_Libraries then
+
+ -- Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
+
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'("-L" & MLib.Utl.Lib_Directory);
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'("-lgnarl");
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'("-lgnat");
+
+ -- If Path_Option is not null, create the switch
+ -- ("-Wl,-rpath," or equivalent) with all the library dirs
+ -- plus the standard GNAT library dir.
+
+ if Path_Option /= null then
+ declare
+ Option : String_Access;
+ Length : Natural := Path_Option'Length;
+ Current : Natural;
+
+ begin
+ -- First, compute the exact length for the switch
+
+ for Index in
+ Library_Paths.First .. Library_Paths.Last
+ loop
+ -- Add the length of the library dir plus one
+ -- for the directory separator.
+
+ Length :=
+ Length +
+ Library_Paths.Table (Index)'Length + 1;
+ end loop;
+
+ -- Finally, add the length of the standard GNAT
+ -- library dir.
+
+ Length := Length + MLib.Utl.Lib_Directory'Length;
+ Option := new String (1 .. Length);
+ Option (1 .. Path_Option'Length) := Path_Option.all;
+ Current := Path_Option'Length;
+
+ -- Put each library dir followed by a dir separator
+
+ for Index in
+ Library_Paths.First .. Library_Paths.Last
+ loop
+ Option
+ (Current + 1 ..
+ Current +
+ Library_Paths.Table (Index)'Length) :=
+ Library_Paths.Table (Index).all;
+ Current :=
+ Current +
+ Library_Paths.Table (Index)'Length + 1;
+ Option (Current) := Path_Separator;
+ end loop;
+
+ -- Finally put the standard GNAT library dir
+
+ Option
+ (Current + 1 ..
+ Current + MLib.Utl.Lib_Directory'Length) :=
+ MLib.Utl.Lib_Directory;
+
+ -- And add the switch to the last switches
+
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ Option;
+ end;
+ end if;
+ end if;
+
+ -- Check if the first ALI file specified can be found, either
+ -- in the object directory of the main project or in an object
+ -- directory of a project file extended by the main project.
+ -- If the ALI file can be found, replace its name with its
+ -- absolute path.
+
+ Skip_Executable := False;
+
+ Switch_Loop : for J in 1 .. Last_Switches.Last loop
+
+ -- If we have an executable just reset the flag
+
+ if Skip_Executable then
+ Skip_Executable := False;
+
+ -- If -o, set flag so that next switch is not processed
+
+ elsif Last_Switches.Table (J).all = "-o" then
+ Skip_Executable := True;
+
+ -- Normal case
+
+ else
+ declare
+ Switch : constant String :=
+ Last_Switches.Table (J).all;
+
+ ALI_File : constant String (1 .. Switch'Length + 4) :=
+ Switch & ".ali";
+
+ Test_Existence : Boolean := False;
+
+ begin
+ Last := Switch'Length;
+
+ -- Skip real switches
+
+ if Switch'Length /= 0
+ and then Switch (Switch'First) /= '-'
+ then
+ -- Append ".ali" if file name does not end with it
+
+ if Switch'Length <= 4
+ or else Switch (Switch'Last - 3 .. Switch'Last)
+ /= ".ali"
+ then
+ Last := ALI_File'Last;
+ end if;
+
+ -- If file name includes directory information,
+ -- stop if ALI file exists.
+
+ if Is_Absolute_Path (ALI_File (1 .. Last)) then
+ Test_Existence := True;
+
+ else
+ for K in Switch'Range loop
+ if Switch (K) = '/' or else
+ Switch (K) = Directory_Separator
+ then
+ Test_Existence := True;
+ exit;
+ end if;
+ end loop;
+ end if;
+
+ if Test_Existence then
+ if Is_Regular_File (ALI_File (1 .. Last)) then
+ exit Switch_Loop;
+ end if;
+
+ -- Look in object directories if ALI file exists
+
+ else
+ Project_Loop : loop
+ declare
+ Dir : constant String :=
+ Get_Name_String
+ (Projects.Table (Prj).
+ Object_Directory);
+ begin
+ if Is_Regular_File
+ (Dir &
+ Directory_Separator &
+ ALI_File (1 .. Last))
+ then
+ -- We have found the correct project, so we
+ -- replace the file with the absolute path.
+
+ Last_Switches.Table (J) :=
+ new String'
+ (Dir & Directory_Separator &
+ ALI_File (1 .. Last));
+
+ -- And we are done
+
+ exit Switch_Loop;
+ end if;
+ end;
+
+ -- Go to the project being extended,
+ -- if any.
+
+ Prj := Projects.Table (Prj).Extends;
+ exit Project_Loop when Prj = No_Project;
+ end loop Project_Loop;
+ end if;
+ end if;
+ end;
+ end if;
+ end loop Switch_Loop;
+
+ -- If a relative path output file has been specified, we add
+ -- the exec directory.
+
+ for J in reverse 1 .. Last_Switches.Last - 1 loop
+ if Last_Switches.Table (J).all = "-o" then
+ Check_Relative_Executable
+ (Name => Last_Switches.Table (J + 1));
+ Look_For_Executable := False;
+ exit;
+ end if;
+ end loop;
+
+ if Look_For_Executable then
+ for J in reverse 1 .. First_Switches.Last - 1 loop
+ if First_Switches.Table (J).all = "-o" then
+ Look_For_Executable := False;
+ Check_Relative_Executable
+ (Name => First_Switches.Table (J + 1));
+ exit;
+ end if;
+ end loop;
+ end if;
+
+ -- If no executable is specified, then find the name
+ -- of the first ALI file on the command line and issue
+ -- a -o switch with the absolute path of the executable
+ -- in the exec directory.
+
+ if Look_For_Executable then
+ for J in 1 .. Last_Switches.Last loop
+ Arg := Last_Switches.Table (J);
+ Last := 0;
+
+ if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
+ if Arg'Length > 4
+ and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
+ then
+ Last := Arg'Last - 4;
+
+ elsif Is_Regular_File (Arg.all & ".ali") then
+ Last := Arg'Last;
+ end if;
+
+ if Last /= 0 then
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'("-o");
+ Get_Name_String
+ (Projects.Table (Project).Exec_Directory);
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'(Name_Buffer (1 .. Name_Len) &
+ Directory_Separator &
+ Base_Name (Arg (Arg'First .. Last)) &
+ Get_Executable_Suffix.all);
+ exit;
+ end if;
+ end if;
+ end loop;
+ end if;
+ end Process_Link;
+
---------------------
-- Set_Library_For --
---------------------
@@ -317,7 +837,6 @@ procedure GNATCmd is
new String'(Get_Name_String
(Projects.Table (Project).Library_Dir));
end if;
-
end if;
end Set_Library_For;
@@ -341,9 +860,9 @@ procedure GNATCmd is
if Sw (1) = '-' then
if Sw'Length >= 3
- and then (Sw (2) = 'A'
- or else Sw (2) = 'I'
- or else Sw (2) = 'L')
+ and then (Sw (2) = 'A' or else
+ Sw (2) = 'I' or else
+ Sw (2) = 'L')
then
Start := 3;
@@ -352,9 +871,9 @@ procedure GNATCmd is
end if;
elsif Sw'Length >= 4
- and then (Sw (2 .. 3) = "aL"
- or else Sw (2 .. 3) = "aO"
- or else Sw (2 .. 3) = "aI")
+ and then (Sw (2 .. 3) = "aL" or else
+ Sw (2 .. 3) = "aO" or else
+ Sw (2 .. 3) = "aI")
then
Start := 4;
@@ -937,301 +1456,7 @@ begin
end if;
if The_Command = Link then
-
- -- Add the default search directories, to be able to find
- -- libgnat in call to MLib.Utl.Lib_Directory.
-
- Add_Default_Search_Dirs;
-
- declare
- There_Are_Libraries : Boolean := False;
- Path_Option : constant String_Access :=
- MLib.Linker_Library_Path_Option;
-
- begin
- Library_Paths.Set_Last (0);
-
- -- Check if there are library project files
-
- if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
- Set_Libraries (Project, There_Are_Libraries);
- end if;
-
- -- If there are, add the necessary additional switches
-
- if There_Are_Libraries then
-
- -- Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
-
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'("-L" & MLib.Utl.Lib_Directory);
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'("-lgnarl");
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'("-lgnat");
-
- -- If Path_Option is not null, create the switch
- -- ("-Wl,-rpath," or equivalent) with all the library dirs
- -- plus the standard GNAT library dir.
-
- if Path_Option /= null then
- declare
- Option : String_Access;
- Length : Natural := Path_Option'Length;
- Current : Natural;
-
- begin
- -- First, compute the exact length for the switch
-
- for Index in
- Library_Paths.First .. Library_Paths.Last
- loop
- -- Add the length of the library dir plus one
- -- for the directory separator.
-
- Length :=
- Length +
- Library_Paths.Table (Index)'Length + 1;
- end loop;
-
- -- Finally, add the length of the standard GNAT
- -- library dir.
-
- Length := Length + MLib.Utl.Lib_Directory'Length;
- Option := new String (1 .. Length);
- Option (1 .. Path_Option'Length) := Path_Option.all;
- Current := Path_Option'Length;
-
- -- Put each library dir followed by a dir separator
-
- for Index in
- Library_Paths.First .. Library_Paths.Last
- loop
- Option
- (Current + 1 ..
- Current +
- Library_Paths.Table (Index)'Length) :=
- Library_Paths.Table (Index).all;
- Current :=
- Current +
- Library_Paths.Table (Index)'Length + 1;
- Option (Current) := Path_Separator;
- end loop;
-
- -- Finally put the standard GNAT library dir
-
- Option
- (Current + 1 ..
- Current + MLib.Utl.Lib_Directory'Length) :=
- MLib.Utl.Lib_Directory;
-
- -- And add the switch to the last switches
-
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- Option;
- end;
- end if;
- end if;
- end;
-
- -- Check if the first ALI file specified can be found, either
- -- in the object directory of the main project or in an object
- -- directory of a project file extended by the main project.
- -- If the ALI file can be found, replace its name with its
- -- absolute path.
-
- declare
- Skip_Executable : Boolean := False;
-
- begin
- Switch_Loop : for J in 1 .. Last_Switches.Last loop
-
- -- If we have an executable just reset the flag
-
- if Skip_Executable then
- Skip_Executable := False;
-
- -- If -o, set flag so that next switch is not processed
-
- elsif Last_Switches.Table (J).all = "-o" then
- Skip_Executable := True;
-
- -- Normal case
-
- else
- declare
- Switch : constant String :=
- Last_Switches.Table (J).all;
-
- ALI_File : constant String (1 .. Switch'Length + 4) :=
- Switch & ".ali";
-
- Last : Natural := Switch'Length;
- Test_Existence : Boolean := False;
-
- begin
- -- Skip real switches
-
- if Switch'Length /= 0 and then
- Switch (Switch'First) /= '-'
- then
- -- Append ".ali" if file name does not end with it
-
- if Switch'Length <= 4 or else
- Switch (Switch'Last - 3 .. Switch'Last) /= ".ali"
- then
- Last := ALI_File'Last;
- end if;
-
- -- If file name includes directory information,
- -- stop if ALI file exists.
-
- if Is_Absolute_Path (ALI_File (1 .. Last)) then
- Test_Existence := True;
-
- else
- for K in Switch'Range loop
- if Switch (K) = '/' or else
- Switch (K) = Directory_Separator
- then
- Test_Existence := True;
- exit;
- end if;
- end loop;
- end if;
-
- if Test_Existence then
- if Is_Regular_File (ALI_File (1 .. Last)) then
- exit Switch_Loop;
- end if;
-
- else
- -- Look in the object directories if the ALI
- -- file exists.
-
- declare
- Prj : Project_Id := Project;
- begin
- Project_Loop :
- loop
- declare
- Dir : constant String :=
- Get_Name_String
- (Projects.Table (Prj).
- Object_Directory);
- begin
- if Is_Regular_File
- (Dir & Directory_Separator &
- ALI_File (1 .. Last))
- then
- -- We have found the correct
- -- project, so we replace the file
- -- with the absolute path.
-
- Last_Switches.Table (J) :=
- new String'
- (Dir & Directory_Separator &
- ALI_File (1 .. Last));
-
- -- And we are done
-
- exit Switch_Loop;
- end if;
- end;
-
- -- Go to the project being extended,
- -- if any.
-
- Prj := Projects.Table (Prj).Extends;
- exit Project_Loop when Prj = No_Project;
- end loop Project_Loop;
- end;
- end if;
- end if;
- end;
- end if;
- end loop Switch_Loop;
- end;
-
- -- If a relative path output file has been specified, we add
- -- the exec directory.
-
- declare
- Look_For_Executable : Boolean := True;
-
- begin
-
- for J in reverse 1 .. Last_Switches.Last - 1 loop
- if Last_Switches.Table (J).all = "-o" then
- Check_Relative_Executable
- (Name => Last_Switches.Table (J + 1));
- Look_For_Executable := False;
- exit;
- end if;
- end loop;
-
- if Look_For_Executable then
- for J in reverse 1 .. First_Switches.Last - 1 loop
- if First_Switches.Table (J).all = "-o" then
- Look_For_Executable := False;
- Check_Relative_Executable
- (Name => First_Switches.Table (J + 1));
- exit;
- end if;
- end loop;
- end if;
-
- -- If no executable is specified, then find the name
- -- of the first ALI file on the command line and issue
- -- a -o switch with the absolute path of the executable
- -- in the exec directory.
-
- if Look_For_Executable then
- for J in 1 .. Last_Switches.Last loop
- declare
- Arg : constant String_Access :=
- Last_Switches.Table (J);
- Last : Natural := 0;
-
- begin
- if Arg'Length /= 0 and then Arg (Arg'First) /= '-' then
- if Arg'Length > 4
- and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
- then
- Last := Arg'Last - 4;
-
- elsif Is_Regular_File (Arg.all & ".ali") then
- Last := Arg'Last;
- end if;
-
- if Last /= 0 then
- declare
- Executable_Name : constant String :=
- Base_Name (Arg (Arg'First .. Last));
- begin
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'("-o");
- Get_Name_String
- (Projects.Table (Project).Exec_Directory);
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'(Name_Buffer (1 .. Name_Len) &
- Directory_Separator &
- Executable_Name &
- Get_Executable_Suffix.all);
- exit;
- end;
- end if;
- end if;
- end;
- end loop;
- end if;
- end;
+ Process_Link;
end if;
if The_Command = Link or The_Command = Bind then
@@ -1337,46 +1562,30 @@ begin
end;
end if;
+ -- For gnatmetric, the generated files should be put in the
+ -- object directory. This must be the first dwitch, because it may
+ -- be overriden by a switch in package Metrics in the project file
+ -- or by a command line option.
+
+ if The_Command = Metric then
+ First_Switches.Increment_Last;
+ First_Switches.Table (2 .. First_Switches.Last) :=
+ First_Switches.Table (1 .. First_Switches.Last - 1);
+ First_Switches.Table (1) :=
+ new String'("-d=" &
+ Get_Name_String
+ (Projects.Table (Project).Object_Directory));
+ end if;
+
-- For gnat pretty and gnat metric, if no file has been put on the
-- command line, call the tool with all the sources of the main
-- project.
- if The_Command = Pretty or else The_Command = Metric then
- declare
- Add_Sources : Boolean := True;
- Unit_Data : Prj.Com.Unit_Data;
- begin
- -- Check if there is at least one argument that is not a switch
-
- for Index in 1 .. Last_Switches.Last loop
- if Last_Switches.Table (Index)(1) /= '-' then
- Add_Sources := False;
- exit;
- end if;
- end loop;
-
- -- If all arguments were switches, add the path names of
- -- all the sources of the main project.
-
- if Add_Sources then
- for Unit in 1 .. Prj.Com.Units.Last loop
- Unit_Data := Prj.Com.Units.Table (Unit);
-
- for Kind in Prj.Com.Spec_Or_Body loop
-
- -- Put only sources that belong to the main project
-
- if Unit_Data.File_Names (Kind).Project = Project then
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'
- (Get_Name_String
- (Unit_Data.File_Names (Kind).Display_Path));
- end if;
- end loop;
- end loop;
- end if;
- end;
+ if The_Command = Pretty or else
+ The_Command = Metric or else
+ The_Command = List
+ then
+ Check_Files;
end if;
end if;
@@ -1384,8 +1593,9 @@ begin
declare
The_Args : Argument_List
- (1 .. First_Switches.Last + Last_Switches.Last);
- Arg_Num : Natural := 0;
+ (1 .. First_Switches.Last + Last_Switches.Last);
+ Arg_Num : Natural := 0;
+
begin
for J in 1 .. First_Switches.Last loop
Arg_Num := Arg_Num + 1;
generated by cgit v1.1 at 2025-06-01 02:56:03 +0000