new bug

tests/webtbf/tw3241.pp

@@ -0,0 +1,38 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 3241 }
+{ Submitted by "Mattias Gaertner" on  2004-08-09 }
+{ e-mail: [email protected] }
+program TwoDefaults;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils;
+
+type
+  TMyClass = class
+  private
+    function GetA1(Index: integer): integer;
+    function GetA2(Index: integer): integer;
+  public
+    property A1[Index: integer]: integer read GetA1; default;
+    { Next line should give an error }
+    property A2[Index: integer]: integer read GetA2; default;
+  end;
+
+{ TMyClass }
+
+function TMyClass.GetA1(Index: integer): integer;
+begin
+  Result:=0;
+end;
+
+function TMyClass.GetA2(Index: integer): integer;
+begin
+  Result:=0;
+end;
+
+begin
+end.
+

tests/webtbf/tw3253.pp

@@ -0,0 +1,16 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 3253 }
+{ Submitted by "marco" on  2004-08-16 }
+{ e-mail:  }
+PROGRAM TEST;
+ {$R+}
+ {$Q+}
+ CONST Range = 10;
+ { The next line is not possible, the ( expects an enumeration declation }
+ TYPE Sometype = ((-1)*(Range-1))..(Range-1);
+ VAR Somevar: SOMETYPE;
+ BEGIN
+   Somevar := -9;
+   WriteLn(Somevar);
+ END.

tests/webtbs/tw2388.pp

@@ -0,0 +1,26 @@
+var
+  err : boolean;
+
+procedure check(const s:string;b:boolean);
+begin
+  writeln(s,b);
+  if not b then
+    begin
+      err:=true;
+      writeln('error!');
+    end;
+end;
+
+Var SS : ShortString;
+    AS : AnsiString;
+
+Begin
+  SS := 'asdf';
+  AS := 'asdf';
+  Check('SS         > '''': ', SS > '');
+  Check('Length(SS) >  0: '  , Length(SS) > 0);
+  Check('AS         > '''': ', AS > '');
+  Check('Length(AS) >  0: '  , Length(AS) > 0);
+  if err then
+    halt(1);
+End.

tests/webtbs/tw3222.pp

@@ -0,0 +1,53 @@
+{ Source provided for Free Pascal Bug Report 3222 }
+{ Submitted by "Christian Iversen" on  2004-07-28 }
+{ e-mail: [email protected] }
+(******************************************************************************
+ *
+ *  (C)Copyright 1999-2003 Technetium Group.  All Rights Reserved.
+ *
+ *  File:          LibXThread.pas
+ *  Content:
+ *
+ *  Compatiblity:  32-Bit, Delphi, FPC approved
+ *
+ *  Programmer:    Ivo Steinmann
+ *  E-Mail:        [email protected]
+ *  Homepage:      http://www.technetium.dk
+ *
+ *  $Date$
+ *  $Rev: 1651 $
+ *
+ *****************************************************************************)
+
+
+Unit tw3222;
+
+{$mode delphi}
+
+Interface
+
+Type
+  XThreadMethod = Function: LongInt Of Object;
+
+  PThreadSyncRec = ^XThreadSyncRec;
+  XThreadSyncRec = Record
+    Method : XThreadMethod;
+  End;
+
+  PSyncRecArray = ^XSyncRecArray;
+  XSyncRecArray = Array[Byte] Of PThreadSyncRec;
+
+Implementation
+
+Function TXThreadSynchronizerProcess: LongInt;
+Var
+  Local: PSyncRecArray;
+Begin
+  With Local[0]^ Do
+  Begin
+    Result := Method; // Doesn't work
+    Result := Method(); // Works
+  End;
+End;
+
+End.

tests/webtbs/tw3227.pp

@@ -0,0 +1,129 @@
+{ Source provided for Free Pascal Bug Report 3227 }
+{ Submitted by "mickaël leduque" on  2004-08-03 }
+{ e-mail: [email protected] }
+uses variants;
+
+
+type
+  TGffVarType		= (
+
+    gffBYTE,		// 0
+
+    gffCHAR,		// 1
+
+    gffWORD,		// 2
+
+    gffSHORT,		// 3
+
+    gffDWORD,		// 4
+
+    gffINT,		// 5
+
+    gffDWORD64,		// 6
+
+    gffINT64,		// 7
+
+    gffFLOAT,		// 8
+
+    gffDOUBLE,		// 9
+
+    gffVoid,		// 13
+
+    gffStruct,		// 14
+
+    gffList		// 15
+
+  );
+
+  TGffVarData		= record
+
+    AsVoid		: array of Char;
+
+    case TGffVarType of
+
+      gffBYTE		: (AsByte: Byte);
+
+      gffCHAR		: (AsChar: Shortint);
+
+      gffWORD		: (AsWord: Word);
+
+      gffSHORT		: (AsShort: Smallint);
+
+      gffDWORD		: (AsDWord: Longword);
+
+      gffINT		: (AsInt: Longint);
+
+      gffDWORD64,
+
+      gffINT64		: (AsInt64: Int64);
+
+      gffFLOAT		: (AsFloat: Single);
+
+      gffDOUBLE		: (AsDouble: Double);
+
+  end;
+
+
+
+
+
+
+var	FType : TGffVarType;
+
+	Machin : variant;
+	Data : TGffVarData;
+
+begin
+SetLength(Data.AsVoid,3);
+Data.AsVoid[0]:='b';
+Data.AsVoid[1]:='c';
+Data.asFloat:=0.0;
+FType:=gffBYTE;
+
+  case FType of
+
+    gffBYTE:
+
+      Machin		:= Data.AsByte;
+
+    gffCHAR:
+
+      Machin		:= Data.AsChar;
+
+    gffWORD:
+
+      Machin		:= Data.AsWord;
+
+    gffSHORT:
+
+      Machin		:= Data.AsShort;
+
+    gffDWORD:
+
+      Machin		:= Data.AsDWord;
+
+    gffINT:
+
+      Machin		:= Data.AsInt;
+
+    gffDWORD64, gffINT64:
+
+      Machin		:= Data.AsInt64;
+
+    gffFLOAT:
+
+      Machin		:= Data.AsFloat;
+
+    gffDOUBLE:
+
+      Machin		:= Data.AsDouble;
+
+    gffVoid:
+
+      Machin		:= Data.AsVoid;
+
+  end;
+
+end;
+
+

tests/webtbs/tw3241a.pp

@@ -0,0 +1,40 @@
+{ Source provided for Free Pascal Bug Report 3241 }
+{ Submitted by "Mattias Gaertner" on  2004-08-09 }
+{ e-mail: [email protected] }
+program TwoDefaults;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils;
+
+type
+  TMyParentClass = class
+  private
+    function GetA1(Index: integer): integer;
+  public
+    property A1[Index: integer]: integer read GetA1; default;
+  end;
+
+  TMyClass = class(TMyParentClass)
+  private
+    function GetA2(Index: integer): integer;
+  public
+    property A2[Index: integer]: integer read GetA2; default;
+  end;
+
+{ TMyClass }
+
+function TMyParentClass.GetA1(Index: integer): integer;
+begin
+  Result:=0;
+end;
+
+function TMyClass.GetA2(Index: integer): integer;
+begin
+  Result:=0;
+end;
+
+begin
+end.
+

tests/webtbs/tw3252.pp

@@ -0,0 +1,23 @@
+{ Source provided for Free Pascal Bug Report 3252 }
+{ Submitted by "Tom Verhoeff" on  2004-08-16 }
+{ e-mail: [email protected] }
+program ConstRange;
+  { To demonstrate error with sqr in const expression }
+
+const
+  Max1 = 12; { program compiles fine when changing 12 to 11 }
+  Max2 = Max1 * Max1; { this works fine }
+  Max3 = sqr ( Max1 ); { this fails }
+
+type
+  Index = 0 .. Max3;
+
+{ remainder not relevant, but included to have a complete program }
+
+var
+  i: Index;
+
+begin
+  i := 0
+; writeln ( i )
+end.

tests/webtbs/tw3255.pp

@@ -0,0 +1,35 @@
+{ Source provided for Free Pascal Bug Report 3255 }
+{ Submitted by "Patrick Dietrich" on  2004-08-17 }
+{ e-mail: [email protected] }
+program testclassptr;
+
+{$mode delphi}
+
+type
+  TProc = procedure (Sender: TClass) of object;
+
+  TTest = class
+  public
+    class procedure foo;
+    class procedure bar(Sender: TClass);
+    class procedure baz(proc: TProc);
+  end;
+
+class procedure TTest.foo;
+begin
+  baz(bar);
+end;
+
+class procedure TTest.bar;
+begin
+  writeln('hello world');
+end;
+
+class procedure TTest.baz;
+begin
+  proc(self);
+end;
+
+begin
+  TTest.foo;
+end.

tests/webtbs/tw3261.pp

@@ -0,0 +1,23 @@
+{ Source provided for Free Pascal Bug Report 3261 }
+{ Submitted by "Andreas Hausladen" on  2004-08-18 }
+{ e-mail: [email protected] }
+program test;
+
+{$mode delphi}
+
+type
+  TTest = class(TObject)
+  public
+    procedure myfunc(arg1: Integer; arg2: TTest); overload;
+    procedure myfunc(arg1: TTest); overload;
+  end;
+
+procedure TTest.myfunc(arg1: Integer; arg2: TTest); external 'test.dll' name 'TTest_myfunc';
+
+procedure TTest.myfunc(arg1: TTest);
+begin
+  if arg1 = nil then ;
+end;
+
+begin
+end.