--
--	cause-errors.occ: test run-time error handling
--	Copyright (C) 2008  Adam Sampson <ats@offog.org>
--
--	This library is free software; you can redistribute it and/or
--	modify it under the terms of the GNU Lesser General Public
--	License as published by the Free Software Foundation; either
--	version 2 of the License, or (at your option) any later version.
--
--	This library 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
--	Lesser General Public License for more details.
--
--	You should have received a copy of the GNU Lesser General Public
--	License along with this library; if not, write to the Free Software
--	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
--

#INCLUDE "course.module"
#INCLUDE "file.module"

PROC main (CHAN BYTE err!)
  --{{{  PROC usage
  PROC usage ()
    SEQ
      out.string ("Usage: cause-errors [OPTION]...*n", 0, err!)
      err ! '*n'
      out.string ("Test run-time error handling.*n", 0, err!)
      err ! '*n'
      out.string ("-s                           STOP*n", 0, err!)
      out.string ("-c                           CAUSEERROR ()*n", 0, err!)
      out.string ("-O                           floating-point overflow*n", 0, err!)
      out.string ("-U                           floating-point underflow (not an error by default)*n", 0, err!)
      out.string ("-z                           integer divide by zero*n", 0, err!)
      out.string ("-Z                           floating-point divide by zero*n", 0, err!)
      out.string ("-b                           array bounds range check*n", 0, err!)
      out.string ("-i                           INT64-to-INT32 conversion range check*n", 0, err!)
      out.string ("-h                           shift range check*n", 0, err!)
      err ! '*n'
      out.string ("Report bugs to <kroc-bugs@kent.ac.uk>.*n*n", 0, err!)
      CAUSEERROR ()
  :
  --}}}

  INITIAL BYTE type IS 0:
  SEQ
    --{{{  parse command-line options
    CHAN GETOPT opts:
    PAR
      file.get.options ("scOUzZbih", opts!)
      INITIAL BOOL running IS TRUE:
      WHILE running
        BYTE o:
        MOBILE []BYTE a:
        opts ? CASE
          opt; o
            type := o
          opt.arg; o; a
            usage ()
          arg; a
            usage ()
          bad; o
            usage ()
          done
            running := FALSE
    --}}}
    --{{{  perform test
    CASE type
      0
        --{{{  no error specified
        usage ()
        --}}}
      's'
        STOP
      'c'
        CAUSEERROR ()
      'O'
        --{{{  FP overflow
        INITIAL REAL32 r IS 1.0:
        SEQ i = 0 FOR 1000
          r := r * 2.0
        --}}}
      'U'
        --{{{  FP underflow
        INITIAL REAL32 r IS 1.0:
        SEQ i = 0 FOR 1000
          r := r / 2.0
        --}}}
      'z'
        --{{{  integer divide by zero
        INT a, b:
        SEQ
          a := 0
          b := 4
          b := b / a
        --}}}
      'Z'
        --{{{  FP divide by zero
        REAL32 a, b:
        SEQ
          a := 0.0
          b := 4.0
          b := b / a
        --}}}
      'b'
        --{{{  array bounds
        PROC p ([]INT a)
          a[6] := 42
        :
        [5]INT a:
        p (a)
        --}}}
      'i'
        --{{{  conversion range check
        INITIAL INT64 big IS #1000000000000:
        INT32 small:
        small := INT32 big
        --}}}
      'h'
        --{{{  shift range check
        INT32 n:
        SEQ
          n := 42
          n := n << (INT n)
        --}}}
    --}}}
    --{{{  no error detected
    out.string ("Error: a runtime error should have been raised by now*n", 0, err!)
    CAUSEERROR ()
    --}}}
:
