Browse Source

+ unified erroru unit for error generation

pierre 26 years ago
parent
commit
28e6c92973
1 changed files with 71 additions and 0 deletions
  1. 71 0
      tests/erroru.pp

+ 71 - 0
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.