Browse Source

* error code testing (based on bug report 2043)

carl 23 years ago
parent
commit
b53d789e1d
1 changed files with 52 additions and 0 deletions
  1. 52 0
      tests/test/units/objects/testobj2.pp

+ 52 - 0
tests/test/units/objects/testobj2.pp

@@ -0,0 +1,52 @@
+{ Source provided for Free Pascal Bug Report 2043 }
+{ Submitted by "Luis Castedo" on  2002-07-16 }
+{ e-mail: [email protected] }
+program tb1;
+
+{$MODE TP}
+
+uses
+  Objects;
+
+const
+  csFName1 = 'tb1_1.tmp';
+  csFName2 = 'tb1_2.tmp';
+
+var
+  pStream1: PStream;
+  pStream2: PStream;
+  lAux    : Longint;
+  error : boolean;
+begin
+  error := false;
+  Write('Error checking for object streams...'); 
+  { Legal operation on pStream1 }
+  pStream1 := New(PDosStream, Init(csFName1, stCreate));
+  { Faulty operation on pStream2 }
+  pStream2 := New(PDosStream, Init(csFName2, stOpenRead));
+  if pStream2^.Status = stOk then
+     error := true;
+     
+  { Legal operation on pStream1 }
+  pStream1^.Write(lAux, SizeOf(lAux));
+  { Normally, if the values are not shared, this should be ok! }
+  if pStream1^.Status <> stOk then
+     error := true;
+
+  pStream2^.Free;
+  pStream1^.Free;
+  if error then
+    Begin
+      WriteLn('FAILED! Errors are mixed up!');
+      halt(1);
+    end
+  else
+      Writeln('Success!');
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-10-31 12:59:11  carl
+   * error code testing (based on bug report 2043)
+
+}