12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952 |
- unit tests.rtti.value;
- {$mode ObjFPC}{$H+}
- interface
- uses
- fpcunit,testregistry, testutils, typinfo,
- Classes, SysUtils, Rtti;
- Type
- TTestValueGeneral = Class(TTestCase)
- Published
- procedure TestDataSize;
- procedure TestDataSizeEmpty;
- procedure TestReferenceRawData;
- procedure TestReferenceRawDataEmpty;
- procedure TestIsManaged;
- end;
- TTestValueSimple = Class(TTestCase)
- private
- procedure MakeFromOrdinalTObject;
- procedure MakeFromOrdinalSet;
- procedure MakeFromOrdinalString;
- procedure MakeFromOrdinalNil;
- Published
- // Moved here from Tests.rtti
- procedure TestIsType;
- procedure TestMakeNil;
- procedure TestMakeObject;
- procedure TestMakeSingle;
- procedure TestMakeDouble;
- procedure TestMakeExtended;
- procedure TestMakeCurrency;
- procedure TestMakeComp;
- procedure TestMakeEnum;
- procedure TestMakeAnsiChar;
- procedure TestMakeWideChar;
- procedure TestMakeNativeInt;
- procedure TestMakeVariant;
- procedure TestMakeGenericNil;
- procedure TestMakeGenericLongInt;
- procedure TestMakeGenericString;
- procedure TestMakeGenericObject;
- procedure TestMakeGenericDouble;
- procedure TestMakeGenericAnsiChar;
- procedure TestMakeGenericWideChar;
- procedure TestFromOrdinal;
- end;
- { TTestValueArray }
- TTestValueArray = class(TTestCase)
- Published
- procedure TestMakeArrayDynamic;
- procedure TestMakeArrayStatic;
- procedure TestMakeFromArray;
- {$ifdef fpc}
- procedure TestMakeArrayOpen;
- Procedure TestOpenArrayToDyn;
- {$ENDIF}
- end;
- { TTestValueVariant }
- TTestValueVariant = class(TTestCase)
- private
- FSrc: Variant;
- FValue: TValue;
- FVarRec: TVarRec;
- Public
- Procedure Setup; override;
- Procedure TearDown; override;
- Procedure DoFromVariant;
- Procedure DoFromVarRec;
- Property Value : TValue Read FValue;
- Property Src : Variant Read FSrc;
- Property VarRec : TVarRec Read FVarRec;
- Published
- Procedure TestFromVariantInteger;
- Procedure TestFromVariantBoolean;
- Procedure TestFromVariantSmallInt;
- Procedure TestFromVariantOleStr;
- Procedure TestFromVariantInt64;
- Procedure TestFromVariantQWord;
- Procedure TestFromVariantShortInt;
- Procedure TestFromVariantByte;
- Procedure TestFromVariantWord;
- Procedure TestFromVariantLongWord;
- Procedure TestFromVariantSingle;
- Procedure TestFromVariantDouble;
- Procedure TestFromVariantDate;
- Procedure TestFromVariantDispatch;
- Procedure TestFromVariantError;
- Procedure TestFromVariantUnknown;
- Procedure TestFromVariantCurrency;
- Procedure TestFromVariantString;
- Procedure TestFromVariantUnicodeString;
- Procedure TestFromVarrecInteger;
- Procedure TestFromVarrecBoolean;
- Procedure TestFromVarRecChar;
- Procedure TestFromVarRecExtended;
- Procedure TestFromVarRecString;
- Procedure TestFromVarRecPointer;
- Procedure TestFromVarRecPChar;
- Procedure TestFromVarRecObject;
- Procedure TestFromVarRecClass;
- Procedure TestFromVarRecWideChar;
- Procedure TestFromVarRecPWideChar;
- Procedure TestFromVarRecAnsiString;
- Procedure TestFromVarRecCurrency;
- Procedure TestFromVarRecVariant;
- Procedure TestFromVarRecInterface;
- Procedure TestFromVarRecWideString;
- Procedure TestFromVarRecInt64;
- Procedure TestFromVarRecQWord;
- Procedure TestFromVarRecUnicodeString;
- Procedure TestArrayOfConstToTValue;
- end;
- { TMyUNknown }
- TMyUNknown = Class(TInterfacedObject,IDispatch)
- function GetTypeInfoCount(out count : longint) : HResult;stdcall;
- function GetTypeInfo(Index,LocaleID : longint; out TypeInfo): HResult;stdcall;
- function GetIDsOfNames(const iid: TGUID; names: Pointer; NameCount, LocaleID: LongInt; DispIDs: Pointer) : HResult;stdcall;
- function Invoke(DispID: LongInt;const iid : TGUID; LocaleID : longint; Flags: Word;var params; VarResult,ExcepInfo,ArgErr : pointer) : HResult;stdcall;
- end;
- implementation
- uses tests.rtti.types, variants;
- { TTestValueVariant }
- procedure TTestValueVariant.Setup;
- begin
- inherited Setup;
- FValue:=Default(TValue);
- FSrc:=unassigned;
- end;
- procedure TTestValueVariant.TearDown;
- begin
- FValue:=Default(TValue);
- FSrc:=unassigned;
- inherited TearDown;
- end;
- procedure TTestValueVariant.DoFromVariant;
- begin
- FValue:=TValue.FromVariant(Src);
- end;
- procedure TTestValueVariant.DoFromVarRec;
- begin
- FValue:=TValue.FromVarRec(FVarRec);
- end;
- procedure TTestValueVariant.TestFromVarrecInteger;
- begin
- FVarrec.VType:=vtInteger;
- FVarrec.VInteger:=1;
- DoFromVarRec;
- CheckEquals(1,Value.AsInteger,'Value');
- CheckTrue(TypeInfo(Integer)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarrecBoolean;
- begin
- FVarrec.VType:=vtBoolean;
- FVarrec.VBoolean:=True;
- DoFromVarRec;
- CheckEquals(True,Value.AsBoolean,'Value');
- CheckTrue(TypeInfo(Boolean)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecChar;
- begin
- FVarrec.VType:=vtChar;
- FVarrec.VChar:='c';
- DoFromVarRec;
- CheckEquals('c',Value.AsAnsiChar,'Value');
- CheckTrue(TypeInfo(AnsiChar)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecExtended;
- var
- E : Extended;
- begin
- E:=1.23;
- FVarRec.VExtended:=@E;
- FVarRec.vType:=vtExtended;
- DoFromVarRec;
- CheckEquals(1.23,Value.AsExtended,0.01,'Value');
- CheckTrue(TypeInfo(Extended)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecString;
- Var
- s : ShortString;
- begin
- S:='123';
- FVarrec.VType:=vtString;
- FVarrec.VString:=@S;
- DoFromVarRec;
- CheckEquals('123',Value.AsString,'Value');
- CheckTrue(TypeInfo(ShortString)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecPointer;
- Var
- s : ShortString;
- begin
- S:='123';
- FVarrec.VType:=vtPointer;
- FVarrec.VString:=@S;
- DoFromVarRec;
- CheckTrue(@S=Value.AsPointer,'Value');
- CheckTrue(TypeInfo(Pointer)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecPChar;
- Var
- s : AnsiString;
- begin
- S:='123';
- FVarrec.VType:=vtPChar;
- FVarrec.VPChar:=PAnsiChar(S);
- DoFromVarRec;
- CheckTrue(S=Value.AsAnsiString,'Value');
- // In delphi it is String, but not widestring !
- CheckTrue(TypeInfo(AnsiString)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecObject;
- Var
- C : TObject;
- begin
- C:=TComponent.Create(Nil);
- FVarrec.VType:=vtObject;
- FVarrec.VObject:=C;
- DoFromVarRec;
- CheckSame(C,Value.AsObject,'Value');
- // In delphi it is String, but not widestring !
- CheckTrue(TypeInfo(TComponent)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, True,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecClass;
- Var
- C : TClass;
- begin
- C:=TComponent;
- FVarrec.VType:=vtClass;
- FVarrec.VClass:=C;
- DoFromVarRec;
- CheckEquals(C,Value.AsClass,'Value');
- // In delphi it is String, but not widestring !
- CheckTrue(TypeInfo(TClass)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, True,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecWideChar;
- begin
- FVarrec.VType:=vtWideChar;
- FVarrec.VWideChar:='c';
- DoFromVarRec;
- CheckEquals('c',Value.AsWideChar,'Value');
- CheckTrue(TypeInfo(WideChar)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecPWideChar;
- Var
- s : WideString;
- begin
- S:='123';
- FVarrec.VType:=vtPWideChar;
- FVarrec.VPWideChar:=PWideChar(S);
- DoFromVarRec;
- CheckEquals('123',Value.AsUnicodeString,'Value');
- CheckTrue(TypeInfo(WideString)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecAnsiString;
- Var
- s : AnsiString;
- begin
- S:='123';
- FVarrec.VType:=vtAnsiString;
- FVarrec.VAnsiString:=Pointer(S);
- DoFromVarRec;
- CheckEquals('123',Value.AsAnsiString,'Value');
- CheckTrue(TypeInfo(AnsiString)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecCurrency;
- var
- C : Currency;
- begin
- C:=1.23;
- FVarRec.VCurrency:=@C;
- FVarRec.vType:=vtCurrency;
- DoFromVarRec;
- CheckEquals(1.23,Value.AsCurrency,0.01,'Value');
- CheckTrue(TypeInfo(Currency)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecVariant;
- var
- V : Variant;
- begin
- V:='1.23';
- FVarRec.VVariant:=@V;
- FVarRec.vType:=vtVariant;
- DoFromVarRec;
- CheckEquals(V,String(Value.AsVariant),'Value');
- CheckTrue(TypeInfo(Variant)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecInterface;
- Var
- U : IInterface;
- begin
- U:=TMyUNknown.Create;
- FVarRec.VInterface:=U;
- FVarRec.VType:=vtInterface;
- DoFromVarRec;
- CheckTrue(U=Value.AsInterface,'Value');
- CheckTrue(TypeInfo(IInterface)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecWideString;
- Var
- s : WideString;
- begin
- S:='123';
- FVarrec.VType:=vtWideString;
- FVarrec.VWideString:=Pointer(S);
- DoFromVarRec;
- CheckEquals('123',Value.AsUnicodeString,'Value');
- CheckTrue(TypeInfo(WideString)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecInt64;
- Var
- I : Int64;
- begin
- I:=Int64(1);
- FVarRec.VInt64:=@I;
- FVarRec.vType:=vtInt64;
- DoFromVarRec;
- CheckEquals(1,Value.AsInt64,'Value');
- CheckTrue(TypeInfo(Int64)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecQWord;
- Var
- Q : QWord;
- begin
- Q:=1;
- FVarRec.VQWord:=@Q;
- FVarRec.vType:=vtQWord;
- DoFromVarRec;
- CheckEquals(1,Value.AsUInt64,'Value');
- CheckTrue(TypeInfo(QWord)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVarRecUnicodeString;
- Var
- s : UnicodeString;
- begin
- S:='123';
- FVarrec.VType:=vtUnicodeString;
- FVarrec.VUnicodeString:=Pointer(S);
- DoFromVarRec;
- CheckEquals('123',Value.AsUnicodeString,'Value');
- CheckTrue(TypeInfo(UnicodeString)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantInteger;
- begin
- FSrc:=Integer(1);
- DoFromVariant;
- CheckEquals(1,Value.AsInteger,'Value');
- CheckTrue(TypeInfo(Longint)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantBoolean;
- begin
- FSrc:=True;
- DoFromVariant;
- CheckEquals(True,Value.AsBoolean,'Value');
- CheckTrue(TypeInfo(Boolean)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantSmallInt;
- begin
- FSrc:=SmallInt(1);
- DoFromVariant;
- CheckEquals(1,Value.AsInteger,'Value');
- CheckTrue(TypeInfo(SmallInt)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantOleStr;
- begin
- FSrc:=WideString('1.23');
- DoFromVariant;
- CheckEquals('1.23',Value.AsUnicodeString,'Value');
- CheckTrue(TypeInfo(WideString)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantInt64;
- begin
- FSrc:=Int64(1);
- DoFromVariant;
- CheckEquals(1,Value.AsInt64,'Value');
- CheckTrue(TypeInfo(Int64)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantQWord;
- begin
- FSrc:=QWord(1);
- DoFromVariant;
- CheckEquals(1,Value.AsInt64,'Value');
- CheckTrue(TypeInfo(QWord)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantShortInt;
- begin
- FSrc:=ShortInt(1);
- DoFromVariant;
- CheckEquals(1,Value.AsInteger,'Value');
- CheckTrue(TypeInfo(Shortint)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantByte;
- begin
- FSrc:=Byte(1);
- DoFromVariant;
- CheckEquals(1,Value.AsInteger,'Value');
- CheckTrue(TypeInfo(Byte)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantWord;
- begin
- FSrc:=Word(1);
- DoFromVariant;
- CheckEquals(1,Value.AsInteger,'Value');
- CheckTrue(TypeInfo(Word)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantLongWord;
- begin
- FSrc:=Cardinal(1);
- DoFromVariant;
- CheckEquals(1,Value.AsInteger,'Value');
- CheckTrue(TypeInfo(Cardinal)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantSingle;
- begin
- FSrc:=Single(1.23); // Results in double...
- VarCast(FSrc,FSrc,varSingle);
- DoFromVariant;
- CheckEquals(1.23,Value.AsSingle,0.01,'Value');
- CheckTrue(TypeInfo(Single)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantDouble;
- begin
- FSrc:=Double(1.23);
- DoFromVariant;
- CheckEquals(1.23,Value.AsDouble,0.01,'Value');
- CheckTrue(TypeInfo(Double)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantDate;
- Var
- D : TDateTime;
- begin
- D:=Time;
- FSrc:=D;
- DoFromVariant;
- CheckEquals(D,Value.AsDateTime,0.01,'Value');
- CheckTrue(TypeInfo(TDateTime)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantDispatch;
- Var
- U : IDispatch;
- begin
- U:=TMyUNknown.Create;
- FSrc:=U;
- DoFromVariant;
- CheckTrue(U=Value.AsInterface,'Value');
- CheckTrue(TypeInfo(IDispatch)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantError;
- begin
- TVarData(FSrc).verror:=S_FALSE;
- TVarData(FSrc).vtype:=varError;
- DoFromVariant;
- CheckTrue(S_FALSE=Value.AsError,'Value');
- CheckTrue(TypeInfo(HRESULT)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, True,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantUnknown;
- Var
- U : IInterface;
- begin
- U:=TMyUNknown.Create;
- FSrc:=U;
- DoFromVariant;
- CheckTrue(U=Value.AsInterface,'Value');
- CheckTrue(TypeInfo(IInterface)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantCurrency;
- begin
- FSrc:=Currency(1.23);
- DoFromVariant;
- CheckEquals(1.23,Value.AsCurrency,0.01,'Value');
- CheckTrue(TypeInfo(Currency)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantString;
- begin
- FSrc:='1.23';
- DoFromVariant;
- CheckEquals('1.23',Value.AsString,'Value');
- CheckTrue(TypeInfo(AnsiString)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestFromVariantUnicodeString;
- begin
- TVarData(FSrc).vustring:=Pointer(UnicodeString('1.23'));
- TVarData(FSrc).vtype:=varUString;
- DoFromVariant;
- CheckEquals('1.23',Value.AsString,'Value');
- CheckTrue(TypeInfo(UnicodeString)=Value.TypeInfo,'Correct typeinfo');
- CheckEquals(Value.IsClass, False,'Class');
- CheckEquals(Value.IsObject, False,'Object');
- CheckEquals(Value.IsOrdinal, False,'Ordinal');
- end;
- procedure TTestValueVariant.TestArrayOfConstToTValue;
- Var
- S:TValueArray;
- begin
- S:=ArrayOfConstToTValueArray([1,'something',1.23]);
- CheckEquals(3,Length(S),'Length');
- CheckEquals(1,S[0].AsInteger,'Value 1');
- CheckEquals('something',S[1].AsString,'Value 3');
- CheckEquals(1.23,S[2].AsDouble,0.01,'Value 3');
- end;
- { TMyUNknown }
- function TMyUNknown.GetTypeInfoCount(out count: longint): HResult; stdcall;
- begin
- count:=0;
- Result:=S_OK;
- end;
- function TMyUNknown.GetTypeInfo(Index, LocaleID: longint; out TypeInfo
- ): HResult; stdcall;
- begin
- Result:=S_OK;
- end;
- function TMyUNknown.GetIDsOfNames(const iid: TGUID; names: Pointer; NameCount,
- LocaleID: LongInt; DispIDs: Pointer): HResult; stdcall;
- begin
- Result:=S_OK;
- end;
- function TMyUNknown.Invoke(DispID: LongInt; const iid: TGUID;
- LocaleID: longint; Flags: Word; var params; VarResult, ExcepInfo,
- ArgErr: pointer): HResult; stdcall;
- begin
- Result:=S_OK;
- end;
- type
- TMyLongInt = type LongInt;
- procedure TTestValueSimple.TestIsType;
- { Delphi does not provide type information for local types :/ }
- {type
- TMyLongInt = type LongInt;}
- var
- v: TValue;
- l: LongInt;
- ml: TMyLongInt;
- begin
- l := 42;
- ml := 42;
- TValue.Make(@l, TypeInfo(LongInt), v);
- Check(v.IsType(TypeInfo(LongInt)));
- Check(not v.IsType(TypeInfo(TMyLongInt)));
- Check(not v.IsType(TypeInfo(String)));
- Check(v.{$ifdef fpc}specialize{$endif} IsType<LongInt>);
- Check(not v.{$ifdef fpc}specialize{$endif} IsType<TMyLongInt>);
- Check(not v.{$ifdef fpc}specialize{$endif} IsType<String>);
- TValue.Make(@ml, TypeInfo(TMyLongInt), v);
- Check(v.IsType(TypeInfo(TMyLongInt)));
- Check(not v.IsType(TypeInfo(LongInt)));
- Check(not v.IsType(TypeInfo(String)));
- Check(v.{$ifdef fpc}specialize{$endif} IsType<TMyLongInt>);
- Check(not v.{$ifdef fpc}specialize{$endif} IsType<LongInt>);
- Check(not v.{$ifdef fpc}specialize{$endif} IsType<String>);
- end;
- procedure TTestValueSimple.TestMakeNil;
- var
- value: TValue;
- begin
- TValue.Make(Nil, Nil, value);
- CheckTrue(value.Kind = tkUnknown);
- CheckTrue(value.IsEmpty);
- CheckTrue(value.IsObject);
- CheckTrue(value.IsClass);
- CheckTrue(value.IsOrdinal);
- CheckFalse(value.IsArray);
- CheckTrue(value.AsObject = Nil);
- CheckTrue(value.AsClass = Nil);
- CheckTrue(value.AsInterface = Nil);
- CheckEquals(0, value.AsOrdinal);
- TValue.Make(Nil, TypeInfo(TObject), value);
- CheckTrue(value.IsEmpty);
- CheckTrue(value.IsObject);
- CheckTrue(value.IsClass);
- CheckTrue(value.IsOrdinal);
- CheckFalse(value.IsArray);
- CheckTrue(value.AsObject=Nil);
- CheckTrue(value.AsClass=Nil);
- CheckTrue(value.AsInterface=Nil);
- CheckEquals(0, value.AsOrdinal);
- TValue.Make(Nil, TypeInfo(TClass), value);
- CheckTrue(value.IsEmpty);
- CheckTrue(value.IsClass);
- CheckTrue(value.IsOrdinal);
- CheckFalse(value.IsArray);
- CheckTrue(value.AsObject=Nil);
- CheckTrue(value.AsClass=Nil);
- CheckTrue(value.AsInterface=Nil);
- CheckEquals(0, value.AsOrdinal);
- TValue.Make(Nil, TypeInfo(LongInt), value);
- CheckTrue(value.IsOrdinal);
- CheckFalse(value.IsEmpty);
- CheckFalse(value.IsClass);
- CheckFalse(value.IsObject);
- CheckFalse(value.IsArray);
- CheckEquals(0, value.AsOrdinal);
- CheckEquals(0, value.AsInteger);
- CheckEquals(0, value.AsInt64);
- CheckEquals(0, value.AsUInt64);
- TValue.Make(Nil, TypeInfo(String), value);
- CheckFalse(value.IsEmpty);
- CheckFalse(value.IsObject);
- CheckFalse(value.IsClass);
- CheckFalse(value.IsArray);
- CheckEquals('', value.AsString);
- end;
- procedure TTestValueSimple.TestMakeObject;
- var
- AValue: TValue;
- ATestClass: TTestValueClass;
- begin
- ATestClass := TTestValueClass.Create;
- ATestClass.AInteger := 54329;
- TValue.Make(@ATestClass, TypeInfo(TTestValueClass),AValue);
- CheckEquals(AValue.IsClass, False);
- CheckEquals(AValue.IsObject, True);
- Check(AValue.AsObject=ATestClass);
- Check(PPointer(AValue.GetReferenceToRawData)^ = Pointer(ATestClass));
- CheckEquals(TTestValueClass(AValue.AsObject).AInteger, 54329);
- ATestClass.Free;
- end;
- procedure TTestValueArray.TestMakeArrayDynamic;
- var
- arr: TArrayOfLongintDyn;
- value: TValue;
- begin
- SetLength(arr, 2);
- arr[0] := 42;
- arr[1] := 21;
- TValue.Make(@arr, TypeInfo(TArrayOfLongintDyn), value);
- CheckEquals(value.IsArray, True);
- CheckEquals(value.IsObject, False);
- CheckEquals(value.IsOrdinal, False);
- CheckEquals(value.IsClass, False);
- CheckEquals(value.GetArrayLength, 2);
- CheckEquals(value.GetArrayElement(0).AsInteger, 42);
- CheckEquals(value.GetArrayElement(1).AsInteger, 21);
- Check(PPointer(value.GetReferenceToRawData)^ = Pointer(arr));
- value.SetArrayElement(0, Integer(84));
- CheckEquals(arr[0], 84);
- end;
- procedure TTestValueArray.TestMakeArrayStatic;
- type
- TArrStat = array[0..1] of LongInt;
- TArrStat2D = array[0..1, 0..1] of LongInt;
- var
- arr: TArrStat;
- arr2D: TArrStat2D;
- value: TValue;
- begin
- arr[0] := 42;
- arr[1] := 21;
- TValue.Make(@arr, TypeInfo(TArrStat), value);
- CheckEquals(value.IsArray, True);
- CheckEquals(value.IsObject, False);
- CheckEquals(value.IsOrdinal, False);
- CheckEquals(value.IsClass, False);
- CheckEquals(value.GetArrayLength, 2);
- CheckEquals(value.GetArrayElement(0).AsInteger, 42);
- CheckEquals(value.GetArrayElement(1).AsInteger, 21);
- value.SetArrayElement(0, integer(84));
- { since this is a static array the original array isn't touched! }
- CheckEquals(arr[0], 42);
- arr2D[0, 0] := 42;
- arr2D[0, 1] := 21;
- arr2D[1, 0] := 84;
- arr2D[1, 1] := 63;
- TValue.Make(@arr2D, TypeInfo(TArrStat2D), value);
- CheckEquals(value.IsArray, True);
- CheckEquals(value.GetArrayLength, 4);
- CheckEquals(value.GetArrayElement(0).AsInteger, 42);
- CheckEquals(value.GetArrayElement(1).AsInteger, 21);
- CheckEquals(value.GetArrayElement(2).AsInteger, 84);
- CheckEquals(value.GetArrayElement(3).AsInteger, 63);
- end;
- {$ifdef fpc}
- procedure TTestValueArray.TestMakeArrayOpen;
- procedure TestOpenArrayValueCopy(aArr: array of LongInt);
- var
- value: TValue;
- begin
- TValue.MakeOpenArray(@aArr[0], Length(aArr), PTypeInfo(TypeInfo(aArr)), value);
- CheckEquals(value.IsArray, True);
- CheckEquals(value.IsOpenArray, True);
- CheckEquals(value.IsObject, False);
- CheckEquals(value.IsOrdinal, False);
- CheckEquals(value.IsClass, False);
- CheckEquals(value.GetArrayLength, 2);
- CheckEquals(value.GetArrayElement(0).AsInteger, 42);
- CheckEquals(value.GetArrayElement(1).AsInteger, 21);
- value.SetArrayElement(0, Integer(84));
- { since this is an open array the original array is modified! }
- CheckEquals(aArr[0], 84);
- end;
- procedure TestOpenArrayValueVar(var aArr: array of LongInt);
- var
- value: TValue;
- begin
- TValue.MakeOpenArray(@aArr[0], Length(aArr), PTypeInfo(TypeInfo(aArr)), value);
- CheckEquals(value.IsArray, True);
- CheckEquals(value.IsOpenArray, True);
- CheckEquals(value.IsObject, False);
- CheckEquals(value.IsOrdinal, False);
- CheckEquals(value.IsClass, False);
- CheckEquals(value.GetArrayLength, 2);
- CheckEquals(value.GetArrayElement(0).AsInteger, 42);
- CheckEquals(value.GetArrayElement(1).AsInteger, 21);
- value.SetArrayElement(0, 84);
- { since this is an open array the original array is modified! }
- CheckEquals(aArr[0], 84);
- end;
- procedure TestOpenArrayValueOut(var aArr: array of LongInt);
- var
- value: TValue;
- begin
- TValue.MakeOpenArray(@aArr[0], Length(aArr), PTypeInfo(TypeInfo(aArr)), value);
- CheckEquals(value.IsArray, True);
- CheckEquals(value.IsOpenArray, True);
- CheckEquals(value.IsObject, False);
- CheckEquals(value.IsOrdinal, False);
- CheckEquals(value.IsClass, False);
- CheckEquals(value.GetArrayLength, 2);
- CheckEquals(value.GetArrayElement(0).AsInteger, 42);
- CheckEquals(value.GetArrayElement(1).AsInteger, 21);
- value.SetArrayElement(0, 84);
- value.SetArrayElement(1, 128);
- { since this is an open array the original array is modified! }
- CheckEquals(aArr[0], 84);
- CheckEquals(aArr[1], 128);
- CheckEquals(value.GetArrayElement(0).AsInteger, 84);
- CheckEquals(value.GetArrayElement(1).AsInteger, 128);
- end;
- var
- arr: array of LongInt;
- begin
- TestOpenArrayValueCopy([42, 21]);
- arr := [42, 21];
- TestOpenArrayValueVar(arr);
- CheckEquals(arr[0], 84);
- CheckEquals(arr[1], 21);
- arr := [42, 21];
- TestOpenArrayValueOut(arr);
- CheckEquals(arr[0], 84);
- CheckEquals(arr[1], 128);
- end;
- {$endif}
- procedure TTestValueSimple.TestMakeSingle;
- var
- fs: Single;
- v: TValue;
- hadexcept: Boolean;
- begin
- fs := 3.14;
- TValue.Make(@fs, TypeInfo(Single), v);
- CheckEquals(v.IsClass, False);
- CheckEquals(v.IsObject, False);
- CheckEquals(v.IsOrdinal, False);
- Check(v.AsExtended=fs);
- Check(v.GetReferenceToRawData <> @fs);
- try
- hadexcept := False;
- v.AsInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No signed type conversion exception');
- try
- hadexcept := False;
- v.AsUInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No unsigned type conversion exception');
- end;
- procedure TTestValueSimple.TestMakeDouble;
- var
- fd: Double;
- v: TValue;
- hadexcept: Boolean;
- begin
- fd := 3.14;
- TValue.Make(@fd, TypeInfo(Double), v);
- CheckEquals(v.IsClass, False);
- CheckEquals(v.IsObject, False);
- CheckEquals(v.IsOrdinal, False);
- Check(v.AsExtended=fd);
- Check(v.GetReferenceToRawData <> @fd);
- try
- hadexcept := False;
- v.AsInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No signed type conversion exception');
- try
- hadexcept := False;
- v.AsUInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No unsigned type conversion exception');
- end;
- procedure TTestValueSimple.TestMakeExtended;
- var
- fe: Extended;
- v: TValue;
- hadexcept: Boolean;
- begin
- fe := 3.14;
- TValue.Make(@fe, TypeInfo(Extended), v);
- CheckEquals(v.IsClass, False);
- CheckEquals(v.IsObject, False);
- CheckEquals(v.IsOrdinal, False);
- Check(v.AsExtended=fe);
- Check(v.GetReferenceToRawData <> @fe);
- try
- hadexcept := False;
- v.AsInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No signed type conversion exception');
- try
- hadexcept := False;
- v.AsUInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No unsigned type conversion exception');
- end;
- procedure TTestValueSimple.TestMakeCurrency;
- var
- fcu: Currency;
- v: TValue;
- hadexcept: Boolean;
- begin
- fcu := 3.14;
- TValue.Make(@fcu, TypeInfo(Currency), v);
- CheckEquals(v.IsClass, False);
- CheckEquals(v.IsObject, False);
- CheckEquals(v.IsOrdinal, False);
- Check(v.AsExtended=Extended(fcu));
- Check(v.AsCurrency=fcu);
- Check(v.GetReferenceToRawData <> @fcu);
- try
- hadexcept := False;
- v.AsInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No signed type conversion exception');
- try
- hadexcept := False;
- v.AsUInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No unsigned type conversion exception');
- end;
- procedure TTestValueSimple.TestMakeComp;
- var
- fco: Comp;
- v: TValue;
- hadexcept: Boolean;
- begin
- fco := 314;
- TValue.Make(@fco, TypeInfo(Comp), v);
- if v.Kind <> tkFloat then
- Exit;
- CheckEquals(v.IsClass, False);
- CheckEquals(v.IsObject, False);
- CheckEquals(v.IsOrdinal, False);
- Check(v.AsExtended=Extended(fco));
- Check(v.GetReferenceToRawData <> @fco);
- try
- hadexcept := False;
- CheckEquals(v.AsInt64, 314);
- except
- hadexcept := True;
- end;
- CheckFalse(hadexcept, 'Had signed type conversion exception');
- try
- hadexcept := False;
- CheckEquals(v.AsUInt64, 314);
- except
- hadexcept := True;
- end;
- CheckFalse(hadexcept, 'Had unsigned type conversion exception');
- end;
- procedure TTestValueSimple.TestMakeEnum;
- var
- e: TTestEnum;
- v: TValue;
- begin
- e := te1;
- TValue.Make(@e, TypeInfo(TTestEnum), v);
- Check(not v.IsClass);
- Check(not v.IsArray);
- Check(not v.IsEmpty);
- {$ifdef fpc}
- Check(not v.IsOpenArray);
- {$endif}
- Check(not v.IsObject);
- Check(v.IsOrdinal);
- Check(v.GetReferenceToRawData <> @e);
- Check(TTestEnum(v.AsOrdinal) = te1);
- end;
- procedure TTestValueSimple.TestMakeAnsiChar;
- var
- c: AnsiChar;
- v: TValue;
- begin
- c := #20;
- TValue.Make(@c, TypeInfo(AnsiChar), v);
- Check(not v.IsClass);
- Check(not v.IsArray);
- Check(not v.IsEmpty);
- {$ifdef fpc}
- Check(not v.IsOpenArray);
- {$endif}
- Check(not v.IsObject);
- Check(v.IsOrdinal);
- Check(v.GetReferenceToRawData <> @c);
- Check(AnsiChar(v.AsOrdinal) = #20);
- Check(v.AsAnsiChar = #20);
- end;
- procedure TTestValueSimple.TestMakeWideChar;
- var
- c: WideChar;
- v: TValue;
- begin
- c := #$1234;
- TValue.Make(@c, TypeInfo(WideChar), v);
- Check(not v.IsClass);
- Check(not v.IsArray);
- Check(not v.IsEmpty);
- {$ifdef fpc}
- Check(not v.IsOpenArray);
- {$endif}
- Check(not v.IsObject);
- Check(v.IsOrdinal);
- Check(v.GetReferenceToRawData <> @c);
- Check(WideChar(v.AsOrdinal) = #$1234);
- Check(v.AsWideChar = #$1234);
- end;
- procedure TTestValueSimple.TestMakeNativeInt;
- var
- fni: NativeInt;
- s: AnsiString;
- v: TValue;
- o: TObject;
- begin
- fni := 2021;
- TValue.Make(fni, TypeInfo(LongInt), v);
- CheckEquals(v.IsClass, False);
- CheckEquals(v.IsObject, False);
- CheckEquals(v.IsOrdinal, True);
- Check(NativeInt(v.GetReferenceToRawData) <> fni);
- CheckEquals(v.AsOrdinal, 2021);
- s := 'Hello World';
- TValue.Make(NativeInt(s), TypeInfo(AnsiString), v);
- CheckEquals(v.IsClass, False);
- CheckEquals(v.IsObject, False);
- CheckEquals(v.IsOrdinal, False);
- CheckEquals(v.AsString, s);
- o := TObject.Create;
- TValue.Make(NativeInt(o), TypeInfo(TObject), v);
- CheckEquals(v.IsClass, False);
- CheckEquals(v.IsObject, True);
- CheckEquals(v.IsOrdinal, False);
- Check(PPointer(v.GetReferenceToRawData)^ = Pointer(o));
- Check(v.AsObject = o);
- o.Free;
- end;
- procedure TTestValueSimple.TestMakeVariant;
- var
- vv : Variant;
- vd : TVarData;
- v: TValue;
- begin
- vv := 'Some String';
- TValue.Make(@vv, TypeInfo(Variant), v);
- Check(not v.IsClass);
- Check(not v.IsArray);
- Check(not v.IsEmpty);
- {$ifdef fpc}
- Check(not v.IsOpenArray);
- {$endif}
- Check(not v.IsObject);
- Check(not v.IsOrdinal);
- Check(v.GetReferenceToRawData <> @vv);
- Check(String(v.AsVariant) = 'Some String');
- end;
- procedure TTestValueArray.TestMakeFromArray;
- var
- arr, subarr: array of TValue;
- v, varr: TValue;
- ti: PTypeInfo;
- i: LongInt;
- begin
- SetLength(arr, 3 * 4);
- for i := 0 to High(arr) do
- TValue.{$ifdef fpc}specialize{$endif} Make<LongInt>(i + 1, arr[i]);
- ti := PTypeInfo(TypeInfo(LongInt));
- v := TValue.FromArray(TypeInfo(TArrayOfLongintDyn), arr);
- Check(not v.IsEmpty, 'Array is empty');
- Check(v.IsArray, 'Value is not an array');
- CheckEquals(Length(arr), v.GetArrayLength, 'Array length does not match');
- for i := 0 to High(arr) do begin
- varr := v.GetArrayElement(i);
- Check(varr.TypeInfo = ti, 'Type info of array element does not match');
- Check(varr.IsOrdinal, 'Array element is not an ordinal');
- Check(varr.AsInteger = arr[i].AsInteger, 'Value of array element does not match');
- end;
- subarr := Copy(arr, 0, 4);
- v := TValue.FromArray(TypeInfo(TArrayOfLongintStatic), subarr);
- Check(not v.IsEmpty, 'Array is empty');
- Check(v.IsArray, 'Value is not an array');
- CheckEquals(Length(subarr), v.GetArrayLength, 'Array length does not match');
- for i := 0 to High(subarr) do begin
- varr := v.GetArrayElement(i);
- Check(varr.TypeInfo = ti, 'Type info of array element does not match');
- Check(varr.IsOrdinal, 'Array element is not an ordinal');
- Check(varr.AsInteger = subarr[i].AsInteger, 'Value of array element does not match');
- end;
- v := TValue.FromArray(TypeInfo(TArrayOfLongint2DStatic), arr);
- Check(not v.IsEmpty, 'Array is empty');
- Check(v.IsArray, 'Value is not an array');
- CheckEquals(Length(arr), v.GetArrayLength, 'Array length does not match');
- for i := 0 to High(arr) do begin
- varr := v.GetArrayElement(i);
- Check(varr.TypeInfo = ti, 'Type info of array element does not match');
- Check(varr.IsOrdinal, 'Array element is not an ordinal');
- Check(varr.AsInteger = arr[i].AsInteger, 'Value of array element does not match');
- end;
- end;
- procedure TTestValueSimple.TestMakeGenericNil;
- var
- value: TValue;
- begin
- TValue.{$ifdef fpc}specialize{$endif} Make<TObject>(Nil, value);
- CheckTrue(value.IsEmpty);
- CheckTrue(value.IsObject);
- CheckTrue(value.IsClass);
- CheckTrue(value.IsOrdinal);
- CheckFalse(value.IsArray);
- CheckTrue(value.AsObject=Nil);
- CheckTrue(value.AsClass=Nil);
- CheckTrue(value.AsInterface=Nil);
- CheckEquals(0, value.AsOrdinal);
- TValue.{$ifdef fpc}specialize{$endif} Make<TClass>(Nil, value);
- CheckTrue(value.IsEmpty);
- CheckTrue(value.IsClass);
- CheckTrue(value.IsOrdinal);
- CheckFalse(value.IsArray);
- CheckTrue(value.AsObject=Nil);
- CheckTrue(value.AsClass=Nil);
- CheckTrue(value.AsInterface=Nil);
- CheckEquals(0, value.AsOrdinal);
- end;
- procedure TTestValueSimple.TestMakeGenericLongInt;
- var
- value: TValue;
- begin
- TValue.{$ifdef fpc}specialize{$endif} Make<LongInt>(0, value);
- CheckTrue(value.IsOrdinal);
- CheckFalse(value.IsEmpty);
- CheckFalse(value.IsClass);
- CheckFalse(value.IsObject);
- CheckFalse(value.IsArray);
- CheckEquals(0, value.AsOrdinal);
- CheckEquals(0, value.AsInteger);
- CheckEquals(0, value.AsInt64);
- CheckEquals(0, value.AsUInt64);
- end;
- procedure TTestValueSimple.TestMakeGenericString;
- var
- value: TValue;
- begin
- TValue.{$ifdef fpc}specialize{$endif} Make<String>('test', value);
- CheckFalse(value.IsEmpty);
- CheckFalse(value.IsObject);
- CheckFalse(value.IsClass);
- CheckFalse(value.IsArray);
- CheckEquals('test', value.AsString);
- end;
- procedure TTestValueSimple.TestMakeGenericObject;
- var
- value: TValue;
- TestClass: TTestValueClass;
- begin
- TestClass := TTestValueClass.Create;
- TestClass.AInteger := 54329;
- TValue.{$ifdef fpc}specialize{$endif} Make<TTestValueClass>(TestClass, value);
- CheckEquals(value.IsClass, False);
- CheckEquals(value.IsObject, True);
- Check(value.AsObject=TestClass);
- Check(PPointer(value.GetReferenceToRawData)^ = Pointer(TestClass));
- CheckEquals(TTestValueClass(value.AsObject).AInteger, 54329);
- TestClass.Free;
- end;
- procedure TTestValueSimple.TestMakeGenericDouble;
- var
- fd: Double;
- v: TValue;
- hadexcept: Boolean;
- begin
- fd := 3.14;
- TValue.{$ifdef fpc}specialize{$endif} Make<Double>(fd, v);
- CheckEquals(v.IsClass, False);
- CheckEquals(v.IsObject, False);
- CheckEquals(v.IsOrdinal, False);
- Check(v.AsExtended=fd);
- Check(v.GetReferenceToRawData <> @fd);
- try
- hadexcept := False;
- v.AsInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No signed type conversion exception');
- try
- hadexcept := False;
- v.AsUInt64;
- except
- hadexcept := True;
- end;
- CheckTrue(hadexcept, 'No unsigned type conversion exception');
- end;
- procedure TTestValueSimple.TestMakeGenericAnsiChar;
- var
- c: AnsiChar;
- v: TValue;
- begin
- c := #20;
- TValue.{$ifdef fpc}specialize{$endif} Make<AnsiChar>(c, v);
- Check(not v.IsClass);
- Check(not v.IsArray);
- Check(not v.IsEmpty);
- {$ifdef fpc}
- Check(not v.IsOpenArray);
- {$endif}
- Check(not v.IsObject);
- Check(v.IsOrdinal);
- Check(v.GetReferenceToRawData <> @c);
- Check(AnsiChar(v.AsOrdinal) = #20);
- Check(v.AsAnsiChar = #20);
- end;
- procedure TTestValueSimple.TestMakeGenericWideChar;
- var
- c: WideChar;
- v: TValue;
- begin
- c := #$1234;
- TValue.{$ifdef fpc}specialize{$endif} Make<WideChar>(c, v);
- Check(not v.IsClass);
- Check(not v.IsArray);
- Check(not v.IsEmpty);
- {$ifdef fpc}
- Check(not v.IsOpenArray);
- {$endif}
- Check(not v.IsObject);
- Check(v.IsOrdinal);
- Check(v.GetReferenceToRawData <> @c);
- Check(WideChar(v.AsOrdinal) = #$1234);
- Check(v.AsWideChar = #$1234);
- end;
- procedure TTestValueSimple.MakeFromOrdinalTObject;
- begin
- TValue.FromOrdinal(TypeInfo(TObject), 42);
- end;
- procedure TTestValueSimple.MakeFromOrdinalSet;
- begin
- TValue.FromOrdinal(TypeInfo(TTestSet), 42);
- end;
- procedure TTestValueSimple.MakeFromOrdinalString;
- begin
- TValue.FromOrdinal(TypeInfo(AnsiString), 42);
- end;
- procedure TTestValueSimple.MakeFromOrdinalNil;
- begin
- TValue.FromOrdinal(Nil, 42);
- end;
- procedure TTestValueSimple.TestFromOrdinal;
- var
- v: TValue;
- begin
- v := TValue.FromOrdinal(TypeInfo(LongInt), 42);
- Check(v.IsOrdinal);
- CheckEquals(v.AsOrdinal, 42);
- v := TValue.FromOrdinal(TypeInfo(Boolean), Ord(True));
- Check(v.IsOrdinal);
- CheckEquals(v.AsOrdinal, Ord(True));
- v := TValue.FromOrdinal(TypeInfo(Int64), $1234123412341234);
- Check(v.IsOrdinal);
- CheckEquals(v.AsOrdinal, $1234123412341234);
- v := TValue.FromOrdinal(TypeInfo(QWord), $1234123412341234);
- Check(v.IsOrdinal);
- CheckEquals(v.AsOrdinal, $1234123412341234);
- v := TValue.FromOrdinal(TypeInfo(LongBool), Ord(True));
- Check(v.IsOrdinal);
- CheckEquals(v.AsOrdinal, Ord(True));
- v := TValue.FromOrdinal(TypeInfo(TTestEnum), Ord(te1));
- Check(v.IsOrdinal);
- CheckEquals(v.AsOrdinal, Ord(te1));
- v := TValue.FromOrdinal(TypeInfo(AnsiChar), Ord(#20));
- Check(v.IsOrdinal);
- CheckEquals(v.AsOrdinal, Ord(#20));
- v := TValue.FromOrdinal(TypeInfo(WideChar), Ord(#$1234));
- Check(v.IsOrdinal);
- CheckEquals(v.AsOrdinal, Ord(#$1234));
- CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalNil, EInvalidCast);
- CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalTObject, EInvalidCast);
- CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalSet, EInvalidCast);
- CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalString, EInvalidCast);
- end;
- { TTestValueArray }
- {$ifdef fpc}
- procedure TTestValueArray.TestOpenArrayToDyn;
- procedure OpenArrayProc(aArr: array of LongInt);
- var
- value: TValue;
- begin
- {$ifndef InLazIDE}
- value := specialize OpenArrayToDynArrayValue<LongInt>(aArr);
- {$endif}
- CheckEquals(value.IsArray, True);
- CheckEquals(value.IsOpenArray, False);
- CheckEquals(value.IsObject, False);
- CheckEquals(value.IsOrdinal, False);
- CheckEquals(value.IsClass, False);
- CheckEquals(value.GetArrayLength, 2);
- CheckEquals(value.GetArrayElement(0).AsInteger, 42);
- CheckEquals(value.GetArrayElement(1).AsInteger, 84);
- value.SetArrayElement(0, Integer(21));
- { since this is a copy the original array is not modified! }
- CheckEquals(aArr[0], 42);
- end;
- begin
- OpenArrayProc([42, 84]);
- end;
- {$endif}
- procedure TTestValueGeneral.TestDataSize;
- var
- u8: UInt8;
- u16: UInt16;
- u32: UInt32;
- u64: UInt64;
- s8: Int8;
- s16: Int16;
- s32: Int32;
- s64: Int64;
- f32: Single;
- f64: Double;
- {$ifdef FPC_HAS_TYPE_EXTENDED}
- f80: Extended;
- {$endif}
- fco: Comp;
- fcu: Currency;
- ss: ShortString;
- sa: AnsiString;
- su: UnicodeString;
- sw: WideString;
- o: TObject;
- c: TClass;
- i: IInterface;
- ad: TArrayOfLongintDyn;
- _as: TArrayOfLongintStatic;
- b8: Boolean;
- {$ifdef fpc}
- b16: Boolean16;
- b32: Boolean32;
- b64: Boolean64;
- {$endif}
- bl8: ByteBool;
- bl16: WordBool;
- bl32: LongBool;
- {$ifdef fpc}
- bl64: QWordBool;
- {$endif}
- e: TTestEnum;
- s: TTestSet;
- t: TTestRecord;
- p: Pointer;
- proc: TTestProc;
- method: TTestMethod;
- value: TValue;
- begin
- u8:=245;
- TValue.Make(@u8, TypeInfo(UInt8), value);
- CheckEquals(1, value.DataSize, 'Size of UInt8 differs');
- u16:=789;
- TValue.Make(@u16, TypeInfo(UInt16), value);
- CheckEquals(2, value.DataSize, 'Size of UInt16 differs');
- u32:=568789;
- TValue.Make(@u32, TypeInfo(UInt32), value);
- CheckEquals(4, value.DataSize, 'Size of UInt32 differs');
- u64:=$abdcefadbcef;
- TValue.Make(@u64, TypeInfo(UInt64), value);
- CheckEquals(8, value.DataSize, 'Size of UInt64 differs');
- s8:=-32;
- TValue.Make(@s8, TypeInfo(Int8), value);
- CheckEquals(1, value.DataSize, 'Size of Int8 differs');
- s16:=-5345;
- TValue.Make(@s16, TypeInfo(Int16), value);
- CheckEquals(2, value.DataSize, 'Size of Int16 differs');
- s32:=-234567;
- TValue.Make(@s32, TypeInfo(Int32), value);
- CheckEquals(4, value.DataSize, 'Size of Int32 differs');
- s64:=23456789012;
- TValue.Make(@s64, TypeInfo(Int64), value);
- CheckEquals(8, value.DataSize, 'Size of Int64 differs');
- b8:=false;
- TValue.Make(@b8, TypeInfo(Boolean), value);
- CheckEquals(1, value.DataSize, 'Size of Boolean differs');
- {$ifdef fpc}
- b16:=true;
- TValue.Make(@b16, TypeInfo(Boolean16), value);
- CheckEquals(2, value.DataSize, 'Size of Boolean16 differs');
- b32:=false;
- TValue.Make(@b32, TypeInfo(Boolean32), value);
- CheckEquals(4, value.DataSize, 'Size of Boolean32 differs');
- b64:=true;
- TValue.Make(@b64, TypeInfo(Boolean64), value);
- CheckEquals(8, value.DataSize, 'Size of Boolean64 differs');
- {$endif}
- bl8:=true;
- TValue.Make(@bl8, TypeInfo(ByteBool), value);
- CheckEquals(1, value.DataSize, 'Size of ByteBool differs');
- bl16:=false;
- TValue.Make(@bl16, TypeInfo(WordBool), value);
- CheckEquals(2, value.DataSize, 'Size of WordBool differs');
- bl32:=false;
- TValue.Make(@bl32, TypeInfo(LongBool), value);
- CheckEquals(4, value.DataSize, 'Size of LongBool differs');
- {$ifdef fpc}
- bl64:=true;
- TValue.Make(@bl64, TypeInfo(QWordBool), value);
- CheckEquals(8, value.DataSize, 'Size of QWordBool differs');
- {$endif}
- f32:=4.567;
- TValue.Make(@f32, TypeInfo(Single), value);
- CheckEquals(4, value.DataSize, 'Size of Single differs');
- f64:=-3456.678;
- TValue.Make(@f64, TypeInfo(Double), value);
- CheckEquals(8, value.DataSize, 'Size of Double differs');
- {$ifdef FPC_HAS_TYPE_EXTENDED}
- f80:=-2345.678;
- TValue.Make(@f80, TypeInfo(Extended), value);
- CheckEquals(10, value.DataSize, 'Size of Extended differs');
- {$endif}
- fcu:=56.78;
- TValue.Make(@fcu, TypeInfo(Currency), value);
- CheckEquals(SizeOf(Currency), value.DataSize, 'Size of Currency differs');
- fco:=456;
- TValue.Make(@fco, TypeInfo(Comp), value);
- CheckEquals(SizeOf(Comp), value.DataSize, 'Size of Comp differs');
- ss := '';
- TValue.Make(@ss, TypeInfo(ShortString), value);
- CheckEquals(254, value.DataSize, 'Size ofShortString differs');
- sa:= '';
- TValue.Make(@sa, TypeInfo(AnsiString), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of AnsiString differs');
- sw := '';
- TValue.Make(@sw, TypeInfo(WideString), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of WideString differs');
- su:='';
- TValue.Make(@su, TypeInfo(UnicodeString), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of UnicodeString differs');
- o := TTestValueClass.Create;
- TValue.Make(@o, TypeInfo(TObject), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TObject differs');
- o.Free;
- c := TObject;
- TValue.Make(@c, TypeInfo(TClass), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TClass differs');
- i := Nil;
- TValue.Make(@i, TypeInfo(IInterface), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of IInterface differs');
- TValue.Make(@t, TypeInfo(TTestRecord), value);
- CheckEquals(SizeOf(TTestRecord), value.DataSize, 'Size of TTestRecord differs');
- proc := Nil;
- TValue.Make(@proc, TypeInfo(TTestProc), value);
- CheckEquals(SizeOf(TTestProc), value.DataSize, 'Size of TTestProc differs');
- method := Nil;
- TValue.Make(@method, TypeInfo(TTestMethod), value);
- CheckEquals(SizeOf(TTestMethod), value.DataSize, 'Size of TTestMethod differs');
- TValue.Make(@_as, TypeInfo(TArrayOfLongintStatic), value);
- CheckEquals(SizeOf(TArrayOfLongintStatic), value.DataSize, 'Size of TArrayOfLongintStatic differs');
- TValue.Make(@ad, TypeInfo(TArrayOfLongintDyn), value);
- CheckEquals(SizeOf(TArrayOfLongintDyn), value.DataSize, 'Size of TArrayOfLongintDyn differs');
- e:=low(TTestEnum);
- TValue.Make(@e, TypeInfo(TTestEnum), value);
- CheckEquals(SizeOf(TTestEnum), value.DataSize, 'Size of TTestEnum differs');
- s:=[low(TTestEnum),high(TTestEnum)];
- TValue.Make(@s, TypeInfo(TTestSet), value);
- CheckEquals(SizeOf(TTestSet), value.DataSize, 'Size of TTestSet differs');
- p := Nil;
- TValue.Make(@p, TypeInfo(Pointer), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs');
- end;
- procedure TTestValueGeneral.TestDataSizeEmpty;
- var
- value: TValue;
- begin
- TValue.Make(Nil, TypeInfo(UInt8), value);
- CheckEquals(1, value.DataSize, 'Size of UInt8 differs');
- TValue.Make(Nil, TypeInfo(UInt16), value);
- CheckEquals(2, value.DataSize, 'Size of UInt16 differs');
- TValue.Make(Nil, TypeInfo(UInt32), value);
- CheckEquals(4, value.DataSize, 'Size of UInt32 differs');
- TValue.Make(Nil, TypeInfo(UInt64), value);
- CheckEquals(8, value.DataSize, 'Size of UInt64 differs');
- TValue.Make(Nil, TypeInfo(Int8), value);
- CheckEquals(1, value.DataSize, 'Size of Int8 differs');
- TValue.Make(Nil, TypeInfo(Int16), value);
- CheckEquals(2, value.DataSize, 'Size of Int16 differs');
- TValue.Make(Nil, TypeInfo(Int32), value);
- CheckEquals(4, value.DataSize, 'Size of Int32 differs');
- TValue.Make(Nil, TypeInfo(Int64), value);
- CheckEquals(8, value.DataSize, 'Size of Int64 differs');
- TValue.Make(Nil, TypeInfo(Boolean), value);
- CheckEquals(1, value.DataSize, 'Size of Boolean differs');
- {$ifdef fpc}
- TValue.Make(Nil, TypeInfo(Boolean16), value);
- CheckEquals(2, value.DataSize, 'Size of Boolean16 differs');
- TValue.Make(Nil, TypeInfo(Boolean32), value);
- CheckEquals(4, value.DataSize, 'Size of Boolean32 differs');
- TValue.Make(Nil, TypeInfo(Boolean64), value);
- CheckEquals(8, value.DataSize, 'Size of Boolean64 differs');
- {$endif}
- TValue.Make(Nil, TypeInfo(ByteBool), value);
- CheckEquals(1, value.DataSize, 'Size of ByteBool differs');
- TValue.Make(Nil, TypeInfo(WordBool), value);
- CheckEquals(2, value.DataSize, 'Size of WordBool differs');
- TValue.Make(Nil, TypeInfo(LongBool), value);
- CheckEquals(4, value.DataSize, 'Size of LongBool differs');
- {$ifdef fpc}
- TValue.Make(Nil, TypeInfo(QWordBool), value);
- CheckEquals(8, value.DataSize, 'Size of QWordBool differs');
- {$endif}
- TValue.Make(Nil, TypeInfo(Single), value);
- CheckEquals(4, value.DataSize, 'Size of Single differs');
- TValue.Make(Nil, TypeInfo(Double), value);
- CheckEquals(8, value.DataSize, 'Size of Double differs');
- {$ifdef FPC_HAS_TYPE_EXTENDED}
- TValue.Make(Nil, TypeInfo(Extended), value);
- CheckEquals(10, value.DataSize, 'Size of Extended differs');
- {$endif}
- TValue.Make(Nil, TypeInfo(Currency), value);
- CheckEquals(SizeOf(Currency), value.DataSize, 'Size of Currency differs');
- TValue.Make(Nil, TypeInfo(Comp), value);
- CheckEquals(SizeOf(Comp), value.DataSize, 'Size of Comp differs');
- TValue.Make(Nil, TypeInfo(ShortString), value);
- CheckEquals(254, value.DataSize, 'Size of ShortString differs');
- TValue.Make(Nil, TypeInfo(AnsiString), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs');
- TValue.Make(Nil, TypeInfo(WideString), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of WideString differs');
- TValue.Make(Nil, TypeInfo(UnicodeString), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of UnicodeString differs');
- TValue.Make(Nil, TypeInfo(TObject), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TObject differs');
- TValue.Make(Nil, TypeInfo(TClass), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TClass differs');
- TValue.Make(Nil, TypeInfo(IInterface), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of IInterface differs');
- TValue.Make(Nil, TypeInfo(TTestRecord), value);
- CheckEquals(SizeOf(TTestRecord), value.DataSize, 'Size of TTestRecord differs');
- TValue.Make(Nil, TypeInfo(TTestProc), value);
- CheckEquals(SizeOf(TTestProc), value.DataSize, 'Size of TTestProc differs');
- TValue.Make(Nil, TypeInfo(TTestMethod), value);
- CheckEquals(SizeOf(TTestMethod), value.DataSize, 'Size of TTestMethod differs');
- TValue.Make(Nil, TypeInfo(TArrayOfLongintStatic), value);
- CheckEquals(SizeOf(TArrayOfLongintStatic), value.DataSize, 'Size of TArrayOfLongintStatic differs');
- TValue.Make(Nil, TypeInfo(TArrayOfLongintDyn), value);
- CheckEquals(SizeOf(TArrayOfLongintDyn), value.DataSize, 'Size of TArrayOfLongintDyn differs');
- TValue.Make(Nil, TypeInfo(TTestEnum), value);
- CheckEquals(SizeOf(TTestEnum), value.DataSize, 'Size of TTestEnum differs');
- TValue.Make(Nil, TypeInfo(TTestSet), value);
- CheckEquals(SizeOf(TTestSet), value.DataSize, 'Size of TTestSet differs');
- TValue.Make(Nil, TypeInfo(Pointer), value);
- CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs');
- end;
- procedure TTestValueGeneral.TestIsManaged;
- begin
- CheckEquals(true, IsManaged(TypeInfo(ansistring)), 'IsManaged for tkAString');
- CheckEquals(true, IsManaged(TypeInfo(widestring)), 'IsManaged for tkWString');
- CheckEquals(true, IsManaged(TypeInfo(Variant)), 'IsManaged for tkVariant');
- CheckEquals(true, IsManaged(TypeInfo(TArrayOfManagedRec)),
- 'IsManaged for tkArray (with managed ElType)');
- CheckEquals(true, IsManaged(TypeInfo(TArrayOfString)),
- 'IsManaged for tkArray (with managed ElType)');
- CheckEquals(true, IsManaged(TypeInfo(TManagedRec)), 'IsManaged for tkRecord');
- {$ifdef fpc}
- CheckEquals(true, IsManaged(TypeInfo(TManagedRecOp)), 'IsManaged for tkRecord');
- {$endif}
- CheckEquals(true, IsManaged(TypeInfo(IInterface)), 'IsManaged for tkInterface');
- CheckEquals(true, IsManaged(TypeInfo(TManagedObj)), 'IsManaged for tkObject');
- {$ifdef fpc}
- CheckEquals(true, IsManaged(TypeInfo(specialize TArray<byte>)), 'IsManaged for tkDynArray');
- {$else}
- CheckEquals(true, IsManaged(TypeInfo(TArray<byte>)), 'IsManaged for tkDynArray');
- {$endif}
- CheckEquals(true, IsManaged(TypeInfo(unicodestring)), 'IsManaged for tkUString');
- CheckEquals(false, IsManaged(TypeInfo(shortstring)), 'IsManaged for tkSString');
- CheckEquals(false, IsManaged(TypeInfo(Byte)), 'IsManaged for tkInteger');
- CheckEquals(false, IsManaged(TypeInfo(Char)), 'IsManaged for tkChar');
- CheckEquals(false, IsManaged(TypeInfo(TTestEnum)), 'IsManaged for tkEnumeration');
- CheckEquals(false, IsManaged(TypeInfo(Single)), 'IsManaged for tkFloat');
- CheckEquals(false, IsManaged(TypeInfo(TTestSet)), 'IsManaged for tkSet');
- {$ifdef fpc}
- CheckEquals(false, IsManaged(TypeInfo(TTestMethod)), 'IsManaged for tkMethod');
- {$else}
- { Delphi bug (or sabotage). For some reason Delphi considers method pointers to be managed (only in newer versions, probably since XE7) :/ }
- CheckEquals({$if RTLVersion>=28}true{$else}false{$endif}, IsManaged(TypeInfo(TTestMethod)), 'IsManaged for tkMethod');
- {$endif}
- CheckEquals(false, IsManaged(TypeInfo(TArrayOfByte)),
- 'IsManaged for tkArray (with non managed ElType)');
- CheckEquals(false, IsManaged(TypeInfo(TArrayOfNonManagedRec)),
- 'IsManaged for tkArray (with non managed ElType)');
- CheckEquals(false, IsManaged(TypeInfo(TNonManagedRec)), 'IsManaged for tkRecord');
- CheckEquals(false, IsManaged(TypeInfo(TObject)), 'IsManaged for tkClass');
- CheckEquals(false, IsManaged(TypeInfo(TNonManagedObj)), 'IsManaged for tkObject');
- CheckEquals(false, IsManaged(TypeInfo(WideChar)), 'IsManaged for tkWChar');
- CheckEquals(false, IsManaged(TypeInfo(Boolean)), 'IsManaged for tkBool');
- CheckEquals(false, IsManaged(TypeInfo(Int64)), 'IsManaged for tkInt64');
- CheckEquals(false, IsManaged(TypeInfo(UInt64)), 'IsManaged for tkQWord');
- {$ifdef fpc}
- CheckEquals(false, IsManaged(TypeInfo(ICORBATest)), 'IsManaged for tkInterfaceRaw');
- {$endif}
- CheckEquals(false, IsManaged(TypeInfo(TTestProc)), 'IsManaged for tkProcVar');
- CheckEquals(false, IsManaged(TypeInfo(TTestHelper)), 'IsManaged for tkHelper');
- {$ifdef fpc}
- CheckEquals(false, IsManaged(TypeInfo(file)), 'IsManaged for tkFile');
- {$endif}
- CheckEquals(false, IsManaged(TypeInfo(TClass)), 'IsManaged for tkClassRef');
- CheckEquals(false, IsManaged(TypeInfo(Pointer)), 'IsManaged for tkPointer');
- CheckEquals(false, IsManaged(nil), 'IsManaged for nil');
- end;
- procedure TTestValueGeneral.TestReferenceRawData;
- var
- value: TValue;
- str: String;
- intf: IInterface;
- i: LongInt;
- test: TTestRecord;
- arrdyn: TArrayOfLongintDyn;
- arrstat: TArrayOfLongintStatic;
- begin
- str := 'Hello World';
- UniqueString(str);
- TValue.Make(@str, TypeInfo(String), value);
- Check(PPointer(value.GetReferenceToRawData)^ = Pointer(str), 'Reference to string data differs');
- intf := TInterfacedObject.Create;
- TValue.Make(@intf, TypeInfo(IInterface), value);
- Check(PPointer(value.GetReferenceToRawData)^ = Pointer(intf), 'Reference to interface data differs');
- i := 42;
- TValue.Make(@i, TypeInfo(LongInt), value);
- Check(value.GetReferenceToRawData <> @i, 'Reference to longint is equal');
- Check(PLongInt(value.GetReferenceToRawData)^ = PLongInt(@i)^, 'Reference to longint data differs');
- test.value1 := 42;
- test.value2 := 'Hello World';
- TValue.Make(@test, TypeInfo(TTestRecord), value);
- Check(value.GetReferenceToRawData <> @test, 'Reference to record is equal');
- Check(PTestRecord(value.GetReferenceToRawData)^.value1 = PTestRecord(@test)^.value1, 'Reference to record data value1 differs');
- Check(PTestRecord(value.GetReferenceToRawData)^.value2 = PTestRecord(@test)^.value2, 'Reference to record data value2 differs');
- SetLength(arrdyn, 3);
- arrdyn[0] := 42;
- arrdyn[1] := 23;
- arrdyn[2] := 49;
- TValue.Make(@arrdyn, TypeInfo(TArrayOfLongintDyn), value);
- Check(PPointer(value.GetReferenceToRawData)^ = Pointer(arrdyn), 'Reference to dynamic array data differs');
- arrstat[0] := 42;
- arrstat[1] := 23;
- arrstat[2] := 49;
- arrstat[3] := 59;
- TValue.Make(@arrstat, TypeInfo(TArrayOfLongintStatic), value);
- Check(value.GetReferenceToRawData <> @arrstat, 'Reference to static array is equal');
- Check(PLongInt(value.GetReferenceToRawData)^ = PLongInt(@arrstat)^, 'Reference to static array data differs');
- end;
- procedure TTestValueGeneral.TestReferenceRawDataEmpty;
- var
- value: TValue;
- begin
- TValue.Make(Nil, TypeInfo(String), value);
- Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty String is not assigned');
- Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty String data is assigned');
- TValue.Make(Nil, TypeInfo(IInterface), value);
- Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty interface is not assigned');
- Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty interface data is assigned');
- TValue.Make(Nil, TypeInfo(LongInt), value);
- Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty LongInt is not assigned');
- Check(PLongInt(value.GetReferenceToRawData)^ = 0, 'Empty longint data is not 0');
- TValue.Make(Nil, TypeInfo(TTestRecord), value);
- Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty record is not assigned');
- Check(PTestRecord(value.GetReferenceToRawData)^.value1 = 0, 'Empty record data value1 is not 0');
- Check(PTestRecord(value.GetReferenceToRawData)^.value2 = '', 'Empty record data value2 is not empty');
- TValue.Make(Nil, TypeInfo(TArrayOfLongintDyn), value);
- Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty dynamic array is not assigned');
- Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty dynamic array data is assigned');
- TValue.Make(Nil, TypeInfo(TArrayOfLongintStatic), value);
- Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty static array is not assigned');
- Check(PLongInt(value.GetReferenceToRawData)^ = 0, 'Empty static array data is not 0');
- end;
- initialization
- RegisterTest(TTestValueGeneral);
- RegisterTest(TTestValueSimple);
- RegisterTest(TTestValueSimple);
- RegisterTest(TTestValueVariant);
- end.
|