+ line endings fixed

* properties set

git-svn-id: trunk@7080 -

.gitattributes

@@ -7858,7 +7858,7 @@ tests/webtbs/tw3691.pp svneol=native#text/plain
 tests/webtbs/tw3694.pp svneol=native#text/plain
 tests/webtbs/tw3695.pp svneol=native#text/plain
 tests/webtbs/tw3697.pp svneol=native#text/plain
-tests/webtbs/tw3700.pp -text svneol=unset#text/plain
+tests/webtbs/tw3700.pp svneol=native#text/plain
 tests/webtbs/tw3708.pp svneol=native#text/plain
 tests/webtbs/tw3719.pp svneol=native#text/plain
 tests/webtbs/tw3721.pp svneol=native#text/plain
@@ -7871,14 +7871,14 @@ tests/webtbs/tw3768.pp svneol=native#text/plain
 tests/webtbs/tw3774.pp svneol=native#text/plain
 tests/webtbs/tw3777.pp svneol=native#text/plain
 tests/webtbs/tw3778.pp svneol=native#text/plain
-tests/webtbs/tw3780.pp svneol=native#text/x-pascal
+tests/webtbs/tw3780.pp svneol=native#text/plain
 tests/webtbs/tw3782.pp svneol=native#text/plain
 tests/webtbs/tw3796.pp svneol=native#text/plain
 tests/webtbs/tw3805.pp svneol=native#text/plain
 tests/webtbs/tw3812.pp svneol=native#text/plain
 tests/webtbs/tw3814.pp svneol=native#text/plain
 tests/webtbs/tw3827.pp svneol=native#text/plain
-tests/webtbs/tw3829.pp -text svneol=unset#text/plain
+tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain
 tests/webtbs/tw3840.pp svneol=native#text/plain
 tests/webtbs/tw3841.pp svneol=native#text/plain
@@ -7891,7 +7891,7 @@ tests/webtbs/tw3898.pp svneol=native#text/plain
 tests/webtbs/tw3899.pp svneol=native#text/plain
 tests/webtbs/tw3900.pp svneol=native#text/plain
 tests/webtbs/tw3913.pp svneol=native#text/plain
-tests/webtbs/tw3930.pp -text
+tests/webtbs/tw3930.pp svneol=native#text/plain
 tests/webtbs/tw3931a.pp svneol=native#text/plain
 tests/webtbs/tw3939.pp svneol=native#text/plain
 tests/webtbs/tw3952.pp svneol=native#text/plain
@@ -7906,7 +7906,7 @@ tests/webtbs/tw3971.pp svneol=native#text/plain
 tests/webtbs/tw3973.pp svneol=native#text/plain
 tests/webtbs/tw3977.pp svneol=native#text/plain
 tests/webtbs/tw3977.txt svneol=native#text/plain
-tests/webtbs/tw3997.pp -text svneol=unset#text/plain
+tests/webtbs/tw3997.pp svneol=native#text/plain
 tests/webtbs/tw4006.pp svneol=native#text/plain
 tests/webtbs/tw4007.pp svneol=native#text/plain
 tests/webtbs/tw4009.pp svneol=native#text/plain
@@ -7945,7 +7945,7 @@ tests/webtbs/tw4209.pp svneol=native#text/plain
 tests/webtbs/tw4215.pp svneol=native#text/plain
 tests/webtbs/tw4219.pp svneol=native#text/plain
 tests/webtbs/tw4223.pp svneol=native#text/plain
-tests/webtbs/tw4229.pp -text svneol=unset#text/plain
+tests/webtbs/tw4229.pp svneol=native#text/plain
 tests/webtbs/tw4229a.pp svneol=native#text/plain
 tests/webtbs/tw4233.pp svneol=native#text/plain
 tests/webtbs/tw4234.pp svneol=native#text/plain
@@ -7956,7 +7956,7 @@ tests/webtbs/tw4247.pp svneol=native#text/plain
 tests/webtbs/tw4253.pp svneol=native#text/plain
 tests/webtbs/tw4254.pp svneol=native#text/plain
 tests/webtbs/tw4260.pp svneol=native#text/plain
-tests/webtbs/tw4266.pp -text
+tests/webtbs/tw4266.pp svneol=native#text/plain
 tests/webtbs/tw4272.pp svneol=native#text/plain
 tests/webtbs/tw4277.pp svneol=native#text/plain
 tests/webtbs/tw4278.pp svneol=native#text/plain
@@ -7975,27 +7975,27 @@ tests/webtbs/tw4427.pp svneol=native#text/plain
 tests/webtbs/tw4428.pp svneol=native#text/plain
 tests/webtbs/tw4450.pp svneol=native#text/plain
 tests/webtbs/tw4477.pp svneol=native#text/plain
-tests/webtbs/tw4487.pp -text svneol=unset#text/plain
-tests/webtbs/tw4489.pp -text svneol=unset#text/plain
+tests/webtbs/tw4487.pp svneol=native#text/plain
+tests/webtbs/tw4489.pp svneol=native#text/plain
 tests/webtbs/tw4496.pp svneol=native#text/plain
-tests/webtbs/tw4519.pp -text svneol=unset#text/plain
-tests/webtbs/tw4520.pp -text svneol=unset#text/plain
-tests/webtbs/tw4529.pp -text svneol=unset#text/plain
+tests/webtbs/tw4519.pp svneol=native#text/plain
+tests/webtbs/tw4520.pp svneol=native#text/plain
+tests/webtbs/tw4529.pp svneol=native#text/plain
 tests/webtbs/tw4533.pp svneol=native#text/plain
 tests/webtbs/tw4534.pp svneol=native#text/plain
 tests/webtbs/tw4537.pp svneol=native#text/plain
-tests/webtbs/tw4540.pp -text svneol=unset#text/plain
+tests/webtbs/tw4540.pp svneol=native#text/plain
 tests/webtbs/tw4541.pp svneol=native#text/plain
 tests/webtbs/tw4557.pp svneol=native#text/plain
-tests/webtbs/tw4566.pp -text svneol=unset#text/plain
+tests/webtbs/tw4566.pp svneol=native#text/plain
 tests/webtbs/tw4574.pp svneol=native#text/plain
 tests/webtbs/tw4599.pp svneol=native#text/plain
-tests/webtbs/tw4613.pp -text svneol=unset#text/plain
+tests/webtbs/tw4613.pp svneol=native#text/plain
 tests/webtbs/tw4616.pp svneol=native#text/plain
-tests/webtbs/tw4624.pp -text svneol=unset#text/plain
+tests/webtbs/tw4624.pp svneol=native#text/plain
 tests/webtbs/tw4632.pp svneol=native#text/plain
 tests/webtbs/tw4633.pp svneol=native#text/plain
-tests/webtbs/tw4634.pp -text
+tests/webtbs/tw4634.pp svneol=native#text/plain
 tests/webtbs/tw4635.pp svneol=native#text/plain
 tests/webtbs/tw4640.pp svneol=native#text/plain
 tests/webtbs/tw4669.pp svneol=native#text/plain

tests/webtbs/tw3700.pp

@@ -1,11 +1,11 @@
 { Source provided for Free Pascal Bug Report 3700 }
 { Submitted by "Roman" on  2005-02-26 }
-{ e-mail: [email protected] }
-uses
-  variants;
-var
-  v : olevariant;
+{ e-mail: [email protected] }
+uses
+  variants;
+var
+  v : olevariant;
   b : boolean;
-begin
-  b:=VarIsArray(V);
-end.
+begin
+  b:=VarIsArray(V);
+end.

tests/webtbs/tw3997.pp

@@ -1,75 +1,75 @@
 { Source provided for Free Pascal Bug Report 3997 }
 { Submitted by "Dominique Louis" on  2005-05-21 }
-{ e-mail: [email protected] }
-
+{ e-mail: [email protected] }
+
 {$mode delphi}
-program Project1;
-
-{$APPTYPE CONSOLE}
-
-uses
-  SysUtils;
-
-type
-  TMyNotifyEvent =  procedure of object;
-
-  TMyBaseWindow = class( TObject )
-  private
-    FOnRender: TMyNotifyEvent;
-  public
-    property OnRender: TMyNotifyEvent read FOnRender write FOnRender;
-  end;
-
-  TBaseInterface = class( TObject )
-  protected
-    procedure Render; virtual; abstract;
-  public
-    MainWindow : TMyBaseWindow;
-    constructor Create;
-    destructor Destroy; override;
-    procedure ResetInputManager;
-  end;
-
-  TMyInterface = class( TBaseInterface )
-  protected
-    procedure Render; override;
-  end;
-
-
-{ TBaseInterface }
-constructor TBaseInterface.Create;
-begin
-  inherited;
-  WriteLn( 'TBaseInterface.Create' );
-  MainWindow := TMyBaseWindow.Create;
-  ResetInputManager;
-end;
-
-destructor TBaseInterface.Destroy;
-begin
-  MainWindow.Free;
-  inherited;
-end;
-
-procedure TBaseInterface.ResetInputManager;
-begin
-  WriteLn( 'ResetInputManager' );
-  MainWindow.OnRender := Render;
-end;
-
-{ TMyInterface }
-procedure TMyInterface.Render;
-begin
-  WriteLn( 'Rendering' );
-end;
-
-var
-  MyInterface : TMyInterface;
-
-begin
-  MyInterface := TMyInterface.Create;
-
-  MyInterface.Render;
-
-  MyInterface.Free;
-end.
+program Project1;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils;
+
+type
+  TMyNotifyEvent =  procedure of object;
+
+  TMyBaseWindow = class( TObject )
+  private
+    FOnRender: TMyNotifyEvent;
+  public
+    property OnRender: TMyNotifyEvent read FOnRender write FOnRender;
+  end;
+
+  TBaseInterface = class( TObject )
+  protected
+    procedure Render; virtual; abstract;
+  public
+    MainWindow : TMyBaseWindow;
+    constructor Create;
+    destructor Destroy; override;
+    procedure ResetInputManager;
+  end;
+
+  TMyInterface = class( TBaseInterface )
+  protected
+    procedure Render; override;
+  end;
+
+
+{ TBaseInterface }
+constructor TBaseInterface.Create;
+begin
+  inherited;
+  WriteLn( 'TBaseInterface.Create' );
+  MainWindow := TMyBaseWindow.Create;
+  ResetInputManager;
+end;
+
+destructor TBaseInterface.Destroy;
+begin
+  MainWindow.Free;
+  inherited;
+end;
+
+procedure TBaseInterface.ResetInputManager;
+begin
+  WriteLn( 'ResetInputManager' );
+  MainWindow.OnRender := Render;
+end;
+
+{ TMyInterface }
+procedure TMyInterface.Render;
+begin
+  WriteLn( 'Rendering' );
+end;
+
+var
+  MyInterface : TMyInterface;
+
+begin
+  MyInterface := TMyInterface.Create;
+
+  MyInterface.Render;
+
+  MyInterface.Free;
+end.

tests/webtbs/tw4229.pp

@@ -1,30 +1,30 @@
 { Source provided for Free Pascal Bug Report 4229 }
 { Submitted by "Gerhard" on  2005-07-28 }
 { e-mail: [email protected] }
-unit tw4229 ;
-
-interface
-
-  type
-    strobj = object
-               bs : string ;
-               ba : ansistring ;
-              end ;
-
-  operator := ( const a : ansistring ) z : strobj ;
-
-implementation
-
-  operator := ( const s : string ) z : strobj ;
-
-    begin
-      z.bs := s ;
-     end ;
-
-  operator := ( const a : ansistring ) z : strobj ;
-
-    begin
-      z.ba := a ;
-     end ;
-
-end.
+unit tw4229 ;
+
+interface
+
+  type
+    strobj = object
+               bs : string ;
+               ba : ansistring ;
+              end ;
+
+  operator := ( const a : ansistring ) z : strobj ;
+
+implementation
+
+  operator := ( const s : string ) z : strobj ;
+
+    begin
+      z.bs := s ;
+     end ;
+
+  operator := ( const a : ansistring ) z : strobj ;
+
+    begin
+      z.ba := a ;
+     end ;
+
+end.

tests/webtbs/tw4487.pp

@@ -1,38 +1,38 @@
 { Source provided for Free Pascal Bug Report 4487 }
 { Submitted by "Phil H." on  2005-11-02 }
 { e-mail: [email protected] }
-program TestVarBug;
-
-{$IFDEF FPC}
-{$mode objfpc}
-uses
-  Variants;
-{$ENDIF}
-
-type
-  TMyClass = class
-  private
-    function GetValue(AsInt : Boolean) : Variant;
-  public
-    property Value[AsInt : Boolean] : Variant read GetValue;
-  end;
-  
-function TMyClass.GetValue(AsInt : Boolean) : Variant;
-begin
-  if AsInt then
-    Result := 1
-  else
-    Result := True;
-end;
-
-var
-  AClass : TMyClass;  
-begin
-  AClass := TMyClass.Create;
-  if (AClass.Value[True] = 1) and
-     AClass.Value[False] then  //Throws exception with FPC (requires "= True")
-    WriteLn('Value is True')
-  else
-    WriteLn('Value is False');
-end.
-
+program TestVarBug;
+
+{$IFDEF FPC}
+{$mode objfpc}
+uses
+  Variants;
+{$ENDIF}
+
+type
+  TMyClass = class
+  private
+    function GetValue(AsInt : Boolean) : Variant;
+  public
+    property Value[AsInt : Boolean] : Variant read GetValue;
+  end;
+
+function TMyClass.GetValue(AsInt : Boolean) : Variant;
+begin
+  if AsInt then
+    Result := 1
+  else
+    Result := True;
+end;
+
+var
+  AClass : TMyClass;
+begin
+  AClass := TMyClass.Create;
+  if (AClass.Value[True] = 1) and
+     AClass.Value[False] then  //Throws exception with FPC (requires "= True")
+    WriteLn('Value is True')
+  else
+    WriteLn('Value is False');
+end.
+

tests/webtbs/tw4489.pp

@@ -1,25 +1,25 @@
 { Source provided for Free Pascal Bug Report 4489 }
 { Submitted by "Vincent Snijders" on  2005-11-04 }
 { e-mail: [email protected] }
-program Project1;
-
-{$mode objfpc}{$H+}
-
-uses
-  Classes, SysUtils
-  { add your units here };
-
-var
-  s: string;
-  u: SizeUInt;
-  d: qword;
-
-begin
-   d:=11111111;
-   u:=1111;
-   s := format('pid=%d', [u]);
-   writeln(s);
-   s := format('pid=%d', [d]);
-   writeln(s);
-end.
-    
+program Project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils
+  { add your units here };
+
+var
+  s: string;
+  u: SizeUInt;
+  d: qword;
+
+begin
+   d:=11111111;
+   u:=1111;
+   s := format('pid=%d', [u]);
+   writeln(s);
+   s := format('pid=%d', [d]);
+   writeln(s);
+end.
+

tests/webtbs/tw4519.pp

@@ -1,49 +1,49 @@
 { Source provided for Free Pascal Bug Report 4519 }
 { Submitted by "Martin Schreiber" on  2005-11-17 }
 { e-mail:  }
-program project1;
-{$mode objfpc}{$h+}
-uses
- classes;
- 
-type
- ttestcomp = class(tcomponent)
-  private
-   fstringvar: string;
-   procedure readstringvar(reader: treader);
-   procedure writestringvar(writer: twriter);
-  protected
-   procedure defineproperties(filer: tfiler); override;
- end;
- 
-{ ttestcomp }
-
-procedure ttestcomp.readstringvar(reader: treader);
-begin
- fstringvar:= reader.readstring;
-end;
-
-procedure ttestcomp.writestringvar(writer: twriter);
-begin
- writer.writestring(fstringvar);
-end;
-
-procedure ttestcomp.defineproperties(filer: tfiler);
-begin
- filer.defineproperty('stringvar',@readstringvar,@writestringvar,true);
-end;
-
-var
- testcomp: ttestcomp;
- stream1,stream2: tmemorystream;
- 
-begin
- testcomp:= ttestcomp.create(nil);
- stream1:= tmemorystream.create;
- stream1.writecomponent(testcomp);
- stream1.position:= 0;
- stream2:= tmemorystream.create;
- objectbinarytotext(stream1,stream2); //<- AV
- stream1.free;
- stream2.free;
-end.
+program project1;
+{$mode objfpc}{$h+}
+uses
+ classes;
+
+type
+ ttestcomp = class(tcomponent)
+  private
+   fstringvar: string;
+   procedure readstringvar(reader: treader);
+   procedure writestringvar(writer: twriter);
+  protected
+   procedure defineproperties(filer: tfiler); override;
+ end;
+
+{ ttestcomp }
+
+procedure ttestcomp.readstringvar(reader: treader);
+begin
+ fstringvar:= reader.readstring;
+end;
+
+procedure ttestcomp.writestringvar(writer: twriter);
+begin
+ writer.writestring(fstringvar);
+end;
+
+procedure ttestcomp.defineproperties(filer: tfiler);
+begin
+ filer.defineproperty('stringvar',@readstringvar,@writestringvar,true);
+end;
+
+var
+ testcomp: ttestcomp;
+ stream1,stream2: tmemorystream;
+
+begin
+ testcomp:= ttestcomp.create(nil);
+ stream1:= tmemorystream.create;
+ stream1.writecomponent(testcomp);
+ stream1.position:= 0;
+ stream2:= tmemorystream.create;
+ objectbinarytotext(stream1,stream2); //<- AV
+ stream1.free;
+ stream2.free;
+end.

tests/webtbs/tw4520.pp

@@ -1,18 +1,18 @@
 { Source provided for Free Pascal Bug Report 4520 }
 { Submitted by "Martin Schreiber" on  2005-11-17 }
 { e-mail:  }
-program project1;
- { $mode objfpc}{$h+}
-uses
- sysutils;
-var
- rea1,rea2: real;
- str1: string;
-begin
- rea1:= 1e100;
- str1:= floattostr(rea1);
- if str1<>'1E100' then
-   halt(1);
- writeln('1: ',rea1);
- writeln('2: ',str1);
-end.
+program project1;
+ { $mode objfpc}{$h+}
+uses
+ sysutils;
+var
+ rea1,rea2: real;
+ str1: string;
+begin
+ rea1:= 1e100;
+ str1:= floattostr(rea1);
+ if str1<>'1E100' then
+   halt(1);
+ writeln('1: ',rea1);
+ writeln('2: ',str1);
+end.

tests/webtbs/tw4529.pp

@@ -1,20 +1,20 @@
 { Source provided for Free Pascal Bug Report 4529 }
 { Submitted by "Vincent Snijders" on  2005-11-20 }
 { e-mail: [email protected] }
-program Project1;
-
-{$mode objfpc}{$H+}{$static on}
-
-uses
-  Classes
-  { add your units here };
-
-type
-  MyClass = class(TComponent)
-  //private
-  public
-    FClassVar: integer; static;
-  end;
-
-begin
-end.
+program Project1;
+
+{$mode objfpc}{$H+}{$static on}
+
+uses
+  Classes
+  { add your units here };
+
+type
+  MyClass = class(TComponent)
+  //private
+  public
+    FClassVar: integer; static;
+  end;
+
+begin
+end.

tests/webtbs/tw4540.pp

@@ -1,23 +1,23 @@
 { Source provided for Free Pascal Bug Report 4540 }
 { Submitted by "Aleksa Todorovic" on  2005-11-23 }
 { e-mail: [email protected] }
-program TestAnsiEndsStr;
-
-uses
-  StrUtils;
-
-begin
-  Writeln('A/AB: ', AnsiEndsStr('A', 'AB'));
-  if AnsiEndsStr('A', 'AB')<>false then
-    halt(1);
-    // False -> ok
-  Writeln('AB/AB: ', AnsiEndsStr('AB', 'AB'));
-  if AnsiEndsStr('AB', 'AB')<>true then
-    halt(1);
-    // True -> ok
-  Writeln('ABC/AB: ', AnsiEndsStr('ABC', 'AB'));
-  if AnsiEndsStr('ABC', 'AB')<>false then
-    halt(1);
-  writeln('ok');
-    // True -> ???
-end.
+program TestAnsiEndsStr;
+
+uses
+  StrUtils;
+
+begin
+  Writeln('A/AB: ', AnsiEndsStr('A', 'AB'));
+  if AnsiEndsStr('A', 'AB')<>false then
+    halt(1);
+    // False -> ok
+  Writeln('AB/AB: ', AnsiEndsStr('AB', 'AB'));
+  if AnsiEndsStr('AB', 'AB')<>true then
+    halt(1);
+    // True -> ok
+  Writeln('ABC/AB: ', AnsiEndsStr('ABC', 'AB'));
+  if AnsiEndsStr('ABC', 'AB')<>false then
+    halt(1);
+  writeln('ok');
+    // True -> ???
+end.

tests/webtbs/tw4566.pp

@@ -1,15 +1,14 @@
 { Source provided for Free Pascal Bug Report 4566 }
 { Submitted by "Vincent Snijders" on  2005-12-04 }
 { e-mail: [email protected] }
-program bug4566;
-
-{$mode objfpc}{$H+}
-
-var
-  s: string;
-  
-begin
-  //accidently use #1310 instead of #13#10
-  s := 'Message Text' + #1310 + #1310 + 'More Text';
-end.
-                   
+program bug4566;
+
+{$mode objfpc}{$H+}
+
+var
+  s: string;
+
+begin
+  //accidently use #1310 instead of #13#10
+  s := 'Message Text' + #1310 + #1310 + 'More Text';
+end.

tests/webtbs/tw4624.pp

@@ -1,16 +1,16 @@
 { Source provided for Free Pascal Bug Report 4624 }
 { Submitted by "benoit sanchez" on  2005-12-20 }
 { e-mail: [email protected] }
-type Number=record
-  value:boolean;
-end;
-
-operator div (a,b:number) c:number;
-begin
-  c.value:=true;
-end;
-
-var a:number;
-begin
-  a:=a div a;
-end.
+type Number=record
+  value:boolean;
+end;
+
+operator div (a,b:number) c:number;
+begin
+  c.value:=true;
+end;
+
+var a:number;
+begin
+  a:=a div a;
+end.

tests/webtbs/tw4634.pp

@@ -1,89 +1,89 @@
 { Source provided for Free Pascal Bug Report 4634 }
 { Submitted by "Graeme Geldenhuys" on  2005-12-23 }
 { e-mail: [email protected] }
-program Project1;
-{$ifdef fpc}
-{$mode objfpc}
-{$endif fpc}
-{$H+}
-uses
-  Classes, SysUtils, Variants;
-
-function IsVariantOfType( pVariant : Variant ; pVarType : TVarType ) : boolean ;
-var
-  xVT : TVarType;
-  xVTHigh : TVarType;
-begin
-//  result := ( varType( pVariant ) and pVarType ) = pVarType ;
-// Contr: VarType is varDate = 0007, pVarType is varInteger=0003.
-// 0007 and 0003 = 0003. WRONG!
-
-  xVT := VarType(pVariant);
-  xVTHigh := xVT and (not varTypeMask);
-
-{  in true pVarType can be and OR of two types: varArray and varString (or others)
-   we have to recognize it.
-   there shouldn't be xVTLow because when we have array of string (normal) then
-   xVT=$2008 = $2000 (var Array) or $0008 (var String)
-   then when we asked:
-     is $2000 (varArray)? we should receive TRUE (xVTHigh=pVarType)
-     is $2008 (varArray of varString)? we should receive TRUE (xVT=pVarType)
-     is $0008 (varString)? we should receive FALSE
-}
-  Result := (xVT=pVarType) or ((xVTHigh=pVarType) and (xVTHigh<>varEmpty));
-end ;
-
-procedure TestIsVariantOfType ;
-
-  procedure _tiIsVariantOfType(xVar : variant; xExpected : TVarType; xMsg : string);
-
-    procedure __tiIsVariantOfType(xxCheck : TVarType; xxMsg : string);
-    begin
-      if xxCheck=xExpected then
-      begin
-        If not IsVariantOfType( xVar, xxCheck ) then
-          Writeln(xMsg);
-      end
-      else
-      begin
-        If IsVariantOfType( xVar, xxCheck ) then
-          Writeln(xMsg + ' - ' + xxMsg);
-      end;
-    end;
-
-  begin
-    __tiIsVariantOfType(varEmpty,'varEmpty');
-    __tiIsVariantOfType(varNull,'varNull');
-    __tiIsVariantOfType(varSmallint,'varSmallInt');
-    __tiIsVariantOfType(varInteger,'varInteger');
-    __tiIsVariantOfType(varSingle,'varSingle');
-    __tiIsVariantOfType(varDouble,'varDouble');
-    __tiIsVariantOfType(varDate,'varDate');
-    __tiIsVariantOfType(varBoolean,'varBoolean');
-    __tiIsVariantOfType(varOleStr,'varOleStr');
-  end;
-var
-  lVar : Variant ;
-  lSmallInt : Smallint;
-  lInteger : Integer;
-  lDouble : Double;
-  lDateTimeNow : TDateTime;
-  lDateTimeDate : TDateTime;
-  lOleString : WideString;
-  lString : string;
-  lBoolean : boolean;
-  lCurrency : Currency;
-begin
-  lDouble := 123.45678901234567890;
-
-// Can't make this one work
-  lVar:=VarAsType(123.456,varSingle);
-  _tiIsVariantOfType(lVar,varSingle,'Failed with VarSingle');
-
-  lVar:=lDouble;
-  _tiIsVariantOfType(lVar,varDouble,'Failed with VarDouble');
-end;
-
-begin
-  TestIsVariantOfType;
-end.
+program Project1;
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+{$H+}
+uses
+  Classes, SysUtils, Variants;
+
+function IsVariantOfType( pVariant : Variant ; pVarType : TVarType ) : boolean ;
+var
+  xVT : TVarType;
+  xVTHigh : TVarType;
+begin
+//  result := ( varType( pVariant ) and pVarType ) = pVarType ;
+// Contr: VarType is varDate = 0007, pVarType is varInteger=0003.
+// 0007 and 0003 = 0003. WRONG!
+
+  xVT := VarType(pVariant);
+  xVTHigh := xVT and (not varTypeMask);
+
+{  in true pVarType can be and OR of two types: varArray and varString (or others)
+   we have to recognize it.
+   there shouldn't be xVTLow because when we have array of string (normal) then
+   xVT=$2008 = $2000 (var Array) or $0008 (var String)
+   then when we asked:
+     is $2000 (varArray)? we should receive TRUE (xVTHigh=pVarType)
+     is $2008 (varArray of varString)? we should receive TRUE (xVT=pVarType)
+     is $0008 (varString)? we should receive FALSE
+}
+  Result := (xVT=pVarType) or ((xVTHigh=pVarType) and (xVTHigh<>varEmpty));
+end ;
+
+procedure TestIsVariantOfType ;
+
+  procedure _tiIsVariantOfType(xVar : variant; xExpected : TVarType; xMsg : string);
+
+    procedure __tiIsVariantOfType(xxCheck : TVarType; xxMsg : string);
+    begin
+      if xxCheck=xExpected then
+      begin
+        If not IsVariantOfType( xVar, xxCheck ) then
+          Writeln(xMsg);
+      end
+      else
+      begin
+        If IsVariantOfType( xVar, xxCheck ) then
+          Writeln(xMsg + ' - ' + xxMsg);
+      end;
+    end;
+
+  begin
+    __tiIsVariantOfType(varEmpty,'varEmpty');
+    __tiIsVariantOfType(varNull,'varNull');
+    __tiIsVariantOfType(varSmallint,'varSmallInt');
+    __tiIsVariantOfType(varInteger,'varInteger');
+    __tiIsVariantOfType(varSingle,'varSingle');
+    __tiIsVariantOfType(varDouble,'varDouble');
+    __tiIsVariantOfType(varDate,'varDate');
+    __tiIsVariantOfType(varBoolean,'varBoolean');
+    __tiIsVariantOfType(varOleStr,'varOleStr');
+  end;
+var
+  lVar : Variant ;
+  lSmallInt : Smallint;
+  lInteger : Integer;
+  lDouble : Double;
+  lDateTimeNow : TDateTime;
+  lDateTimeDate : TDateTime;
+  lOleString : WideString;
+  lString : string;
+  lBoolean : boolean;
+  lCurrency : Currency;
+begin
+  lDouble := 123.45678901234567890;
+
+// Can't make this one work
+  lVar:=VarAsType(123.456,varSingle);
+  _tiIsVariantOfType(lVar,varSingle,'Failed with VarSingle');
+
+  lVar:=lDouble;
+  _tiIsVariantOfType(lVar,varDouble,'Failed with VarDouble');
+end;
+
+begin
+  TestIsVariantOfType;
+end.