diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-06-25 16:39:33 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-06-25 16:39:33 +0000 |
| commit | 80d4fec446bcdba9588f2a861b2ddd449fb48292 (patch) | |
| tree | 7773949d835bb70e525203ff86961e0f04f2c02c /gcc/ada/makegpr.adb | |
| parent | d9f1f85c05be9b82743f471d36fc67093e5517a1 (diff) | |
| download | gcc-80d4fec446bcdba9588f2a861b2ddd449fb48292.tar.gz | |
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
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@83658 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/makegpr.adb')
| -rw-r--r-- | gcc/ada/makegpr.adb | 1415 |
1 files changed, 926 insertions, 489 deletions
diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index 5947f19825d..d818ff25423 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -66,15 +66,14 @@ package body Makegpr is -- sources and the C++ compiler is not g++. No_Argument : constant Argument_List := (1 .. 0 => null); + -- Null argument list representing case of no arguments FD : Process_Descriptor; -- The process descriptor used when invoking a non GNU compiler with -M -- and getting the output with GNAT.Expect. - Line_Matcher : constant Pattern_Matcher := - Compile ("^.*?\n", Single_Line); - -- The pattern when using GNAT.Expect for the invocation of a non GNU - -- compiler with -M. + Line_Matcher : constant Pattern_Matcher := Compile ("^.*?\n", Single_Line); + -- Pattern for GNAT.Expect for the invocation of a non GNU compiler with -M Name_Ide : Name_Id; Name_Compiler_Command : Name_Id; @@ -85,11 +84,11 @@ package body Makegpr is -- True when switch -u is used on the command line type Source_Index_Rec is record - Id : Other_Source_Id; - Found : Boolean := False; + Project : Project_Id; + Id : Other_Source_Id; + Found : Boolean := False; end record; - -- Used as component of Source_Indexes, to check if an archive need to - -- be rebuilt. + -- Used as Source_Indexes component to check if archive needs to be rebuilt type Source_Index_Array is array (Positive range <>) of Source_Index_Rec; type Source_Indexes_Ref is access Source_Index_Array; @@ -127,8 +126,7 @@ package body Makegpr is Copyright_Output : Boolean := False; Usage_Output : Boolean := False; - -- Flags to avoid multiple displays of the Copyright notice and of the - -- Usage. + -- Flags to avoid multiple displays of Copyright notice and of Usage Output_File_Name : String_Access := null; -- The name given after a switch -o @@ -156,8 +154,7 @@ package body Makegpr is Binder_String 'Access, Linker_String 'Access); Packages_To_Check : constant String_List_Access := List_Of_Packages'Access; - -- List of the packages to be checked when parsing/processing project - -- files. + -- List of the packages to be checked when parsing/processing project files Main_Project : Project_Id; -- The project id of the main project @@ -300,6 +297,8 @@ package body Makegpr is -- Used when Keep_Going is True (switch -k) to keep the total number -- of compilation/linking errors, to report at the end of execution. + Need_To_Rebuild_Global_Archive : Boolean := False; + Error_Header : constant String := "*** ERROR: "; -- The beginning of error message, when Keep_Going is True @@ -335,12 +334,13 @@ package body Makegpr is -- Current_Processor and Current_Language. procedure Add_Search_Directories - (Data : Project_Data; Language : Programming_Language); + (Data : Project_Data; + Language : Programming_Language); -- Either add to the Arguments the necessary -I switches needed to -- compile, or, when compiler is gcc/g++, set up the C*INCLUDE_PATH -- environment variable, if necessary. - procedure Add_Source_Id (Id : Other_Source_Id); + procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id); -- Add a source id to Source_Indexes, with Found set to False procedure Add_Switches @@ -352,11 +352,21 @@ package body Makegpr is -- or language (attribute Default_Switches), coming from package Compiler -- or Linker (depending on Proc) of a specified project file. - procedure Build_Archive (Project : Project_Id; Unconditionally : Boolean); - -- Build the archive for a specified project. If Unconditionally is - -- False, first check if the archive is up to date, and build it only + procedure Build_Global_Archive; + -- Build the archive for the main project + + procedure Build_Library (Project : Project_Id; Unconditionally : Boolean); + -- Build the library for a library project. If Unconditionally is + -- False, first check if the library is up to date, and build it only -- if it is not. + procedure Check (Option : String); + -- Check that a switch coming from a project file is not the concatenation + -- of several valid switch, for example "-g -v". If it is, issue a warning. + + procedure Check_Archive_Builder; + -- Check if the archive builder (ar) is there + procedure Check_Compilation_Needed (Source : Other_Source; Need_To_Compile : out Boolean); @@ -370,6 +380,7 @@ package body Makegpr is (Source_Id : Other_Source_Id; Data : Project_Data; Local_Errors : in out Boolean); + -- Compile one non-Ada source procedure Compile_Individual_Sources; -- Compile the sources specified on the command line, when in @@ -390,7 +401,10 @@ package body Makegpr is procedure Create_Archive_Dependency_File (Name : String; First_Source : Other_Source_Id); - -- ??? needs comment + -- Create the archive dependency file for a library project + + procedure Create_Global_Archive_Dependency_File (Name : String); + -- Create the archive depenency file for the main project procedure Display_Command (Name : String; @@ -419,6 +433,12 @@ package body Makegpr is -- Do the necessary package initialization and process the command line -- arguments. + function Is_Included_In_Global_Archive + (Object_Name : Name_Id; + Project : Project_Id) return Boolean; + -- Return True if the object Object_Name is not overridden by a source + -- in a project extending project Project. + procedure Link_Executables; -- Link executables @@ -434,7 +454,7 @@ package body Makegpr is -- Process one command line argument function Strip_CR_LF (Text : String) return String; - -- Needs comment ??? + -- Remove characters ASCII.CR and ASCII.LF from a String procedure Usage; -- Display the usage @@ -462,6 +482,103 @@ package body Makegpr is Imported : Project_List; Prj : Project_Id; + procedure Add_Archive_Path; + -- For a library project or the main project, add the archive + -- path to the arguments. + + ---------------------- + -- Add_Archive_Path -- + ---------------------- + + procedure Add_Archive_Path is + Increment : Positive; + Prev_Last : Positive; + + begin + if Data.Library then + + -- If it is a library project file, nothing to do if + -- gnatmake will be invoked, because gnatmake will take + -- care of it, even if the library is not an Ada library. + + if not For_Gnatmake then + if Data.Library_Kind = Static then + Add_Argument + (Get_Name_String (Data.Library_Dir) & + Directory_Separator & + "lib" & Get_Name_String (Data.Library_Name) & + '.' & Archive_Ext, + Verbose_Mode); + + else + -- As we first insert in the reverse order, + -- -L<dir> is put after -l<lib> + + Add_Argument + ("-l" & Get_Name_String (Data.Library_Name), + Verbose_Mode); + + Get_Name_String (Data.Library_Dir); + + Add_Argument + ("-L" & Name_Buffer (1 .. Name_Len), + Verbose_Mode); + + -- If there is a run path option, prepend this + -- directory to the library path. It is probable + -- that the order of the directories in the path + -- option is not important, but just in case + -- put the directories in the same order as the + -- libraries. + + if Path_Option /= null then + + -- If it is not the first directory, make room + -- at the beginning of the table, including + -- for a path separator. + + if Lib_Path.Last > 0 then + Increment := Name_Len + 1; + Prev_Last := Lib_Path.Last; + Lib_Path.Set_Last (Prev_Last + Increment); + + for Index in reverse 1 .. Prev_Last loop + Lib_Path.Table (Index + Increment) := + Lib_Path.Table (Index); + end loop; + + Lib_Path.Table (Increment) := Path_Separator; + + else + -- If it is the first directory, just set + -- Last to the length of the directory. + + Lib_Path.Set_Last (Name_Len); + end if; + + -- Put the directory at the beginning of the + -- table. + + for Index in 1 .. Name_Len loop + Lib_Path.Table (Index) := Name_Buffer (Index); + end loop; + end if; + end if; + end if; + + -- For a non-library project, the only archive needed + -- is the one for the main project. + + elsif Project = Main_Project then + Add_Argument + (Get_Name_String (Data.Object_Directory) & + Directory_Separator & + "lib" & Get_Name_String (Data.Name) & + '.' & Archive_Ext, + Verbose_Mode); + end if; + end Add_Archive_Path; + begin -- Nothing to do when there is no project specified @@ -499,100 +616,17 @@ package body Makegpr is -- If there is sources of language other than Ada in this -- project, add the path of the archive to Arguments. - if Data.Sources_Present then - if Data.Library then - - -- If it is a library project file, nothing to do if - -- gnatmake will be invoked, because gnatmake will take - -- care of it, even if the library is not an Ada library. - - if not For_Gnatmake then - if Data.Library_Kind = Static then - Add_Argument - (Get_Name_String (Data.Library_Dir) & - Directory_Separator & - "lib" & Get_Name_String (Data.Library_Name) & - '.' & Archive_Ext, - Verbose_Mode); - - else - -- As we first insert in the reverse order, - -- -L<dir> is put after -l<lib> - - Add_Argument - ("-l" & Get_Name_String (Data.Library_Name), - Verbose_Mode); - - Get_Name_String (Data.Library_Dir); - - Add_Argument - ("-L" & Name_Buffer (1 .. Name_Len), - Verbose_Mode); - - -- If there is a run path option, prepend this - -- directory to the library path. It is probable - -- that the order of the directories in the path - -- option is not important, but just in case - -- put the directories in the same order as the - -- libraries. - - if Path_Option /= null then - -- If it is not the first directory, make room - -- at the beginning of the table, including - -- for a path separator. - - if Lib_Path.Last > 0 then - declare - Increment : constant Positive := - Name_Len + 1; - Prev_Last : constant Positive := - Lib_Path.Last; - - begin - Lib_Path.Set_Last (Prev_Last + Increment); - - for Index in reverse 1 .. Prev_Last loop - Lib_Path.Table (Index + Increment) := - Lib_Path.Table (Index); - end loop; - - Lib_Path.Table (Increment) := - Path_Separator; - end; - - else - -- If it is the first directory, just set - -- Last to the length of the directory. - - Lib_Path.Set_Last (Name_Len); - end if; - - -- Put the directory at the beginning of the - -- table. - - for Index in 1 .. Name_Len loop - Lib_Path.Table (Index) := Name_Buffer (Index); - end loop; - end if; - end if; - end if; - - else - -- For a non library project, just add the path name of - -- the archive. - - Add_Argument - (Get_Name_String (Data.Object_Directory) & - Directory_Separator & - "lib" & Get_Name_String (Data.Name) & - '.' & Archive_Ext, - Verbose_Mode); - end if; + if Project = Main_Project + or else Data.Other_Sources_Present + then + Add_Archive_Path; end if; end if; end if; end Recursive_Add_Archives; + -- Start of processing for Add_Archives + begin -- First, mark all projects as not processed @@ -723,11 +757,15 @@ package body Makegpr is if Last_Argument + Args'Length > Arguments'Last then declare New_Arguments : constant Argument_List_Access := - new Argument_List - (1 .. Last_Argument + Args'Length + Initial_Argument_Count); + new Argument_List + (1 .. Last_Argument + Args'Length + + Initial_Argument_Count); + New_Arguments_Displayed : constant Booleans := - new Boolean_Array - (1 .. Last_Argument + Args'Length + Initial_Argument_Count); + new Boolean_Array + (1 .. Last_Argument + + Args'Length + + Initial_Argument_Count); begin New_Arguments (1 .. Last_Argument) := @@ -790,7 +828,7 @@ package body Makegpr is -- Add_Source_Id -- ------------------- - procedure Add_Source_Id (Id : Other_Source_Id) is + procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id) is begin -- Reallocate the array, if necessary @@ -808,7 +846,7 @@ package body Makegpr is end if; Last_Source := Last_Source + 1; - Source_Indexes (Last_Source) := (Id, False); + Source_Indexes (Last_Source) := (Project, Id, False); end Add_Source_Id; ---------------------------- @@ -902,12 +940,22 @@ package body Makegpr is if Switches /= Nil_Variable_Value then Element_Id := Switches.Values; - while Element_Id /= Nil_String loop Element := String_Elements.Table (Element_Id); if Element.Value /= No_Name then - Add_Argument (Get_Name_String (Element.Value), True); + Get_Name_String (Element.Value); + + if not Quiet_Output then + + -- When not in quiet output (no -q), check that the switch + -- is not the concatenation of several valid switches, + -- such as "-g -v". If it is, issue a warning. + + Check (Option => Name_Buffer (1 .. Name_Len)); + end if; + + Add_Argument (Name_Buffer (1 .. Name_Len), True); end if; Element_Id := Element.Next; @@ -915,12 +963,12 @@ package body Makegpr is end if; end Add_Switches; - ------------------- - -- Build_Archive -- - ------------------- + -------------------------- + -- Build_Global_Archive -- + -------------------------- - procedure Build_Archive (Project : Project_Id; Unconditionally : Boolean) is - Data : constant Project_Data := Projects.Table (Project); + procedure Build_Global_Archive is + Data : Project_Data := Projects.Table (Main_Project); Source_Id : Other_Source_Id; Source : Other_Source; Success : Boolean; @@ -933,36 +981,344 @@ package body Makegpr is "lib" & Get_Name_String (Data.Name) & ".deps"; -- The name of the archive dependency file for this project - Need_To_Rebuild : Boolean := Unconditionally; + Need_To_Rebuild : Boolean := Need_To_Rebuild_Global_Archive; -- When True, archive will be rebuilt File : Prj.Util.Text_File; - Object_Name : Name_Id; - Time_Stamp : Time_Stamp_Type; + Object_Path : Name_Id; + Time_Stamp : Time_Stamp_Type; Saved_Last_Argument : Natural; + First_Object : Natural; + + Discard : Boolean; begin - -- First, make sure that the archive builder (ar) is on the path + Check_Archive_Builder; - if Archive_Builder_Path = null then - Archive_Builder_Path := Locate_Exec_On_Path (Archive_Builder); + Change_Dir (Get_Name_String (Data.Object_Directory)); - if Archive_Builder_Path = null then - Osint.Fail - ("unable to locate archive builder """, - Archive_Builder, - """"); + if not Need_To_Rebuild then + if Verbose_Mode then + Write_Str (" Checking "); + Write_Line (Archive_Name); end if; - -- If there is an archive indexer (ranlib), try to locate it on the - -- path. Don't fail if it is not found. + -- If the archive does not exist, of course it needs to be built - if Archive_Indexer /= "" then - Archive_Indexer_Path := Locate_Exec_On_Path (Archive_Indexer); + if not Is_Regular_File (Archive_Name) then + Need_To_Rebuild := True; + + if Verbose_Mode then + Write_Line (" -> archive does not exist"); + end if; + + -- Archive does exist + + else + -- Check the archive dependency file + + Open (File, Archive_Dep_Name); + + -- If the archive dependency file does not exist, we need to + -- to rebuild the archive and to create its dependency file. + + if not Is_Valid (File) then + Need_To_Rebuild := True; + + if Verbose_Mode then + Write_Str (" -> archive dependency file "); + Write_Str (Archive_Dep_Name); + Write_Line (" does not exist"); + end if; + + else + -- Put all sources of language other than Ada in + -- Source_Indexes. + + for Proj in 1 .. Projects.Last loop + Data := Projects.Table (Proj); + + if not Data.Library then + Last_Source := 0; + Source_Id := Data.First_Other_Source; + + while Source_Id /= No_Other_Source loop + Add_Source_Id (Proj, Source_Id); + Source_Id := Other_Sources.Table (Source_Id).Next; + end loop; + end if; + end loop; + + -- Read the dependency file, line by line + + while not End_Of_File (File) loop + Get_Line (File, Name_Buffer, Name_Len); + + -- First line is the path of the object file + + Object_Path := Name_Find; + Source_Id := No_Other_Source; + + -- Check if this object file is for a source of this project + + for S in 1 .. Last_Source loop + Source_Id := Source_Indexes (S).Id; + Source := Other_Sources.Table (Source_Id); + + if (not Source_Indexes (S).Found) + and then Source.Object_Path = Object_Path + then + -- We have found the object file: get the source + -- data, and mark it as found. + + Source_Indexes (S).Found := True; + exit; + end if; + end loop; + + -- If it is not for a source of this project, then the + -- archive needs to be rebuilt. + + if Source_Id = No_Other_Source then + Need_To_Rebuild := True; + if Verbose_Mode then + Write_Str (" -> "); + Write_Str (Get_Name_String (Object_Path)); + Write_Line (" is not an object of any project"); + end if; + + exit; + end if; + + -- The second line is the time stamp of the object file. + -- If there is no next line, then the dependency file is + -- truncated, and the archive need to be rebuilt. + + if End_Of_File (File) then + Need_To_Rebuild := True; + + if Verbose_Mode then + Write_Str (" -> archive dependency file "); + Write_Line (" is truncated"); + end if; + + exit; + end if; + + Get_Line (File, Name_Buffer, Name_Len); + + -- If the line has the wrong number of characters, then + -- the dependency file is incorrectly formatted, and the + -- archive needs to be rebuilt. + + if Name_Len /= Time_Stamp_Length then + Need_To_Rebuild := True; + + if Verbose_Mode then + Write_Str (" -> archive dependency file "); + Write_Line (" is incorrectly formatted (time stamp)"); + end if; + + exit; + end if; + + Time_Stamp := Time_Stamp_Type (Name_Buffer (1 .. Name_Len)); + + -- If the time stamp in the dependency file is different + -- from the time stamp of the object file, then the archive + -- needs to be rebuilt. + + if Time_Stamp /= Source.Object_TS then + Need_To_Rebuild := True; + + if Verbose_Mode then + Write_Str (" -> time stamp of "); + Write_Str (Get_Name_String (Object_Path)); + Write_Str (" is incorrect in the archive"); + Write_Line (" dependency file"); + end if; + + exit; + end if; + end loop; + + Close (File); + end if; + end if; + end if; + + if not Need_To_Rebuild then + if Verbose_Mode then + Write_Line (" -> up to date"); + end if; + + -- Archive needs to be rebuilt + + else + -- If the archive is built, then linking will need to occur + -- unconditionally. + + Need_To_Relink := True; + + -- If archive already exists, first delete it + + -- Comment needed on why we discard result??? + + if Is_Regular_File (Archive_Name) then + Delete_File (Archive_Name, Discard); + end if; + + Last_Argument := 0; + + -- Start with the options found in MLib.Tgt (usually just "rc") + + Add_Arguments (Archive_Builder_Options.all, True); + + -- Followed by the archive name + + Add_Argument (Archive_Name, True); + + First_Object := Last_Argument; + + -- Followed by all the object files of the non library projects + + for Proj in 1 .. Projects.Last loop + Data := Projects.Table (Proj); + + if not Data.Library then + Source_Id := Data.First_Other_Source; + + while Source_Id /= No_Other_Source loop + Source := Other_Sources.Table (Source_Id); + + -- Only include object file name that have not been + -- overriden in extending projects. + + if Is_Included_In_Global_Archive + (Source.Object_Name, Proj) + then + Add_Argument + (Get_Name_String (Source.Object_Path), Verbose_Mode); + end if; + + Source_Id := Source.Next; + end loop; + end if; + end loop; + + -- Spawn the archive builder (ar) + + Saved_Last_Argument := Last_Argument; + + Last_Argument := First_Object + Max_In_Archives; + + loop + if Last_Argument > Saved_Last_Argument then + Last_Argument := Saved_Last_Argument; + end if; + + Display_Command (Archive_Builder, Archive_Builder_Path); + + Spawn + (Archive_Builder_Path.all, + Arguments (1 .. Last_Argument), + Success); + + exit when not Success; + + exit when Last_Argument = Saved_Last_Argument; + + Arguments (1) := r; + Arguments (3 .. Saved_Last_Argument - Last_Argument + 2) := + Arguments (Last_Argument + 1 .. Saved_Last_Argument); + Saved_Last_Argument := Saved_Last_Argument - Last_Argument + 2; + end loop; + + -- If the archive was built, run the archive indexer (ranlib) + -- if there is one. + + if Success then + + -- If the archive was built, run the archive indexer (ranlib), + -- if there is one. + + if Archive_Indexer_Path /= null then + Last_Argument := 0; + Add_Argument (Archive_Name, True); + + Display_Command (Archive_Indexer, Archive_Indexer_Path); + + Spawn (Archive_Indexer_Path.all, Arguments (1 .. 1), Success); + + if not Success then + + -- Running ranlib failed, delete the dependency file, + -- if it exists. + + if Is_Regular_File (Archive_Dep_Name) then + Delete_File (Archive_Dep_Name, Success); + end if; + + -- And report the error + + Report_Error + ("running" & Archive_Indexer & " for project """, + Get_Name_String (Data.Name), + """ failed"); + return; + end if; + end if; + + -- The archive was correctly built, create its dependency file + + Create_Global_Archive_Dependency_File (Archive_Dep_Name); + + -- Building the archive failed, delete dependency file if one exists + + else + if Is_Regular_File (Archive_Dep_Name) then + Delete_File (Archive_Dep_Name, Success); + end if; + + -- And report the error + + Report_Error + ("building archive for project """, + Get_Name_String (Data.Name), + """ failed"); end if; end if; + end Build_Global_Archive; + + ------------------- + -- Build_Library -- + ------------------- + + procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) is + Data : constant Project_Data := Projects.Table (Project); + Source_Id : Other_Source_Id; + Source : Other_Source; + + Archive_Name : constant String := + "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext; + -- The name of the archive file for this project + + Archive_Dep_Name : constant String := + "lib" & Get_Name_String (Data.Name) & ".deps"; + -- The name of the archive dependency file for this project + + Need_To_Rebuild : Boolean := Unconditionally; + -- When True, archive will be rebuilt + + File : Prj.Util.Text_File; + + Object_Name : Name_Id; + Time_Stamp : Time_Stamp_Type; + + begin + Check_Archive_Builder; -- If Unconditionally is False, check if the archive need to be built @@ -1001,14 +1357,13 @@ package body Makegpr is end if; else - -- Put all sources of language other than Ada in - -- Source_Indexes. + -- Put all sources of language other than Ada in Source_Indexes Last_Source := 0; Source_Id := Data.First_Other_Source; while Source_Id /= No_Other_Source loop - Add_Source_Id (Source_Id); + Add_Source_Id (Project, Source_Id); Source_Id := Other_Sources.Table (Source_Id).Next; end loop; @@ -1045,6 +1400,7 @@ package body Makegpr is if Source_Id = No_Other_Source then Need_To_Rebuild := True; + if Verbose_Mode then Write_Str (" -> "); Write_Str (Get_Name_String (Object_Name)); @@ -1139,22 +1495,17 @@ package body Makegpr is end if; end if; - -- Build the archive if necessary + -- Build the library if necessary if Need_To_Rebuild then - -- If an archive is built, then linking will need to occur + -- If a library is built, then linking will need to occur -- unconditionally. Need_To_Relink := True; Last_Argument := 0; - -- If it is a library project file, we need to build the library - -- in the library directory. - - if Data.Library then - -- If there are sources in Ada, then gnatmake will build the -- library, so nothing to do. @@ -1192,9 +1543,7 @@ package body Makegpr is Lib_Dir => Get_Name_String (Data.Library_Dir), Symbol_Data => No_Symbols, Driver_Name => No_Name, - Lib_Address => "", Lib_Version => "", - Relocatable => Data.Library_Kind = Relocatable, Auto_Init => False); end if; end if; @@ -1212,109 +1561,88 @@ package body Makegpr is Create_Archive_Dependency_File (Archive_Dep_Name, Data.First_Other_Source); - return; - end if; - - -- Start with the options found in MLib.Tgt (usually just "rc") - - Add_Arguments (Archive_Builder_Options.all, True); - - -- Followed by the archive name - - Add_Argument (Archive_Name, True); - - -- Followed by all the object files of the project - - Source_Id := Data.First_Other_Source; - - while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); - Add_Argument (Get_Name_String (Source.Object_Name), Verbose_Mode); - Source_Id := Source.Next; - end loop; - - -- Spawn the archive builder (ar) - - Saved_Last_Argument := Last_Argument; - - Last_Argument := Max_In_Archives; - - loop - if Last_Argument > Saved_Last_Argument then - Last_Argument := Saved_Last_Argument; - end if; - - Display_Command (Archive_Builder, Archive_Builder_Path); - - Spawn - (Archive_Builder_Path.all, - Arguments (1 .. Last_Argument), - Success); - - exit when not Success; - - exit when Last_Argument = Saved_Last_Argument; - - Arguments (1) := r; - Arguments (3 .. Saved_Last_Argument - Last_Argument + 2) := - Arguments (Last_Argument + 1 .. Saved_Last_Argument); - Saved_Last_Argument := Saved_Last_Argument - Last_Argument + 2; - end loop; + end if; + end Build_Library; - if Success then + ----------- + -- Check -- + ----------- - -- If the archive was built, run the archive indexer (ranlib), - -- if there is one. + procedure Check (Option : String) is + First : Positive := Option'First; + Last : Natural; - if Archive_Indexer_Path /= null then - Last_Argument := 0; - Add_Argument (Archive_Name, True); + begin + for Index in Option'First + 1 .. Option'Last - 1 loop + if Option (Index) = ' ' and then Option (Index + 1) = '-' then + Write_Str ("warning: switch """); + Write_Str (Option); + Write_Str (""" is suspicious; consider using "); + + Last := First; + while Last <= Option'Last loop + if Option (Last) = ' ' then + if First /= Option'First then + Write_Str (", "); + end if; - Display_Command (Archive_Indexer, Archive_Indexer_Path); + Write_Char ('"'); + Write_Str (Option (First .. Last - 1)); + Write_Char ('"'); - Spawn (Archive_Indexer_Path.all, Arguments (1 .. 1), Success); + while Last <= Option'Last and then Option (Last) = ' ' loop + Last := Last + 1; + end loop; - if not Success then + First := Last; - -- Running ranlib failed, delete the dependency file, - -- if it exists. + else + if Last = Option'Last then + if First /= Option'First then + Write_Str (", "); + end if; - if Is_Regular_File (Archive_Dep_Name) then - Delete_File (Archive_Dep_Name, Success); + Write_Char ('"'); + Write_Str (Option (First .. Last)); + Write_Char ('"'); end if; - -- And report the error - - Report_Error - ("running" & Archive_Indexer & " for project """, - Get_Name_String (Data.Name), - """ failed"); - return; + Last := Last + 1; end if; - end if; + end loop; - -- The archive was correctly built, create its dependency file + Write_Line (" instead"); + exit; + end if; + end loop; + end Check; - Create_Archive_Dependency_File - (Archive_Dep_Name, Data.First_Other_Source); + --------------------------- + -- Check_Archive_Builder -- + --------------------------- - else - -- Building the archive failed, delete the dependency file, if - -- one exists. + procedure Check_Archive_Builder is + begin + -- First, make sure that the archive builder (ar) is on the path - if Is_Regular_File (Archive_Dep_Name) then - Delete_File (Archive_Dep_Name, Success); - end if; + if Archive_Builder_Path = null then + Archive_Builder_Path := Locate_Exec_On_Path (Archive_Builder); - -- And report the error + if Archive_Builder_Path = null then + Osint.Fail + ("unable to locate archive builder """, + Archive_Builder, + """"); + end if; - Report_Error - ("building archive for project """, - Get_Name_String (Data.Name), - """ failed"); + -- If there is an archive indexer (ranlib), try to locate it on the + -- path. Don't fail if it is not found. + + if Archive_Indexer /= "" then + Archive_Indexer_Path := Locate_Exec_On_Path (Archive_Indexer); end if; end if; - end Build_Archive; + end Check_Archive_Builder; ------------------------------ -- Check_Compilation_Needed -- @@ -1330,8 +1658,7 @@ package body Makegpr is Dep_Name : constant String := Get_Name_String (Source.Dep_Name); Source_In_Dependencies : Boolean := False; - -- Set to True if the source was find in the dependency file of its - -- object file. + -- Set True if source was found in dependency file of its object file Dep_File : Prj.Util.Text_File; Start : Natural; @@ -1349,8 +1676,7 @@ package body Makegpr is Write_Line (" ... "); end if; - -- If the object file does not exist, of course the source need to be - -- compiled. + -- If object file does not exist, of course source need to be compiled if Source.Object_TS = Empty_Time_Stamp then if Verbose_Mode then @@ -1432,8 +1758,7 @@ package body Makegpr is end loop; -- If dependency file contains only empty lines or comments, then - -- the dependencies are unknown, and the source needs to be - -- recompiled. + -- dependencies are unknown, and the source needs to be recompiled. if End_Of_File_Reached then if Verbose_Mode then @@ -1450,8 +1775,7 @@ package body Makegpr is Start := 1; Finish := Index (Name_Buffer (1 .. Name_Len), ": "); - -- The first line must start with the name of the object file, followed - -- by a colon (:). + -- 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 @@ -1470,7 +1794,7 @@ package body Makegpr is Line_Loop : loop declare - Line : constant String := Name_Buffer (1 .. Name_Len); + Line : constant String := Name_Buffer (1 .. Name_Len); Last : constant Natural := Name_Len; begin @@ -1631,13 +1955,13 @@ package body Makegpr is CPATH : String_Access := null; begin - -- If the compiler is not know yet, get its path name + -- If the compiler is not known yet, get its path name if Compiler_Names (Source.Language) = null then Get_Compiler (Source.Language); end if; - -- For non GCC compilers, get the dependency file, calling first the + -- For non GCC compilers, get the dependency file, first calling the -- compiler with the switch -M. if not Compiler_Is_Gcc (Source.Language) then @@ -1663,8 +1987,7 @@ package body Makegpr is Add_Argument (Options (Source.Language).Table (J), True); end loop; - -- Finally, add the imported directory switches for this - -- project file. + -- Finally, add imported directory switches for this project file Add_Search_Directories (Data, Source.Language); @@ -1800,9 +2123,7 @@ package body Makegpr is -- Add the compiling switches for the language specified -- on the command line, if any. - for - J in 1 .. Comp_Opts.Last (Options (Source.Language)) - loop + for J in 1 .. Comp_Opts.Last (Options (Source.Language)) loop Add_Argument (Options (Source.Language).Table (J), True); end loop; @@ -1830,10 +2151,11 @@ package body Makegpr is Arguments (1 .. Last_Argument), Success); + -- Case of successful compilation + if Success then - -- Compilation was successful, update the time stamp - -- of the object file. + -- Update the time stamp of the object file Source.Object_TS := File_Stamp (Source.Object_Name); @@ -1859,6 +2181,8 @@ package body Makegpr is Other_Sources.Table (Source_Id) := Source; end if; + -- Compilation failed + else Local_Errors := True; Report_Error @@ -1884,9 +2208,7 @@ package body Makegpr is begin Ada_Mains.Init; - To_Mixed (Project_Name); - Compile_Only := True; Get_Imported_Directories (Main_Project, Data); @@ -1896,7 +2218,7 @@ package body Makegpr is Change_Dir (Get_Name_String (Data.Object_Directory)); - if not Data.Sources_Present then + if not Data.Other_Sources_Present then if Ada_Is_A_Language then Mains.Reset; @@ -1930,7 +2252,6 @@ package body Makegpr is if not Sources_Compiled.Get (Source_Name) then Sources_Compiled.Set (Source_Name, True); - Source_Id := Data.First_Other_Source; while Source_Id /= No_Other_Source loop @@ -1942,8 +2263,7 @@ package body Makegpr is if Source_Id = No_Other_Source then if Ada_Is_A_Language then Ada_Mains.Increment_Last; - Ada_Mains.Table (Ada_Mains.Last) := - new String'(Main); + Ada_Mains.Table (Ada_Mains.Last) := new String'(Main); else Report_Error @@ -1962,10 +2282,9 @@ package body Makegpr is if Ada_Mains.Last > 0 then - -- Invoke gnatmake for all sources that are not of a non Ada language + -- Invoke gnatmake for all Ada sources Last_Argument := 0; - Add_Argument (Dash_u, True); for Index in 1 .. Ada_Mains.Last loop @@ -2019,7 +2338,7 @@ package body Makegpr is Add_Argument (Output_File_Name, True); end if; - -- Transmit to gnatmake some switches + -- Transmit some switches to gnatmake -- -c @@ -2075,8 +2394,9 @@ package body Makegpr is end if; if not Compile_Only then - -- If there are linking options from the command line, transmit them - -- to gnatmake. + + -- If there are linking options from the command line, + -- transmit them to gnatmake. if Linker_Options.Last /= 0 then Add_Argument (Dash_largs, True); @@ -2133,7 +2453,7 @@ package body Makegpr is -- True when the archive needs to be built/rebuilt unconditionally begin - -- For each project file + -- Loop through project files for Project in 1 .. Projects.Last loop Local_Errors := False; @@ -2141,7 +2461,7 @@ package body Makegpr is -- Nothing to do when no sources of language other than Ada - if (not Data.Virtual) and then Data.Sources_Present then + if (not Data.Virtual) and then Data.Other_Sources_Present then -- If the imported directory switches are unknown, compute them @@ -2187,11 +2507,18 @@ package body Makegpr is Source_Id := Source.Next; end loop; + if Need_To_Rebuild_Archive and then (not Data.Library) then + Need_To_Rebuild_Global_Archive := True; + end if; + -- If there was no compilation error, build/rebuild the archive -- if necessary. - if not Local_Errors then - Build_Archive (Project, Need_To_Rebuild_Archive); + if not Local_Errors + and then Data.Library + and then not Data.Languages (Lang_Ada) + then + Build_Library (Project, Need_To_Rebuild_Archive); end if; end if; end loop; @@ -2229,7 +2556,10 @@ package body Makegpr is use Ada.Text_IO; begin - Create (Dep_File, Out_File, Name); + -- Create the file in Append mode, to avoid automatic insertion of + -- an end of line if file is empty. + + Create (Dep_File, Append_File, Name); while Source_Id /= No_Other_Source loop Source := Other_Sources.Table (Source_Id); @@ -2247,6 +2577,55 @@ package body Makegpr is end if; end Create_Archive_Dependency_File; + ------------------------------------------- + -- Create_Global_Archive_Dependency_File -- + ------------------------------------------- + + procedure Create_Global_Archive_Dependency_File (Name : String) is + Source_Id : Other_Source_Id; + Source : Other_Source; + Dep_File : Ada.Text_IO.File_Type; + + use Ada.Text_IO; + + begin + -- Create the file in Append mode, to avoid automatic insertion of + -- an end of line if file is empty. + + Create (Dep_File, Append_File, Name); + + -- Get all the object files of non-Ada sources in non-library projects + + for Project in 1 .. Projects.Last loop + if not Projects.Table (Project).Library then + Source_Id := Projects.Table (Project).First_Other_Source; + + while Source_Id /= No_Other_Source loop + Source := Other_Sources.Table (Source_Id); + + -- Put only those object files that are in the global archive + + if Is_Included_In_Global_Archive + (Source.Object_Name, Project) + then + Put_Line (Dep_File, Get_Name_String (Source.Object_Path)); + Put_Line (Dep_File, String (Source.Object_TS)); + end if; + + Source_Id := Source.Next; + end loop; + end if; + end loop; + + Close (Dep_File); + + exception + when others => + if Is_Open (Dep_File) then + Close (Dep_File); + end if; + end Create_Global_Archive_Dependency_File; + --------------------- -- Display_Command -- --------------------- @@ -2261,6 +2640,7 @@ package body Makegpr is -- not in Quiet Output (no -q). if Verbose_Mode or (not Quiet_Output) then + -- In Verbose Mode output the full path of the spawned process if Verbose_Mode then @@ -2391,9 +2771,9 @@ package body Makegpr is Element_Id : String_List_Id := Source_Dirs; Element : String_Element; Add_Arg : Boolean := True; + begin - -- Add each source directory path name, preceded by "-I" to - -- Arguments. + -- Add each source directory path name, preceded by "-I" to Arguments while Element_Id /= Nil_String loop Element := String_Elements.Table (Element_Id); @@ -2476,6 +2856,8 @@ package body Makegpr is end if; end Recursive_Get_Dirs; + -- Start of processing for Get_Imported_Directories + begin -- First, mark all project as not processed @@ -2538,8 +2920,7 @@ package body Makegpr is Write_Eol; end if; - -- Parse and process the project files for other languages - -- (not for Ada). + -- Parse and process project files for other languages (not for Ada) Prj.Pars.Parse (Project => Main_Project, @@ -2570,14 +2951,14 @@ package body Makegpr is if Mains.Number_Of_Mains = 0 then Osint.Fail ("No source specified to compile in 'unique compile' mode"); - else Compile_Individual_Sources; Report_Total_Errors ("compilation"); end if; else - -- First compile sources and build archives, if necessary + -- First compile sources and build archives for library project, + -- if necessary. Compile_Sources; @@ -2590,6 +2971,7 @@ package body Makegpr is -- If -c was not specified, link the executables, if there are any. if not Compile_Only then + Build_Global_Archive; Check_For_C_Plus_Plus; Link_Executables; end if; @@ -2655,6 +3037,34 @@ package body Makegpr is Osint.Add_Default_Search_Dirs; end Initialize; + ----------------------------------- + -- Is_Included_In_Global_Archive -- + ----------------------------------- + + function Is_Included_In_Global_Archive + (Object_Name : Name_Id; + Project : Project_Id) return Boolean + is + Data : Project_Data := Projects.Table (Project); + Source : Other_Source_Id; + + begin + while Data.Extended_By /= No_Project loop + Data := Projects.Table (Data.Extended_By); + Source := Data.First_Other_Source; + + while Source /= No_Other_Source loop + if Other_Sources.Table (Source).Object_Name = Object_Name then + return False; + else + Source := Other_Sources.Table (Source).Next; + end if; + end loop; + end loop; + + return True; + end Is_Included_In_Global_Archive; + ---------------------- -- Link_Executables -- ---------------------- @@ -2684,9 +3094,19 @@ package body Makegpr is procedure Add_C_Plus_Plus_Link_For_Gnatmake; -- Add the --LINK= switch for gnatlink, depending on the C++ compiler + procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type); + -- Check if there is an archive that is more recent than the executable + -- to decide if we need to relink. + procedure Choose_C_Plus_Plus_Link_Process; -- If the C++ compiler is not g++, create the correct script to link + procedure Link_Foreign + (Main : String; + Main_Id : Name_Id; + Source : Other_Source); + -- Link a non-Ada main, when there is no Ada code + --------------------------------------- -- Add_C_Plus_Plus_Link_For_Gnatmake -- --------------------------------------- @@ -2707,6 +3127,61 @@ package body Makegpr is end if; end Add_C_Plus_Plus_Link_For_Gnatmake; + ----------------------- + -- Check_Time_Stamps -- + ----------------------- + + procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type) is + Prj_Data : Project_Data; + + begin + for Prj in 1 .. Projects.Last loop + Prj_Data := Projects.Table (Prj); + + -- There is an archive only in project + -- files with sources other than Ada + -- sources. + + if Data.Other_Sources_Present then + declare + Archive_Path : constant String := + Get_Name_String + (Prj_Data.Object_Directory) & + Directory_Separator & + "lib" & + Get_Name_String (Prj_Data.Name) & + '.' & Archive_Ext; + Archive_TS : Time_Stamp_Type; + begin + Name_Len := 0; + Add_Str_To_Name_Buffer + (Archive_Path); + Archive_TS := File_Stamp (Name_Find); + + -- If the archive is later than the + -- executable, we need to relink. + + if Archive_TS /= Empty_Time_Stamp + and then + Exec_Time_Stamp < Archive_TS + then + Need_To_Relink := True; + + if Verbose_Mode then + Write_Str (" -> "); + Write_Str (Archive_Path); + Write_Str (" has time stamp "); + Write_Str ("later than "); + Write_Line ("executable"); + end if; + + exit; + end if; + end; + end if; + end loop; + end Check_Time_Stamps; + ------------------------------------- -- Choose_C_Plus_Plus_Link_Process -- ------------------------------------- @@ -2747,6 +3222,159 @@ package body Makegpr is end if; end Choose_C_Plus_Plus_Link_Process; + ------------------ + -- Link_Foreign -- + ------------------ + + procedure Link_Foreign + (Main : String; + Main_Id : Name_Id; + Source : Other_Source) + is + Executable_Name : constant String := + Get_Name_String + (Executable_Of + (Project => Main_Project, + Main => Main_Id, + Index => 0, + Ada_Main => False)); + -- File name of the executable + + Executable_Path : constant String := + Get_Name_String + (Data.Exec_Directory) & + Directory_Separator & + Executable_Name; + -- Path name of the executable + + Exec_Time_Stamp : Time_Stamp_Type; + + begin + -- Now, check if the executable is up to date. It is considered + -- up to date if its time stamp is not earlier that the time stamp + -- of any archive. Only do that if we don't know if we need to link. + + if not Need_To_Relink then + + -- Get the time stamp of the executable + + Name_Len := 0; + Add_Str_To_Name_Buffer (Executable_Path); + Exec_Time_Stamp := File_Stamp (Name_Find); + + if Verbose_Mode then + Write_Str (" Checking executable "); + Write_Line (Executable_Name); + end if; + + -- If executable does not exist, we need to link + + if Exec_Time_Stamp = Empty_Time_Stamp then + Need_To_Relink := True; + + if Verbose_Mode then + Write_Line (" -> not found"); + end if; + + -- Otherwise, get the time stamps of each archive. If one of + -- them is found later than the executable, we need to relink. + + else + Check_Time_Stamps (Exec_Time_Stamp); + end if; + + -- If Need_To_Relink is False, we are done + + if Verbose_Mode and (not Need_To_Relink) then + Write_Line (" -> up to date"); + end if; + end if; + + -- Prepare to link + + if Need_To_Relink then + Link_Done := True; + + Last_Argument := 0; + + -- Specify the executable path name + + Add_Argument (Dash_o, True); + Add_Argument + (Get_Name_String (Data.Exec_Directory) & + Directory_Separator & + Get_Name_String + (Executable_Of + (Project => Main_Project, + Main => Main_Id, + Index => 0, + Ada_Main => False)), + True); + + -- Specify the object file of the main source + + Add_Argument + (Object_Dir & Directory_Separator & + Get_Name_String (Source.Object_Name), + True); + + -- Add the switches specified in package Linker of + -- the main project. + + Add_Switches + (Data => Data, + Proc => Linker, + Language => Source.Language, + File_Name => Main_Id); + + -- Add the switches specified in attribute + -- Linker_Options of packages Linker. + + if Link_Options_Switches = null then + Link_Options_Switches := + new Argument_List' + (Linker_Options_Switches (Main_Project)); + end if; + + Add_Arguments (Link_Options_Switches.all, True); + + -- Add the linking options specified on the + -- command line. + + for Arg in 1 .. Linker_Options.Last loop + Add_Argument (Linker_Options.Table (Arg), True); + end loop; + + -- Add all the archives, in a correct order + + Add_Archives (For_Gnatmake => False); + + -- If there are shared libraries and the run path + -- option is supported, add the run path switch. + + if Lib_Path.Last > 0 then + Add_Argument + (Path_Option.all & + String (Lib_Path.Table (1 .. Lib_Path.Last)), + Verbose_Mode); + end if; + + -- And invoke the linker + + Display_Command (Linker_Name.all, Linker_Path); + Spawn + (Linker_Path.all, + Arguments (1 .. Last_Argument), + Success); + + if not Success then + Report_Error ("could not link ", Main); + end if; + end if; + end Link_Foreign; + + -- Start of processing of Link_Executables + begin -- If no mains specified, get mains from attribute Main, if it exists @@ -2769,6 +3397,7 @@ package body Makegpr is end if; if Mains.Number_Of_Mains = 0 then + -- If the attribute Main is an empty list or not specified, -- there is nothing to do. @@ -2786,10 +3415,12 @@ package body Makegpr is -- Check how we are going to do the link - if not Data.Sources_Present then + if not Data.Other_Sources_Present then + -- Only Ada sources in the main project, and even maybe not if not Data.Languages (Lang_Ada) then + -- Fail if the main project has no source of any language Osint.Fail @@ -2802,8 +3433,7 @@ package body Makegpr is Last_Argument := 0; - -- Choose the correct linker if there is C++ code in other - -- projects. + -- Choose correct linker if there is C++ code in other projects if C_Plus_Plus_Is_Used then Choose_C_Plus_Plus_Link_Process; @@ -2820,10 +3450,11 @@ package body Makegpr is -- sources in Ada. if Data.Languages (Lang_Ada) then + -- There is a mix of Ada and other language sources in the main -- project. Any main that is not a source of the other languages -- will be deemed to be an Ada main. - -- + -- Find the mains of the other languages and the Ada mains. Mains.Reset; @@ -2834,8 +3465,9 @@ package body Makegpr is loop declare - Main : constant String := Mains.Next_Main; + Main : constant String := Mains.Next_Main; Main_Id : Name_Id; + begin exit when Main'Length = 0; @@ -2883,6 +3515,7 @@ package body Makegpr is for Main in 1 .. Other_Mains.Last loop declare Source : constant Other_Source := Other_Mains.Table (Main); + begin Last_Argument := 0; @@ -3007,200 +3640,7 @@ package body Makegpr is Get_Name_String (Data.Name)); else - declare - Executable_Name : constant String := - Get_Name_String - (Executable_Of - (Project => Main_Project, - Main => Main_Id, - Index => 0, - Ada_Main => False)); - -- File name of the executable - - Executable_Path : constant String := - Get_Name_String - (Data.Exec_Directory) & - Directory_Separator & - Executable_Name; - -- Path name of the executable - - Exec_Time_Stamp : Time_Stamp_Type; - - begin - -- Now, check if the executable is up to date. - -- It is considered up to date if its time stamp is - -- not earlier that the time stamp of any archive. - -- Only do that if we don't know if we need to link. - - if not Need_To_Relink then - - -- Get the time stamp of the executable - - Name_Len := 0; - Add_Str_To_Name_Buffer (Executable_Path); - Exec_Time_Stamp := File_Stamp (Name_Find); - - if Verbose_Mode then - Write_Str (" Checking executable "); - Write_Line (Executable_Name); - end if; - - -- If executable does not exist, we need to link - - if Exec_Time_Stamp = Empty_Time_Stamp then - Need_To_Relink := True; - - if Verbose_Mode then - Write_Line (" -> not found"); - end if; - - else - -- Otherwise, get the time stamps of each - -- archive. If one of them is found later than - -- the executable, we need to relink. - - declare - Prj_Data : Project_Data; - - begin - for Prj in 1 .. Projects.Last loop - Prj_Data := Projects.Table (Prj); - - -- There is an archive only in project - -- files with sources other than Ada - -- sources. - - if Data.Sources_Present then - declare - Archive_Path : constant String := - Get_Name_String - (Prj_Data.Object_Directory) & - Directory_Separator & - "lib" & - Get_Name_String (Prj_Data.Name) & - '.' & Archive_Ext; - Archive_TS : Time_Stamp_Type; - begin - Name_Len := 0; - Add_Str_To_Name_Buffer - (Archive_Path); - Archive_TS := File_Stamp (Name_Find); - - -- If the archive is later than the - -- executable, we need to relink. - - if Archive_TS /= Empty_Time_Stamp - and then - Exec_Time_Stamp < Archive_TS - then - Need_To_Relink := True; - - if Verbose_Mode then - Write_Str (" -> "); - Write_Str (Archive_Path); - Write_Str (" has time stamp "); - Write_Str ("later than "); - Write_Line ("executable"); - end if; - - exit; - end if; - end; - end if; - end loop; - end; - end if; - - -- If Need_To_Relink is False, we are done - - if Verbose_Mode and (not Need_To_Relink) then - Write_Line (" -> up to date"); - end if; - - end if; - - -- Prepare to link - - if Need_To_Relink then - Link_Done := True; - - Last_Argument := 0; - - -- Specify the executable path name - - Add_Argument (Dash_o, True); - Add_Argument - (Get_Name_String (Data.Exec_Directory) & - Directory_Separator & - Get_Name_String - (Executable_Of - (Project => Main_Project, - Main => Main_Id, - Index => 0, - Ada_Main => False)), - True); - - -- Specify the object file of the main source - - Add_Argument - (Object_Dir & Directory_Separator & - Get_Name_String (Source.Object_Name), - True); - - -- Add the switches specified in package Linker of - -- the main project. - - Add_Switches - (Data => Data, - Proc => Linker, - Language => Source.Language, - File_Name => Main_Id); - - -- Add the switches specified in attribute - -- Linker_Options of packages Linker. - - if Link_Options_Switches = null then - Link_Options_Switches := - new Argument_List' - (Linker_Options_Switches (Main_Project)); - end if; - - Add_Arguments (Link_Options_Switches.all, True); - - -- Add the linking options specified on the - -- command line. - - for Arg in 1 .. Linker_Options.Last loop - Add_Argument (Linker_Options.Table (Arg), True); - end loop; - - -- Add all the archives, in a correct order - - Add_Archives (For_Gnatmake => False); - - -- If there are shared libraries and the run path - -- option is supported, add the run path switch. - - if Lib_Path.Last > 0 then - Add_Argument - (Path_Option.all & - String (Lib_Path.Table (1 .. Lib_Path.Last)), - Verbose_Mode); - end if; - - -- And invoke the linker - - Display_Command (Linker_Name.all, Linker_Path); - Spawn - (Linker_Path.all, - Arguments (1 .. Last_Argument), - Success); - - if not Success then - Report_Error ("could not link ", Main); - end if; - end if; - end; + Link_Foreign (Main, Main_Id, Source); end if; end; end loop; @@ -3211,13 +3651,14 @@ package body Makegpr is Osint.Write_Program_Name; if Mains.Number_Of_Mains = 1 then + -- If there is only one executable, report its name too Write_Str (": """); Mains.Reset; declare - Main : constant String := Mains.Next_Main; + Main : constant String := Mains.Next_Main; Main_Id : Name_Id; begin Name_Len := 0; @@ -3251,8 +3692,7 @@ package body Makegpr is S3 : String := "") is begin - -- If Keep_Going is True, output the error message, preceded by the - -- error header. + -- If Keep_Going is True, output error message preceded by error header if Keep_Going then Total_Number_Of_Errors := Total_Number_Of_Errors + 1; @@ -3262,9 +3702,9 @@ package body Makegpr is Write_Str (S3); Write_Eol; - else - -- Otherwise, just fail + -- Otherwise just fail + else Osint.Fail (S1, S2, S3); end if; end Report_Error; @@ -3300,8 +3740,8 @@ package body Makegpr is return; end if; - -- If preceding switch was -P, a project file name need to be specified, - -- not a switch. + -- If preceding switch was -P, a project file name need to be + -- specified, not a switch. if Project_File_Name_Expected then if Arg (1) = '-' then @@ -3311,8 +3751,8 @@ package body Makegpr is Project_File_Name := new String'(Arg); end if; - -- If preceding switch was -o, an executable name need to be specidied, - -- not a switch. + -- If preceding switch was -o, an executable name need to be + -- specified, not a switch. elsif Output_File_Name_Expected then if Arg (1) = '-' then @@ -3326,10 +3766,9 @@ package body Makegpr is -- -c???args: Compiler arguments - elsif Arg'Length >= 6 and then - Arg (Arg'First .. Arg'First + 1) = "-c" and then - Arg (Arg'Last - 3 .. Arg'Last) = "args" - + elsif Arg'Length >= 6 + and then Arg (Arg'First .. Arg'First + 1) = "-c" + and then Arg (Arg'Last - 3 .. Arg'Last) = "args" then declare OK : Boolean := False; @@ -3347,7 +3786,6 @@ package body Makegpr is if OK then Current_Processor := Compiler; - else Osint.Fail ("illegal option """, Arg, """"); end if; @@ -3417,6 +3855,7 @@ package body Makegpr is elsif Arg = "-v" then Verbose_Mode := True; + Copyright; elsif Arg'Length = 4 and then Arg (1 .. 3) = "-vP" and then Arg (4) in '0' .. '2' @@ -3435,8 +3874,7 @@ package body Makegpr is elsif Arg'Length >= 3 and then Arg (2) = 'X' and then Is_External_Assignment (Arg) then - -- Is_External_Assignment has side effects - -- when it returns True; + -- Is_External_Assignment has side effects when it returns True null; @@ -3456,8 +3894,7 @@ package body Makegpr is ----------------- function Strip_CR_LF (Text : String) return String is - - To : String (1 .. Text'Length); + To : String (1 .. Text'Length); Index_To : Natural := 0; begin |