Description: Avoid using the code shared with GNAT. Use libgnatprj and libgnatvsn instead. . The Gnatvsn.Build_Type enumerated type does not, and will probably never, include the Gnat_Pro value in GCC. . Remove calls to the GNAT.Command_Line.Try_Help and System.OS_Lib.Set_File_Last_Modify_Time_Stamp procedures (new in 4.10). From John Marino, see Origin field. . Rename the Env (4.10) -> Root_Environment (4.9) parameter when calling gnatprj's Makeutl.Compute_Builder_Switches, instantiated as Do_Compute_Builder_Switches. . Copy the GNAT.Rewrite_Data package (new in 4.10, heavily modified from gprbuild 2013) from the 4.10 git repository, revision e1f64bbf602484c62a3749fc1ca200a13d5b0aa4). It is renamed as Rewrite_Data (non system package). . Remove the Mode parameter (new in 4.10) when calling System.Os_Lib.Set_Executable. From John Marino, see Origin field. Author: Nicolas Boulenguez Author: John Marino Origin: https://github.com/freebsd/freebsd-ports/tree/master/devel/gprbuild Forwarded: not-needed --- a/Makefile.in +++ b/Makefile.in @@ -64,7 +64,7 @@ .PHONY: all distall gprbuild gprconfig gprclean gprinstall \ copy_gnat_src complete bootstrap -all: $(xmlada_build_target) $(ADA_GEN_SUBDIR)/stamp-snames +all: $(xmlada_build_target) ${GNATMAKE} $(xmlada_prj_flags) -Pgprbuild -XBUILD=${BUILD} distall: @@ -84,7 +84,7 @@ strip $(prefix)/libexec/gprbuild/gprlib$(EXEXT) endif -all gprconfig gprbuild gprclean: $(objdir)/gprbuild_dummies.o $(objdir)/link.o force +all gprconfig gprbuild gprclean: force MOVE_IF_CHANGE=mv -f -include $(srcdir)/gnat/Make-generated.in --- a/gprbuild.gpr +++ b/gprbuild.gpr @@ -1,3 +1,5 @@ +with "gnatvsn"; +with "gnatprj"; with "xmlada"; project Gprbuild is @@ -24,7 +26,7 @@ "gprinstall-main.adb", "gprslave.adb"); - for Source_Dirs use ("src", "gnat"); + for Source_Dirs use ("src"); case Build_Tool is when "gprbuild" => @@ -102,8 +104,7 @@ end Binder; package Linker is - Common_Switches := (project'Object_Dir & "/gprbuild_dummies.o", - project'Object_Dir & "/link.o"); + Common_Switches := (); -- We use project'Object_Dir here instead of GprBuild'Object_Dir -- for compatibility with GNAT Pro 6.0.2. @@ -148,18 +149,14 @@ Common_Excluded_Source_Files := ("gprlib-build_shared_lib.adb", "gprlib-build_shared_lib-nosymbols.adb", - "gprlib-build_shared_lib-vms.adb", - "mlib-tgt-specific.adb", - "mlib-tgt-vms-alpha.adb", - "mlib-tgt-vms-ia64.adb"); + "gprlib-build_shared_lib-vms.adb"); case Build_Tool is when "gprbuild" => case OS is when "unix" | "Windows_NT" => for Locally_Removed_Files - use Common_Excluded_Source_Files & - ("mlib-tgt-vms.ads", "mlib-tgt-vms.adb"); + use Common_Excluded_Source_Files; -- Excluded_Source_File not supported by GNAT Pro 6.0.2 when "avms" | "ivms" => @@ -176,18 +173,12 @@ when "unix" | "Windows_NT" => for Body ("gprlib.build_shared_lib") use "gprlib-build_shared_lib-nosymbols.adb"; - for Body ("mlib.tgt.specific") - use "mlib-tgt-specific.adb"; when "avms" => for Body ("gprlib.build_shared_lib") use "gprlib-build_shared_lib-vms.adb"; - for Body ("mlib.tgt.specific") - use "mlib-tgt-specific-vms-alpha.adb"; when "ivms" => for Body ("gprlib.build_shared_lib") use "gprlib-build_shared_lib-vms.adb"; - for Body ("mlib.tgt.specific") - use "mlib-tgt-specific-vms-ia64.adb"; end case; end Naming; --- a/src/gpr_version.adb +++ b/src/gpr_version.adb @@ -66,8 +66,6 @@ end loop Last_Loop; case Build_Type is - when Gnatpro => - return "Pro " & Gpr_Version & " " & Date & Host; when GPL => return "GPL " & Gpr_Version & " " & Date & Host; when FSF => --- a/src/gprbuild-main.adb +++ b/src/gprbuild-main.adb @@ -1573,7 +1573,6 @@ end if; if Project_File_Name = null then - Try_Help; Fail_Program (Project_Tree, "no project file specified and no default project file"); @@ -2099,7 +2098,7 @@ Do_Compute_Builder_Switches (Project_Tree => Project_Tree, - Env => Root_Environment, + Root_Environment => Root_Environment, Main_Project => Main_Project); Queue.Initialize (Opt.One_Compilation_Per_Obj_Dir); --- a/src/gprclean-main.adb +++ b/src/gprclean-main.adb @@ -642,7 +642,6 @@ -- Check that a project file was specified and get the configuration if Project_File_Name = null then - Try_Help; Fail_Program (Project_Tree, "no project file specified and no default project file"); --- a/src/gprconfig-main.adb +++ b/src/gprconfig-main.adb @@ -642,6 +642,5 @@ null; when Invalid_Switch | Invalid_Parameter => Put_Line ("Invalid command line switch: -" & Full_Switch); - Try_Help; Ada.Command_Line.Set_Exit_Status (2); end GprConfig.Main; --- a/src/gprinstall-main.adb +++ b/src/gprinstall-main.adb @@ -556,7 +556,6 @@ if Project_File_Name = null and then Usage_Mode /= List_Mode then - Try_Help; Fail_Program (Project_Tree, "no project file specified"); end if; --- /dev/null +++ b/src/rewrite_data.adb @@ -0,0 +1,253 @@ +----------------------------------------------------------------------------- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . R E W R I T E _ D A T A -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2014, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Conversion; + +package body Rewrite_Data is + + use Ada; + + subtype SEO is Stream_Element_Offset; + + procedure Do_Output + (B : in out Buffer; + Data : Stream_Element_Array; + Output : not null access procedure (Data : Stream_Element_Array)); + -- Do the actual output. This ensures that we properly send the data + -- through linked rewrite buffers if any. + + ------------ + -- Create -- + ------------ + + function Create + (Pattern, Value : String; + Size : Stream_Element_Offset := 1_024) return Buffer + is + + subtype SP is String (1 .. Pattern'Length); + subtype SEAP is Stream_Element_Array (1 .. Pattern'Length); + + subtype SV is String (1 .. Value'Length); + subtype SEAV is Stream_Element_Array (1 .. Value'Length); + + function To_SEAP is new Unchecked_Conversion (SP, SEAP); + function To_SEAV is new Unchecked_Conversion (SV, SEAV); + + begin + -- Return result (can't be smaller than pattern) + + return B : Buffer + (SEO'Max (Size, SEO (Pattern'Length)), + SEO (Pattern'Length), + SEO (Value'Length)) + do + B.Pattern := To_SEAP (Pattern); + B.Value := To_SEAV (Value); + B.Pos_C := 0; + B.Pos_B := 0; + end return; + end Create; + + --------------- + -- Do_Output -- + --------------- + + procedure Do_Output + (B : in out Buffer; + Data : Stream_Element_Array; + Output : not null access procedure (Data : Stream_Element_Array)) + is + begin + if B.Next = null then + Output (Data); + else + Write (B.Next.all, Data, Output); + end if; + end Do_Output; + + ----------- + -- Flush -- + ----------- + + procedure Flush + (B : in out Buffer; + Output : not null access procedure (Data : Stream_Element_Array)) + is + begin + -- Flush output buffer + + if B.Pos_B > 0 then + Do_Output (B, B.Buffer (1 .. B.Pos_B), Output); + end if; + + -- Flush current buffer + + if B.Pos_C > 0 then + Do_Output (B, B.Current (1 .. B.Pos_C), Output); + end if; + + -- Flush linked buffer if any + + if B.Next /= null then + Flush (B.Next.all, Output); + end if; + + Reset (B); + end Flush; + + ---------- + -- Link -- + ---------- + + procedure Link (From : in out Buffer; To : Buffer_Ref) is + begin + From.Next := To; + end Link; + + ----------- + -- Reset -- + ----------- + + procedure Reset (B : in out Buffer) is + begin + B.Pos_B := 0; + B.Pos_C := 0; + + if B.Next /= null then + Reset (B.Next.all); + end if; + end Reset; + + ------------- + -- Rewrite -- + ------------- + + procedure Rewrite + (B : in out Buffer; + Input : not null access procedure + (Buffer : out Stream_Element_Array; + Last : out Stream_Element_Offset); + Output : not null access procedure (Data : Stream_Element_Array)) + is + Buffer : Stream_Element_Array (1 .. B.Size); + Last : Stream_Element_Offset; + + begin + Rewrite_All : loop + Input (Buffer, Last); + exit Rewrite_All when Last = 0; + Write (B, Buffer (1 .. Last), Output); + end loop Rewrite_All; + + Flush (B, Output); + end Rewrite; + + ---------- + -- Size -- + ---------- + + function Size (B : Buffer) return Natural is + begin + return Natural (B.Pos_B + B.Pos_C); + end Size; + + ----------- + -- Write -- + ----------- + + procedure Write + (B : in out Buffer; + Data : Stream_Element_Array; + Output : not null access procedure (Data : Stream_Element_Array)) + is + procedure Need_Space (Size : Stream_Element_Offset); + pragma Inline (Need_Space); + + ---------------- + -- Need_Space -- + ---------------- + + procedure Need_Space (Size : Stream_Element_Offset) is + begin + if B.Pos_B + Size > B.Size then + Do_Output (B, B.Buffer (1 .. B.Pos_B), Output); + B.Pos_B := 0; + end if; + end Need_Space; + + -- Start of processing for Write + + begin + if B.Size_Pattern = 0 then + Do_Output (B, Data, Output); + + else + for K in Data'Range loop + if Data (K) = B.Pattern (B.Pos_C + 1) then + + -- Store possible start of a match + + B.Pos_C := B.Pos_C + 1; + B.Current (B.Pos_C) := Data (K); + + else + -- Not part of pattern, if a start of a match was found, + -- remove it. + + if B.Pos_C /= 0 then + Need_Space (B.Pos_C); + + B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Pos_C) := + B.Current (1 .. B.Pos_C); + B.Pos_B := B.Pos_B + B.Pos_C; + B.Pos_C := 0; + end if; + + Need_Space (1); + B.Pos_B := B.Pos_B + 1; + B.Buffer (B.Pos_B) := Data (K); + end if; + + if B.Pos_C = B.Size_Pattern then + + -- The pattern is found + + Need_Space (B.Size_Value); + + B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Size_Value) := B.Value; + B.Pos_C := 0; + B.Pos_B := B.Pos_B + B.Size_Value; + end if; + end loop; + end if; + end Write; + +end Rewrite_Data; --- /dev/null +++ b/src/rewrite_data.ads @@ -0,0 +1,152 @@ +------------------------------------------------------------------------------ +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . R E W R I T E _ D A T A -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2014, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package can be used to rewrite data on the fly. All occurrences of a +-- string (named pattern) will be replaced by another string. + +-- It is not necessary to load all data in memory and so this package can be +-- used for large data chunks like disk files for example. The pattern is +-- a standard string and not a regular expression. + +-- There is no dynamic allocation in the implementation. + +-- For example, to replace all occurrences of "Gnat" with "GNAT": + +-- Rewriter : Buffer := Create (Pattern => "Gnat", Value => "GNAT"); + +-- The output procedure that will receive the rewritten data: + +-- procedure Do (Data : Stream_Element_Array) is +-- begin +-- +-- end Do; + +-- Then: + +-- Write (Rewriter, "Let's talk about Gnat compiler", Do'Access); +-- Write (Rewriter, "Gnat is an Ada compiler", Do'Access); +-- Flush (Rewriter, Do'Access); + +-- Another possible usage is to specify a method to get the input data: + +-- procedure Get +-- (Buffer : out Stream_Element_Array; +-- Last : out Stream_Element_Offset) +-- is +-- begin +-- +-- Last := ... +-- Buffer := ... +-- end Get; + +-- Then we can rewrite the whole file with: + +-- Rewrite (Rewriter, Input => Get'Access, Output => Do'Access); + +with Ada.Streams; use Ada.Streams; + +package Rewrite_Data is + + type Buffer (<>) is limited private; + type Buffer_Ref is access all Buffer; + + function Create + (Pattern, Value : String; + Size : Stream_Element_Offset := 1_024) return Buffer; + -- Create a rewrite buffer. Pattern is the string to be rewritten as Value. + -- Size represents the size of the internal buffer used to store the data + -- ready to be output. A larger buffer may improve the performance, as the + -- Output routine (see Write, Rewrite below) will be called only when this + -- buffer is full. Note that Size cannot be lower than Pattern'Length, and + -- if this is the case, then Size value is set to Pattern'Length. + + function Size (B : Buffer) return Natural; + -- Returns the current size of the buffer (count of Stream_Array_Element) + + procedure Flush + (B : in out Buffer; + Output : not null access procedure (Data : Stream_Element_Array)); + -- Call Output for all remaining data in the buffer. The buffer is + -- reset and ready for another use after this call. + + procedure Reset (B : in out Buffer); + pragma Inline (Reset); + -- Clear all data in buffer, B is ready for another use. Note that this is + -- not needed after a Flush. Note: all data remaining in Buffer is lost. + + procedure Write + (B : in out Buffer; + Data : Stream_Element_Array; + Output : not null access procedure (Data : Stream_Element_Array)); + -- Write Data into the buffer, call Output for any prepared data. Flush + -- must be called when the last piece of Data as been sent in the Buffer. + + procedure Rewrite + (B : in out Buffer; + Input : not null access procedure + (Buffer : out Stream_Element_Array; + Last : out Stream_Element_Offset); + Output : not null access procedure (Data : Stream_Element_Array)); + -- Read data from Input, rewrite it, and then call Output. When there is + -- no more data to be read from Input, Last must be set to 0. Before + -- leaving this routine, call Flush above to send all remaining data to + -- Output. + + procedure Link (From : in out Buffer; To : Buffer_Ref); + -- Link two rewrite buffers. That is, all data sent to From buffer will be + -- rewritten and then passed to the To rewrite buffer. + +private + + type Buffer + (Size, Size_Pattern, Size_Value : Stream_Element_Offset) is + limited record + Buffer : Stream_Element_Array (1 .. Size); + -- Fully prepared/rewritten data waiting to be output + + Current : Stream_Element_Array (1 .. Size_Pattern); + -- Current data checked, this buffer contains every piece of data + -- starting with the pattern. It means that at any point: + -- Current (1 .. Pos_C) = Pattern (1 .. Pos_C). + + Pattern : Stream_Element_Array (1 .. Size_Pattern); + -- The pattern to look for + + Value : Stream_Element_Array (1 .. Size_Value); + -- The value the pattern is replaced by + + Pos_C : Stream_Element_Offset; -- last valid element in Current + Pos_B : Stream_Element_Offset; -- last valid element in Buffer + + Next : Buffer_Ref; + -- A link to another rewriter if any + end record; + +end Rewrite_Data; --- a/src/gprslave.adb +++ b/src/gprslave.adb @@ -1261,17 +1261,8 @@ procedure Set_Stamp (Path_Name : String; Time_Stamp : Time_Stamp_Type) is - TS : constant String := String (Time_Stamp); begin - Set_File_Last_Modify_Time_Stamp - (Path_Name, - GM_Time_Of - (Year => Year_Type'Value (TS (1 .. 4)), - Month => Month_Type'Value (TS (5 .. 6)), - Day => Day_Type'Value (TS (7 .. 8)), - Hour => Hour_Type'Value (TS (9 .. 10)), - Minute => Minute_Type'Value (TS (11 .. 12)), - Second => Second_Type'Value (TS (13 .. 14)))); + pragma Unreferenced (Path_Name, Time_Stamp); end Set_Stamp; ------------------ --- a/src/gprbuild-compilation-protocol.adb +++ b/src/gprbuild-compilation-protocol.adb @@ -24,7 +24,7 @@ with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; use Ada.Strings.Maps; -with GNAT.Rewrite_Data; +with Rewrite_Data; with GNAT.String_Split; use GNAT.String_Split; with Gnatvsn; use Gnatvsn; --- a/src/gprinstall-install.adb +++ b/src/gprinstall-install.adb @@ -723,7 +723,7 @@ if Executable then Set_Executable - (Dest_Filename, Mode => S_Owner + S_Group + S_Others); + (Dest_Filename); end if; -- Add file to manifest