paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 01:48:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed VarAsType with varSingle, fixes bg 4634

Browse Source 
git-svn-id: trunk@2159 -
This commit is contained in:
florian 2006-01-04 15:17:59 +00:00
parent f92f8501ff
commit be74e017d4
2 changed files with 90 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6664,6 +6664,7 @@ tests/webtbs/tw4613.pp -text svneol=unset#text/plain
tests/webtbs/tw4616.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/tw4635.pp svneol=native#text/plain
tests/webtbs/tw4640.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain

89
tests/webtbs/tw4634.pp Normal file
View File

@ -0,0 +1,89 @@
{ Source provided for Free Pascal Bug Report 4634 }
{ Submitted by "Graeme Geldenhuys" on 2005-12-23 }
{ e-mail: graemeg@gmail.com }
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.