123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929 |
- unit tests.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 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 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.
|