Browse Source

* new bug

peter 20 years ago
parent
commit
e98411d817

+ 35 - 0
tests/webtbf/tw3488.pp

@@ -0,0 +1,35 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 3488 }
+{ Submitted by "Jesus Reyes A." on  2004-12-28 }
+{ e-mail: [email protected] }
+program opertest;
+
+{$mode objfpc}{$H+}
+
+type
+  TBug=class
+  private
+    FField: Integer;
+    procedure SetField(const AValue: Integer);
+  public
+    property Field: Integer read FField write SetField;
+  end;
+
+procedure TBug.SetField(const aValue: Integer);
+begin
+  WriteLn('SetField visited');
+  FField := AValue;
+end;
+
+var
+  Bug: TBug;
+begin
+  Bug := TBug.Create;
+  Bug.Field := 10;
+
+  { This is not allowed with properties }
+  Bug.Field += 1;
+
+  WriteLn('Bug.Field=',Bug.Field);
+end.

+ 10 - 0
tests/webtbf/tw3492.pp

@@ -0,0 +1,10 @@
+{ %fail }
+
+{$mode fpc}
+
+{ This is not allowed in normal fpc mode }
+resourcestring
+  s = 'OK';
+begin
+  writeln(s);
+end.

+ 12 - 0
tests/webtbf/tw3495.pp

@@ -0,0 +1,12 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 3495 }
+{ Submitted by "Ido Kanner" on  2005-01-01 }
+{ e-mail: [email protected] }
+{$MACRO ON}
+program Hi;
+{$DEFINE ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890__ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890__________________________________________________________________________________________________________________________________________________________________ := 10}
+
+begin
+        writeln (ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890__ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890__________________________________________________________________________________________________________________________________________________________________);
+end.

+ 12 - 0
tests/webtbf/tw3502.pp

@@ -0,0 +1,12 @@
+{ %fail }
+
+{$ifdef fpc}{$mode delphi}{$endif}
+
+type
+  tc1=class
+    property Loop:integer read Loop;
+  end;
+
+begin
+end.
+  

+ 77 - 0
tests/webtbs/tw3101.pp

@@ -0,0 +1,77 @@
+{ Source provided for Free Pascal Bug Report 3101 }
+{ Submitted by "Martin Schreiber" on  2004-05-15 }
+{ e-mail:  }
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+uses
+  Classes;
+
+type
+ ttestobj = class
+  public
+   constructor create1;
+   constructor create2;
+   destructor destroy; override;
+   procedure afterconstruction; override;
+   procedure beforedestruction; override;
+ end;
+
+var
+ testobj: ttestobj;
+ i : integer;
+ err : boolean;
+
+procedure ttestobj.afterconstruction;
+begin
+ writeln('afterconstruction');
+ if i<>3 then
+   err:=true;
+ inc(i);
+end;
+
+procedure ttestobj.beforedestruction;
+begin
+ writeln('beforedestruction');
+ if i<>4 then
+   err:=true;
+ inc(i);
+end;
+
+constructor ttestobj.create1;
+begin
+ writeln('create1');
+ if i<>1 then
+   err:=true;
+ inc(i);
+ self.create2;
+end;
+
+constructor ttestobj.create2;
+begin
+ writeln('create2');
+ if i<>2 then
+   err:=true;
+ inc(i);
+end;
+
+destructor ttestobj.destroy;
+begin
+ writeln('destroy');
+ inherited;
+ if i<>5 then
+   err:=true;
+ inc(i);
+end;
+
+begin
+ i:=1;
+ testobj:= ttestobj(ttestobj.newinstance);
+ testobj.create1;
+ testobj.free;
+ //expected: create,afterconstruction,beforedestruction,destroy
+ //actual: create,beforedestruction,destroy
+ //kylix shows the expected behavior
+  if err then
+    halt(1);
+end.

+ 20 - 0
tests/webtbs/tw3491.pp

@@ -0,0 +1,20 @@
+{ Source provided for Free Pascal Bug Report 3491 }
+{ Submitted by "Marek Mauder" on  2004-12-29 }
+{ e-mail: [email protected] }
+program ErrorGen;
+{$APPTYPE CONSOLE}
+{$ifdef fpc}{$mode delphi}{$endif}
+type
+  TEnum = (
+    e0 = 10,
+    e1 = 11,
+    e2 = 12,
+    e3 = 15);
+  {errorgen.pas(9,27) Error: enums with assignments can't be used as array index}
+  TEnumArray = array[TEnum] of Byte;
+begin
+  {writes 6}
+  WriteLn(SizeOf(TEnumArray));
+  if SizeOf(TEnumArray)<>6 then
+    halt(1);
+end.

+ 24 - 0
tests/webtbs/tw3504.pp

@@ -0,0 +1,24 @@
+{$mode objfpc}{$H+}
+
+uses SysUtils;
+
+function Func1( Args :array of string ) :string;
+begin
+  WriteLn('project2 Arg0-'+Args[0] +' Arg1-'+Args[1]);
+  if (Args[0]='1') and (Args[1]='2') then
+    Result := 'Ok'
+  else
+    Result := 'Err';
+end;
+
+var
+  Int1, Int2  :integer;
+  s : string;
+begin
+  Int1 := 1;
+  Int2 := 2;
+  s:=Func1( [ IntToStr(Int1), IntToStr(Int2)] );
+  writeln(s);
+  if s<>'Ok' then
+    halt(1);
+end.