Re: expression function bug or think?

[Georg Bauhaus <rm.dash-bauhaus@futureapps.de>]

On 6/16/11 10:31 PM, Florian Weimer wrote:
> * georg bauhaus:
>
>> When I compile the following program with GNAT GPL 2011 on Mac, I
>> get confusingly different behavior depending on whether or not I
>> suppress checks. *Suppressing* the checks results in the desired
>> program behavior. (The effect reminds me of potential for Ariane 5
>> gossip—or simply of me being dense.)  When checks are *disabled*
>> (-gnatp), the program runs as expected and prints fib(10) = 55.
>> When checks are enabled (no -gnatp) I get a constraint error on L.6.
>> Optimization does not affect the result, only -gnatp.
>
> Out of curiosity, can you show us the expanded Ada code, using -gnatG?

GNAT GPL 2011 x86-linux produces Constraint_Error, too.
With Debian/GNU 5.0.8, running on a virtual machine:

$ ./run_fib

raised CONSTRAINT_ERROR : fib.ada:6 range check failed
$ gcc --version|head -1
gcc (GCC) 4.5.3 20110419 for GNAT GPL 2011 (20110419)


Whereas, with -gnatp, I get

$ gnatchop -gnat2012 -r -w fib.ada && gnatmake -gnat2012 -gnatp run_fib
splitting fib.ada into:
    functions.ads
    run_fib.adb
    functions.adb
gcc -c -gnat2012 -gnatp run_fib.adb
gcc -c -gnat2012 -gnatp functions.adb
gnatbind -x run_fib.ali
gnatlink run_fib.ali
$ ./run_fib
fib(10) = 55


Without -gnatp, comparing case expressions and case statements:

GNAT GPL 2011 (20110419)
Copyright 1992-2011, Free Software Foundation, Inc.
Source recreated from tree for Run_Fib (body)
---------------------------------------------

with ada;
pragma source_reference (9, "fib.ada");
with functions;
with ada.ada__text_io;
with system.system__img_int;
with system.system__concat_2;

procedure run_fib is
    n : natural;
begin
    if functions.functions__fib (0) /= 0 then
       [program_error "explicit raise"]
    end if;
    n := functions.functions__fib (10);
    B1b : declare
    begin
       subtype run_fib__B1b__TS2bS is string (1 .. 11);
       S2b : string (1 .. 11);
       P3b : natural;
       $system__img_int__image_integer (integer(n), S2b, P3b);
       R4b : constant natural := P3b;
       [subtype run_fib__B1b__T5b is integer range 1 .. R4b]
       [subtype run_fib__B1b__T6b is string (run_fib__B1b__T5b)]
       reference run_fib__B1b__T6b
       L9b : constant integer := S2b (1 .. R4b)'length;
       L11b : constant integer := 9 + L9b;
       subtype run_fib__B1b__TS12bS is string (1 .. 1 + (L11b - 1));
       S12b : string (1 .. 1 + (L11b - 1));
       $system__concat_2__str_concat_2 (S12b, "fib(10) =", S2b (1 .. R4b));
       ada.ada__text_io.ada__text_io__put_line__2 (S12b);
    end B1b;
    return;
end run_fib;



Compiling: run_fib.adb (source file time stamp: 2011-06-17 08:49:11)

         pragma Source_Reference (000009, "fib.ada");
      9.
     10. with Functions;
     11. with Ada.Text_IO;
     12.
     13. procedure Run_Fib is
     14.     N : Natural;
     15. begin
     16.     if Functions.Fib(0) /= 0 then
     17.          raise Program_Error;
     18.     end if;
     19.     N := Functions.Fib(10);
     20.     Ada.Text_IO.Put_Line ("fib(10) =" & Natural'Image(N));
     21. end Run_Fib;

  14 lines: No errors

GNAT GPL 2011 (20110419)
Copyright 1992-2011, Free Software Foundation, Inc.
Source recreated from tree for Functions (body)
-----------------------------------------------

pragma source_reference (22, "fib.ada");
with interfaces;

package body functions is

    function functions__fib2 (n : natural) return natural is
    begin
       [constraint_error when
         not (interfaces__unsigned_32!(n) <= 16#7FFF_FFFF#)
         "invalid data"]
       case n is
          when 0 =>
             return 0;
          when 1 =>
             return 1;
          when others =>
             [constraint_error when
               not (n - 1 >= 0)
               "range check failed"]
             [constraint_error when
               not (n - 2 >= 0)
               "range check failed"]
             return natural(functions__fib2 (n - 1) + functions__fib2 (n -
               2));
       end case;
    end functions__fib2;
begin
    null;
end functions;

Source recreated from tree for Functions (spec)
-----------------------------------------------

pragma source_reference (1, "fib.ada");
with interfaces;
functions_E : short_integer := 0;

package functions is
    function functions__fib (n : natural) return natural;

    function functions__fib (n : natural) return natural is
    begin
       return
          do
             T2s : natural;[constraint_error when
               not (n - 1 >= 0)
               "range check failed"][constraint_error when
               not (n - 2 >= 0)
               "range check failed"][constraint_error when
               not (interfaces__unsigned_32!(n) <= 16#7FFF_FFFF#)
               "invalid data"]
             case n is
                when 0 =>
                   T2s := 0;
                when 1 =>
                   T2s := 1;
                when others =>
                   T2s := functions__fib (n - 1) + functions__fib (n -
                     2);
             end case;
          in T2s end
       ;
    end functions__fib;

    function functions__fib2 (n : natural) return natural;
end functions;



Compiling: functions.adb (source file time stamp: 2011-06-17 08:49:11)

         pragma Source_Reference (000022, "fib.ada");
     22.
     23. package body Functions is
     24. function Fib2 (N : Natural) return Natural is
     25. begin
     26.     case N is
     27.     when 0 => return 0;
     28.     when 1 => return 1;
     29.     when others => return Fib2(N-1) + Fib2(N-2);
     30.     end case;
     31. end Fib2;
     32. end Functions;

Compiling: functions.ads (source file time stamp: 2011-06-17 08:49:11)

         pragma Source_Reference (000001, "fib.ada");
      1. package Functions is
      2. function Fib (N : Natural) return Natural is
      3.     (case N is
      4.      when 0 => 0,
      5.      when 1 => 1,
      6.      when others => Fib(N-1) + Fib(N-2));
      7. function Fib2 (N : Natural) return Natural;
      8. end Functions;

  12 lines: No errors