[Bug ada/95452] New: Overflow Bug in GNAT Heapsort implementations

[cthowie at netzero dot net]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95452

            Bug ID: 95452
           Summary: Overflow Bug in GNAT Heapsort implementations
           Product: gcc
           Version: unknown
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: ada
          Assignee: unassigned at gcc dot gnu.org
          Reporter: cthowie at netzero dot net
  Target Milestone: ---

TOOLCHAINS: GCC GNAT FSF 8.2 and 10.1 (perhaps also 9.2 and others (?), I have
8.2 and 10.1).

ISSUE: All 3 "GNAT" implementations of Heapsort as found in the 'adainclude'
directory have an arithmetic overflow bug. The affected files are:

   g-heasor.adb
   g-hesorg.adb
   g-hesora.adb

REASON: in all 3 implementations, the nested subprogram called "Sift", inside
the procedure "Sort", uses the following expression:

   Son := 2 * C;

where "Son" and "C" are type "Positive". Note that in "g-heasor.adb" the
expression is a variant with the same overflow problem:

   Son := C + C;

Clearly, any integer type when doubled can overflow unless steps are taken to
mitigate e.g., by doubling "C" using a wider type like a Long_Long_Integer and
then comparing that with the surrounding loop termination condition (note that
"Max", like "Son", is type Positive in the affected code):

   exit when Son > Max;

In the current implementations, there is no check for this overflow, meaning
Heapsort fails with a runtime exception under certain inputs, when it need not.
The sort works if you trap the overflow and exit the loop. Thus the current
implementation is broken for any arrays of length greater than Positive'Last /
2.

EXAMPLE SOLUTION
A solution could therefore be to change the loop body of "Sift" to something
like the following:

   loop
      declare
         Two_C : constant Long_Long_Integer := 2 * Long_Long_Integer (C);

         pragma Suppress (All_Checks);  
         --  It'll be safe to convert Two_C to Son if we get past 
         --  the 'exit' check i.e., to take the lower precision integer 
         --  value (here 32 bits from 64 bits)
      begin
         exit when Two_C > Long_Long_Integer (Max);
         Son := Positive (Two_C);
      end;

      if Son < Max then
         if Lt (Son, Son + 1) then
            Son := Son + 1;
         end if;
      end if;

      Move (Son, C);
      C := Son;
   end loop;

Note that the three files cited don't have identical code with respect to
checking for loop termination, but they have the same logical meaning i.e., in
my 10.1 toolchains, "g-hesorg.adb" and "g-heasor.adb" use:

   Son := 2 * C;
   if Son < Max then
      if Lt (Son, Son + 1) then
         Son := Son + 1;
      end if;
   elsif Son > Max then                 --  termination is checked down here

while "g-hesora.adb" uses the form I demonstrated in the above solution:

   loop
      Son := 2 * C;
      exit when Son > Max;              --  termination is checked early
      if Son < Max and then Lt (Son, Son + 1) then
         Son := Son + 1;
      end if;