tbs0178.pp 1.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364
  1. PROGRAM NoLabel; { this program compiles fine with TP but not with FP }
  2. type
  3. ptestobj = ^ttestobj;
  4. ttestobj = object
  5. constructor init;
  6. procedure test_self;
  7. end;
  8. const
  9. allowed : boolean = false;
  10. constructor ttestobj.init;
  11. begin
  12. if not allowed then
  13. fail;
  14. end;
  15. procedure ttestobj.test_self;
  16. function myself : ptestobj;
  17. begin
  18. myself:=@self;
  19. end;
  20. begin
  21. if myself<>@self then
  22. begin
  23. Writeln('problem with self');
  24. Halt(1);
  25. end;
  26. end;
  27. LABEL
  28. N1,
  29. N2,
  30. FAIL, { this is a reserved word in constructors only! - FP fails here
  31. }
  32. More; { label not defined - FP fails, but a warning is enough for that
  33. }
  34. { since label referenced nowhere }
  35. var ptest : ptestobj;
  36. self : longint;
  37. BEGIN
  38. new(ptest,init);
  39. if ptest<>nil then
  40. begin
  41. Writeln('Fail does not work !!');
  42. Halt(1);
  43. end;
  44. allowed:=true;
  45. new(ptest,init);
  46. if ptest=nil then
  47. begin
  48. Writeln('Constructor does not work !!');
  49. Halt(1);
  50. end
  51. else
  52. ptest^.test_self;
  53. N1: Write;
  54. N2: Write;
  55. FAIL: Write;
  56. self:=1;
  57. END.