diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 23 | ||||
| -rw-r--r-- | gcc/ada/bindgen.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-expect.adb | 237 | ||||
| -rw-r--r-- | gcc/ada/g-expect.ads | 42 | ||||
| -rw-r--r-- | gcc/ada/gnatbind.adb | 125 | ||||
| -rwxr-xr-x | gcc/ada/s-regpat.adb | 5 |
6 files changed, 320 insertions, 116 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0392b7344c2..6c6e09cdfd1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2010-06-21 Thomas Quinot <quinot@adacore.com> + + * bindgen.ads: Update comments. + +2010-06-21 Vincent Celier <celier@adacore.com> + + * gnatbind.adb: Suppress dupicates when listing the sources in the + closure (switch -R). + +2010-06-21 Emmanuel Briot <briot@adacore.com> + + * s-regpat.adb (Link_Tail): Fix error when size of the pattern matcher + is too small. + +2010-06-21 Emmanuel Briot <briot@adacore.com> + + * g-expect.adb, g-expect.ads (First_Dead_Process, Free, Has_Process): + New subprograms. + (Expect_Internal): No longer raises an exception, so that it can set + out parameters as well. When a process has died, reset its Input_Fd + to Invalid_Fd, so that when using multiple processes we can find out + which process has died. + 2010-06-21 Robert Dewar <dewar@adacore.com> * s-regpat.adb, s-tpoben.adb, sem_attr.adb, sem_util.adb, sem_util.ads, diff --git a/gcc/ada/bindgen.ads b/gcc/ada/bindgen.ads index 1bce36d4bb2..96d2e306888 100644 --- a/gcc/ada/bindgen.ads +++ b/gcc/ada/bindgen.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -24,7 +24,7 @@ ------------------------------------------------------------------------------ -- This package contains the routines to output the binder file. This is --- a C program which contains the following: +-- an Ada or C program which contains the following: -- initialization for main program case -- sequence of calls to elaboration routines in appropriate order diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb index 6510c310813..d2872fdd0d9 100644 --- a/gcc/ada/g-expect.adb +++ b/gcc/ada/g-expect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2009, AdaCore -- +-- Copyright (C) 2000-2010, AdaCore -- -- -- -- 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- -- @@ -45,6 +45,11 @@ package body GNAT.Expect is type Array_Of_Pd is array (Positive range <>) of Process_Descriptor_Access; + Expect_Process_Died : constant Expect_Match := -100; + Expect_Internal_Error : constant Expect_Match := -101; + -- Additional possible outputs of Expect_Internal. These are not visible in + -- the spec because the user will never see them. + procedure Expect_Internal (Descriptors : in out Array_Of_Pd; Result : out Expect_Match; @@ -52,11 +57,14 @@ package body GNAT.Expect is Full_Buffer : Boolean); -- Internal function used to read from the process Descriptor. -- - -- Three outputs are possible: + -- Several outputs are possible: -- Result=Expect_Timeout, if no output was available before the timeout -- expired. -- Result=Expect_Full_Buffer, if Full_Buffer is True and some characters -- had to be discarded from the internal buffer of Descriptor. + -- Result=Express_Process_Died if one of the processes was terminated. + -- That process's Input_Fd is set to Invalid_FD + -- Result=Express_Internal_Error -- Result=<integer>, indicates how many characters were added to the -- internal buffer. These characters are from indexes -- Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index @@ -211,7 +219,9 @@ package body GNAT.Expect is Next_Filter : Filter_List; begin - Close (Descriptor.Input_Fd); + if Descriptor.Input_Fd /= Invalid_FD then + Close (Descriptor.Input_Fd); + end if; if Descriptor.Error_Fd /= Descriptor.Output_Fd then Close (Descriptor.Error_Fd); @@ -344,10 +354,17 @@ package body GNAT.Expect is Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer); - if N = Expect_Timeout or else N = Expect_Full_Buffer then - Result := N; - return; - end if; + case N is + when Expect_Internal_Error | Expect_Process_Died => + raise Process_Died; + + when Expect_Timeout | Expect_Full_Buffer => + Result := N; + return; + + when others => + null; -- See below + end case; -- Calculate the timeout for the next turn @@ -493,10 +510,17 @@ package body GNAT.Expect is Expect_Internal (Descriptors, N, Timeout, Full_Buffer); - if N = Expect_Timeout or else N = Expect_Full_Buffer then - Result := N; - return; - end if; + case N is + when Expect_Internal_Error | Expect_Process_Died => + raise Process_Died; + + when Expect_Timeout | Expect_Full_Buffer => + Result := N; + return; + + when others => + null; -- Continue + end case; end loop; end Expect; @@ -515,7 +539,9 @@ package body GNAT.Expect is for J in Descriptors'Range loop Descriptors (J) := Regexps (J).Descriptor; - Reinitialize_Buffer (Regexps (J).Descriptor.all); + if Descriptors (J) /= null then + Reinitialize_Buffer (Regexps (J).Descriptor.all); + end if; end loop; loop @@ -526,25 +552,36 @@ package body GNAT.Expect is -- checking the regexps). for J in Regexps'Range loop - Match (Regexps (J).Regexp.all, - Regexps (J).Descriptor.Buffer - (1 .. Regexps (J).Descriptor.Buffer_Index), - Matched); - - if Matched (0) /= No_Match then - Result := Expect_Match (J); - Regexps (J).Descriptor.Last_Match_Start := Matched (0).First; - Regexps (J).Descriptor.Last_Match_End := Matched (0).Last; - return; + if Regexps (J).Regexp /= null + and then Regexps (J).Descriptor /= null + then + Match (Regexps (J).Regexp.all, + Regexps (J).Descriptor.Buffer + (1 .. Regexps (J).Descriptor.Buffer_Index), + Matched); + + if Matched (0) /= No_Match then + Result := Expect_Match (J); + Regexps (J).Descriptor.Last_Match_Start := Matched (0).First; + Regexps (J).Descriptor.Last_Match_End := Matched (0).Last; + return; + end if; end if; end loop; Expect_Internal (Descriptors, N, Timeout, Full_Buffer); - if N = Expect_Timeout or else N = Expect_Full_Buffer then - Result := N; - return; - end if; + case N is + when Expect_Internal_Error | Expect_Process_Died => + raise Process_Died; + + when Expect_Timeout | Expect_Full_Buffer => + Result := N; + return; + + when others => + null; -- Continue + end case; end loop; end Expect; @@ -564,21 +601,30 @@ package body GNAT.Expect is N : Integer; type File_Descriptor_Array is - array (Descriptors'Range) of File_Descriptor; + array (0 .. Descriptors'Length - 1) of File_Descriptor; Fds : aliased File_Descriptor_Array; + Fds_Count : Natural := 0; + + Fds_To_Descriptor : array (Fds'Range) of Integer; + -- Maps file descriptor entries from Fds to entries in Descriptors. + -- They do not have the same index when entries in Descriptors are null. - type Integer_Array is array (Descriptors'Range) of Integer; + type Integer_Array is array (Fds'Range) of Integer; Is_Set : aliased Integer_Array; begin for J in Descriptors'Range loop - Fds (J) := Descriptors (J).Output_Fd; + if Descriptors (J) /= null then + Fds (Fds'First + Fds_Count) := Descriptors (J).Output_Fd; + Fds_To_Descriptor (Fds'First + Fds_Count) := J; + Fds_Count := Fds_Count + 1; - if Descriptors (J).Buffer_Size = 0 then - Buffer_Size := Integer'Max (Buffer_Size, 4096); - else - Buffer_Size := - Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size); + if Descriptors (J).Buffer_Size = 0 then + Buffer_Size := Integer'Max (Buffer_Size, 4096); + else + Buffer_Size := + Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size); + end if; end if; end loop; @@ -587,19 +633,23 @@ package body GNAT.Expect is -- Buffer used for input. This is allocated only once, not for -- every iteration of the loop + D : Integer; + -- Index in Descriptors + begin -- Loop until we match or we have a timeout loop Num_Descriptors := - Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address); + Poll (Fds'Address, Fds_Count, Timeout, Is_Set'Address); case Num_Descriptors is -- Error? when -1 => - raise Process_Died; + Result := Expect_Internal_Error; + return; -- Timeout? @@ -610,15 +660,17 @@ package body GNAT.Expect is -- Some input when others => - for J in Descriptors'Range loop - if Is_Set (J) = 1 then - Buffer_Size := Descriptors (J).Buffer_Size; + for F in Fds'Range loop + if Is_Set (F) = 1 then + D := Fds_To_Descriptor (F); + + Buffer_Size := Descriptors (D).Buffer_Size; if Buffer_Size = 0 then Buffer_Size := 4096; end if; - N := Read (Descriptors (J).Output_Fd, Buffer'Address, + N := Read (Descriptors (D).Output_Fd, Buffer'Address, Buffer_Size); -- Error or End of file @@ -626,43 +678,46 @@ package body GNAT.Expect is if N <= 0 then -- ??? Note that ddd tries again up to three times -- in that case. See LiterateA.C:174 - raise Process_Died; + + Descriptors (D).Input_Fd := Invalid_FD; + Result := Expect_Process_Died; + return; else -- If there is no limit to the buffer size - if Descriptors (J).Buffer_Size = 0 then + if Descriptors (D).Buffer_Size = 0 then declare - Tmp : String_Access := Descriptors (J).Buffer; + Tmp : String_Access := Descriptors (D).Buffer; begin if Tmp /= null then - Descriptors (J).Buffer := + Descriptors (D).Buffer := new String (1 .. Tmp'Length + N); - Descriptors (J).Buffer (1 .. Tmp'Length) := + Descriptors (D).Buffer (1 .. Tmp'Length) := Tmp.all; - Descriptors (J).Buffer + Descriptors (D).Buffer (Tmp'Length + 1 .. Tmp'Length + N) := Buffer (1 .. N); Free (Tmp); - Descriptors (J).Buffer_Index := - Descriptors (J).Buffer'Last; + Descriptors (D).Buffer_Index := + Descriptors (D).Buffer'Last; else - Descriptors (J).Buffer := + Descriptors (D).Buffer := new String (1 .. N); - Descriptors (J).Buffer.all := + Descriptors (D).Buffer.all := Buffer (1 .. N); - Descriptors (J).Buffer_Index := N; + Descriptors (D).Buffer_Index := N; end if; end; else -- Add what we read to the buffer - if Descriptors (J).Buffer_Index + N > - Descriptors (J).Buffer_Size + if Descriptors (D).Buffer_Index + N > + Descriptors (D).Buffer_Size then -- If the user wants to know when we have -- read more than the buffer can contain. @@ -675,33 +730,33 @@ package body GNAT.Expect is -- Keep as much as possible from the buffer, -- and forget old characters. - Descriptors (J).Buffer - (1 .. Descriptors (J).Buffer_Size - N) := - Descriptors (J).Buffer - (N - Descriptors (J).Buffer_Size + - Descriptors (J).Buffer_Index + 1 .. - Descriptors (J).Buffer_Index); - Descriptors (J).Buffer_Index := - Descriptors (J).Buffer_Size - N; + Descriptors (D).Buffer + (1 .. Descriptors (D).Buffer_Size - N) := + Descriptors (D).Buffer + (N - Descriptors (D).Buffer_Size + + Descriptors (D).Buffer_Index + 1 .. + Descriptors (D).Buffer_Index); + Descriptors (D).Buffer_Index := + Descriptors (D).Buffer_Size - N; end if; -- Keep what we read in the buffer - Descriptors (J).Buffer - (Descriptors (J).Buffer_Index + 1 .. - Descriptors (J).Buffer_Index + N) := + Descriptors (D).Buffer + (Descriptors (D).Buffer_Index + 1 .. + Descriptors (D).Buffer_Index + N) := Buffer (1 .. N); - Descriptors (J).Buffer_Index := - Descriptors (J).Buffer_Index + N; + Descriptors (D).Buffer_Index := + Descriptors (D).Buffer_Index + N; end if; -- Call each of the output filter with what we -- read. Call_Filters - (Descriptors (J).all, Buffer (1 .. N), Output); + (Descriptors (D).all, Buffer (1 .. N), Output); - Result := Expect_Match (N); + Result := Expect_Match (D); return; end if; end if; @@ -730,6 +785,24 @@ package body GNAT.Expect is (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End); end Expect_Out_Match; + ------------------------ + -- First_Dead_Process -- + ------------------------ + + function First_Dead_Process + (Regexp : Multiprocess_Regexp_Array) return Natural is + begin + for R in Regexp'Range loop + if Regexp (R).Descriptor /= null + and then Regexp (R).Descriptor.Input_Fd = GNAT.OS_Lib.Invalid_FD + then + return R; + end if; + end loop; + + return 0; + end First_Dead_Process; + ----------- -- Flush -- ----------- @@ -785,6 +858,18 @@ package body GNAT.Expect is end loop; end Flush; + ---------- + -- Free -- + ---------- + + procedure Free (Regexp : in out Multiprocess_Regexp) is + procedure Unchecked_Free is new Ada.Unchecked_Deallocation + (Process_Descriptor'Class, Process_Descriptor_Access); + begin + Unchecked_Free (Regexp.Descriptor); + Free (Regexp.Regexp); + end Free; + ------------------------ -- Get_Command_Output -- ------------------------ @@ -915,6 +1000,15 @@ package body GNAT.Expect is return Descriptor.Pid; end Get_Pid; + ----------------- + -- Has_Process -- + ----------------- + + function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean is + begin + return Regexp /= (Regexp'Range => (null, null)); + end Has_Process; + --------------- -- Interrupt -- --------------- @@ -1136,6 +1230,13 @@ package body GNAT.Expect is Expect_Internal (Descriptors, Result, Timeout => 0, Full_Buffer => False); + + if Result = Expect_Internal_Error + or else Result = Expect_Process_Died + then + raise Process_Died; + end if; + Descriptor.Last_Match_End := Descriptor.Buffer_Index; -- Empty the buffer diff --git a/gcc/ada/g-expect.ads b/gcc/ada/g-expect.ads index 1e50852522a..5c535831e98 100644 --- a/gcc/ada/g-expect.ads +++ b/gcc/ada/g-expect.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2009, AdaCore -- +-- Copyright (C) 2000-2010, AdaCore -- -- -- -- 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- -- @@ -466,7 +466,22 @@ package GNAT.Expect is Regexp : Pattern_Matcher_Access; end record; type Multiprocess_Regexp_Array is array (Positive range <>) - of Multiprocess_Regexp; + of Multiprocess_Regexp; + + procedure Free (Regexp : in out Multiprocess_Regexp); + -- Free the memory occupied by Regexp + + function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean; + -- Return True if at least one entry in Regexp is non-null, ie there is + -- still at least one process to monitor + + function First_Dead_Process + (Regexp : Multiprocess_Regexp_Array) return Natural; + -- Find the first entry in Regexp that corresponds to a dead process that + -- wasn't Free-d yet. + -- This function is called in general when Expect (below) raises the + -- exception Process_Died. + -- This returns 0 if no process has died yet. procedure Expect (Result : out Expect_Match; @@ -474,7 +489,28 @@ package GNAT.Expect is Matched : out GNAT.Regpat.Match_Array; Timeout : Integer := 10_000; Full_Buffer : Boolean := False); - -- Same as above, but for multi processes + -- Same as above, but for multi processes. Any of the entries in + -- Regexps can have a null Descriptor or Regexp. Such entries will + -- simply be ignored. Therefore when a process terminates, you can + -- simply reset its entry. + -- The expect loop would therefore look like: + -- + -- Processes : Multiprocess_Regexp_Array (...) := ...; + -- R : Natural; + -- + -- while Has_Process (Processes) loop + -- begin + -- Expect (Result, Processes, Timeout => -1); + -- ... process output of process Result (output, full buffer,...) + -- + -- exception + -- when Process_Died => + -- -- Free memory + -- R := First_Dead_Process (Processes); + -- Close (Processes (R).Descriptor.all, Status); + -- Free (Processes (R)); + -- end; + -- end loop; procedure Expect (Result : out Expect_Match; diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 11dd9a8b62c..8b6edbd3aab 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -45,6 +45,7 @@ with Rident; use Rident; with Snames; with Switch; use Switch; with Switch.B; use Switch.B; +with Table; with Targparm; use Targparm; with Types; use Types; @@ -815,55 +816,97 @@ begin -- sources) if -R was used. if List_Closure then - if not Zero_Formatting then - Write_Eol; - Write_Str ("REFERENCED SOURCES"); - Write_Eol; - end if; - - for J in reverse Elab_Order.First .. Elab_Order.Last loop - - -- Do not include the sources of the runtime + declare + package Sources is new Table.Table + (Table_Component_Type => File_Name_Type, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 10, + Table_Increment => 100, + Table_Name => "Gnatbind.Sources"); + -- Table to record the sources in the closure, to avoid + -- dupications. + + Source : File_Name_Type; + + function Put_In_Sources (S : File_Name_Type) return Boolean; + -- Check if S is already in table Sources and put in Sources + -- if it is not. Return False if the source is already in + -- Sources, and True if it is added. + + -------------------- + -- Put_In_Sources -- + -------------------- + + function Put_In_Sources (S : File_Name_Type) + return Boolean + is + begin + for J in 1 .. Sources.Last loop + if Sources.Table (J) = S then + return False; + end if; + end loop; - if not Is_Internal_File_Name - (Units.Table (Elab_Order.Table (J)).Sfile) - then - if not Zero_Formatting then - Write_Str (" "); - end if; + Sources.Append (S); + return True; + end Put_In_Sources; - Write_Str - (Get_Name_String - (Units.Table (Elab_Order.Table (J)).Sfile)); + begin + if not Zero_Formatting then + Write_Eol; + Write_Str ("REFERENCED SOURCES"); Write_Eol; end if; - end loop; - -- Subunits do not appear in the elaboration table because they - -- are subsumed by their parent units, but we need to list them - -- for other tools. For now they are listed after other files, - -- rather than right after their parent, since there is no easy - -- link between the elaboration table and the ALIs table ??? - -- Note also that subunits may appear repeatedly in the list, - -- if the parent unit appears in the context of several units - -- in the closure. - - for J in Sdep.First .. Sdep.Last loop - if Sdep.Table (J).Subunit_Name /= No_Name - and then not Is_Internal_File_Name (Sdep.Table (J).Sfile) - then - if not Zero_Formatting then - Write_Str (" "); + for J in reverse Elab_Order.First .. Elab_Order.Last loop + + Source := Units.Table (Elab_Order.Table (J)).Sfile; + + -- Do not include the sources of the runtime and do not + -- include the same source several times. + + if Put_In_Sources (Source) + and then not Is_Internal_File_Name (Source) + then + if not Zero_Formatting then + Write_Str (" "); + end if; + + Write_Str (Get_Name_String (Source)); + Write_Eol; end if; + end loop; + + -- Subunits do not appear in the elaboration table because + -- they are subsumed by their parent units, but we need to + -- list them for other tools. For now they are listed after + -- other files, rather than right after their parent, since + -- there is no easy link between the elaboration table and + -- the ALIs table ??? As subunits may appear repeatedly in + -- the list, if the parent unit appears in the context of + -- several units in the closure, duplicates are suppressed. + + for J in Sdep.First .. Sdep.Last loop + Source := Sdep.Table (J).Sfile; + + if Sdep.Table (J).Subunit_Name /= No_Name + and then Put_In_Sources (Source) + and then not Is_Internal_File_Name (Source) + then + if not Zero_Formatting then + Write_Str (" "); + end if; + + Write_Str (Get_Name_String (Source)); + Write_Eol; + end if; + end loop; - Write_Str (Get_Name_String (Sdep.Table (J).Sfile)); + if not Zero_Formatting then Write_Eol; end if; - end loop; - - if not Zero_Formatting then - Write_Eol; - end if; + end; end if; end if; end if; diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index 8dc079ed244..27a108c1d58 100755 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -802,10 +802,11 @@ package body System.Regpat is Offset : Pointer; begin - -- Find last node + -- Find last node (the size of the pattern matcher might be too + -- small, so don't try to read past its end) Scan := P; - while Scan <= PM.Size loop + while Scan + 3 <= PM.Size loop Temp := Get_Next (Program, Scan); exit when Temp = Scan; Scan := Temp; |