Re: ada/4851: GNAT crashs on certain argument lines

[Florian Weimer <fw at deneb dot enyo dot de>]

Geert Bosch <bosch@gnat.com> writes:

> Your patch is OK. I have regression-tested it against the ACT test-suite
> and it passes fine, as expected. I'd only suggest a one-word comment
> improvement:
>
> <       --  Generic procedure that chooses a position for S in T at the

> >       --  Generic procedure that allocates a position for S in T at the

I've committed the following change, incorporating your suggestion.

2001-12-22  Florian Weimer  <fw@deneb.enyo.de>

	* make.adb (Add_Switch): Make Generic_Position a procedure.  The
	function approach did not work well because of a side effect (the
	function call could reallocate the table which was being indexed
	using its result). Fixes ada/4851.

Index: make.adb
===================================================================
RCS file: /cvs/gcc/egcs/gcc/ada/make.adb,v
retrieving revision 1.9
diff -c -3 -r1.9 make.adb
*** make.adb	2001/12/20 06:22:41	1.9
--- make.adb	2001/12/22 11:53:26
***************
*** 554,608 ****
     is
        generic
           with package T is new Table.Table (<>);
!       function Generic_Position return Integer;
!       --  Generic procedure that adds S at the end or beginning of T depending
!       --  of the value of the boolean Append_Switch.
  
        ----------------------
        -- Generic_Position --
        ----------------------
  
!       function Generic_Position return Integer is
        begin
           T.Increment_Last;
  
           if Append_Switch then
!             return Integer (T.Last);
           else
              for J in reverse T.Table_Index_Type'Succ (T.First) .. T.Last loop
                 T.Table (J) := T.Table (T.Table_Index_Type'Pred (J));
              end loop;
  
!             return Integer (T.First);
           end if;
        end Generic_Position;
  
!       function Gcc_Switches_Pos    is new Generic_Position (Gcc_Switches);
!       function Binder_Switches_Pos is new Generic_Position (Binder_Switches);
!       function Linker_Switches_Pos is new Generic_Position (Linker_Switches);
  
!       function Saved_Gcc_Switches_Pos is new
          Generic_Position (Saved_Gcc_Switches);
  
!       function Saved_Binder_Switches_Pos is new
          Generic_Position (Saved_Binder_Switches);
  
!       function Saved_Linker_Switches_Pos is new
          Generic_Position (Saved_Linker_Switches);
  
     --  Start of processing for Add_Switch
  
     begin
        if And_Save then
           case Program is
              when Compiler =>
!                Saved_Gcc_Switches.Table (Saved_Gcc_Switches_Pos) := S;
  
              when Binder   =>
!                Saved_Binder_Switches.Table (Saved_Binder_Switches_Pos) := S;
  
              when Linker   =>
!                Saved_Linker_Switches.Table (Saved_Linker_Switches_Pos) := S;
  
              when None =>
                 raise Program_Error;
--- 554,613 ----
     is
        generic
           with package T is new Table.Table (<>);
!       procedure Generic_Position (New_Position : out Integer);
!       --  Generic procedure that allocates a position for S in T at the
!       --  beginning or the end, depending on the boolean Append_Switch.
  
        ----------------------
        -- Generic_Position --
        ----------------------
  
!       procedure  Generic_Position (New_Position : out Integer) is
        begin
           T.Increment_Last;
  
           if Append_Switch then
!             New_Position := Integer (T.Last);
           else
              for J in reverse T.Table_Index_Type'Succ (T.First) .. T.Last loop
                 T.Table (J) := T.Table (T.Table_Index_Type'Pred (J));
              end loop;
  
!             New_Position := Integer (T.First);
           end if;
        end Generic_Position;
  
!       procedure Gcc_Switches_Pos    is new Generic_Position (Gcc_Switches);
!       procedure Binder_Switches_Pos is new Generic_Position (Binder_Switches);
!       procedure Linker_Switches_Pos is new Generic_Position (Linker_Switches);
  
!       procedure Saved_Gcc_Switches_Pos is new
          Generic_Position (Saved_Gcc_Switches);
  
!       procedure Saved_Binder_Switches_Pos is new
          Generic_Position (Saved_Binder_Switches);
  
!       procedure Saved_Linker_Switches_Pos is new
          Generic_Position (Saved_Linker_Switches);
  
+       New_Position : Integer;
+ 
     --  Start of processing for Add_Switch
  
     begin
        if And_Save then
           case Program is
              when Compiler =>
!                Saved_Gcc_Switches_Pos (New_Position);
!                Saved_Gcc_Switches.Table (New_Position) := S;
  
              when Binder   =>
!                Saved_Binder_Switches_Pos (New_Position);
!                Saved_Binder_Switches.Table (New_Position) := S;
  
              when Linker   =>
!                Saved_Linker_Switches_Pos (New_Position);
!                Saved_Linker_Switches.Table (New_Position) := S;
  
              when None =>
                 raise Program_Error;
***************
*** 611,623 ****
        else
           case Program is
              when Compiler =>
!                Gcc_Switches.Table (Gcc_Switches_Pos) := S;
  
              when Binder   =>
!                Binder_Switches.Table (Binder_Switches_Pos) := S;
  
              when Linker   =>
!                Linker_Switches.Table (Linker_Switches_Pos) := S;
  
              when None =>
                 raise Program_Error;
--- 616,631 ----
        else
           case Program is
              when Compiler =>
!                Gcc_Switches_Pos (New_Position);
!                Gcc_Switches.Table (New_Position) := S;
  
              when Binder   =>
!                Binder_Switches_Pos (New_Position);
!                Binder_Switches.Table (New_Position) := S;
  
              when Linker   =>
!                Linker_Switches_Pos (New_Position);
!                Linker_Switches.Table (New_Position) := S;
  
              when None =>
                 raise Program_Error;