Browse Source

Tests for resizing dynamis arrays

michael 21 years ago
parent
commit
a872dac906
2 changed files with 81 additions and 0 deletions
  1. 55 0
      tests/webtbs/tw3280.pp
  2. 26 0
      tests/webtbs/tw3320.pp

+ 55 - 0
tests/webtbs/tw3280.pp

@@ -0,0 +1,55 @@
+{ Source provided for Free Pascal Bug Report 3280 }
+{ Submitted by "Alan Mead" on  2004-08-29 }
+{ e-mail: [email protected] }
+program example;
+
+var
+  err : boolean;
+  
+type
+  MatrixType = record
+    Mat: array of array of real;
+    Rows: Integer;
+    Cols: Integer;
+    Name: String;
+    Transpose: Boolean;
+    Diagonal: Boolean;
+  end;
+
+
+
+  procedure MatrixNew(var Mat: MatrixType; Rows, Cols: Integer; Name: String; Transpose: Boolean; Diagonal: Boolean);
+    begin
+      writeln('Found ',Rows,' rows and ',Cols,' columns.');
+      {SetLength(Mat.Mat,0,0);}
+      SetLength(Mat.Mat,Rows,Cols);
+      Mat.Rows := Rows;
+      Mat.Cols := Cols;
+      Mat.Name := Name;
+      Mat.Transpose := Transpose;
+      Mat.Diagonal := Diagonal;
+      writeln('Created matrix with ',Rows,' rows and ',Cols,' columns.'); { debug }
+    end;
+
+
+  procedure ShowResults(RetainedDimensions: Integer);
+    var
+      i:Integer;
+      xv: MatrixType;
+    begin
+
+      for i := 0 to 2 do
+        begin
+          writeln('Retained dimensions = ',RetainedDimensions); { debug }
+          MatrixNew(xv,RetainedDimensions,1,'Term vector',FALSE,FALSE);
+          writeln('(',xv.Rows,',',xv.Cols,')');
+          if (xv.Rows<>3) or (xv.Cols<>1) then
+            err:=true;
+        end;
+    end;
+
+begin
+  ShowResults(3);
+  if err then
+    halt(1);
+end.

+ 26 - 0
tests/webtbs/tw3320.pp

@@ -0,0 +1,26 @@
+{ %version=1.1 }
+
+var
+  a,b:array of integer;
+  i :integer;
+  err : boolean;
+begin
+  setlength(a,3);
+  a[0]:=1;
+  a[1]:=2;
+  a[2]:=3;
+  b:=a;
+  writeln('len b= ',length(b)); // output is 3: OK
+  if length(b)<>3 then
+    err:=true;
+  setlength(a,0);
+  writeln('len a= ',length(a)); // output is 0: OK
+  if length(a)<>0 then
+    err:=true;
+  for i:=1 to length(b) do writeln(b[i-1]); // output is 1: BAD
+  writeln('len b= ',length(b)); // output is 1: BAD, must be 3
+  if length(b)<>3 then
+    err:=true;
+  if err then
+    halt(1);  
+end.