tobjsiz2.pp 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147
  1. { Variation without virtual classes : no VMT }
  2. { here sizeof directly returns a constant value }
  3. {$static on}
  4. type
  5. pbaseclass = ^tbaseclass;
  6. pderivedclass = ^tderivedclass;
  7. tbaseclass = object
  8. x : longint;
  9. {constructor init;}
  10. function getsize : longint; static;
  11. function getsize2 : longint;
  12. procedure check_size; {virtual;}
  13. procedure static_check_size; static;
  14. procedure check_normal;
  15. procedure check_static; static;
  16. {procedure check_virtual; virtual;}
  17. {destructor done; virtual;}
  18. end;
  19. tderivedclass = object(tbaseclass)
  20. y : longint;
  21. procedure check_size; {virtual;}
  22. end;
  23. const
  24. has_error : boolean = false;
  25. expected_size_for_tbaseclass = {sizeof(pointer) + }sizeof(longint);
  26. expected_size_for_tderivedclass = {sizeof(pointer) +} 2*sizeof(longint);
  27. var
  28. basesize : longint;
  29. derivedsize : longint;
  30. {constructor tbaseclass.init;
  31. begin
  32. end;
  33. destructor tbaseclass.done;
  34. begin
  35. end; }
  36. function tbaseclass.getsize : longint;
  37. begin
  38. getsize:=sizeof(self);
  39. end;
  40. function tbaseclass.getsize2 : longint;
  41. begin
  42. getsize2:=sizeof(self);
  43. end;
  44. procedure tbaseclass.check_size;
  45. begin
  46. if sizeof(self)<>getsize then
  47. begin
  48. Writeln('Compiler creates garbage');
  49. has_error:=true;
  50. end;
  51. if sizeof(self)<>getsize2 then
  52. begin
  53. Writeln('Compiler creates garbage');
  54. has_error:=true;
  55. end;
  56. end;
  57. procedure tbaseclass.static_check_size;
  58. begin
  59. if sizeof(self)<>getsize then
  60. begin
  61. Writeln('Compiler creates garbage');
  62. has_error:=true;
  63. end;
  64. end;
  65. procedure tbaseclass.check_normal;
  66. begin
  67. check_size;
  68. static_check_size;
  69. end;
  70. procedure tbaseclass.check_static;
  71. begin
  72. {check_size;}
  73. static_check_size;
  74. end;
  75. {procedure tbaseclass.check_virtual;
  76. begin
  77. check_size;
  78. static_check_size;
  79. end;}
  80. procedure tderivedclass.check_size;
  81. begin
  82. Writeln('Calling tderived check_size method');
  83. inherited check_size;
  84. end;
  85. var
  86. cb : tbaseclass;
  87. cd : tderivedclass;
  88. c1 : pbaseclass;
  89. begin
  90. {cb.init;
  91. cd.init;}
  92. new(c1);
  93. basesize:=sizeof(cb);
  94. Writeln('Sizeof(cb)=',basesize);
  95. if basesize<>expected_size_for_tbaseclass then
  96. Writeln('not the expected size : ',expected_size_for_tbaseclass);
  97. derivedsize:=sizeof(cd);
  98. Writeln('Sizeof(ct)=',derivedsize);
  99. if derivedsize<>expected_size_for_tderivedclass then
  100. Writeln('not the expected size : ',expected_size_for_tderivedclass);
  101. cb.check_size;
  102. cd.check_size;
  103. c1^.check_size;
  104. cb.static_check_size;
  105. cd.static_check_size;
  106. c1^.static_check_size;
  107. tbaseclass.static_check_size;
  108. tderivedclass.static_check_size;
  109. tbaseclass.check_static;
  110. tderivedclass.check_static;
  111. cb.check_normal;
  112. cb.check_static;
  113. cd.check_normal;
  114. cd.check_static;
  115. if has_error then
  116. begin
  117. Writeln('Error with object methods');
  118. halt(1);
  119. end;
  120. end.