tw9162.pp 1.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253
  1. program DestBug;
  2. {$APPTYPE CONSOLE}
  3. {$MODE Delphi}
  4. uses
  5. Variants, SysUtils;
  6. type
  7. TSampleVariant = class(TCustomVariantType)
  8. protected
  9. procedure Clear(var V: TVarData); override;
  10. procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean ); override;
  11. procedure DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer); override;
  12. end;
  13. procedure TSampleVariant.Clear(var V: TVarData);
  14. begin
  15. V.VType:=varEmpty;
  16. end;
  17. procedure TSampleVariant.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
  18. begin
  19. if Indirect and VarDataIsByRef(Source) then
  20. VarDataCopyNoInd(Dest, Source)
  21. else with Dest do
  22. VType:=Source.VType;
  23. end;
  24. var
  25. p : pointer;
  26. procedure TSampleVariant.DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
  27. begin
  28. Writeln('Dest is 0x', IntToStr(Cardinal(Dest)));
  29. p:=Dest;
  30. end;
  31. var
  32. SampleVariant: TSampleVariant;
  33. v, v1: Variant;
  34. begin
  35. SampleVariant:=TSampleVariant.Create;
  36. TVarData(v).VType:=SampleVariant.VarType;
  37. v.SomeProc;
  38. if assigned(p) then
  39. halt(1);
  40. v1:=v.SomeFunc;
  41. if not(assigned(p)) then
  42. halt(1);
  43. writeln('ok');
  44. end.