gcc/testsuite/gnat.dg/overflow_sum.adb

   1 --  { dg-do run }
   2 --  { dg-options "-gnato" }
   3
   4 procedure Overflow_Sum is
   5
   6    function sum (a, b, c, d, e, f, g, h, i, j, k, l, m,
   7                  n, o, p, q, r, s, t, u, v, w, x, y, z : Integer)
   8                  return Integer
   9    is
  10    begin
  11       return a + b + c + d + e + f + g + h + i + j + k + l + m
  12            + n + o + p + q + r + s + t + u + v + w + x + y + z;
  13    end;
  14
  15    f : integer;
  16 begin
  17    f := sum (a => -2**31, b =>      1, c =>  2**31 - 1,  -- 0
  18              d =>      1, e => -2**31, f =>  2**31 - 1,  -- 0
  19              g =>   2**0, h =>      2, i =>          4,  -- 2**3 - 1
  20              j =>   2**3, k =>   2**4, l =>       2**5,  -- 2**6 - 1
  21              m =>   2**6, n =>   2**7, o =>       2**8,  -- 2**9 - 1
  22              p =>   2**9, q =>  2**10, r =>      2**11,  -- 2**12 - 1
  23              s =>  2**12, t =>  2**13, u =>      2**14,  -- 2**15 - 1
  24              v =>  2**15, w =>  2**16, x =>      2**17,  -- 2**18 - 1
  25              y =>  2**31 - 2**18,      z =>          0); -- 2**31 - 1
  26
  27    if f /= 2**31 - 1 then
  28       raise Program_Error;
  29    end if;
  30
  31    begin
  32       f := sum (a =>      f, b => -2**31, c =>          1,  -- 0
  33                 d => -2**31, e =>      1, f =>          f,  -- 0
  34                 g =>   2**0, h =>      2, i =>          4,  -- 2**3 - 1
  35                 j =>   2**3, k =>   2**4, l =>       2**5,  -- 2**6 - 1
  36                 m =>   2**6, n =>   2**7, o =>       2**8,  -- 2**9 - 1
  37                 p =>   2**9, q =>  2**10, r =>      2**11,  -- 2**12 - 1
  38                 s =>  2**12, t =>  2**13, u =>      2**14,  -- 2**15 - 1
  39                 v =>  2**15, w =>  2**16, x =>      2**17,  -- 2**18 - 1
  40                 y =>  2**31 - 2**18,      z =>          1); -- 2**31 (overflow)
  41       raise Program_Error;
  42    exception
  43       when Constraint_Error => null;
  44    end;
  45 end;