
(********************************************************************)
(*                                                                  *)
(*  chkexc.sd7    Checks exceptions                                 *)
(*  Copyright (C) 1994, 2005, 2010  Thomas Mertes                   *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "stdio.s7i";
  include "bigint.s7i";
  include "float.s7i";
  include "math.s7i";
  include "utf8.s7i";
  include "shell.s7i";
  include "bigfile.s7i";
  include "osfiles.s7i";


const proc: f1 (in integer: number) is func
  begin
    ignore(1 div 0);
  end func;


const proc: f2 (in integer: number) is func
  begin
    f1(number);
  end func;


const proc: f3 is func
  begin
    f2(5);
  end func;


const proc: f4 (in integer: number) is func
  begin
    f3;
  end func;


const func integer: test_func (in integer: number) is
  return number;


const func integer: intExpr (in integer: number) is
  return number + length(str(rand(1, 9))[2 ..]);


const proc: check_integer_exponentiation (inout boolean: okay) is func
  local
    var integer: number is 0;
    var integer: i_num is 0;
  begin
    block
      i_num := 0 ** 0;
      if i_num = 1 then
        incr(number);
      else
        writeln(" ***** 0 ** 0 did not deliver 1");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 0 ** 0 did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := 0 ** (-2);
      writeln(" ***** 0 ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0 ** intExpr(0);
      if i_num = 1 then
        incr(number);
      else
        writeln(" ***** 0 ** intExpr(0) did not deliver 1");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 0 ** intExpr(0) did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := 0 ** intExpr(-2);
      writeln(" ***** 0 ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(0) ** 0;
      if i_num = 1 then
        incr(number);
      else
        writeln(" ***** intExpr(0) ** 0 did not deliver 1");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** intExpr(0) ** 0 did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := intExpr(0) ** (-2);
      writeln(" ***** intExpr(0) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(0) ** intExpr(0);
      if i_num = 1 then
        incr(number);
      else
        writeln(" ***** intExpr(0) ** intExpr(0) did not deliver 1");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** intExpr(0) ** intExpr(0) did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := intExpr(0) ** intExpr(-2);
      writeln(" ***** intExpr(0) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1 ** (-2);
      writeln(" ***** 1 ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1 ** intExpr(-2);
      writeln(" ***** 1 ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(1) ** (-2);
      writeln(" ***** intExpr(1) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(1) ** intExpr(-2);
      writeln(" ***** intExpr(1) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 2 ** (-2);
      writeln(" ***** 2 ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 2 ** intExpr(-2);
      writeln(" ***** 2 ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(2) ** (-2);
      writeln(" ***** intExpr(2) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(2) ** intExpr(-2);
      writeln(" ***** intExpr(2) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 3 ** (-2);
      writeln(" ***** 3 ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 3 ** intExpr(-2);
      writeln(" ***** 3 ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(3) ** (-2);
      writeln(" ***** intExpr(3) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(3) ** intExpr(-2);
      writeln(" ***** 3 ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 4 ** (-2);
      writeln(" ***** 4 ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 4 ** intExpr(-2);
      writeln(" ***** 4 ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(4) ** (-2);
      writeln(" ***** intExpr(4) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(4) ** intExpr(-2);
      writeln(" ***** intExpr(4) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := (-1) ** (-2);
      writeln(" ***** (-1) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := (-1) ** (-3);
      writeln(" ***** (-1) ** (-3) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := (-1) ** intExpr(-2);
      writeln(" ***** (-1) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := (-1) ** intExpr(-3);
      writeln(" ***** (-1) ** intExpr(-3) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(-1) ** (-2);
      writeln(" ***** (-1) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(-1) ** (-3);
      writeln(" ***** (-1) ** (-3) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(-1) ** intExpr(-2);
      writeln(" ***** (-1) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := intExpr(-1) ** intExpr(-3);
      writeln(" ***** (-1) ** intExpr(-3) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    if okay and number <> 32 then
      writeln(" ***** Integer exceptions for exponentiation do not work correct");
      writeln;
      okay := FALSE;
    end if;
  end func;


const proc: check_integer is func
  local
    var boolean: okay is TRUE;
    var integer: number is 0;
    var integer: zero is 0;
    var integer: one is 0;
    var integer: i_num is 0;
    const integer: int0 is 0;
    const integer: int2m is -2;
    const integer: int3m is -3;
  begin
    block
      i_num := 1 div 0;
      writeln(" ***** 1 div 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1 div zero;
      writeln(" ***** 1 div zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := one div 0;
      writeln(" ***** one div 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := one div zero;
      writeln(" ***** one div zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0 div 0;
      writeln(" ***** 0 div 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0 div zero;
      writeln(" ***** 0 div zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := zero div 0;
      writeln(" ***** zero div 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := zero div zero;
      writeln(" ***** zero div zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1 rem 0;
      writeln(" ***** 1 rem 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1 rem zero;
      writeln(" ***** 1 rem zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := one rem 0;
      writeln(" ***** one rem 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := one rem zero;
      writeln(" ***** one rem zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0 rem 0;
      writeln(" ***** 0 rem 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0 rem zero;
      writeln(" ***** 0 rem zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := zero rem 0;
      writeln(" ***** zero rem 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := zero rem zero;
      writeln(" ***** zero rem zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1 mdiv 0;
      writeln(" ***** 1 mdiv 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1 mdiv zero;
      writeln(" ***** 1 mdiv zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := one mdiv 0;
      writeln(" ***** one mdiv 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := one mdiv zero;
      writeln(" ***** one mdiv zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0 mdiv 0;
      writeln(" ***** 0 mdiv 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0 mdiv zero;
      writeln(" ***** 0 mdiv zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := zero mdiv 0;
      writeln(" ***** zero mdiv 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := zero mdiv zero;
      writeln(" ***** zero mdiv zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1 mod 0;
      writeln(" ***** 1 mod 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1 mod zero;
      writeln(" ***** 1 mod zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := one mod 0;
      writeln(" ***** one mod 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := one mod zero;
      writeln(" ***** one mod zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0 mod 0;
      writeln(" ***** 0 mod 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0 mod zero;
      writeln(" ***** 0 mod zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := zero mod 0;
      writeln(" ***** zero mod 0 did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := zero mod zero;
      writeln(" ***** zero mod zero did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := ! (-1);
      writeln(" ***** ! (-1) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := log2(-1);
      writeln(" ***** log2(-1) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num  := integer parse "";
      writeln(" ***** integer parse \"\" did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num  := integer parse "123asdf";
      writeln(" ***** integer parse \"123asdf\" did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num  := integer parse "asdf";
      writeln(" ***** integer parse \"asdf\" did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num := rand(1, 0);
      writeln(" ***** rand(1, 0) did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num  := sqrt(-1);
      writeln(" ***** sqrt(-1) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      block
        i_num := 1 div 0;
        writeln(" ***** 1 div 0 did not raise NUMERIC_ERROR");
        okay := FALSE;
      exception
        catch NUMERIC_ERROR:
          incr(number);
      end block;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** NUMERIC_ERROR catched at wrong level");
    end block;

    block
      block
        i_num := 1 div 0;
        writeln(" ***** 1 div 0 did not raise NUMERIC_ERROR");
        okay := FALSE;
      exception
        catch RANGE_ERROR:
          writeln(" ***** NUMERIC_ERROR catched at wrong level");
      end block;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    check_integer_exponentiation(okay);

    if okay and number = 41 then
      writeln("Integer exceptions work correct.");
    else
      writeln(" ***** Integer exceptions do not work correct");
      writeln;
    end if;
  end func;


const func bigInteger: bigIntExpr (in bigInteger: number) is
  return number;


const proc: check_bigInteger_exponentiation (inout boolean: okay) is func
  local
    var integer: number is 0;
    var bigInteger: i_num is 0_;
  begin
    block
      i_num := 0_ ** 0;
      if i_num = 1_ then
        incr(number);
      else
        writeln(" ***** 0_ ** 0 did not deliver 1_");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 0_ ** 0 did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := 0_ ** (-2);
      writeln(" ***** 0_ ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 0_ ** intExpr(0);
      if i_num = 1_ then
        incr(number);
      else
        writeln(" ***** 0_ ** intExpr(0) did not deliver 1_");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 0_ ** intExpr(0) did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := 0_ ** intExpr(-2);
      writeln(" ***** 0_ ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(0_) ** 0;
      if i_num = 1_ then
        incr(number);
      else
        writeln(" ***** bigIntExpr(0_) ** 0 did not deliver 1");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** bigIntExpr(0_) ** 0 did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := bigIntExpr(0_) ** (-2);
      writeln(" ***** bigIntExpr(0_) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(0_) ** intExpr(0);
      if i_num = 1_ then
        incr(number);
      else
        writeln(" ***** bigIntExpr(0_) ** intExpr(0) did not deliver 1");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** bigIntExpr(0_) ** intExpr(0) did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := bigIntExpr(0_) ** intExpr(-2);
      writeln(" ***** bigIntExpr(0_) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1_ ** (-2);
      writeln(" ***** 1_ ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1_ ** intExpr(-2);
      writeln(" ***** 1_ ** bigIntExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(1_) ** (-2);
      writeln(" ***** bigIntExpr(1_) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(1_) ** intExpr(-2);
      writeln(" ***** bigIntExpr(1_) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 2_ ** (-2);
      writeln(" ***** 2_ ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 2_ ** intExpr(-2);
      writeln(" ***** 2_ ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(2_) ** (-2);
      writeln(" ***** bigIntExpr(2_) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(2_) ** intExpr(-2);
      writeln(" ***** bigIntExpr(2_) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 3_ ** (-2);
      writeln(" ***** 3_ ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 3_ ** intExpr(-2);
      writeln(" ***** 3_ ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(3_) ** (-2);
      writeln(" ***** bigIntExpr(3_) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(3_) ** intExpr(-2);
      writeln(" ***** 3_ ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 4_ ** (-2);
      writeln(" ***** 4_ ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 4_ ** intExpr(-2);
      writeln(" ***** 4_ ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(4_) ** (-2);
      writeln(" ***** bigIntExpr(4_) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(4_) ** intExpr(-2);
      writeln(" ***** bigIntExpr(4_) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := (-1_) ** (-2);
      writeln(" ***** (-1_) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := (-1_) ** (-3);
      writeln(" ***** (-1_) ** (-3) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := (-1_) ** intExpr(-2);
      writeln(" ***** (-1_) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := (-1_) ** intExpr(-3);
      writeln(" ***** (-1_) ** intExpr(-3) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(-1_) ** (-2);
      writeln(" ***** (-1_) ** (-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(-1_) ** (-3);
      writeln(" ***** (-1_) ** (-3) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(-1_) ** intExpr(-2);
      writeln(" ***** (-1_) ** intExpr(-2) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := bigIntExpr(-1_) ** intExpr(-3);
      writeln(" ***** (-1_) ** intExpr(-3) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    if okay and number <> 32 then
      writeln(" ***** BigInteger exceptions for exponentiation do not work correct");
      writeln;
      okay := FALSE;
    end if;
  end func;


const proc: check_bigInteger is func
  local
    var boolean: okay is TRUE;
    var integer: number is 0;
    var bigInteger: i_num is 0_;
  begin
    block
      i_num := 1_ div 0_;
      writeln(" ***** 1_ div 0_ did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1_ rem 0_;
      writeln(" ***** 1_ rem 0_ did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1_ mdiv 0_;
      writeln(" ***** 1_ mdiv 0_ did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num := 1_ mod 0_;
      writeln(" ***** 1_ mod 0_ did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    (* block
      i_num := ! (-1_);
      writeln(" ***** ! (-1_) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block; *)

    block
      i_num := log2(-1_);
      writeln(" ***** log2(-1_) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      i_num  := bigInteger parse "";
      writeln(" ***** bigInteger parse \"\" did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num  := bigInteger parse "123asdf";
      writeln(" ***** bigInteger parse \"123asdf\" did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num  := bigInteger parse "asdf";
      writeln(" ***** bigInteger parse \"asdf\" did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num := rand(1_, 0_);
      writeln(" ***** rand(1_, 0_) did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num  := sqrt(-1_);
      writeln(" ***** sqrt(-1_) did not raise NUMERIC_ERROR");
      okay := FALSE;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    block
      block
        i_num := 1_ div 0_;
        writeln(" ***** 1_ div 0_ did not raise NUMERIC_ERROR");
        okay := FALSE;
      exception
        catch NUMERIC_ERROR:
          incr(number);
      end block;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** NUMERIC_ERROR catched at wrong level");
    end block;

    block
      block
        i_num := 1_ div 0_;
        writeln(" ***** 1_ div 0_ did not raise NUMERIC_ERROR");
        okay := FALSE;
      exception
        catch RANGE_ERROR:
          writeln(" ***** NUMERIC_ERROR catched at wrong level");
      end block;
    exception
      catch NUMERIC_ERROR:
        incr(number);
    end block;

    check_bigInteger_exponentiation(okay);

    if okay and number = 12 then
      writeln("BigInteger exceptions work correct.");
    else
      writeln(" ***** BigInteger exceptions do not work correct");
      writeln;
    end if;
  end func;


const proc: check_float is func
  local
    var boolean: okay is TRUE;
    var integer: number is 0;
    var float: f_num is 0.0;
    var integer: i_num is 0;
  begin
    block
      f_num  := rand(1.0, 0.0);
      writeln(" ***** rand(1.0, 0.0) did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      f_num  := sqrt(-1.0);
      if isNaN(f_num) then
        incr(number);
      else
        writeln(" ***** sqrt(-1.0) did not deliver NaN");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** sqrt(-1.0) raises NUMERIC_ERROR");
        okay := FALSE;
    end block;

(*
    block
      i_num  := trunc(1.0E37);
      writeln(" ***** trunc(1.0E37) returned " <& i_num);
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** trunc(1.0E37) raised NUMERIC_ERROR");
    end block;
*)

    block
      f_num  := 1.0 / 0.0;
      if f_num = Infinity then
        incr(number);
      else
        writeln(" ***** 1.0 / 0.0 did not deliver Infinity");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 1.0 / 0.0 raises NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num  := 1.0 / -0.0;
      if f_num = -Infinity then
        incr(number);
      else
        writeln(" ***** 1.0 / -0.0 did not deliver -Infinity");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 1.0 / -0.0 raises NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num  := -1.0 / 0.0;
      if f_num = -Infinity then
        incr(number);
      else
        writeln(" ***** -1.0 / 0.0 did not deliver -Infinity");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** -1.0 / 0.0 raises NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num  := -1.0 / -0.0;
      if f_num = Infinity then
        incr(number);
      else
        writeln(" ***** -1.0 / -0.0 did not deliver Infinity");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** -1.0 / -0.0 raises NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num  := 0.0 / 0.0;
      if isNaN(f_num) then
        incr(number);
      else
        writeln(" ***** 0.0 / 0.0 did not deliver NaN");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 0.0 / 0.0 raises NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num  := 0.0 / -0.0;
      if isNaN(f_num) then
        incr(number);
      else
        writeln(" ***** 0.0 / -0.0 did not deliver NaN");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 0.0 / -0.0 raises NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num  := -0.0 / 0.0;
      if isNaN(f_num) then
        incr(number);
      else
        writeln(" ***** -0.0 / 0.0 did not deliver NaN");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** -0.0 / 0.0 raises NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num  := -0.0 / -0.0;
      if isNaN(f_num) then
        incr(number);
      else
        writeln(" ***** -0.0 / -0.0 did not deliver NaN");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** -0.0 / -0.0 raises NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num := 0.0 ** (-2);
      if f_num = Infinity then
        incr(number);
      else
        writeln(" ***** 0.0 ** (-2) did not deliver Infinity");
        writeln(f_num);
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 0.0 ** (-2) did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num := 0.0 ** 0.0;
      if f_num = 1.0 then
        incr(number);
      else
        writeln(" ***** 0.0 ** 0.0 did not deliver 1.0");
        writeln(f_num);
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 0.0 ** 0.0 did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num := 0.0 ** (-1.0);
      if f_num = Infinity then
        incr(number);
      else
        writeln(" ***** 0.0 ** (-1.0) did not deliver Infinity");
        okay := FALSE;
      end if;
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** 0.0 ** (-1.0) did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    block
      f_num := (-2.0) ** 0.5;
      incr(number);
    exception
      catch NUMERIC_ERROR:
        writeln(" ***** (-2.0) ** 0.5 did raise NUMERIC_ERROR");
        okay := FALSE;
    end block;

    if okay and number = 14 then
      writeln("Floating point exceptions work correct.");
    else
      writeln(" ***** Floating point exceptions do not work correct");
      writeln;
    end if;
  end func;


const proc: check_string is func
  local
    var boolean: okay is TRUE;
    var integer: number is 0;
    var integer: i_num is 0;
    var string: stri is "";
    var char: ch is ' ';
  begin
    block
      ch := "asdf"[-1];
      writeln(" ***** \"asdf\"[-1] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      ch := "asdf"[0];
      writeln(" ***** \"asdf\"[0] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      ch := "asdf"[1];
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** \"asdf\"[1] did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      ch := "asdf"[4];
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** \"asdf\"[4] did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      ch := "asdf"[5];
      writeln(" ***** \"asdf\"[5] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      ch := "asdf"[6];
      writeln(" ***** \"asdf\"[6] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := "asdf";
      stri @:= [-1] 'x';
      writeln(" ***** stri @:= [-1] 'x'; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := "asdf";
      stri @:= [0] 'x';
      writeln(" ***** stri @:= [0] 'x'; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := "asdf";
      stri @:= [1] 'x';
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** stri @:= [1] 'x'; did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      stri := "asdf";
      stri @:= [4] 'x';
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** stri @:= [4] 'x'; did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      stri := "asdf";
      stri @:= [5] 'x';
      writeln(" ***** stri @:= [5] 'x'; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := "asdf";
      stri @:= [6] 'x';
      writeln(" ***** stri @:= [6] 'x'; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := "asdf";
      i_num := -1;
      stri @:= [i_num] 'x';
      writeln(" ***** stri @:= [-1] 'x'; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := "asdf";
      i_num := 0;
      stri @:= [i_num] 'x';
      writeln(" ***** stri @:= [0] 'x'; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := "asdf";
      i_num := 1;
      stri @:= [i_num] 'x';
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** stri @:= [1] 'x'; did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      stri := "asdf";
      i_num := 4;
      stri @:= [i_num] 'x';
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** stri @:= [4] 'x'; did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      stri := "asdf";
      i_num := 5;
      stri @:= [i_num] 'x';
      writeln(" ***** stri @:= [5] 'x'; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := "asdf";
      i_num := 6;
      stri @:= [i_num] 'x';
      writeln(" ***** stri @:= [6] 'x'; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := "asdf" mult -1;
      writeln(" ***** \"asdf\" mult -1 did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;
(*
    block
      stri := "a" mult 1048576;
      stri := stri mult 16384;
      stri := stri mult 1048576;
      stri := stri mult 64;
      stri := stri mult 64;
      writeln(" ***** string mult does not raise MEMORY_ERROR");
      okay := FALSE;
    exception
      catch MEMORY_ERROR:
        incr(number);
    end block;
*)
    block
      i_num := pos("asdf", "df", -1);
      writeln(" ***** pos(\"asdf\", \"df\", -1) did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      stri := str('\99999;');
      incr(number);
    exception
      catch RANGE_ERROR: writeln(" ***** str('\\99999;') raises RANGE_ERROR");
      okay := FALSE;
    end block;

    if okay and number = 21 then
      writeln("String exceptions work correct.");
    else
      writeln(" ***** String exceptions do not work correct");
      writeln;
    end if;
  end func;


const proc: check_array is func
  local
    var boolean: okay is TRUE;
    var integer: number is 0;
    var integer: index is 0;
    var integer: i_num is 0;
    var array integer: arr is 0 times 1;
    const array integer: constantArray is 4 times 1;
  begin
    block
      i_num := constantArray[-1];
      writeln(" ***** constantArray[-1] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num := constantArray[0];
      writeln(" ***** constantArray[0] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num := constantArray[1];
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** constantArray[1] did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := constantArray[4];
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** constantArray[4] did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := constantArray[5];
      writeln(" ***** constantArray[5] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num := constantArray[6];
      writeln(" ***** constantArray[6] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      index := -1;
      i_num := constantArray[index];
      writeln(" ***** constantArray[index] for -1 did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      index := 0;
      i_num := constantArray[index];
      writeln(" ***** constantArray[index] for 0 did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      index := 1;
      i_num := constantArray[index];
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** constantArray[index] for 1 did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      index := 4;
      i_num := constantArray[index];
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** constantArray[index] for 4 did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      index := 5;
      i_num := constantArray[index];
      writeln(" ***** constantArray[index] for 5 did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      index := 6;
      i_num := constantArray[index];
      writeln(" ***** constantArray[index] for 6 did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num := (4 times 1)[-1];
      writeln(" ***** (4 times 1)[-1] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num := (4 times 1)[0];
      writeln(" ***** (4 times 1)[0] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num := (4 times 1)[1];
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** (4 times 1)[1] did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := (4 times 1)[4];
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** (4 times 1)[4] did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      i_num := (4 times 1)[5];
      writeln(" ***** (4 times 1)[5] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      i_num := (4 times 1)[6];
      writeln(" ***** (4 times 1)[6] did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      arr := 4 times 1;
      arr[-1] := 2;
      writeln(" ***** arr[-1] := 2; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      arr := 4 times 1;
      arr[0] := 2;
      writeln(" ***** arr[0] := 2; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      arr := 4 times 1;
      arr[1] := 2;
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** arr[1] := 2; did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      arr := 4 times 1;
      arr[4] := 2;
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** arr[4] := 2; did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      arr := 4 times 1;
      arr[5] := 2;
      writeln(" ***** arr[5] := 2; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      arr := 4 times 1;
      arr[6] := 2;
      writeln(" ***** arr[6] := 2; did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      arr := 4 times 1;
      i_num := remove(arr, -1);
      writeln(" ***** remove(arr, -1); did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      arr := 4 times 1;
      i_num := remove(arr, 0);
      writeln(" ***** remove(arr, 0); did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      arr := 4 times 1;
      i_num := remove(arr, 1);
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** remove(arr, 1); did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      arr := 4 times 1;
      i_num := remove(arr, 4);
      incr(number);
    exception
      catch RANGE_ERROR:
        writeln(" ***** remove(arr, 4); did raise RANGE_ERROR");
        okay := FALSE;
    end block;

    block
      arr := 4 times 1;
      i_num := remove(arr, 5);
      writeln(" ***** remove(arr, 5); did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      arr := 4 times 1;
      i_num := remove(arr, 6);
      writeln(" ***** remove(arr, 6); did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    block
      arr := -1 times 1;
      writeln(" ***** -1 times 1 did not raise RANGE_ERROR");
      okay := FALSE;
    exception
      catch RANGE_ERROR:
        incr(number);
    end block;

    if okay and number = 31 then
      writeln("Array exceptions work correct.");
    else
      writeln(" ***** Array exceptions do not work correct");
      writeln;
    end if;
  end func;


const proc: check_file is func
  local
    var boolean: okay is TRUE;
    var integer: number is 0;
    var integer: i_num is 0;
    var string: test_file_name is "";
    var string: test_file_name8 is "";
    var file: aFile is STD_NULL;
    var string: stri is "";
    var integer: file_pos is 0;
    var bigInteger: big_file_pos is 0_;
  begin
    block
      i_num := length(STD_NULL);
      writeln(" ***** length(STD_NULL) succeeded");
      okay := FALSE;
    exception
      catch FILE_ERROR:
        incr(number);
    end block;
    block
      i_num := tell(STD_NULL);
      writeln(" ***** tell(STD_NULL) succeeded");
      okay := FALSE;
    exception
      catch FILE_ERROR:
        incr(number);
    end block;
    block
      seek(STD_NULL, 1);
      writeln(" ***** seek(STD_NULL, 1) succeeded");
      okay := FALSE;
    exception
      catch FILE_ERROR:
        incr(number);
    end block;

    block
      i_num := length(aFile);
      writeln(" ***** length for STD_NULL succeeded");
      okay := FALSE;
    exception
      catch FILE_ERROR:
        incr(number);
    end block;
    block
      i_num := tell(aFile);
      writeln(" ***** tell for STD_NULL succeeded");
      okay := FALSE;
    exception
      catch FILE_ERROR:
        incr(number);
    end block;
    block
      seek(aFile, 1);
      writeln(" ***** seek for STD_NULL succeeded");
      okay := FALSE;
    exception
      catch FILE_ERROR:
        incr(number);
    end block;

    repeat
      test_file_name := homeDir <& "/tmp_test_file_" <& rand(0, 999) lpad0 3;
    until fileType(test_file_name) = FILE_ABSENT;
    repeat
      test_file_name8 := homeDir <& "/tmp_test_file8_" <& rand(0, 999) lpad0 3;
    until fileType(test_file_name8) = FILE_ABSENT;

    aFile := open(test_file_name, "w");
    if aFile = STD_NULL then
      writeln(" ***** Failed to open file");
    else
      block
        stri := gets(aFile, 0);
        incr(number);
      exception
        catch FILE_ERROR:
          writeln(" ***** gets(aFile, 0) from write only file fails");
          okay := FALSE;
      end block;
      block
        stri := gets(aFile, 10);
        writeln(" ***** gets from write only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        stri := gets(aFile, 2000000);
        writeln(" ***** gets from write only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        stri := getln(aFile);
        writeln(" ***** getln from write only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        stri := getwd(aFile);
        writeln(" ***** getwd from write only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      close(aFile);
    end if;

    aFile := openUtf8(test_file_name8, "w");
    if aFile = STD_NULL then
      writeln(" ***** Failed to open UTF-8 file");
    else
      block
        stri := gets(aFile, 0);
        incr(number);
      exception
        catch FILE_ERROR:
          writeln(" ***** gets(aFile, 0) from UTF-8 write only file fails");
          okay := FALSE;
      end block;
      block
        stri := gets(aFile, 10);
        writeln(" ***** gets from UTF-8 write only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        stri := gets(aFile, 2000000);
        writeln(" ***** gets from UTF-8 write only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        stri := getln(aFile);
        writeln(" ***** getln from UTF-8 write only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        stri := getwd(aFile);
        writeln(" ***** getwd from UTF-8 write only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      close(aFile);
    end if;

    aFile := open(test_file_name, "w");
    if aFile = STD_NULL then
      writeln(" ***** Failed to open file");
    else
      writeln(aFile, "asdf");
      close(aFile);
    end if;
    aFile := open(test_file_name, "r");
    if aFile = STD_NULL then
      writeln(" ***** Failed to open file");
    else
      block
        write(aFile, "");
        incr(number);
      exception
        catch FILE_ERROR:
          writeln(" ***** writing \"\" to read only file fails");
          okay := FALSE;
      end block;
      block
        write(aFile, "qwert");
        writeln(" ***** write to read only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        close(aFile);
        incr(number);
      exception
        catch FILE_ERROR:
          writeln(" ***** closing a read only file fails");
          okay := FALSE;
      end block;
    end if;

    aFile := openUtf8(test_file_name, "r");
    if aFile = STD_NULL then
      writeln(" ***** Failed to open file");
    else
      block
        write(aFile, "");
        incr(number);
      exception
        catch FILE_ERROR:
          writeln(" ***** writing \"\" to UTF-8 read only file fails");
          okay := FALSE;
      end block;
      block
        write(aFile, "qwert");
        writeln(" ***** write to UTF-8 read only file succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        close(aFile);
        incr(number);
      exception
        catch FILE_ERROR:
          writeln(" ***** closing an UTF-8 read only file fails");
          okay := FALSE;
      end block;
    end if;

    if fileType("./s7") = FILE_REGULAR then
      aFile := popen("./s7", "r");
    else
      aFile := popen("s7", "r");
    end if;
    if aFile = STD_NULL then
      writeln(" ***** Failed to popen pipe");
    else
      block
        file_pos := length(aFile);
        writeln(" ***** length for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        big_file_pos := bigLength(aFile);
        writeln(" ***** bigLength for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        seek(aFile, 123);
        writeln(" ***** seek for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        seek(aFile, 123_);
        writeln(" ***** seek for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        file_pos := tell(aFile);
        writeln(" ***** tell for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        big_file_pos := bigTell(aFile);
        writeln(" ***** bigTell for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      ignore(gets(aFile, 1)); # Necessary to avoid a SIGPIPE in the executed process
      close(aFile);
    end if;

    if fileType("./s7") = FILE_REGULAR then
      aFile := popen8("./s7", "r");
    else
      aFile := popen8("s7", "r");
    end if;
    if aFile = STD_NULL then
      writeln(" ***** Failed to popen pipe");
    else
      block
        file_pos := length(aFile);
        writeln(" ***** length for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        big_file_pos := bigLength(aFile);
        writeln(" ***** bigLength for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        seek(aFile, 123);
        writeln(" ***** seek for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        seek(aFile, 123_);
        writeln(" ***** seek for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        file_pos := tell(aFile);
        writeln(" ***** tell for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      block
        big_file_pos := bigTell(aFile);
        writeln(" ***** bigTell for pipe succeeded");
        okay := FALSE;
      exception
        catch FILE_ERROR:
          incr(number);
      end block;
      ignore(gets(aFile, 1)); # Necessary to avoid a SIGPIPE in the executed process
      close(aFile);
    end if;

    block
      removeFile(test_file_name);
      removeFile(test_file_name8);
      incr(number);
    exception
      catch FILE_ERROR:
        writeln(" ***** removeFile fails");
        okay := FALSE;
    end block;

    if okay and number = 35 then
      writeln("File exceptions work correct.");
    else
      writeln(" ***** File exceptions do not work correct");
      writeln;
    end if;
  end func;


const proc: main is func
  local
    var string: stri is "";
    var boolean: bool is FALSE;
    var integer: number is 0;
    var reference: obj is NIL;
  begin
    # f4(6);
    writeln;
    check_integer;
    check_bigInteger;
    check_float;
    check_string;
    check_array;
    check_file;

(*
    block
      obj := ref_list.EMPTY[0];
      writeln(" ***** ref_list.EMPTY[0] did not raise RANGE_ERROR");
    exception
      catch RANGE_ERROR: writeln("ref_list.EMPTY[0] raises RANGE_ERROR");
    end block;

    block
      obj := ref_list.EMPTY[1];
      writeln(" ***** ref_list.EMPTY[1] did not raise RANGE_ERROR");
    exception
      catch RANGE_ERROR: writeln("ref_list.EMPTY[1] raises RANGE_ERROR");
    end block;

    block
      ignore(action "asdf");
      writeln(" ***** action \"asdf\" did not raise RANGE_ERROR");
    exception
      catch RANGE_ERROR: writeln("action \"asdf\" raises RANGE_ERROR");
    end block;
*)

    block
      seek(STD_IN, 0);
      writeln(" ***** seek(STD_IN, 0) did not raise RANGE_ERROR");
    exception
      catch RANGE_ERROR: writeln("seek(STD_IN, 0) raises RANGE_ERROR");
    end block;

    block
      stri := gets(STD_IN, -1);
      writeln(" ***** gets(STD_IN, -1) did not raise RANGE_ERROR");
    exception
      catch RANGE_ERROR: writeln("gets(STD_IN, -1) raises RANGE_ERROR");
    end block;

    block
      number := test_func(1 div 0);
      writeln(" ***** test_func(1 div 0) did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("test_func(1 div 0) raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("test_func(1 div 0) raises RANGE_ERROR");
    end block;

    block
      bool := 1 div 0 = 0 and TRUE;
      writeln(" ***** 1 div 0 = 0 and TRUE did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("1 div 0 = 0 and TRUE raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("1 div 0 = 0 and TRUE raises RANGE_ERROR");
    end block;

    block
      bool := 1 div 0 = 0 and FALSE;
      writeln(" ***** 1 div 0 = 0 and FALSE did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("1 div 0 = 0 and FALSE raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("1 div 0 = 0 and FALSE raises RANGE_ERROR");
    end block;

    block
      bool := TRUE and 1 div 0 = 0;
      writeln(" ***** TRUE and 1 div 0 = 0 did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("TRUE and 1 div 0 = 0 raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("TRUE and 1 div 0 = 0 raises RANGE_ERROR");
    end block;

    block
      bool := 1 div 0 = 0 or TRUE;
      writeln(" ***** 1 div 0 = 0 or TRUE did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("1 div 0 = 0 or TRUE raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("1 div 0 = 0 or TRUE raises RANGE_ERROR");
    end block;

    block
      bool := 1 div 0 = 0 or FALSE;
      writeln(" ***** 1 div 0 = 0 or FALSE did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("1 div 0 = 0 or FALSE raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("1 div 0 = 0 or FALSE raises RANGE_ERROR");
    end block;

    block
      bool := FALSE or 1 div 0 = 0;
      writeln(" ***** FALSE or 1 div 0 = 0 did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("FALSE or 1 div 0 = 0 raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("FALSE or 1 div 0 = 0 raises RANGE_ERROR");
    end block;

    block
      if 1 div 0 = 0 then
        writeln(" ***** if 1 div 0 did not raise NUMERIC_ERROR");
      end if;
      writeln(" ***** if 1 div 0 did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("if 1 div 0 raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("if 1 div 0 raises RANGE_ERROR");
    end block;

    block
      if TRUE then
        number := 1 div 0;
      end if;
      writeln(" ***** 1 div 0 in if then did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("1 div 0 in if then raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("1 div 0 in if then raises RANGE_ERROR");
    end block;

    block
      if FALSE then
        noop;
      else
        number := 1 div 0;
      end if;
      writeln(" ***** 1 div 0 in if else did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("1 div 0 in if else raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("1 div 0 in if else raises RANGE_ERROR");
    end block;

    block
      while 1 div 0 = 0 do
        writeln(" ***** while 1 div 0 did not raise NUMERIC_ERROR");
      end while;
      writeln(" ***** while 1 div 0 did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("while 1 div 0 raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("while 1 div 0 raises RANGE_ERROR");
    end block;

    block
      while TRUE do
        number := 1 div 0;
      end while;
      writeln(" ***** 1 div 0 in while did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("1 div 0 in while raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("1 div 0 in while raises RANGE_ERROR");
    end block;

    block
      repeat
        noop;
      until 1 div 0 = 0;
      writeln(" ***** repeat until 1 div 0 did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("repeat until 1 div 0 raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("repeat until 1 div 0 raises RANGE_ERROR");
    end block;

    block
      repeat
        number := 1 div 0;
      until TRUE;
      writeln(" ***** 1 div 0 in repeat did not raise NUMERIC_ERROR");
    exception
      catch NUMERIC_ERROR: writeln("1 div 0 in repeat raises NUMERIC_ERROR");
      catch RANGE_ERROR:   writeln("1 div 0 in repeat raises RANGE_ERROR");
    end block;
  end func;
