+ unified erroru unit for error generation

This commit is contained in:
pierre 1999-05-17 13:57:12 +00:00
parent 722ce4b7e9
commit 28e6c92973

71
tests/erroru.pp Normal file
View File

@ -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.