diff options
Diffstat (limited to 'gcc/ada/gnatcmd.adb')
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 892 |
1 files changed, 551 insertions, 341 deletions
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 0352d7c05cb..3a0e5e4a7f1 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; |