program trtti17; {$mode objfpc}{$H+} uses typinfo, variants; type TEvent = procedure of object; TTestObj = object end; TTestRec = record end; TArrayDyn = array of LongInt; TArrayStatic = array[0..10] of LongInt; TSet = set of (alpha, beta, gamma); var gError: LongInt = 0; function NextErrorCode: LongInt; inline; begin Inc(gError); Result := gError; end; procedure TestTypeInfo(aTypeInfo: PTypeInfo; aType: TTypeKind); begin if aTypeInfo^.Kind <> aType then begin Writeln('TypeInfo failure; expected: ', aType, ', got: ', aTypeInfo^.Kind); Halt(NextErrorCode); end; NextErrorCode; end; generic procedure TestTypeKind(aType: TTypeKind); inline; begin if GetTypeKind(T) <> aType then begin Writeln('GetTypeKind() failure; expected: ', aType, ', got: ', GetTypeKind(T)); Halt(NextErrorCode); end; TestTypeInfo(PTypeInfo(TypeInfo(T)), aType); end; begin specialize TestTypeKind(tkClass); specialize TestTypeKind(tkClassRef); specialize TestTypeKind(tkProcVar); specialize TestTypeKind(tkMethod); specialize TestTypeKind(tkInteger); specialize TestTypeKind(tkInteger); specialize TestTypeKind(tkInteger); specialize TestTypeKind(tkInt64); specialize TestTypeKind(tkInteger); specialize TestTypeKind(tkInteger); specialize TestTypeKind(tkInteger); specialize TestTypeKind(tkQWord); specialize TestTypeKind(tkObject); specialize TestTypeKind(tkRecord); specialize TestTypeKind(tkEnumeration); specialize TestTypeKind(tkBool); specialize TestTypeKind(tkBool); specialize TestTypeKind(tkBool); specialize TestTypeKind(tkBool); specialize TestTypeKind(tkBool); specialize TestTypeKind(tkBool); specialize TestTypeKind(tkBool); specialize TestTypeKind(tkBool); specialize TestTypeKind(tkPointer); specialize TestTypeKind(tkDynArray); specialize TestTypeKind(tkArray); specialize TestTypeKind(tkInterface); specialize TestTypeKind(tkInterface); specialize TestTypeKind(tkSString); specialize TestTypeKind(tkAString); {$ifdef FPC_WIDESTRING_EQUAL_UNICODESTRING} specialize TestTypeKind(tkUString); {$else} specialize TestTypeKind(tkWString); {$endif} specialize TestTypeKind(tkUString); specialize TestTypeKind(tkChar); specialize TestTypeKind(tkWChar); specialize TestTypeKind(tkWChar); specialize TestTypeKind(tkFloat); specialize TestTypeKind(tkFloat); specialize TestTypeKind(tkFloat); specialize TestTypeKind(tkFloat); {$ifdef FPC_COMP_IS_INT64} specialize TestTypeKind(tkInt64); {$else} specialize TestTypeKind(tkFloat); {$endif} specialize TestTypeKind(tkSet); specialize TestTypeKind(tkVariant); {specialize TestTypeKind(tkFile); specialize TestTypeKind(tkFile);} Writeln('ok'); end.