Browse Source

+ Added test for typed files

michael 27 years ago
parent
commit
fe4a3fcbf1
2 changed files with 75 additions and 1 deletions
  1. 1 1
      tests/README
  2. 74 0
      tests/ts010015.pp

+ 1 - 1
tests/README

@@ -23,7 +23,7 @@ ts010003.pp       tests the crt unit colors
 ts010004.pp       tests forward classes
 ts010005.pp       tests method overriding
 ts010006.pp       tests libraries
-
+ts010015.pp       tests typed files.
 
 ts10100.pp        tests for delphi object model
 -

+ 74 - 0
tests/ts010015.pp

@@ -0,0 +1,74 @@
+program ttyped;
+
+Type 
+  TRec = record
+    X,Y : longint;
+    end;
+  
+  TRecFile = File of TRec;
+  
+var TF : TRecFile;
+    LF : File of longint;
+    i,j,k,l : longint;
+    t : Trec;
+    
+begin
+  Write ('Writing files...');
+  assign (LF,'longint.dat');
+  rewrite (LF);
+  for i:=1 to 10 do 
+   write (LF,i);
+  close (LF);
+  Assign (TF,'TRec.dat');
+  rewrite (TF);
+  for i:=1 to 10 do
+    for j:=1 to 10 do
+      begin
+      t.x:=i;
+      t.y:=j;
+      write (TF,T);
+      end;
+  close (TF);
+  writeln ('Done');
+  reset (LF);
+  reset (TF);
+  Write ('Sequential read test...');
+  for i:=1 to 10 do
+    begin
+    read (LF,J);
+    if j<>i then writeln ('Read of longint failed at :',i);
+    end;
+  for i:=1 to 10 do
+    for j:=1 to 10 do
+      begin
+      read (tf,t);
+      if (t.x<>i) or (t.y<>j) then
+        writeln ('Read of record failed at :',i,',',j);
+      end;
+  writeln ('Done.');
+  Write ('Random access read test...');
+  For i:=1 to 10 do
+    begin
+    k:=random(10);
+    seek (lf,k);
+    read (lf,j); 
+    if j<>k+1 then 
+     Writeln ('Failed random read of longint at pos ',k,' : ',j);
+    end;
+  For i:=1 to 10 do
+    for j:=1 to 10 do
+      begin
+      k:=random(10);
+      l:=random(10);
+      seek (tf,k*10+l);
+      read (tf,t); 
+      if (t.x<>k+1) or (t.y<>l+1) then 
+        Writeln ('Failed random read of longint at pos ',k,',',l,' : ',t.x,',',t.y);
+      end;
+  Writeln ('Done.');
+  close (lf);
+  close (TF);
+  erase (lf);
+  erase (tf);
+       
+end.