diff --git a/tests/webtbf/tw3241.pp b/tests/webtbf/tw3241.pp new file mode 100644 index 0000000000..58b6a5d4e9 --- /dev/null +++ b/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: mattias@freepascal.org } +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. + diff --git a/tests/webtbf/tw3253.pp b/tests/webtbf/tw3253.pp new file mode 100644 index 0000000000..f878ebdb96 --- /dev/null +++ b/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. diff --git a/tests/webtbs/tw2388.pp b/tests/webtbs/tw2388.pp new file mode 100644 index 0000000000..6ef6fd75b7 --- /dev/null +++ b/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. diff --git a/tests/webtbs/tw3222.pp b/tests/webtbs/tw3222.pp new file mode 100644 index 0000000000..588fe34cd2 --- /dev/null +++ b/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: chrivers@iversen-net.dk } +(****************************************************************************** + * + * (C)Copyright 1999-2003 Technetium Group. All Rights Reserved. + * + * File: LibXThread.pas + * Content: + * + * Compatiblity: 32-Bit, Delphi, FPC approved + * + * Programmer: Ivo Steinmann + * E-Mail: isteinmann@bluewin.ch + * 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. diff --git a/tests/webtbs/tw3227.pp b/tests/webtbs/tw3227.pp new file mode 100644 index 0000000000..8a324350fe --- /dev/null +++ b/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: mickael.leduque@laposte.net } +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; + + diff --git a/tests/webtbs/tw3241a.pp b/tests/webtbs/tw3241a.pp new file mode 100644 index 0000000000..4f6b804bd8 --- /dev/null +++ b/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: mattias@freepascal.org } +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. + diff --git a/tests/webtbs/tw3252.pp b/tests/webtbs/tw3252.pp new file mode 100644 index 0000000000..3d313a4031 --- /dev/null +++ b/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: T.Verhoeff@tue.nl } +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. diff --git a/tests/webtbs/tw3255.pp b/tests/webtbs/tw3255.pp new file mode 100644 index 0000000000..82e0d21542 --- /dev/null +++ b/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: patrick.dietrich@informatik.uni-ulm.de } +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. diff --git a/tests/webtbs/tw3261.pp b/tests/webtbs/tw3261.pp new file mode 100644 index 0000000000..eb0961f776 --- /dev/null +++ b/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: Andreas.Hausladen@gmx.de } +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.