瀏覽代碼

* new bugs

peter 21 年之前
父節點
當前提交
bb47a3d13a
共有 7 個文件被更改,包括 186 次插入0 次删除
  1. 20 0
      tests/webtbf/tw3337.pp
  2. 38 0
      tests/webtbf/tw3342.pp
  3. 29 0
      tests/webtbf/tw3343.pp
  4. 29 0
      tests/webtbs/tw3349.pp
  5. 26 0
      tests/webtbs/tw3351.pp
  6. 16 0
      tests/webtbs/tw3353.pp
  7. 28 0
      tests/webtbs/uw3353.pp

+ 20 - 0
tests/webtbf/tw3337.pp

@@ -0,0 +1,20 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 3337 }
+{ Submitted by "Vincent Snijders" on  2004-10-01 }
+{ e-mail: [email protected] }
+
+{$mode objfpc}
+
+type
+  TB=class
+    function AddNewFile: integer; override;
+  end;
+
+function TB.AddNewFile: integer;
+begin
+  Result:= 5;
+end;
+
+begin
+end.

+ 38 - 0
tests/webtbf/tw3342.pp

@@ -0,0 +1,38 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 3342 }
+{ Submitted by "Alan Mead" on  2004-10-05 }
+{ e-mail: [email protected] }
+{$ifdef fpc}{$MODE Delphi}{$endif}
+
+unit tw3342;
+
+Interface
+
+uses
+ Classes;
+
+type
+  TAgreementMatrix = class(TObject)
+    private
+      _Count: Array[1..100,1..100] of Integer;
+    public
+      constructor Create;
+      destructor Destroy; override;
+      property Count[Row,Column:Integer]:Integer read _Count[Row,Column] write _Count[Row,Column]; default;
+  end;
+
+Implementation
+
+constructor TAgreementMatrix.Create;
+begin
+  inherited;
+end;
+
+destructor TAgreementMatrix.Destroy;
+begin
+  inherited;
+end;
+
+begin
+end.

+ 29 - 0
tests/webtbf/tw3343.pp

@@ -0,0 +1,29 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 3343 }
+{ Submitted by "Martin Schreiber" on  2004-10-06 }
+{ e-mail:  }
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes;
+
+type
+
+ itest = interface
+ end;
+
+ ttestclass = class(tinterfacedobject)
+ end;
+
+var
+ testclass: ttestclass;
+ testintf: itest;
+begin
+ testclass:= ttestclass.create;
+ testintf:= itest(testclass);
+ //fpc: project1.pas(21,13) Warning: Class types "ttestclass" and "itest" are not related
+ //kylix: [Error] project1.pas(21): Incompatible types: 'itest' and 'ttestclass'
+end.

+ 29 - 0
tests/webtbs/tw3349.pp

@@ -0,0 +1,29 @@
+{ Source provided for Free Pascal Bug Report 3349 }
+{ Submitted by "Martin Schreiber" on  2004-10-10 }
+{ e-mail:  }
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+uses
+  Classes,sysutils;
+type
+ integerarty = array of integer;
+var
+ count: integer;
+
+function getvalue: integerarty;
+begin
+ writeln(inttostr(count)+' getvalue called');
+ inc(count);
+ result:= nil;
+end;
+
+procedure proc(par: array of integer);
+begin
+end;
+
+begin
+  //getvalue is called twice, once for length and once for data
+  proc(getvalue);
+  if count<>1 then
+    halt(1);
+end.

+ 26 - 0
tests/webtbs/tw3351.pp

@@ -0,0 +1,26 @@
+{ %opt=-Sc }
+
+{ Source provided for Free Pascal Bug Report 3351 }
+{ Submitted by "Maciej &#379;enczykowski" on  2004-10-10 }
+{ e-mail: [email protected] }
+
+type
+  PInteger = ^Integer;
+var
+  i : integer;
+  t : array [0..1] of integer;
+
+function f : PInteger;
+  begin
+    f := @t[i];
+    Inc(i);
+    Write('.');
+  end;
+
+begin
+  i:=0;
+  f^ += 1;
+  writeln(t[0], ' ', t[1]);
+  if i<>1 then
+    halt(1);
+end.

+ 16 - 0
tests/webtbs/tw3353.pp

@@ -0,0 +1,16 @@
+{ Source provided for Free Pascal Bug Report 3353 }
+{ Submitted by "Vincent Snijders" on  2004-10-11 }
+{ e-mail: [email protected] }
+uses uw3353;
+
+{$ifdef fpc}{$mode objfpc}{$endif}
+
+var
+        gfx:    TGPGraphics;
+    a: integer;
+begin
+  err:=true;
+  gfx := TGPGraphics.Create(a);
+  if err then
+    halt(1);
+end.

+ 28 - 0
tests/webtbs/uw3353.pp

@@ -0,0 +1,28 @@
+{$ifdef fpc}{$mode objfpc}{$endif}
+
+unit uw3353;
+
+interface
+
+var
+  err : boolean;
+
+type
+  TGPGraphics = class(TObject)
+  protected
+    constructor Create(graphics: pointer); reintroduce; overload;
+  public
+    constructor Create(a: integer); reintroduce; overload;
+  end;
+
+implementation
+
+  constructor TGPGraphics.Create(a: integer);
+  begin
+    err:=false;
+  end;
+
+  constructor TGPGraphics.Create(graphics: pointer);
+  begin
+  end;
+end.