|
@@ -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.
|