diff --git a/tests/erroru.pp b/tests/erroru.pp new file mode 100644 index 0000000000..a0a502170c --- /dev/null +++ b/tests/erroru.pp @@ -0,0 +1,71 @@ +unit erroru; + +interface + + procedure error; + + procedure accept_error(num : longint); + + procedure require_error(num : longint); + +implementation + +const program_has_error : boolean = false; + +procedure error; +begin + Writeln('Error in ',paramstr(0)); + program_has_error:=true; +end; + +const + store_exitproc : pointer = nil; + accepted_error_num : longint = 0; + required_error_num : longint = 0; + + +procedure accept_error(num : longint); +begin + accepted_error_num:=num; +end; + +procedure require_error(num : longint); +begin + required_error_num:=num; +end; + +procedure error_unit_exit; +begin + exitproc:=store_exitproc; + if exitcode<>0 then + begin + if (required_error_num<>0) and (exitcode<>required_error_num) then + begin + Write('Program ',paramstr(0)); + Write('exited with error ',exitcode,' whereas error '); + Writeln(required_error_num,' was expected'); + Halt(1); + end + else if exitcode<>accepted_error_num then + begin + Write('Program ',paramstr(0)); + Write('exited with error ',exitcode,' whereas only error '); + Writeln(accepted_error_num,' was expected'); + Halt(1); + end; + end + else if required_error_num<>0 then + begin + Write('Program ',paramstr(0)); + Write('exited without error whereas error '); + Writeln(required_error_num,' was expected'); + Halt(1); + end; + if program_has_error then + Halt(1); +end; + +begin + store_exitproc:=exitproc; + exitproc:=@error_unit_exit; +end.