From 553d357d64226f5f11b357634e360f4a601e14c6 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Sun, 3 Apr 2011 13:33:23 +0000 Subject: [PATCH] Completely restructured the test for the helper feature. The tests were split into three categories: * general tests for the helper feature (thlp*) * tests for class helpers (tchlp*) * tests for record helpers (trhlp*) With my current yet-to-be-commited implementation nearly all tests pass, but some fail because of missing FPC features: * thlp30.pp currently fails because of generic constraints, but should fail despite the constraints * thlp29.pp fails, because generic methods are not yet supported * trhlp8.pp, trhlp9.pp, trhlp10.pp fail, because one can't use default properties using the abbreviated syntax * trhlp17.pp, trhlp18.pp, trhlp19.pp fail, because nested types are not supported for records git-svn-id: branches/svenbarth/classhelpers@17237 - --- .gitattributes | 146 +++++++++++++++++--------- tests/test/tchlp1.pp | 55 +++------- tests/test/tchlp10.pp | 33 ++++-- tests/test/tchlp11.pp | 19 ++-- tests/test/tchlp12.pp | 34 +++--- tests/test/tchlp13.pp | 42 +++----- tests/test/tchlp14.pp | 26 ++--- tests/test/tchlp15.pp | 33 +++--- tests/test/tchlp16.pp | 20 ++-- tests/test/tchlp17.pp | 19 +++- tests/test/tchlp18.pp | 21 ++-- tests/test/tchlp19.pp | 18 ++-- tests/test/tchlp2.pp | 44 ++------ tests/test/tchlp20.pp | 17 ++- tests/test/tchlp21.pp | 18 ++-- tests/test/tchlp22.pp | 32 ++---- tests/test/tchlp23.pp | 31 ++---- tests/test/tchlp24.pp | 37 +++++-- tests/test/tchlp25.pp | 14 ++- tests/test/tchlp26.pp | 15 ++- tests/test/tchlp27.pp | 32 +++--- tests/test/tchlp28.pp | 41 ++++---- tests/test/tchlp29.pp | 50 +++++---- tests/test/tchlp3.pp | 19 +++- tests/test/tchlp30.pp | 36 ++++--- tests/test/tchlp31.pp | 34 ++++-- tests/test/tchlp32.pp | 30 ++++-- tests/test/tchlp33.pp | 38 ++++--- tests/test/tchlp34.pp | 24 +++-- tests/test/tchlp35.pp | 38 +++++-- tests/test/tchlp36.pp | 43 +++++--- tests/test/tchlp37.pp | 40 +++---- tests/test/tchlp38.pp | 35 +++--- tests/test/tchlp39.pp | 50 ++++----- tests/test/tchlp4.pp | 20 +++- tests/test/tchlp40.pp | 44 ++++---- tests/test/tchlp41.pp | 52 ++++++--- tests/test/tchlp42.pp | 73 +++++-------- tests/test/tchlp43.pp | 48 +++------ tests/test/tchlp44.pp | 26 ++--- tests/test/tchlp45.pp | 34 ++++-- tests/test/tchlp46.pp | 46 ++++++-- tests/test/tchlp47.pp | 51 +++++++-- tests/test/tchlp48.pp | 51 +++++++-- tests/test/tchlp49.pp | 46 ++++++-- tests/test/tchlp5.pp | 27 +++-- tests/test/tchlp50.pp | 37 +++++-- tests/test/tchlp51.pp | 44 ++++++-- tests/test/tchlp52.pp | 67 ++++++++++-- tests/test/tchlp53.pp | 89 +++++++++++++--- tests/test/tchlp54.pp | 114 +++++++++++++++++--- tests/test/tchlp55.pp | 26 ----- tests/test/tchlp56.pp | 34 ------ tests/test/tchlp57.pp | 30 ------ tests/test/tchlp58.pp | 31 ------ tests/test/tchlp6.pp | 29 +++-- tests/test/tchlp62.pp | 51 --------- tests/test/tchlp63.pp | 51 --------- tests/test/tchlp64.pp | 46 -------- tests/test/tchlp67.pp | 47 --------- tests/test/tchlp68.pp | 48 --------- tests/test/tchlp7.pp | 39 +++++-- tests/test/tchlp78.pp | 18 ---- tests/test/tchlp79.pp | 23 ---- tests/test/tchlp8.pp | 34 ++++-- tests/test/tchlp82.pp | 26 ----- tests/test/tchlp83.pp | 26 ----- tests/test/tchlp84.pp | 26 ----- tests/test/tchlp85.pp | 26 ----- tests/test/tchlp86.pp | 30 ------ tests/test/tchlp87.pp | 33 ------ tests/test/tchlp88.pp | 42 -------- tests/test/tchlp89.pp | 47 --------- tests/test/tchlp9.pp | 28 ++--- tests/test/tchlp90.pp | 51 --------- tests/test/thlp1.pp | 18 ++++ tests/test/thlp10.pp | 20 ++++ tests/test/thlp11.pp | 21 ++++ tests/test/thlp12.pp | 21 ++++ tests/test/thlp13.pp | 24 +++++ tests/test/thlp14.pp | 25 +++++ tests/test/thlp15.pp | 18 ++++ tests/test/thlp16.pp | 17 +++ tests/test/thlp17.pp | 23 ++++ tests/test/thlp18.pp | 21 ++++ tests/test/thlp19.pp | 20 ++++ tests/test/thlp2.pp | 28 +++++ tests/test/thlp20.pp | 19 ++++ tests/test/thlp21.pp | 19 ++++ tests/test/thlp22.pp | 19 ++++ tests/test/thlp23.pp | 24 +++++ tests/test/{tchlp69.pp => thlp24.pp} | 3 +- tests/test/{tchlp70.pp => thlp25.pp} | 3 +- tests/test/{tchlp71.pp => thlp26.pp} | 8 +- tests/test/{tchlp72.pp => thlp27.pp} | 3 +- tests/test/{tchlp73.pp => thlp28.pp} | 3 +- tests/test/{tchlp74.pp => thlp29.pp} | 12 +-- tests/test/thlp3.pp | 28 +++++ tests/test/{tchlp75.pp => thlp30.pp} | 6 +- tests/test/thlp31.pp | 18 ++++ tests/test/thlp32.pp | 18 ++++ tests/test/thlp33.pp | 18 ++++ tests/test/thlp34.pp | 18 ++++ tests/test/thlp35.pp | 18 ++++ tests/test/thlp36.pp | 18 ++++ tests/test/{tchlp80.pp => thlp37.pp} | 13 ++- tests/test/thlp38.pp | 59 +++++++++++ tests/test/thlp39.pp | 15 +++ tests/test/thlp4.pp | 20 ++++ tests/test/thlp40.pp | 16 +++ tests/test/thlp41.pp | 16 +++ tests/test/thlp42.pp | 16 +++ tests/test/thlp43.pp | 21 ++++ tests/test/thlp44.pp | 32 ++++++ tests/test/thlp5.pp | 23 ++++ tests/test/thlp6.pp | 24 +++++ tests/test/thlp7.pp | 20 ++++ tests/test/thlp8.pp | 16 +++ tests/test/thlp9.pp | 17 +++ tests/test/trhlp1.pp | 28 +++++ tests/test/{tchlp81.pp => trhlp10.pp} | 20 ++-- tests/test/{tchlp59.pp => trhlp11.pp} | 10 +- tests/test/trhlp12.pp | 25 +++++ tests/test/trhlp13.pp | 15 +++ tests/test/trhlp14.pp | 24 +++++ tests/test/trhlp15.pp | 25 +++++ tests/test/trhlp16.pp | 25 +++++ tests/test/trhlp17.pp | 14 +++ tests/test/trhlp18.pp | 15 +++ tests/test/trhlp19.pp | 15 +++ tests/test/trhlp2.pp | 30 ++++++ tests/test/trhlp20.pp | 26 +++++ tests/test/trhlp21.pp | 27 +++++ tests/test/trhlp22.pp | 30 ++++++ tests/test/trhlp23.pp | 23 ++++ tests/test/trhlp24.pp | 22 ++++ tests/test/trhlp25.pp | 20 ++++ tests/test/trhlp26.pp | 27 +++++ tests/test/trhlp27.pp | 36 +++++++ tests/test/trhlp28.pp | 35 ++++++ tests/test/trhlp29.pp | 36 +++++++ tests/test/trhlp3.pp | 27 +++++ tests/test/trhlp30.pp | 30 ++++++ tests/test/trhlp31.pp | 40 +++++++ tests/test/trhlp32.pp | 42 ++++++++ tests/test/trhlp33.pp | 34 ++++++ tests/test/trhlp34.pp | 51 +++++++++ tests/test/trhlp35.pp | 34 ++++++ tests/test/trhlp36.pp | 36 +++++++ tests/test/{tchlp61.pp => trhlp37.pp} | 22 ++-- tests/test/{tchlp65.pp => trhlp38.pp} | 17 ++- tests/test/{tchlp66.pp => trhlp39.pp} | 19 ++-- tests/test/trhlp4.pp | 28 +++++ tests/test/trhlp40.pp | 74 +++++++++++++ tests/test/trhlp41.pp | 97 +++++++++++++++++ tests/test/trhlp5.pp | 20 ++++ tests/test/trhlp6.pp | 25 +++++ tests/test/trhlp7.pp | 29 +++++ tests/test/{tchlp76.pp => trhlp8.pp} | 13 ++- tests/test/{tchlp77.pp => trhlp9.pp} | 15 ++- tests/test/uchlp12.pp | 36 +++++++ tests/test/uchlp18.pp | 95 +++++++++++++++++ tests/test/uchlp27a.pp | 24 ----- tests/test/uchlp27b.pp | 25 ----- tests/test/uchlp27c.pp | 27 ----- tests/test/uchlp32a.pp | 16 --- tests/test/uchlp32b.pp | 25 ----- tests/test/uchlp32c.pp | 25 ----- tests/test/uchlp33a.pp | 16 --- tests/test/uchlp33b.pp | 25 ----- tests/test/uchlp33c.pp | 25 ----- tests/test/uchlp35.pp | 28 ----- tests/test/uchlp50.pp | 34 ------ tests/test/uchlp51a.pp | 22 ---- tests/test/uchlp51b.pp | 25 ----- tests/test/uchlp51c.pp | 28 ----- tests/test/uhlp3.pp | 25 +++++ tests/test/{uchlp45.pp => uhlp31.pp} | 13 ++- tests/test/uhlp39.pp | 30 ++++++ tests/test/uhlp41a.pp | 21 ++++ tests/test/uhlp41b.pp | 17 +++ tests/test/uhlp43.pp | 38 +++++++ tests/test/{uchlp82.pp => urhlp14.pp} | 11 +- tests/test/urhlp17.pp | 54 ++++++++++ 184 files changed, 3585 insertions(+), 1995 deletions(-) delete mode 100644 tests/test/tchlp55.pp delete mode 100644 tests/test/tchlp56.pp delete mode 100644 tests/test/tchlp57.pp delete mode 100644 tests/test/tchlp58.pp delete mode 100644 tests/test/tchlp62.pp delete mode 100644 tests/test/tchlp63.pp delete mode 100644 tests/test/tchlp64.pp delete mode 100644 tests/test/tchlp67.pp delete mode 100644 tests/test/tchlp68.pp delete mode 100644 tests/test/tchlp78.pp delete mode 100644 tests/test/tchlp79.pp delete mode 100644 tests/test/tchlp82.pp delete mode 100644 tests/test/tchlp83.pp delete mode 100644 tests/test/tchlp84.pp delete mode 100644 tests/test/tchlp85.pp delete mode 100644 tests/test/tchlp86.pp delete mode 100644 tests/test/tchlp87.pp delete mode 100644 tests/test/tchlp88.pp delete mode 100644 tests/test/tchlp89.pp delete mode 100644 tests/test/tchlp90.pp create mode 100644 tests/test/thlp1.pp create mode 100644 tests/test/thlp10.pp create mode 100644 tests/test/thlp11.pp create mode 100644 tests/test/thlp12.pp create mode 100644 tests/test/thlp13.pp create mode 100644 tests/test/thlp14.pp create mode 100644 tests/test/thlp15.pp create mode 100644 tests/test/thlp16.pp create mode 100644 tests/test/thlp17.pp create mode 100644 tests/test/thlp18.pp create mode 100644 tests/test/thlp19.pp create mode 100644 tests/test/thlp2.pp create mode 100644 tests/test/thlp20.pp create mode 100644 tests/test/thlp21.pp create mode 100644 tests/test/thlp22.pp create mode 100644 tests/test/thlp23.pp rename tests/test/{tchlp69.pp => thlp24.pp} (85%) rename tests/test/{tchlp70.pp => thlp25.pp} (85%) rename tests/test/{tchlp71.pp => thlp26.pp} (59%) rename tests/test/{tchlp72.pp => thlp27.pp} (88%) rename tests/test/{tchlp73.pp => thlp28.pp} (87%) rename tests/test/{tchlp74.pp => thlp29.pp} (52%) create mode 100644 tests/test/thlp3.pp rename tests/test/{tchlp75.pp => thlp30.pp} (79%) create mode 100644 tests/test/thlp31.pp create mode 100644 tests/test/thlp32.pp create mode 100644 tests/test/thlp33.pp create mode 100644 tests/test/thlp34.pp create mode 100644 tests/test/thlp35.pp create mode 100644 tests/test/thlp36.pp rename tests/test/{tchlp80.pp => thlp37.pp} (74%) create mode 100644 tests/test/thlp38.pp create mode 100644 tests/test/thlp39.pp create mode 100644 tests/test/thlp4.pp create mode 100644 tests/test/thlp40.pp create mode 100644 tests/test/thlp41.pp create mode 100644 tests/test/thlp42.pp create mode 100644 tests/test/thlp43.pp create mode 100644 tests/test/thlp44.pp create mode 100644 tests/test/thlp5.pp create mode 100644 tests/test/thlp6.pp create mode 100644 tests/test/thlp7.pp create mode 100644 tests/test/thlp8.pp create mode 100644 tests/test/thlp9.pp create mode 100644 tests/test/trhlp1.pp rename tests/test/{tchlp81.pp => trhlp10.pp} (57%) rename tests/test/{tchlp59.pp => trhlp11.pp} (62%) create mode 100644 tests/test/trhlp12.pp create mode 100644 tests/test/trhlp13.pp create mode 100644 tests/test/trhlp14.pp create mode 100644 tests/test/trhlp15.pp create mode 100644 tests/test/trhlp16.pp create mode 100644 tests/test/trhlp17.pp create mode 100644 tests/test/trhlp18.pp create mode 100644 tests/test/trhlp19.pp create mode 100644 tests/test/trhlp2.pp create mode 100644 tests/test/trhlp20.pp create mode 100644 tests/test/trhlp21.pp create mode 100644 tests/test/trhlp22.pp create mode 100644 tests/test/trhlp23.pp create mode 100644 tests/test/trhlp24.pp create mode 100644 tests/test/trhlp25.pp create mode 100644 tests/test/trhlp26.pp create mode 100644 tests/test/trhlp27.pp create mode 100644 tests/test/trhlp28.pp create mode 100644 tests/test/trhlp29.pp create mode 100644 tests/test/trhlp3.pp create mode 100644 tests/test/trhlp30.pp create mode 100644 tests/test/trhlp31.pp create mode 100644 tests/test/trhlp32.pp create mode 100644 tests/test/trhlp33.pp create mode 100644 tests/test/trhlp34.pp create mode 100644 tests/test/trhlp35.pp create mode 100644 tests/test/trhlp36.pp rename tests/test/{tchlp61.pp => trhlp37.pp} (55%) rename tests/test/{tchlp65.pp => trhlp38.pp} (62%) rename tests/test/{tchlp66.pp => trhlp39.pp} (63%) create mode 100644 tests/test/trhlp4.pp create mode 100644 tests/test/trhlp40.pp create mode 100644 tests/test/trhlp41.pp create mode 100644 tests/test/trhlp5.pp create mode 100644 tests/test/trhlp6.pp create mode 100644 tests/test/trhlp7.pp rename tests/test/{tchlp76.pp => trhlp8.pp} (69%) rename tests/test/{tchlp77.pp => trhlp9.pp} (71%) create mode 100644 tests/test/uchlp12.pp create mode 100644 tests/test/uchlp18.pp delete mode 100644 tests/test/uchlp27a.pp delete mode 100644 tests/test/uchlp27b.pp delete mode 100644 tests/test/uchlp27c.pp delete mode 100644 tests/test/uchlp32a.pp delete mode 100644 tests/test/uchlp32b.pp delete mode 100644 tests/test/uchlp32c.pp delete mode 100644 tests/test/uchlp33a.pp delete mode 100644 tests/test/uchlp33b.pp delete mode 100644 tests/test/uchlp33c.pp delete mode 100644 tests/test/uchlp35.pp delete mode 100644 tests/test/uchlp50.pp delete mode 100644 tests/test/uchlp51a.pp delete mode 100644 tests/test/uchlp51b.pp delete mode 100644 tests/test/uchlp51c.pp create mode 100644 tests/test/uhlp3.pp rename tests/test/{uchlp45.pp => uhlp31.pp} (80%) create mode 100644 tests/test/uhlp39.pp create mode 100644 tests/test/uhlp41a.pp create mode 100644 tests/test/uhlp41b.pp create mode 100644 tests/test/uhlp43.pp rename tests/test/{uchlp82.pp => urhlp14.pp} (60%) create mode 100644 tests/test/urhlp17.pp diff --git a/.gitattributes b/.gitattributes index 3b244f12ec..d6b60856c8 100644 --- a/.gitattributes +++ b/.gitattributes @@ -9567,45 +9567,10 @@ tests/test/tchlp51.pp svneol=native#text/pascal tests/test/tchlp52.pp svneol=native#text/pascal tests/test/tchlp53.pp svneol=native#text/pascal tests/test/tchlp54.pp svneol=native#text/pascal -tests/test/tchlp55.pp svneol=native#text/pascal -tests/test/tchlp56.pp svneol=native#text/pascal -tests/test/tchlp57.pp svneol=native#text/pascal -tests/test/tchlp58.pp svneol=native#text/pascal -tests/test/tchlp59.pp svneol=native#text/pascal tests/test/tchlp6.pp svneol=native#text/pascal -tests/test/tchlp61.pp svneol=native#text/pascal -tests/test/tchlp62.pp svneol=native#text/pascal -tests/test/tchlp63.pp svneol=native#text/pascal -tests/test/tchlp64.pp svneol=native#text/pascal -tests/test/tchlp65.pp svneol=native#text/pascal -tests/test/tchlp66.pp svneol=native#text/pascal -tests/test/tchlp67.pp svneol=native#text/pascal -tests/test/tchlp68.pp svneol=native#text/pascal -tests/test/tchlp69.pp svneol=native#text/pascal tests/test/tchlp7.pp svneol=native#text/pascal -tests/test/tchlp70.pp svneol=native#text/pascal -tests/test/tchlp71.pp svneol=native#text/pascal -tests/test/tchlp72.pp svneol=native#text/pascal -tests/test/tchlp73.pp svneol=native#text/pascal -tests/test/tchlp74.pp svneol=native#text/pascal -tests/test/tchlp75.pp svneol=native#text/pascal -tests/test/tchlp76.pp svneol=native#text/pascal -tests/test/tchlp77.pp svneol=native#text/pascal -tests/test/tchlp78.pp svneol=native#text/pascal -tests/test/tchlp79.pp svneol=native#text/pascal tests/test/tchlp8.pp svneol=native#text/pascal -tests/test/tchlp80.pp svneol=native#text/pascal -tests/test/tchlp81.pp svneol=native#text/pascal -tests/test/tchlp82.pp svneol=native#text/pascal -tests/test/tchlp83.pp svneol=native#text/pascal -tests/test/tchlp84.pp svneol=native#text/pascal -tests/test/tchlp85.pp svneol=native#text/pascal -tests/test/tchlp86.pp svneol=native#text/pascal -tests/test/tchlp87.pp svneol=native#text/pascal -tests/test/tchlp88.pp svneol=native#text/pascal -tests/test/tchlp89.pp svneol=native#text/pascal tests/test/tchlp9.pp svneol=native#text/pascal -tests/test/tchlp90.pp svneol=native#text/pascal tests/test/tcint64.pp svneol=native#text/plain tests/test/tclass1.pp svneol=native#text/plain tests/test/tclass10.pp svneol=native#text/pascal @@ -9765,6 +9730,50 @@ tests/test/theap.pp svneol=native#text/plain tests/test/theapthread.pp svneol=native#text/plain tests/test/thintdir.pp svneol=native#text/plain tests/test/thintdir1.pp svneol=native#text/pascal +tests/test/thlp1.pp svneol=native#text/pascal +tests/test/thlp10.pp svneol=native#text/pascal +tests/test/thlp11.pp svneol=native#text/pascal +tests/test/thlp12.pp svneol=native#text/pascal +tests/test/thlp13.pp svneol=native#text/pascal +tests/test/thlp14.pp svneol=native#text/pascal +tests/test/thlp15.pp svneol=native#text/pascal +tests/test/thlp16.pp svneol=native#text/pascal +tests/test/thlp17.pp svneol=native#text/pascal +tests/test/thlp18.pp svneol=native#text/pascal +tests/test/thlp19.pp svneol=native#text/pascal +tests/test/thlp2.pp svneol=native#text/pascal +tests/test/thlp20.pp svneol=native#text/pascal +tests/test/thlp21.pp svneol=native#text/pascal +tests/test/thlp22.pp svneol=native#text/pascal +tests/test/thlp23.pp svneol=native#text/pascal +tests/test/thlp24.pp svneol=native#text/pascal +tests/test/thlp25.pp svneol=native#text/pascal +tests/test/thlp26.pp svneol=native#text/pascal +tests/test/thlp27.pp svneol=native#text/pascal +tests/test/thlp28.pp svneol=native#text/pascal +tests/test/thlp29.pp svneol=native#text/pascal +tests/test/thlp3.pp svneol=native#text/pascal +tests/test/thlp30.pp svneol=native#text/pascal +tests/test/thlp31.pp svneol=native#text/pascal +tests/test/thlp32.pp svneol=native#text/pascal +tests/test/thlp33.pp svneol=native#text/pascal +tests/test/thlp34.pp svneol=native#text/pascal +tests/test/thlp35.pp svneol=native#text/pascal +tests/test/thlp36.pp svneol=native#text/pascal +tests/test/thlp37.pp svneol=native#text/pascal +tests/test/thlp38.pp svneol=native#text/pascal +tests/test/thlp39.pp svneol=native#text/pascal +tests/test/thlp4.pp svneol=native#text/pascal +tests/test/thlp40.pp svneol=native#text/pascal +tests/test/thlp41.pp svneol=native#text/pascal +tests/test/thlp42.pp svneol=native#text/pascal +tests/test/thlp43.pp svneol=native#text/pascal +tests/test/thlp44.pp svneol=native#text/pascal +tests/test/thlp5.pp svneol=native#text/pascal +tests/test/thlp6.pp svneol=native#text/pascal +tests/test/thlp7.pp svneol=native#text/pascal +tests/test/thlp8.pp svneol=native#text/pascal +tests/test/thlp9.pp svneol=native#text/pascal tests/test/timplements1.pp svneol=native#text/plain tests/test/timplements2.pp svneol=native#text/plain tests/test/timplements3.pp svneol=native#text/plain @@ -10031,6 +10040,47 @@ tests/test/trecreg2.pp svneol=native#text/plain tests/test/trecreg3.pp svneol=native#text/plain tests/test/trecreg4.pp svneol=native#text/plain tests/test/tresstr.pp svneol=native#text/plain +tests/test/trhlp1.pp svneol=native#text/pascal +tests/test/trhlp10.pp svneol=native#text/pascal +tests/test/trhlp11.pp svneol=native#text/pascal +tests/test/trhlp12.pp svneol=native#text/pascal +tests/test/trhlp13.pp svneol=native#text/pascal +tests/test/trhlp14.pp svneol=native#text/pascal +tests/test/trhlp15.pp svneol=native#text/pascal +tests/test/trhlp16.pp svneol=native#text/pascal +tests/test/trhlp17.pp svneol=native#text/pascal +tests/test/trhlp18.pp svneol=native#text/pascal +tests/test/trhlp19.pp svneol=native#text/pascal +tests/test/trhlp2.pp svneol=native#text/pascal +tests/test/trhlp20.pp svneol=native#text/pascal +tests/test/trhlp21.pp svneol=native#text/pascal +tests/test/trhlp22.pp svneol=native#text/pascal +tests/test/trhlp23.pp svneol=native#text/pascal +tests/test/trhlp24.pp svneol=native#text/pascal +tests/test/trhlp25.pp svneol=native#text/pascal +tests/test/trhlp26.pp svneol=native#text/pascal +tests/test/trhlp27.pp svneol=native#text/pascal +tests/test/trhlp28.pp svneol=native#text/pascal +tests/test/trhlp29.pp svneol=native#text/pascal +tests/test/trhlp3.pp svneol=native#text/pascal +tests/test/trhlp30.pp svneol=native#text/pascal +tests/test/trhlp31.pp svneol=native#text/pascal +tests/test/trhlp32.pp svneol=native#text/pascal +tests/test/trhlp33.pp svneol=native#text/pascal +tests/test/trhlp34.pp svneol=native#text/pascal +tests/test/trhlp35.pp svneol=native#text/pascal +tests/test/trhlp36.pp svneol=native#text/pascal +tests/test/trhlp37.pp svneol=native#text/pascal +tests/test/trhlp38.pp svneol=native#text/pascal +tests/test/trhlp39.pp svneol=native#text/pascal +tests/test/trhlp4.pp svneol=native#text/pascal +tests/test/trhlp40.pp svneol=native#text/pascal +tests/test/trhlp41.pp svneol=native#text/pascal +tests/test/trhlp5.pp svneol=native#text/pascal +tests/test/trhlp6.pp svneol=native#text/pascal +tests/test/trhlp7.pp svneol=native#text/pascal +tests/test/trhlp8.pp svneol=native#text/pascal +tests/test/trhlp9.pp svneol=native#text/pascal tests/test/trox1.pp svneol=native#text/plain tests/test/trox2.pp svneol=native#text/plain tests/test/trstr1.pp svneol=native#text/plain @@ -10138,22 +10188,8 @@ tests/test/twrstr6.pp svneol=native#text/plain tests/test/twrstr7.pp svneol=native#text/plain tests/test/twrstr8.pp svneol=native#text/plain tests/test/uabstrcl.pp svneol=native#text/plain -tests/test/uchlp27a.pp svneol=native#text/pascal -tests/test/uchlp27b.pp svneol=native#text/pascal -tests/test/uchlp27c.pp svneol=native#text/pascal -tests/test/uchlp32a.pp svneol=native#text/pascal -tests/test/uchlp32b.pp svneol=native#text/pascal -tests/test/uchlp32c.pp svneol=native#text/pascal -tests/test/uchlp33a.pp svneol=native#text/pascal -tests/test/uchlp33b.pp svneol=native#text/pascal -tests/test/uchlp33c.pp svneol=native#text/pascal -tests/test/uchlp35.pp svneol=native#text/pascal -tests/test/uchlp45.pp svneol=native#text/pascal -tests/test/uchlp50.pp svneol=native#text/pascal -tests/test/uchlp51a.pp svneol=native#text/pascal -tests/test/uchlp51b.pp svneol=native#text/pascal -tests/test/uchlp51c.pp svneol=native#text/pascal -tests/test/uchlp82.pp svneol=native#text/pascal +tests/test/uchlp12.pp svneol=native#text/pascal +tests/test/uchlp18.pp svneol=native#text/pascal tests/test/uenum2a.pp svneol=native#text/plain tests/test/uenum2b.pp svneol=native#text/plain tests/test/ugeneric10.pp svneol=native#text/plain @@ -10162,6 +10198,12 @@ tests/test/ugeneric3.pp svneol=native#text/plain tests/test/ugeneric4.pp svneol=native#text/plain tests/test/ugeneric7.pp svneol=native#text/plain tests/test/uhintdir.pp svneol=native#text/plain +tests/test/uhlp3.pp svneol=native#text/pascal +tests/test/uhlp31.pp svneol=native#text/pascal +tests/test/uhlp39.pp svneol=native#text/pascal +tests/test/uhlp41a.pp svneol=native#text/pascal +tests/test/uhlp41b.pp svneol=native#text/pascal +tests/test/uhlp43.pp svneol=native#text/pascal tests/test/uimpluni1.pp svneol=native#text/plain tests/test/uimpluni2.pp svneol=native#text/plain tests/test/uinline4a.pp svneol=native#text/plain @@ -10325,6 +10367,8 @@ tests/test/uprec6.pp svneol=native#text/plain tests/test/uprec7.pp svneol=native#text/plain tests/test/uprocext1.pp svneol=native#text/plain tests/test/uprocext2.pp svneol=native#text/plain +tests/test/urhlp14.pp svneol=native#text/pascal +tests/test/urhlp17.pp svneol=native#text/pascal tests/test/utasout.pp svneol=native#text/plain tests/test/uunit1.pp svneol=native#text/plain tests/test/uunit2a.pp svneol=native#text/plain diff --git a/tests/test/tchlp1.pp b/tests/test/tchlp1.pp index 40b6162526..29e4bc989b 100644 --- a/tests/test/tchlp1.pp +++ b/tests/test/tchlp1.pp @@ -1,50 +1,29 @@ -{%NORUN} +{ %NORUN } -{ checks for support of the class helper syntax in mode objfpc } +{ this tests that helpers can introduce instance methods for classes - mode + Delphi } program tchlp1; -{$mode objfpc} +{$ifdef fpc} + {$mode delphi} +{$endif} type - TObjectHelper = class helper for TObject - procedure SomePublicMethod; - strict private - procedure SomeStrictPrivateMethod; - private - procedure SomePrivateMethod; - strict protected - procedure SomeStrictProtectedMethod; - protected - procedure SomeProtectedMethod; - public - procedure SomePublicMethod2; + TTest = class + end; -procedure TObjectHelper.SomePublicMethod; + TTestHelper = class helper for TTest + procedure Test; + end; + +procedure TTestHelper.Test; begin + end; -procedure TObjectHelper.SomeStrictPrivateMethod; +var + t: TTest; begin -end; - -procedure TObjectHelper.SomePrivateMethod; -begin -end; - -procedure TObjectHelper.SomeStrictProtectedMethod; -begin -end; - -procedure TObjectHelper.SomeProtectedMethod; -begin -end; - -procedure TObjectHelper.SomePublicMethod2; -begin -end; - -begin - + t.Test; end. - diff --git a/tests/test/tchlp10.pp b/tests/test/tchlp10.pp index 0bf9cddc28..5da217868a 100644 --- a/tests/test/tchlp10.pp +++ b/tests/test/tchlp10.pp @@ -1,25 +1,40 @@ { %NORUN } -{ first simple scope test for class helpers } +{ method modifiers of the extended class are completly irrelevant } program tchlp10; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} type - TObjectHelper = class helper for TObject - procedure SomeMethod; + TTest = class + procedure Test; virtual; end; -procedure TObjectHelper.SomeMethod; + TTestHelper = class helper for TTest + procedure Test; virtual; + end; + + TTestHelperSub = class helper(TTestHelper) for TTest + procedure Test; override; + end; + +procedure TTest.Test; begin end; -var - o: TObject; +procedure TTestHelper.Test; begin - o.SomeMethod; -end. +end; + +procedure TTestHelperSub.Test; +begin + +end; + +begin + +end. diff --git a/tests/test/tchlp11.pp b/tests/test/tchlp11.pp index 51294268cc..6aa4f46f5d 100644 --- a/tests/test/tchlp11.pp +++ b/tests/test/tchlp11.pp @@ -1,23 +1,20 @@ -{ %NORUN } +{ %FAIL } -{ second simple scope test for class helpers } +{ it's forbidden for a class helper to extend a record } program tchlp11; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} type - TObjectHelper = class helper for TObject - class procedure SomeMethod; + TTest = record + end; -class procedure TObjectHelper.SomeMethod; -begin - -end; + TTestHelper = class helper for TTest + end; begin - TObject.SomeMethod; + end. - diff --git a/tests/test/tchlp12.pp b/tests/test/tchlp12.pp index 42df54bd7a..fb42c91a9e 100644 --- a/tests/test/tchlp12.pp +++ b/tests/test/tchlp12.pp @@ -1,35 +1,25 @@ -{ class helpers hide methods of the extended class } +{ %FAIL } + +{ class helpers can access (strict) protected, public and published members - + here: strict private } program tchlp12; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +uses + uchlp12; + type - TFoo = class - function Test: Integer; + TTestHelper = class helper for TTest + function AccessTest: Integer; end; - TFooHelper = class helper for TFoo - function Test: Integer; - end; - -function TFoo.Test: Integer; +function TTestHelper.AccessTest: Integer; begin - Result := 1; + Result := Test1; end; -function TFooHelper.Test: Integer; begin - Result := 2; -end; - -var - f: TFoo; -begin - f := TFoo.Create; - if f.Test <> 2 then - Halt(1); - Writeln('ok'); end. - diff --git a/tests/test/tchlp13.pp b/tests/test/tchlp13.pp index 7f70e0c426..5ee3f5334a 100644 --- a/tests/test/tchlp13.pp +++ b/tests/test/tchlp13.pp @@ -1,44 +1,26 @@ -{ class helpers don't hide methods of the subclasses of the extended class } +{ %FAIL } + +{ class helpers can access (strict) protected, public and published members - + here: private } program tchlp13; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +uses + uchlp12; + type - TFoo = class - function Test: Integer; + TTestHelper = class helper for TTest + function AccessTest: Integer; end; - TFooHelper = class helper for TFoo - function Test: Integer; - end; - - TFooSub = class(TFoo) - function Test: Integer; - end; - -function TFoo.Test: Integer; +function TTestHelper.AccessTest: Integer; begin - Result := 1; + Result := Test2; end; -function TFooHelper.Test: Integer; begin - Result := 2; -end; - -function TFooSub.Test: Integer; -begin - Result := 3; -end; - -var - f: TFooSub; -begin - f := TFooSub.Create; - if f.Test <> 3 then - Halt(1); - Writeln('ok'); end. diff --git a/tests/test/tchlp14.pp b/tests/test/tchlp14.pp index 86f61d4969..585a82a593 100644 --- a/tests/test/tchlp14.pp +++ b/tests/test/tchlp14.pp @@ -1,32 +1,26 @@ -{ %FAIL } +{ %NORUN } -{ class helpers must not override virtual methods of the extended class } +{ class helpers can access (strict) protected, public and published members - + here: strict protected } program tchlp14; {$ifdef fpc} {$mode delphi} {$endif} +uses + uchlp12; + type - TFoo = class - function Test: Integer; virtual; + TTestHelper = class helper for TTest + function AccessTest: Integer; end; - TFooHelper = class helper for TFoo - function Test: Integer; override; - end; - -function TFoo.Test: Integer; +function TTestHelper.AccessTest: Integer; begin - Result := 1; -end; - -function TFooHelper.Test: Integer; -begin - Result := 2; + Result := Test3; end; begin - end. diff --git a/tests/test/tchlp15.pp b/tests/test/tchlp15.pp index 0f2c8c8e9d..e391a85a5c 100644 --- a/tests/test/tchlp15.pp +++ b/tests/test/tchlp15.pp @@ -1,35 +1,26 @@ -{ class helpers may hide virtual methods of the extended class } +{ %NORUN } + +{ class helpers can access (strict) protected, public and published members - + here: protected } program tchlp15; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +uses + uchlp12; + type - TFoo = class - function Test: Integer; virtual; + TTestHelper = class helper for TTest + function AccessTest: Integer; end; - TFooHelper = class helper for TFoo - function Test: Integer; - end; - -function TFoo.Test: Integer; +function TTestHelper.AccessTest: Integer; begin - Result := 1; + Result := Test4; end; -function TFooHelper.Test: Integer; begin - Result := 2; -end; - -var - f: TFoo; -begin - f := TFoo.Create; - if f.Test <> 2 then - Halt(1); - Writeln('ok'); end. diff --git a/tests/test/tchlp16.pp b/tests/test/tchlp16.pp index 470690f3fc..ee67fcd710 100644 --- a/tests/test/tchlp16.pp +++ b/tests/test/tchlp16.pp @@ -1,18 +1,26 @@ -{ %FAIL } +{ %NORUN } -{ class helpers may not be referenced in any way - test 1 } +{ class helpers can access (strict) protected, public and published members - + here: public } program tchlp16; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +uses + uchlp12; + type - TObjectHelper = class helper for TObject + TTestHelper = class helper for TTest + function AccessTest: Integer; end; -var - o: TObjectHelper; +function TTestHelper.AccessTest: Integer; +begin + Result := Test5; +end; + begin end. diff --git a/tests/test/tchlp17.pp b/tests/test/tchlp17.pp index 4116ef47fe..a8bd7c0c90 100644 --- a/tests/test/tchlp17.pp +++ b/tests/test/tchlp17.pp @@ -1,17 +1,26 @@ -{ %FAIL } +{ %NORUN } -{ class helpers may not be referenced in any way - test 2 } +{ class helpers can access (strict) protected, public and published members - + here: published } program tchlp17; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +uses + uchlp12; + type - TObjectHelper = class helper for TObject + TTestHelper = class helper for TTest + function AccessTest: Integer; end; +function TTestHelper.AccessTest: Integer; +begin + Result := Test6; +end; + begin - with TObjectHelper.Create do ; end. diff --git a/tests/test/tchlp18.pp b/tests/test/tchlp18.pp index 9640d5b7c4..6228b02f67 100644 --- a/tests/test/tchlp18.pp +++ b/tests/test/tchlp18.pp @@ -1,23 +1,18 @@ { %FAIL } -{ class helpers may not be referenced in any way - test 3 } +{ usage of nested helpers adheres to visibility rules as well - here: + strict private } program tchlp18; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -type - TObjectHelper = class helper for TObject - class procedure Test; - end; +uses + uchlp18; -class procedure TObjectHelper.Test; +var + t: TTest1; begin - -end; - -begin - TObjectHelper.Test; + t.Test; end. - diff --git a/tests/test/tchlp19.pp b/tests/test/tchlp19.pp index b63dde6b4a..a0fa3f7686 100644 --- a/tests/test/tchlp19.pp +++ b/tests/test/tchlp19.pp @@ -1,21 +1,19 @@ { %FAIL } -{ class helpers may not be referenced in any way - test 4 } +{ usage of nested helpers adheres to visibility rules as well - here: + private } program tchlp19; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -type - TObjectHelper = class helper for TObject - end; - -procedure SomeProc(aHelper: TObjectHelper); -begin - -end; +uses + uchlp18; +var + t: TTest2; begin + t.Test; end. diff --git a/tests/test/tchlp2.pp b/tests/test/tchlp2.pp index b3976b8b3e..f21450e5a8 100644 --- a/tests/test/tchlp2.pp +++ b/tests/test/tchlp2.pp @@ -1,6 +1,7 @@ -{%NORUN} +{ %NORUN } -{ checks for support of the class helper syntax in mode delphi } +{ this tests that helpers can introduce class methods for classes - mode + Delphi } program tchlp2; {$ifdef fpc} @@ -8,45 +9,20 @@ program tchlp2; {$endif} type - TObjectHelper = class helper for TObject - procedure SomePublicMethod; - strict private - procedure SomeStrictPrivateMethod; - private - procedure SomePrivateMethod; - strict protected - procedure SomeStrictProtectedMethod; - protected - procedure SomeProtectedMethod; - public - procedure SomePublicMethod2; + TTest = class + end; -procedure TObjectHelper.SomePublicMethod; -begin -end; + TTestHelper = class helper for TTest + class procedure Test; + end; -procedure TObjectHelper.SomeStrictPrivateMethod; +class procedure TTestHelper.Test; begin -end; -procedure TObjectHelper.SomePrivateMethod; -begin -end; - -procedure TObjectHelper.SomeStrictProtectedMethod; -begin -end; - -procedure TObjectHelper.SomeProtectedMethod; -begin -end; - -procedure TObjectHelper.SomePublicMethod2; -begin end; begin - + TTest.Test; end. diff --git a/tests/test/tchlp20.pp b/tests/test/tchlp20.pp index a4359f9d3d..1af5fe4d1d 100644 --- a/tests/test/tchlp20.pp +++ b/tests/test/tchlp20.pp @@ -1,20 +1,19 @@ { %FAIL } -{ class helpers may not be referenced in any way - test 5 } +{ usage of nested helpers adheres to visibility rules as well - here: + strict protected } program tchlp20; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -type - TObjectHelper = class helper for TObject - end; - - TSomeRec = record - helper: TObjectHelper; - end; +uses + uchlp18; +var + t: TTest3; begin + t.Test; end. diff --git a/tests/test/tchlp21.pp b/tests/test/tchlp21.pp index 124c7d5daf..5d9d4911e2 100644 --- a/tests/test/tchlp21.pp +++ b/tests/test/tchlp21.pp @@ -1,19 +1,19 @@ { %FAIL } -{ class helpers may not be referenced in any way - test 6 } -program tchlp21; +{ usage of nested helpers adheres to visibility rules as well - here: + protected } +program tchlp18; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -type - TObjectHelper = class helper for TObject - end; - - TObjectHelperHelper = class helper for TObjectHelper - end; +uses + uchlp18; +var + t: TTest4; begin + t.Test; end. diff --git a/tests/test/tchlp22.pp b/tests/test/tchlp22.pp index 822ba3966c..bdd074b272 100644 --- a/tests/test/tchlp22.pp +++ b/tests/test/tchlp22.pp @@ -1,35 +1,19 @@ -{ %FAIL } +{ %NORUN } -{ overloading needs to be enabled explicitly } +{ usage of nested helpers adheres to visibility rules as well - here: + public } program tchlp22; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -type - TFoo = class - procedure Test(const aTest: String); - end; - - TFooHelper = class helper for TFoo - procedure Test; - end; - -procedure TFoo.Test(const aTest: String); -begin - -end; - -procedure TFooHelper.Test; -begin - -end; +uses + uchlp18; var - f: TFoo; + t: TTest5; begin - f := TFoo.Create; - f.Test('Foo'); + t.Test; end. diff --git a/tests/test/tchlp23.pp b/tests/test/tchlp23.pp index d7ef2b824b..eb500e89a0 100644 --- a/tests/test/tchlp23.pp +++ b/tests/test/tchlp23.pp @@ -1,36 +1,19 @@ { %NORUN } -{ overloading needs to be enabled explicitly } +{ usage of nested helpers adheres to visibility rules as well - here: + published } program tchlp23; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -type - TFoo = class - procedure Test(const aTest: String); - end; - - TFooHelper = class helper for TFoo - procedure Test; overload; - end; - -procedure TFoo.Test(const aTest: String); -begin - -end; - -procedure TFooHelper.Test; -begin - -end; +uses + uchlp18; var - f: TFoo; + t: TTest6; begin - f := TFoo.Create; - f.Test; - f.Test('Foo'); + t.Test; end. diff --git a/tests/test/tchlp24.pp b/tests/test/tchlp24.pp index 077c7e88d0..9d0604d9d6 100644 --- a/tests/test/tchlp24.pp +++ b/tests/test/tchlp24.pp @@ -1,19 +1,42 @@ -{ %FAIL } - -{ class helpers may not be referenced in any way - test 7 } +{ published methods of class helpers are not accessible through the extended + class' RTTI } program tchlp24; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +{$apptype console} type - TObjectHelper = class helper for TObject +{$M+} + TTest = class end; +{$M-} - TObjectHelperSub = class(TObjectHelper) +{$M+} + TTestHelper = class helper for TTest + published + function Test: Integer; end; +{$M-} +function TTestHelper.Test: Integer; begin -end. + Result := 1; +end; +var + f: TTest; + res: Pointer; +begin + f := TTest.Create; + res := f.MethodAddress('Test'); +{$ifdef fpc} + Writeln('Address of TTest.Test: ', PtrInt(res)); +{$else} + Writeln('Address of TTest.Test: ', NativeInt(res)); +{$endif} + if res <> Nil then + Halt(1); + Writeln('ok'); +end. diff --git a/tests/test/tchlp25.pp b/tests/test/tchlp25.pp index 8553ec35d1..703b80bcde 100644 --- a/tests/test/tchlp25.pp +++ b/tests/test/tchlp25.pp @@ -1,17 +1,23 @@ -{ %FAIL } +{ %NORUN } -{ class helpers may not contain any fields } +{ class helpers can extend a subclass of the parent's extended class } program tchlp25; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} type TObjectHelper = class helper for TObject - Test: Integer; + end; + + TTest = class + end; + + TTestHelper = class helper(TObjectHelper) for TTest end; begin + end. diff --git a/tests/test/tchlp26.pp b/tests/test/tchlp26.pp index e9cecd704e..bbfb632292 100644 --- a/tests/test/tchlp26.pp +++ b/tests/test/tchlp26.pp @@ -1,23 +1,20 @@ -{ %NORUN } +{ %FAIL } -{ class helpers can extend a subclass of the parent's extended class } +{ a class helper can only inherit from another class helper } program tchlp26; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} type - TObjectHelperA = class helper for TObject + TTest = class + end; - TFoo = class - end; - - TObjectHelperB = class helper(TObjectHelperA) for TFoo + TObjectHelper = class helper(TTest) for TObject end; begin - end. diff --git a/tests/test/tchlp27.pp b/tests/test/tchlp27.pp index 0ec571aa12..d502ef869f 100644 --- a/tests/test/tchlp27.pp +++ b/tests/test/tchlp27.pp @@ -1,22 +1,26 @@ -{ extensive scoping test - test 1 } +{ %FAIL } + +{ a class helper must extend a subclass of the parent class helper } program tchlp27; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -uses - uchlp27a, uchlp27b; +type + TTest1 = class + + end; + + TTest1Helper = class helper for TTest1 + end; + + TTest2 = class + + end; + + TTest2Helper = class helper(TTest1Helper) for TTest2 + end; -var - f: TFoo; - res: Integer; begin - f := TFoo.Create; - res := f.Test; - Writeln('f.Test: ', res); - if res <> 2 then - Halt(1); - Writeln('ok'); end. - diff --git a/tests/test/tchlp28.pp b/tests/test/tchlp28.pp index 9be0a490ad..85713c2b17 100644 --- a/tests/test/tchlp28.pp +++ b/tests/test/tchlp28.pp @@ -1,30 +1,35 @@ -{ extensive scoping test - test 2 } +{ class helpers hide methods of the extended class } program tchlp28; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -uses - uchlp27a, uchlp27b, uchlp27c; +type + TTest = class + function Test: Integer; + end; + + TTestHelper = class helper for TTest + function Test: Integer; + end; + +function TTest.Test: Integer; +begin + Result := 1; +end; + +function TTestHelper.Test: Integer; +begin + Result := 2; +end; var - f: TFoo; - b: TBar; - res: Integer; + t: TTest; begin - f := TBar.Create; - res := f.Test; - Writeln('f.Test: ', res); - if res <> 2 then + t := TTest.Create; + if t.Test <> 2 then Halt(1); - - b := TBar.Create; - res := b.Test; - Writeln('b.Test: ', res); - if res <> 3 then - Halt(2); - Writeln('ok'); end. diff --git a/tests/test/tchlp29.pp b/tests/test/tchlp29.pp index 22e5856f11..825fbe0837 100644 --- a/tests/test/tchlp29.pp +++ b/tests/test/tchlp29.pp @@ -1,30 +1,44 @@ -{ extensive scoping test - test 3 } +{ class helpers don't hide methods of the subclasses of the extended class } program tchlp29; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -uses - uchlp27a, uchlp27c, uchlp27b; +type + TTest = class + function Test: Integer; + end; + + TTestHelper = class helper for TTest + function Test: Integer; + end; + + TTestSub = class(TTest) + function Test: Integer; + end; + +function TTest.Test: Integer; +begin + Result := 1; +end; + +function TTestHelper.Test: Integer; +begin + Result := 2; +end; + +function TTestSub.Test: Integer; +begin + Result := 3; +end; var - f: TFoo; - b: TBar; - res: Integer; + t: TTestSub; begin - f := TBar.Create; - res := f.Test; - Writeln('f.Test: ', res); - if res <> 2 then + t := TTestSub.Create; + if t.Test <> 3 then Halt(1); - - b := TBar.Create; - res := b.Test; - Writeln('b.Test: ', res); - if res <> 3 then - Halt(2); - Writeln('ok'); end. diff --git a/tests/test/tchlp3.pp b/tests/test/tchlp3.pp index bf1f6f28f6..abbf6f926c 100644 --- a/tests/test/tchlp3.pp +++ b/tests/test/tchlp3.pp @@ -1,6 +1,7 @@ -{%FAIL} +{ %NORUN } -{ forward declarations are not allowed } +{ this tests that helpers can introduce instance methods for classes - mode + ObjFPC } program tchlp3; {$ifdef fpc} @@ -8,12 +9,22 @@ program tchlp3; {$endif} type - TObjectHelper = class helper for TObject; + TTest = class - TObjectHelper = class helper for TObject end; + TTestHelper = class helper for TTest + procedure Test; + end; + +procedure TTestHelper.Test; begin +end; + +var + t: TTest; +begin + t.Test; end. diff --git a/tests/test/tchlp30.pp b/tests/test/tchlp30.pp index 08eb88ede0..b7111071f3 100644 --- a/tests/test/tchlp30.pp +++ b/tests/test/tchlp30.pp @@ -1,23 +1,31 @@ -{ extensive scoping test - test 4 } +{ %FAIL } + +{ helpers must not override virtual methods of the extended class } program tchlp30; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -uses - uchlp27b, uchlp27a; +type + TTest = class + function Test: Integer; virtual; + end; + + TTestHelper = class helper for TTest + function Test: Integer; override; + end; + +function TTest.Test: Integer; +begin + +end; + +function TTestHelper.Test: Integer; +begin + +end; -var - f: TFoo; - res: Integer; begin - f := TFoo.Create; - res := f.Test; - Writeln('f.Test: ', res); - if res <> 2 then - Halt(1); - Writeln('ok'); end. - diff --git a/tests/test/tchlp31.pp b/tests/test/tchlp31.pp index a1c881c342..a349cff6c8 100644 --- a/tests/test/tchlp31.pp +++ b/tests/test/tchlp31.pp @@ -1,23 +1,35 @@ -{ extensive scoping test - test 5 } +{ helpers may hide virtual methods of the extended class } program tchlp31; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -uses - uchlp27b, uchlp27c; +type + TTest = class + function Test: Integer; virtual; + end; + + TTestHelper = class helper for TTest + function Test: Integer; + end; + +function TTest.Test: Integer; +begin + Result := 1; +end; + +function TTestHelper.Test: Integer; +begin + Result := 2; +end; var - b: TBar; - res: Integer; + t: TTest; begin - b := TBar.Create; - res := b.Test; - Writeln('b.Test: ', res); - if res <> 3 then + t := TTest.Create; + if t.Test <> 2 then Halt(1); - Writeln('ok'); end. diff --git a/tests/test/tchlp32.pp b/tests/test/tchlp32.pp index e3dbd9d947..4baa217a08 100644 --- a/tests/test/tchlp32.pp +++ b/tests/test/tchlp32.pp @@ -1,19 +1,35 @@ { %FAIL } -{ only the last available class helper for a class must be used - test 1 } +{ overloading needs to be enabled explicitly } program tchlp32; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -uses - uchlp32a, uchlp32b, uchlp32c; +type + TTest = class + procedure Test(const aTest: String); + end; + + TTestHelper = class helper for TTest + procedure Test; + end; + +procedure TTest.Test(const aTest: String); +begin + +end; + +procedure TTestHelper.Test; +begin + +end; var - f: TFoo; + t: TTest; begin - f := TFoo.Create; - f.Method1; + t := TTest.Create; + t.Test('Foo'); end. diff --git a/tests/test/tchlp33.pp b/tests/test/tchlp33.pp index 41ecd6b1db..b6b0770543 100644 --- a/tests/test/tchlp33.pp +++ b/tests/test/tchlp33.pp @@ -1,22 +1,36 @@ -{ only the last available class helper for a class must be used - test 2 } +{ %NORUN } + +{ overloading needs to be enabled explicitly } program tchlp33; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} -uses - uchlp33a, uchlp33c, uchlp33b; +type + TTest = class + procedure Test(const aTest: String); + end; + + TTestHelper = class helper for TTest + procedure Test; overload; + end; + +procedure TTest.Test(const aTest: String); +begin + +end; + +procedure TTestHelper.Test; +begin + +end; var - f: TFoo; - res: Integer; + t: TTest; begin - f := TFoo.Create; - res := f.Test; - Writeln('f.Test: ', res); - if res <> 1 then - Halt(1); - Writeln('ok'); + t := TTest.Create; + t.Test; + t.Test('Foo'); end. diff --git a/tests/test/tchlp34.pp b/tests/test/tchlp34.pp index d5bf731c39..40531d8fca 100644 --- a/tests/test/tchlp34.pp +++ b/tests/test/tchlp34.pp @@ -1,20 +1,30 @@ -{ %FAIL } +{ %NORUN } -{ a class helper can only inherit from another class helper } +{ a helper can already be accessed when implementing a class' methods } program tchlp34; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} type - TFoo = class - + TTest = class + procedure Test; end; - TObjectHelper = class helper(TFoo) for TObject + TTestHelper = class helper for TTest + procedure DoSomething; end; +procedure TTest.Test; +begin + DoSomething; +end; + +procedure TTestHelper.DoSomething; +begin + +end; + begin end. - diff --git a/tests/test/tchlp35.pp b/tests/test/tchlp35.pp index 62acae08d8..1eada42b81 100644 --- a/tests/test/tchlp35.pp +++ b/tests/test/tchlp35.pp @@ -1,4 +1,4 @@ -{ tests virtual methods inside class helpers } +{ helper methods also influence calls to a parent's method in a derived class } program tchlp35; {$ifdef fpc} @@ -6,26 +6,42 @@ program tchlp35; {$endif} {$apptype console} -uses - uchlp35; - type - TObjectHelperB = class helper(TObjectHelperA) for TObject - function VirtualTest: Integer; override; + TTest = class + function Test: Integer; end; -function TObjectHelperB.VirtualTest: Integer; + TTestSub = class(TTest) + function AccessTest: Integer; + end; + + TTestHelper = class helper for TTest + function Test: Integer; + end; + +function TTest.Test: Integer; +begin + Result := 1; +end; + +function TTestSub.AccessTest: Integer; +begin + Result := Test; +end; + +function TTestHelper.Test: Integer; begin Result := 2; end; var - o: TObject; + t: TTestSub; res: Integer; begin - o := TObject.Create; - res := o.Test; + t := TTestSub.Create; + res := t.AccessTest; + Writeln('f.AccessTest: ', res); if res <> 2 then Halt(1); + Writeln('ok'); end. - diff --git a/tests/test/tchlp36.pp b/tests/test/tchlp36.pp index d445383d49..f1b8ece509 100644 --- a/tests/test/tchlp36.pp +++ b/tests/test/tchlp36.pp @@ -1,31 +1,48 @@ -{ %FAIL } - -{ a class helper must extend a subclass of the parent class helper } +{ helper methods also influence calls to a parent's method in a derived class } program tchlp36; {$ifdef fpc} {$mode delphi} {$endif} +{$apptype console} type - TBar = class - + TTest = class + function Test: Integer; end; - TBarHelper = class helper for TBar - procedure Test; + TTestSub = class(TTest) + function AccessTest: Integer; end; - TFoo = class - + TTestHelper = class helper for TTest + function Test: Integer; end; - TFooHelper = class helper(TBarHelper) for TFoo - end; - -procedure TBarHelper.Test; +function TTest.Test: Integer; begin + Result := 1; end; +function TTestSub.AccessTest: Integer; begin + Result := inherited Test; +end; + +function TTestHelper.Test: Integer; +begin + Result := 2; +end; + +var + t: TTestSub; + res: Integer; +begin + t := TTestSub.Create; + res := t.AccessTest; + Writeln('f.AccessTest: ', res); + if res <> 2 then + Halt(1); + Writeln('ok'); end. + diff --git a/tests/test/tchlp37.pp b/tests/test/tchlp37.pp index f7e1a180f6..f8aa52a64d 100644 --- a/tests/test/tchlp37.pp +++ b/tests/test/tchlp37.pp @@ -1,47 +1,33 @@ -{ a parent class helper's methods are available in a child class helper } +{ %NORUN } + +{ helpers of a parent are available in a subclass as well } program tchlp37; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} {$apptype console} type - TFoo = class - function Test: Integer; + TTest = class + end; - TFooHelper = class helper for TFoo - function Test: Integer; + TTestSub = class(TTest) + end; - TFooBarHelper = class helper(TFooHelper) for TFoo - function AccessTest: Integer; + TTestHelper = class helper for TTest + procedure Test; end; -function TFoo.Test: Integer; +procedure TTestHelper.Test; begin - Result := 1; -end; -function TFooHelper.Test: Integer; -begin - Result := 2; -end; - -function TFooBarHelper.AccessTest: Integer; -begin - Result := Test; end; var - f: TFoo; - res: Integer; + t: TTestSub; begin - f := TFoo.Create; - res := f.AccessTest; - Writeln(res); - if res <> 2 then - Halt(1); - Writeln('ok'); + t.Test; end. diff --git a/tests/test/tchlp38.pp b/tests/test/tchlp38.pp index 4b1ae20745..ecf1f0fcf5 100644 --- a/tests/test/tchlp38.pp +++ b/tests/test/tchlp38.pp @@ -1,41 +1,42 @@ -{ methods of the extended class can be called using "inherited" } +{ a helper of a parent class hides the parent's methods } program tchlp38; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} {$apptype console} type - TFoo = class - function Test(aRecurse: Boolean): Integer; + TTest = class + function Test: Integer; end; - TFooHelper = class helper for TFoo - function Test(aRecurse: Boolean): Integer; + TTestSub = class(TTest) + end; -function TFoo.Test(aRecurse: Boolean): Integer; + TTestHelper = class helper for TTest + function Test: Integer; + end; + +function TTest.Test: Integer; begin Result := 1; end; -function TFooHelper.Test(aRecurse: Boolean): Integer; +function TTestHelper.Test: Integer; begin - if aRecurse then - Result := inherited Test(False) - else - Result := 2; + Result := 2; end; var - f: TFoo; + t: TTestSub; res: Integer; begin - f := TFoo.Create; - res := f.Test(True); - Writeln('f.Test: ', res); - if res <> 1 then + t := TTestSub.Create; + res := t.Test; + Writeln('b.TestFoo: ', res); + if res <> 2 then Halt(1); Writeln('ok'); end. diff --git a/tests/test/tchlp39.pp b/tests/test/tchlp39.pp index 3e2a429a64..351b6af3aa 100644 --- a/tests/test/tchlp39.pp +++ b/tests/test/tchlp39.pp @@ -1,51 +1,51 @@ -{ the extended class has higher priority than the parent class when - searching for symbols } -program tchlp39; +{ a helper of a parent class hides methods in the child class if its also a + parent of the helper for the child class } +program tchlp90; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} {$apptype console} type - TFoo = class - function Test(aRecurse: Boolean): Integer; + TTest = class + function Test: Integer; end; - TFooHelper = class helper for TFoo - function Test(aRecurse: Boolean): Integer; + TTestSub = class(TTest) + function Test: Integer; end; - TFooSubHelper = class helper(TFooHelper) for TFoo - function Test(aRecurse: Boolean): Integer; + TTestHelper = class helper for TTest + function Test: Integer; end; -function TFoo.Test(aRecurse: Boolean): Integer; + TTestSubHelper = class helper(TTestHelper) for TTestSub + end; + +function TTest.Test: Integer; begin Result := 1; end; -function TFooHelper.Test(aRecurse: Boolean): Integer; +function TTestSub.Test: Integer; +begin + Result := 4; +end; + +function TTestHelper.Test: Integer; begin Result := 2; end; -function TFooSubHelper.Test(aRecurse: Boolean): Integer; -begin - if aRecurse then - Result := inherited Test(False) - else - Result := 3; -end; - var - f: TFoo; + t: TTestSub; res: Integer; begin - f := TFoo.Create; - res := f.Test(True); - Writeln('f.Test: ', res); - if res <> 1 then + t := TTestSub.Create; + res := t.Test; + Writeln('b.TestFoo: ', res); + if res <> 2 then Halt(1); Writeln('ok'); end. diff --git a/tests/test/tchlp4.pp b/tests/test/tchlp4.pp index ffcdbf2a93..cbcdef3440 100644 --- a/tests/test/tchlp4.pp +++ b/tests/test/tchlp4.pp @@ -1,18 +1,28 @@ -{%FAIL} +{ %NORUN } -{ destructors are not allowed } +{ this tests that helpers can introduce class methods for classes - mode + ObjFPC } program tchlp4; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} type - TObjectHelper = class helper for TObject - destructor Destroy; override; + TTest = class + end; + TTestHelper = class helper for TTest + class procedure Test; + end; + +class procedure TTestHelper.Test; begin +end; + +begin + TTest.Test; end. diff --git a/tests/test/tchlp40.pp b/tests/test/tchlp40.pp index 72dcf58e45..c699714b42 100644 --- a/tests/test/tchlp40.pp +++ b/tests/test/tchlp40.pp @@ -1,4 +1,4 @@ -{ published is allowed in mode Delphi, but unusable } +{ methods of the extended class can be called using "inherited" } program tchlp40; {$ifdef fpc} @@ -7,33 +7,35 @@ program tchlp40; {$apptype console} type - {$M+} - TFoo = class - end; - {$M-} - - TFooHelper = class helper for TFoo - published - function Test: Integer; + TTest = class + function Test(aRecurse: Boolean): Integer; end; -function TFooHelper.Test: Integer; + TTestHelper = class helper for TTest + function Test(aRecurse: Boolean): Integer; + end; + +function TTest.Test(aRecurse: Boolean): Integer; begin Result := 1; end; -var - f: TFoo; - res: Pointer; +function TTestHelper.Test(aRecurse: Boolean): Integer; begin - f := TFoo.Create; - res := f.MethodAddress('Test'); -{$ifdef fpc} - Writeln('Address of TFoo.Test: ', res); -{$else} - Writeln('Address of TFoo.Test: ', Integer(res)); -{$endif} - if res <> Nil then + if aRecurse then + Result := inherited Test(False) + else + Result := 2; +end; + +var + t: TTest; + res: Integer; +begin + t := TTest.Create; + res := t.Test(True); + Writeln('t.Test: ', res); + if res <> 1 then Halt(1); Writeln('ok'); end. diff --git a/tests/test/tchlp41.pp b/tests/test/tchlp41.pp index 6d89477fc1..0617943acd 100644 --- a/tests/test/tchlp41.pp +++ b/tests/test/tchlp41.pp @@ -1,25 +1,51 @@ -{ %FAIL } - -{ puplished members are not allowed in mode objfpc } +{ the extended class has higher priority than the parent class when + searching for symbols } program tchlp41; -{$mode objfpc} +{$ifdef fpc} + {$mode delphi} +{$endif} +{$apptype console} type - {$M+} - TFoo = class - end; - {$M-} - - TFooHelper = class helper for TFoo - published - function Test: Integer; + TTest = class + function Test(aRecurse: Boolean): Integer; end; -function TFooHelper.Test: Integer; + TTestHelper = class helper for TTest + function Test(aRecurse: Boolean): Integer; + end; + + TTestHelperSub = class helper(TTestHelper) for TTest + function Test(aRecurse: Boolean): Integer; + end; + +function TTest.Test(aRecurse: Boolean): Integer; begin Result := 1; end; +function TTestHelper.Test(aRecurse: Boolean): Integer; begin + Result := 2; +end; + +function TTestHelperSub.Test(aRecurse: Boolean): Integer; +begin + if aRecurse then + Result := inherited Test(False) + else + Result := 3; +end; + +var + t: TTest; + res: Integer; +begin + t := TTest.Create; + res := t.Test(True); + Writeln('t.Test: ', res); + if res <> 1 then + Halt(1); + Writeln('ok'); end. diff --git a/tests/test/tchlp42.pp b/tests/test/tchlp42.pp index 6291eb713f..aa304259f4 100644 --- a/tests/test/tchlp42.pp +++ b/tests/test/tchlp42.pp @@ -1,74 +1,51 @@ -{ a class helper may introduce a enumerator } +{ the extended type is searched first for a inherited method even if it's + defined as "override" } program tchlp42; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} {$apptype console} type - TContainer = class - Contents: array[0..5] of Integer; - constructor Create; + TTest = class + function Test(aRecurse: Boolean): Integer; virtual; end; - TContainerEnum = class - private - fIndex: Integer; - fContainer: TContainer; - public - constructor Create(aContainer: TContainer); - function GetCurrent: Integer; - function MoveNext: Boolean; - property Current: Integer read GetCurrent; + TObjectHelper = class helper for TObject + function Test(aRecurse: Boolean): Integer; virtual; end; - TContainerHelper = class helper for TContainer - function GetEnumerator: TContainerEnum; + TTestHelper = class helper(TObjectHelper) for TTest + function Test(aRecurse: Boolean): Integer; override; end; -{ TContainer } - -constructor TContainer.Create; -var - i: Integer; +function TTest.Test(aRecurse: Boolean): Integer; begin - for i := Low(Contents) to High(Contents) do - Contents[i] := High(Contents) - i; + Result := 1; end; -{ TContainerHelper } - -function TContainerHelper.GetEnumerator: TContainerEnum; +function TObjectHelper.Test(aRecurse: Boolean): Integer; begin - Result := TContainerEnum.Create(Self); + Result := 2; end; -{ TContainerEnum } - -constructor TContainerEnum.Create(aContainer: TContainer); +function TTestHelper.Test(aRecurse: Boolean): Integer; begin - fContainer := aContainer; - fIndex := Low(fContainer.Contents) - 1; -end; - -function TContainerEnum.GetCurrent: Integer; -begin - Result := fContainer.Contents[fIndex]; -end; - -function TContainerEnum.MoveNext: Boolean; -begin - Inc(fIndex); - Result := fIndex <= High(fContainer.Contents); + if aRecurse then + Result := inherited Test(False) + else + Result := 3; end; var - cont: TContainer; - i: Integer; + t: TTest; + res: Integer; begin - cont := TContainer.Create; - for i in cont do - Writeln(i); + t := TTest.Create; + res := t.Test(True); + Writeln('t.Test: ', res); + if res <> 1 then + Halt(1); Writeln('ok'); end. diff --git a/tests/test/tchlp43.pp b/tests/test/tchlp43.pp index de9437267f..1a9cb229fe 100644 --- a/tests/test/tchlp43.pp +++ b/tests/test/tchlp43.pp @@ -1,51 +1,35 @@ -{ the extended type is searched first for a inherited method even if it's - defined as "override" } +{ %NORUN } + +{ for helpers Self always refers to the extended class } program tchlp43; {$ifdef fpc} - {$mode delphi} + {$mode objfpc} {$endif} -{$apptype console} type - TFoo = class - function Test(aRecurse: Boolean): Integer; virtual; + TTest = class + procedure DoTest(aTest: TTest); end; - TObjectHelper = class helper for TObject - function Test(aRecurse: Boolean): Integer; virtual; + TTestHelper = class helper for TTest + procedure Test; end; - TFooHelper = class helper(TObjectHelper) for TFoo - function Test(aRecurse: Boolean): Integer; override; - end; - -function TFoo.Test(aRecurse: Boolean): Integer; +procedure TTest.DoTest(aTest: TTest); begin - Result := 1; + end; -function TObjectHelper.Test(aRecurse: Boolean): Integer; +procedure TTestHelper.Test; begin - Result := 2; -end; - -function TFooHelper.Test(aRecurse: Boolean): Integer; -begin - if aRecurse then - Result := inherited Test(False) - else - Result := 3; + DoTest(Self); end; var - f: TFoo; - res: Integer; + t: TTest; begin - f := TFoo.Create; - res := f.Test(True); - Writeln('f.Test: ', res); - if res <> 1 then - Halt(1); - Writeln('ok'); + t := TTest.Create; + t.Test; end. + diff --git a/tests/test/tchlp44.pp b/tests/test/tchlp44.pp index bead514815..af47eff0cd 100644 --- a/tests/test/tchlp44.pp +++ b/tests/test/tchlp44.pp @@ -1,49 +1,49 @@ -{ in a parent class helper Self always is of the type of the extended class } +{ in a class helper Self always is of the type of the extended class } program tchlp44; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} {$apptype console} type - TFoo = class + TTest = class function Test: Integer; end; - TBar = class(TFoo) + TTestSub = class(TTest) function Test: Integer; end; - TFooHelper = class helper for TFoo + TTestHelper = class helper for TTest function AccessTest: Integer; end; - TBarHelper = class helper(TFooHelper) for TBar + TTestSubHelper = class helper(TTestHelper) for TTestSub end; -function TFoo.Test: Integer; +function TTest.Test: Integer; begin Result := 1; end; -function TBar.Test: Integer; +function TTestSub.Test: Integer; begin Result := 2; end; -function TFooHelper.AccessTest: Integer; +function TTestHelper.AccessTest: Integer; begin Result := Test; end; var - b: TBar; + t: TTestSub; res: Integer; begin - b := TBar.Create; - res := b.AccessTest; - Writeln('b.AccessTest: ', res); + t := TTestSub.Create; + res := t.AccessTest; + Writeln('t.AccessTest: ', res); if res <> 1 then Halt(1); Writeln('ok'); diff --git a/tests/test/tchlp45.pp b/tests/test/tchlp45.pp index 282f3bff9c..0db08ceb01 100644 --- a/tests/test/tchlp45.pp +++ b/tests/test/tchlp45.pp @@ -1,19 +1,35 @@ -{ %FAIL } +{ %NORUN } -{ access to methods must adhere to visibility rules (here: strict private) } +{ tests whether the methods of a parent helper are usable in a derived helper } program tchlp45; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} {$apptype console} -uses - uchlp45; +type + TTest = class + + end; + + TTestHelper = class helper for TTest + procedure Test; + end; + + TTestHelperSub = class helper(TTestHelper) for TTest + procedure AccessTest; + end; + +procedure TTestHelper.Test; +begin + +end; + +procedure TTestHelperSub.AccessTest; +begin + Test; +end; -var - f: TFoo; begin - f := TFoo.Create; - f.Test1; end. diff --git a/tests/test/tchlp46.pp b/tests/test/tchlp46.pp index f29caa83a9..08c69bc414 100644 --- a/tests/test/tchlp46.pp +++ b/tests/test/tchlp46.pp @@ -1,18 +1,46 @@ -{ %FAIL } - -{ access to methods must adhere to visibility rules (here: private)} +{ test that helpers can access the methods of the parent helper using + "inherited" } program tchlp46; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +{$apptype console} -uses - uchlp45; +type + TTest = class + + end; + + TTestHelper = class helper for TTest + function Test(aRecurse: Boolean): Integer; + end; + + TTestHelperSub = class helper(TTestHelper) for TTest + function Test(aRecurse: Boolean): Integer; + end; + +function TTestHelper.Test(aRecurse: Boolean): Integer; +begin + Result := 1; +end; + +function TTestHelperSub.Test(aRecurse: Boolean): Integer; +begin + if aRecurse then + Result := inherited Test(False) + else + Result := 2; +end; var - f: TFoo; + t: TTest; + res: Integer; begin - f := TFoo.Create; - f.Test2; + t := TTest.Create; + res := t.Test(True); + Writeln('t.Test: ', res); + if res <> 1 then + Halt(1); + Writeln('ok'); end. diff --git a/tests/test/tchlp47.pp b/tests/test/tchlp47.pp index 34e1b03100..3f2197c187 100644 --- a/tests/test/tchlp47.pp +++ b/tests/test/tchlp47.pp @@ -1,18 +1,51 @@ -{ %FAIL } - -{ access to methods must adhere to visibility rules (here: strict protected)} +{ a method defined in a parent helper has higher priority than a method defined + in the parent of the extended class - test 1} program tchlp47; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +{$apptype console} -uses - uchlp45; +type + TTest = class + function Test: Integer; + end; + + TTestSub = class(TTest) + end; + + TTestSubHelper = class helper for TTestSub + function Test: Integer; + end; + + TTestSubHelperSub = class helper(TTestSubHelper) for TTestSub + function AccessTest: Integer; + end; + +function TTest.Test: Integer; +begin + Result := 1; +end; + +function TTestSubHelper.Test: Integer; +begin + Result := 2; +end; + +function TTestSubHelperSub.AccessTest: Integer; +begin + Result := Test; +end; var - f: TFoo; + t: TTestSub; + res: Integer; begin - f := TFoo.Create; - f.Test3; + t := TTestSub.Create; + res := t.AccessTest; + Writeln('t.AccessTest: ', res); + if res <> 2 then + Halt(1); + Writeln('ok'); end. diff --git a/tests/test/tchlp48.pp b/tests/test/tchlp48.pp index 091cf0085c..3288b99028 100644 --- a/tests/test/tchlp48.pp +++ b/tests/test/tchlp48.pp @@ -1,18 +1,51 @@ -{ %FAIL } - -{ access to methods must adhere to visibility rules (here: protected)} +{ a method defined in a parent helper has higher priority than a method defined + in the parent of the extended class - test 2 } program tchlp48; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +{$apptype console} -uses - uchlp45; +type + TTest = class + function Test: Integer; + end; + + TTestSub = class(TTest) + end; + + TTestSubHelper = class helper for TTestSub + function Test: Integer; + end; + + TTestSubHelperSub = class helper(TTestSubHelper) for TTestSub + function AccessTest: Integer; + end; + +function TTest.Test: Integer; +begin + Result := 1; +end; + +function TTestSubHelper.Test: Integer; +begin + Result := 2; +end; + +function TTestSubHelperSub.AccessTest: Integer; +begin + Result := inherited Test; +end; var - f: TFoo; + t: TTestSub; + res: Integer; begin - f := TFoo.Create; - f.Test4; + t := TTestSub.Create; + res := t.AccessTest; + Writeln('t.AccessTest: ', res); + if res <> 2 then + Halt(1); + Writeln('ok'); end. diff --git a/tests/test/tchlp49.pp b/tests/test/tchlp49.pp index 7b7fed819e..bd3b3fb80f 100644 --- a/tests/test/tchlp49.pp +++ b/tests/test/tchlp49.pp @@ -1,18 +1,46 @@ -{ %NORUN } - -{ access to methods must adhere to visibility rules (here: public)} +{ a class helper can access methods defined in the parent of the extended + class } program tchlp49; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +{$apptype console} -uses - uchlp45; +type + TTest = class + function Test(aRecurse: Boolean): Integer; + end; + + TTestSub = class(TTest) + end; + + TTestSubHelper = class helper for TTestSub + function Test(aRecurse: Boolean): Integer; + end; + +function TTest.Test(aRecurse: Boolean): Integer; +begin + Result := 1; +end; + +function TTestSubHelper.Test(aRecurse: Boolean): Integer; +begin + if aRecurse then + Result := inherited Test(False) + else + Result := 2; +end; var - f: TFoo; + t: TTestSub; + res: Integer; begin - f := TFoo.Create; - f.Test5; + t := TTestSub.Create; + res := t.Test(True); + Writeln('t.Test: ', res); + if res <> 1 then + Halt(1); + Writeln('ok'); end. + diff --git a/tests/test/tchlp5.pp b/tests/test/tchlp5.pp index 17816ef369..5458812a85 100644 --- a/tests/test/tchlp5.pp +++ b/tests/test/tchlp5.pp @@ -1,18 +1,29 @@ -{%FAIL} - -{ class destructors are not allowed } +{ the size of a class helper is equivalent to that of a pointer } program tchlp5; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +{$apptype console} type - TObjectHelper = class helper for TObject - class destructor Destroy; override; + TTest = class + s: String; + i32: Integer; + b: Boolean; + i64: Int64; end; + TTestHelper = class helper for TTest + end; + +var + res: Integer; begin - + res := SizeOf(TTestHelper); + Writeln('SizeOf(TTest): ', SizeOf(TTest)); + Writeln('SizeOf(TTestHelper): ', res); + if res <> SizeOf(Pointer) then + Halt(1); + Writeln('ok'); end. - diff --git a/tests/test/tchlp50.pp b/tests/test/tchlp50.pp index dd2dd6fe20..13e30af048 100644 --- a/tests/test/tchlp50.pp +++ b/tests/test/tchlp50.pp @@ -1,24 +1,41 @@ -{ test whether the correct class helper is used, if two are defined for the - same class in a unit } +{ without "inherited" the methods of the helper are called first } program tchlp50; {$ifdef fpc} - {$mode objfpc}{$H+} + {$mode delphi} {$endif} {$apptype console} -uses - uchlp50; +type + TTest = class + function Test(aRecurse: Boolean): Integer; + end; + + TTestHelper = class helper for TTest + function Test(aRecurse: Boolean): Integer; + end; + +function TTest.Test(aRecurse: Boolean): Integer; +begin + Result := 1; +end; + +function TTestHelper.Test(aRecurse: Boolean): Integer; +begin + if aRecurse then + Result := Test(False) + else + Result := 2; +end; var - f: TFoo; + t: TTest; res: Integer; begin - f := TFoo.Create; - res := f.Test; - Writeln('f.Test: ', res); + t := TTest.Create; + res := t.Test(True); + Writeln('t.Test: ', res); if res <> 2 then Halt(1); Writeln('ok'); end. - diff --git a/tests/test/tchlp51.pp b/tests/test/tchlp51.pp index 1edcc3939e..6f1d5e1f36 100644 --- a/tests/test/tchlp51.pp +++ b/tests/test/tchlp51.pp @@ -1,23 +1,47 @@ -{ this tests whether a class helper introduced in the uses clause of an - implementation section overrides the one introduced in the interface section } +{ methods defined in a helper have higher priority than those defined in the + extended type } program tchlp51; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} {$apptype console} -uses - uchlp51a, uchlp51c; +type + TTest = class + function Test: Integer; + end; + + TTestHelper = class helper for TTest + private + function Test: Integer; + public + function AccessTest: Integer; + end; + +function TTest.Test: Integer; +begin + Result := 1; +end; + +function TTestHelper.Test: Integer; +begin + Result := 2; +end; + +function TTestHelper.AccessTest: Integer; +begin + Result := Test; +end; var - f: TFoo; + t: TTest; res: Integer; begin - f := TFoo.Create; - res := f.AccessTest; - Writeln('f.AccessTest: ', res); - if res <> 1 then + t := TTest.Create; + res := t.AccessTest; + Writeln('t.AccessTest: ', res); + if res <> 2 then Halt(1); Writeln('ok'); end. diff --git a/tests/test/tchlp52.pp b/tests/test/tchlp52.pp index 7297aa222e..14e1a7f192 100644 --- a/tests/test/tchlp52.pp +++ b/tests/test/tchlp52.pp @@ -1,24 +1,73 @@ -{ %FAIL } +{ %NORUN } -{ class helpers may not be referenced in any way - test 7 } +{ a helper may introduce an enumerator } program tchlp52; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} type - TObjectHelper = class helper for TObject - procedure Test; + TContainer = class + Contents: array[0..5] of Integer; + constructor Create; end; -procedure TObjectHelper.Test; -begin + TContainerEnum = class + private + fIndex: Integer; + fContainer: TContainer; + public + constructor Create(aContainer: TContainer); + function GetCurrent: Integer; + function MoveNext: Boolean; + property Current: Integer read GetCurrent; + end; + TContainerHelper = class helper for TContainer + function GetEnumerator: TContainerEnum; + end; + +{ TContainer } + +constructor TContainer.Create; +var + i: Integer; +begin + for i := Low(Contents) to High(Contents) do + Contents[i] := i; +end; + +{ TContainerHelper } + +function TContainerHelper.GetEnumerator: TContainerEnum; +begin + Result := TContainerEnum.Create(Self); +end; + +{ TContainerEnum } + +constructor TContainerEnum.Create(aContainer: TContainer); +begin + fContainer := aContainer; + fIndex := Low(fContainer.Contents) - 1; +end; + +function TContainerEnum.GetCurrent: Integer; +begin + Result := fContainer.Contents[fIndex]; +end; + +function TContainerEnum.MoveNext: Boolean; +begin + Inc(fIndex); + Result := fIndex <= High(fContainer.Contents); end; var - o: TObject; + cont: TContainer; + i: Integer; begin - TObjectHelper(o).Test; + cont := TContainer.Create; + for i in cont do ; end. diff --git a/tests/test/tchlp53.pp b/tests/test/tchlp53.pp index 76353a4270..bc6dae5056 100644 --- a/tests/test/tchlp53.pp +++ b/tests/test/tchlp53.pp @@ -1,40 +1,97 @@ -{ %NORUN } - -{ method modifiers of the extended class are completly irrelevant } +{ a helper hides an existing enumerator } program tchlp53; {$ifdef fpc} {$mode delphi} {$endif} +{$apptype console} type - TFoo = class - procedure Test; virtual; + TContainerEnum = class; + + TContainer = class + Contents: array[0..5] of Integer; + function GetEnumerator: TContainerEnum; + constructor Create; end; - TFooHelper = class helper for TFoo - procedure Test; virtual; + TContainerEnum = class + private + fIndex: Integer; + fContainer: TContainer; + fForward: Boolean; + public + constructor Create(aContainer: TContainer; aForward: Boolean); + function GetCurrent: Integer; + function MoveNext: Boolean; + property Current: Integer read GetCurrent; end; - TFooSubHelper = class helper(TFooHelper) for TFoo - procedure Test; override; + TContainerHelper = class helper for TContainer + function GetEnumerator: TContainerEnum; end; -procedure TFoo.Test; -begin +{ TContainer } +constructor TContainer.Create; +var + i: Integer; +begin + for i := Low(Contents) to High(Contents) do + Contents[i] := i; end; -procedure TFooHelper.Test; +function TContainer.GetEnumerator: TContainerEnum; begin - + Result := TContainerEnum.Create(Self, True); end; -procedure TFooSubHelper.Test; -begin +{ TContainerHelper } +function TContainerHelper.GetEnumerator: TContainerEnum; +begin + Result := TContainerEnum.Create(Self, False); end; -begin +{ TContainerEnum } +constructor TContainerEnum.Create(aContainer: TContainer; aForward: Boolean); +begin + fContainer := aContainer; + fForward := aForward; + if fForward then + fIndex := Low(fContainer.Contents) - 1 + else + fIndex := High(fContainer.Contents) + 1; +end; + +function TContainerEnum.GetCurrent: Integer; +begin + Result := fContainer.Contents[fIndex]; +end; + +function TContainerEnum.MoveNext: Boolean; +begin + if fForward then begin + Inc(fIndex); + Result := fIndex <= High(fContainer.Contents); + end else begin + Dec(fIndex); + Result := fIndex >= Low(fContainer.Contents); + end; +end; + +var + cont: TContainer; + i, c: Integer; +begin + cont := TContainer.Create; + c := 5; + for i in cont do begin + if c <> i then + Halt(1); + Writeln(i); + Dec(c); + end; + Writeln('ok'); end. diff --git a/tests/test/tchlp54.pp b/tests/test/tchlp54.pp index 35a8859f38..594de1beff 100644 --- a/tests/test/tchlp54.pp +++ b/tests/test/tchlp54.pp @@ -1,33 +1,123 @@ -{ tests whether the methods of a parent helper are usable in a derived helper } +{ this example tests combinations of class and helpers hierarchies } program tchlp54; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} {$apptype console} type - TFoo = class - + TTest1 = class end; - TFooHelper = class helper for TFoo - procedure Test; + TTest2 = class(TTest1) + class function Test3: Integer; end; - TFooBarHelper = class helper(TFooHelper) for TFoo - procedure AccessTest; + TTest3 = class(TTest2) + class function Test1: Integer; + class function Test2: Integer; end; -procedure TFooHelper.Test; + TTest4 = class(TTest3) + end; + + TTest1Helper = class helper for TTest1 + class function Test1: Integer; + class function Test3: Integer; + class function Test4: Integer; + end; + + TTest3Helper = class helper for TTest3 + class function Test2: Integer; + class function Test4: Integer; + end; + + TTest4Helper = class helper(TTest1Helper) for TTest4 + class function DoTest1: Integer; + class function DoTest2: Integer; + class function DoTest3: Integer; + class function DoTest4: Integer; + end; + +class function TTest2.Test3: Integer; begin - + Result := 1; end; -procedure TFooBarHelper.AccessTest; +class function TTest3.Test1: Integer; begin - Test; + Result := 1; end; +class function TTest3.Test2: Integer; begin + Result := 1; +end; + +class function TTest1Helper.Test1: Integer; +begin + Result := 2; +end; + +class function TTest1Helper.Test3: Integer; +begin + Result := 2; +end; + +class function TTest1Helper.Test4: Integer; +begin + Result := 1; +end; + +class function TTest3Helper.Test2: Integer; +begin + Result := 2; +end; + +class function TTest3Helper.Test4: Integer; +begin + Result := 2; +end; + +class function TTest4Helper.DoTest1: Integer; +begin + Result := Test1; +end; + +class function TTest4Helper.DoTest2: Integer; +begin + Result := Test2; +end; + +class function TTest4Helper.DoTest3: Integer; +begin + Result := Test3; +end; + +class function TTest4Helper.DoTest4: Integer; +begin + Result := Test4; +end; + +var + res: Integer; +begin + res := TTest4.DoTest1; + Writeln('TTest4.DoTest1: ', res); + if res <> 2 then + Halt(1); + res := TTest4.DoTest2; + Writeln('TTest4.DoTest2: ', res); + if res <> 2 then + Halt(2); + res := TTest4.DoTest3; + Writeln('TTest4.DoTest3: ', res); + if res <> 2 then + Halt(3); + res := TTest4.DoTest4; + Writeln('TTest4.DoTest4: ', res); + if res <> 1 then + Halt(4); + Writeln('ok'); end. diff --git a/tests/test/tchlp55.pp b/tests/test/tchlp55.pp deleted file mode 100644 index 85e2986bd8..0000000000 --- a/tests/test/tchlp55.pp +++ /dev/null @@ -1,26 +0,0 @@ -program tchlp55; - -{$ifdef fpc} - {$mode objfpc} -{$endif} - -type - TTest = class - strict private - type - TFooHelper = class helper for TObject - procedure Test; - end; - end; - -procedure TTest.TFooHelper.Test; -begin - -end; - -var - o: TObject; -begin - o := TObject.Create; - o.Test; -end. diff --git a/tests/test/tchlp56.pp b/tests/test/tchlp56.pp deleted file mode 100644 index 7b1649806e..0000000000 --- a/tests/test/tchlp56.pp +++ /dev/null @@ -1,34 +0,0 @@ -{ %NORUN } - -{ for helpers Self always refers to the extended class } -program tchlp56; - -{$ifdef fpc} - {$mode objfpc} -{$endif} - -type - TFoo = class - procedure DoFoo(aFoo: TFoo); - end; - - TFooHelper = class helper for TFoo - procedure Test; - end; - -procedure TFoo.DoFoo(aFoo: TFoo); -begin - -end; - -procedure TFooHelper.Test; -begin - DoFoo(Self); -end; - -var - f: TFoo; -begin - f := TFoo.Create; - f.Test; -end. diff --git a/tests/test/tchlp57.pp b/tests/test/tchlp57.pp deleted file mode 100644 index 0df1ee824e..0000000000 --- a/tests/test/tchlp57.pp +++ /dev/null @@ -1,30 +0,0 @@ -{ %NORUN } - -{ a class helper can already be accessed when implementing a class' methods } -program tchlp57; - -{$ifdef fpc} - {$mode objfpc} -{$endif} - -type - TFoo = class - procedure Test; - end; - - TFooHelper = class helper for TFoo - procedure Bar; - end; - -procedure TFoo.Test; -begin - Bar; -end; - -procedure TFooHelper.Bar; -begin - -end; - -begin -end. diff --git a/tests/test/tchlp58.pp b/tests/test/tchlp58.pp deleted file mode 100644 index 096bd18c50..0000000000 --- a/tests/test/tchlp58.pp +++ /dev/null @@ -1,31 +0,0 @@ -{ %NORUN } - -{ tests whether class helpers can introduce properties } -program tchlp58; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - Test: Integer; - end; - - TFooHelper = class helper for TFoo - function GetAccessTest: Integer; - property AccessTest: Integer read GetAccessTest; - end; - -function TFooHelper.GetAccessTest: Integer; -begin - Result := Test; -end; - -var - f: TFoo; -begin - f := TFoo.Create; - f.AccessTest; -end. diff --git a/tests/test/tchlp6.pp b/tests/test/tchlp6.pp index e8fac720ae..8274fd15e5 100644 --- a/tests/test/tchlp6.pp +++ b/tests/test/tchlp6.pp @@ -1,27 +1,34 @@ -{%NORUN} - -{ message methods are allowed in mode Delphi } +{ helpers may introduce new default properties } program tchlp6; {$ifdef fpc} {$mode delphi} {$endif} +{$apptype console} type - TMessage = record - ID: LongWord; + TTest = class + end; - TObjectHelper = class helper for TObject - procedure SomeMessage(var aMessage: TMessage); message 42; + TTestHelper = class helper for TTest + function GetTest(aIndex: Integer): Integer; + property Test[Index: Integer]: Integer read GetTest; default; end; -procedure TObjectHelper.SomeMessage(var aMessage: TMessage); +function TTestHelper.GetTest(aIndex: Integer): Integer; begin - + Result := aIndex; end; +var + t: TTest; + res: Integer; begin - + t := TTest.Create; + res := t[3]; + Writeln('value: ', res); + if res <> 3 then + Halt(1); + Writeln('ok'); end. - diff --git a/tests/test/tchlp62.pp b/tests/test/tchlp62.pp deleted file mode 100644 index fc1d297af9..0000000000 --- a/tests/test/tchlp62.pp +++ /dev/null @@ -1,51 +0,0 @@ -{ a method defined in a parent helper has higher priority than a method defined - in the parent of the extended class - test 1} -program tchlp62; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - function Test: Integer; - end; - - TFooBar = class(TFoo) - end; - - TFooBarHelper = class helper for TFooBar - function Test: Integer; - end; - - TFooBarSubHelper = class helper(TFooBarHelper) for TFooBar - function AccessTest: Integer; - end; - -function TFoo.Test: Integer; -begin - Result := 1; -end; - -function TFooBarHelper.Test: Integer; -begin - Result := 2; -end; - -function TFooBarSubHelper.AccessTest: Integer; -begin - Result := Test; -end; - -var - f: TFooBar; - res: Integer; -begin - f := TFooBar.Create; - res := f.AccessTest; - Writeln('f.AccessTest: ', res); - if res <> 2 then - Halt(1); - Writeln('ok'); -end. diff --git a/tests/test/tchlp63.pp b/tests/test/tchlp63.pp deleted file mode 100644 index 909441009d..0000000000 --- a/tests/test/tchlp63.pp +++ /dev/null @@ -1,51 +0,0 @@ -{ a method defined in a parent helper has higher priority than a method defined - in the parent of the extended class - test 2 } -program tchlp63; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - function Test: Integer; - end; - - TFooBar = class(TFoo) - end; - - TFooBarHelper = class helper for TFooBar - function Test: Integer; - end; - - TFooBarSubHelper = class helper(TFooBarHelper) for TFooBar - function AccessTest: Integer; - end; - -function TFoo.Test: Integer; -begin - Result := 1; -end; - -function TFooBarHelper.Test: Integer; -begin - Result := 2; -end; - -function TFooBarSubHelper.AccessTest: Integer; -begin - Result := inherited Test; -end; - -var - f: TFooBar; - res: Integer; -begin - f := TFooBar.Create; - res := f.AccessTest; - Writeln('f.AccessTest: ', res); - if res <> 2 then - Halt(1); - Writeln('ok'); -end. diff --git a/tests/test/tchlp64.pp b/tests/test/tchlp64.pp deleted file mode 100644 index 49e096a535..0000000000 --- a/tests/test/tchlp64.pp +++ /dev/null @@ -1,46 +0,0 @@ -{ a class helper can access methods defined in the parent of the extended - class } -program tchlp64; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - function Test(aRecurse: Boolean): Integer; - end; - - TFooBar = class(TFoo) - end; - - TFooBarHelper = class helper for TFooBar - function Test(aRecurse: Boolean): Integer; - end; - -function TFoo.Test(aRecurse: Boolean): Integer; -begin - Result := 1; -end; - -function TFooBarHelper.Test(aRecurse: Boolean): Integer; -begin - if aRecurse then - Result := inherited Test(False) - else - Result := 2; -end; - -var - f: TFooBar; - res: Integer; -begin - f := TFooBar.Create; - res := f.Test(True); - Writeln('f.Test: ', res); - if res <> 1 then - Halt(1); - Writeln('ok'); -end. - diff --git a/tests/test/tchlp67.pp b/tests/test/tchlp67.pp deleted file mode 100644 index 6be2722e12..0000000000 --- a/tests/test/tchlp67.pp +++ /dev/null @@ -1,47 +0,0 @@ -{ helper methods also influence calls to a parent's method in a derived class } -program tchlp67; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - function Test: Integer; - end; - - TFooBar = class(TFoo) - function AccessTest: Integer; - end; - - TFooHelper = class helper for TFoo - function Test: Integer; - end; - -function TFoo.Test: Integer; -begin - Result := 1; -end; - -function TFooBar.AccessTest: Integer; -begin - Result := Test; -end; - -function TFooHelper.Test: Integer; -begin - Result := 2; -end; - -var - f: TFooBar; - res: Integer; -begin - f := TFooBar.Create; - res := f.AccessTest; - Writeln('f.AccessTest: ', res); - if res <> 2 then - Halt(1); - Writeln('ok'); -end. diff --git a/tests/test/tchlp68.pp b/tests/test/tchlp68.pp deleted file mode 100644 index 4482959e94..0000000000 --- a/tests/test/tchlp68.pp +++ /dev/null @@ -1,48 +0,0 @@ -{ helper methods also influence calls to a parent's method in a derived class } -program tchlp68; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - function Test: Integer; - end; - - TFooBar = class(TFoo) - function AccessTest: Integer; - end; - - TFooHelper = class helper for TFoo - function Test: Integer; - end; - -function TFoo.Test: Integer; -begin - Result := 1; -end; - -function TFooBar.AccessTest: Integer; -begin - Result := inherited Test; -end; - -function TFooHelper.Test: Integer; -begin - Result := 2; -end; - -var - f: TFooBar; - res: Integer; -begin - f := TFooBar.Create; - res := f.AccessTest; - Writeln('f.AccessTest: ', res); - if res <> 2 then - Halt(1); - Writeln('ok'); -end. - diff --git a/tests/test/tchlp7.pp b/tests/test/tchlp7.pp index e950a7908f..1e30cc65fb 100644 --- a/tests/test/tchlp7.pp +++ b/tests/test/tchlp7.pp @@ -1,25 +1,42 @@ -{%FAIL} - -{ message methods are not allowed in mode ObjFPC } +{ helpers may override existing default properties } program tchlp7; -{$mode objfpc} +{$ifdef fpc} + {$mode delphi} +{$endif} +{$apptype console} type - TMessage = record - ID: LongWord; + TTest = class + private + function GetTest(aIndex: Integer): Integer; + public + property Test[Index: Integer]: Integer read GetTest; default; end; - TObjectHelper = class helper for TObject - procedure SomeMessage(var aMessage: TMessage); message 42; + TTestHelper = class helper for TTest + function GetTest(aIndex: Integer): Integer; + property Test[Index: Integer]: Integer read GetTest; default; end; -procedure TObjectHelper.SomeMessage(var aMessage: TMessage); +function TTest.GetTest(aIndex: Integer): Integer; begin - + Result := - aIndex; end; +function TTestHelper.GetTest(aIndex: Integer): Integer; begin + Result := aIndex; +end; +var + t: TTest; + res: Integer; +begin + t := TTest.Create; + res := t[3]; + Writeln('value: ', res); + if res <> 3 then + Halt(1); + Writeln('ok'); end. - diff --git a/tests/test/tchlp78.pp b/tests/test/tchlp78.pp deleted file mode 100644 index e8d7e43403..0000000000 --- a/tests/test/tchlp78.pp +++ /dev/null @@ -1,18 +0,0 @@ -{ size of a class helper is size of a pointer } -program tchlp78; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TObjectHelper = class helper for TObject - end; - -begin - Writeln('Size of TObjectHelper: ', SizeOf(TObjectHelper)); - if SizeOf(TObjectHelper) <> SizeOf(Pointer) then - Halt(1); - Writeln('ok'); -end. diff --git a/tests/test/tchlp79.pp b/tests/test/tchlp79.pp deleted file mode 100644 index 6f42dcc9af..0000000000 --- a/tests/test/tchlp79.pp +++ /dev/null @@ -1,23 +0,0 @@ -{ size of a record helper is the size of a pointer } -program tchlp79; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TTestRecord = record - i: Integer; - j: Integer; - end; - - TTestRecordHelper = record helper for TTestRecord - end; - -begin - Writeln('Size of TTestRecordHelper: ', SizeOf(TTestRecordHelper)); - if SizeOf(TTestRecordHelper) <> SizeOf(Pointer) then - Halt(1); - Writeln('ok'); -end. diff --git a/tests/test/tchlp8.pp b/tests/test/tchlp8.pp index 8be3bf43f7..fab5cc42bc 100644 --- a/tests/test/tchlp8.pp +++ b/tests/test/tchlp8.pp @@ -1,18 +1,38 @@ -{%FAIL} - -{ abstract methods are not allowed } +{ helpers may introduce new default properties (includes default properties + introudced by the helper's parent) } program tchlp8; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} +{$apptype console} type - TObjectHelper = class helper for TObject - procedure SomeMethod; virtual; abstract; + TTest = class + end; + TTestHelper = class helper for TTest + function GetTest(aIndex: Integer): Integer; + property Test[Index: Integer]: Integer read GetTest; default; + end; + + TTestHelperSub = class helper(TTestHelper) for TTest + end; + +function TTestHelper.GetTest(aIndex: Integer): Integer; begin + Result := aIndex; +end; +var + t: TTest; + res: Integer; +begin + t := TTest.Create; + res := t[3]; + Writeln('value: ', res); + if res <> 3 then + Halt(1); + Writeln('ok'); end. - diff --git a/tests/test/tchlp82.pp b/tests/test/tchlp82.pp deleted file mode 100644 index 3d6189998b..0000000000 --- a/tests/test/tchlp82.pp +++ /dev/null @@ -1,26 +0,0 @@ -{ %FAIL } - -{ test visibility of symbols in the extended type - strict private } -program tchlp82; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -uses - uchlp82; - -type - TFooHelper = class helper for TFoo - function AccessField: Integer; - end; - -function TFooHelper.AccessField: Integer; -begin - Result := Test1; -end; - -begin - -end. diff --git a/tests/test/tchlp83.pp b/tests/test/tchlp83.pp deleted file mode 100644 index 4a3b17e456..0000000000 --- a/tests/test/tchlp83.pp +++ /dev/null @@ -1,26 +0,0 @@ -{ %FAIL } - -{ test visibility of symbols in the extended type - private } -program tchlp83; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -uses - uchlp82; - -type - TFooHelper = class helper for TFoo - function AccessField: Integer; - end; - -function TFooHelper.AccessField: Integer; -begin - Result := Test2; -end; - -begin - -end. diff --git a/tests/test/tchlp84.pp b/tests/test/tchlp84.pp deleted file mode 100644 index bae8f26ebb..0000000000 --- a/tests/test/tchlp84.pp +++ /dev/null @@ -1,26 +0,0 @@ -{ %NORUN } - -{ test visibility of symbols in the extended type - strict protected } -program tchlp84; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -uses - uchlp82; - -type - TFooHelper = class helper for TFoo - function AccessField: Integer; - end; - -function TFooHelper.AccessField: Integer; -begin - Result := Test3; -end; - -begin - -end. diff --git a/tests/test/tchlp85.pp b/tests/test/tchlp85.pp deleted file mode 100644 index 16c3ef8c6f..0000000000 --- a/tests/test/tchlp85.pp +++ /dev/null @@ -1,26 +0,0 @@ -{ %NORUN } - -{ test visibility of symbols in the extended type - protected } -program tchlp85; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -uses - uchlp82; - -type - TFooHelper = class helper for TFoo - function AccessField: Integer; - end; - -function TFooHelper.AccessField: Integer; -begin - Result := Test4; -end; - -begin - -end. diff --git a/tests/test/tchlp86.pp b/tests/test/tchlp86.pp deleted file mode 100644 index 6e0f9af7df..0000000000 --- a/tests/test/tchlp86.pp +++ /dev/null @@ -1,30 +0,0 @@ -{ %FAIL } {???} - -program tchlp86; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - class var - Test: Integer; - end; - - TFooHelper = class helper for TFoo - class constructor Create; - end; - -class constructor TFooHelper.Create; -begin - TFoo.Test := 42; -end; - -begin - Writeln('TFoo.Test: ', TFoo.Test); - if TFoo.Test <> 42 then - Halt(1); - Writeln('ok'); -end. diff --git a/tests/test/tchlp87.pp b/tests/test/tchlp87.pp deleted file mode 100644 index 0860cc8500..0000000000 --- a/tests/test/tchlp87.pp +++ /dev/null @@ -1,33 +0,0 @@ -{ %NORUN } - -{ class helpers of a parent are available in a subclass as well } -program tchlp87; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - - end; - - TBar = class(TFoo) - - end; - - TFooHelper = class helper for TFoo - procedure TestFoo; - end; - -procedure TFooHelper.TestFoo; -begin - -end; - -var - b: TBar; -begin - b.TestFoo; -end. diff --git a/tests/test/tchlp88.pp b/tests/test/tchlp88.pp deleted file mode 100644 index a2b95d5c62..0000000000 --- a/tests/test/tchlp88.pp +++ /dev/null @@ -1,42 +0,0 @@ -{ a helper of a parent class hides the parent's methods } -program tchlp88; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - function TestFoo: Integer; - end; - - TBar = class(TFoo) - - end; - - TFooHelper = class helper for TFoo - function TestFoo: Integer; - end; - -function TFoo.TestFoo: Integer; -begin - Result := 1; -end; - -function TFooHelper.TestFoo: Integer; -begin - Result := 2; -end; - -var - b: TBar; - res: Integer; -begin - b := TBar.Create; - res := b.TestFoo; - Writeln('b.TestFoo: ', res); - if res <> 2 then - Halt(1); - Writeln('ok'); -end. diff --git a/tests/test/tchlp89.pp b/tests/test/tchlp89.pp deleted file mode 100644 index 67d6008f40..0000000000 --- a/tests/test/tchlp89.pp +++ /dev/null @@ -1,47 +0,0 @@ -{ a helper of a parent class does not hide methods in the child class } -program tchlp89; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - function TestFoo: Integer; - end; - - TBar = class(TFoo) - function TestFoo: Integer; - end; - - TFooHelper = class helper for TFoo - function TestFoo: Integer; - end; - -function TFoo.TestFoo: Integer; -begin - Result := 1; -end; - -function TBar.TestFoo: Integer; -begin - Result := 4; -end; - -function TFooHelper.TestFoo: Integer; -begin - Result := 2; -end; - -var - b: TBar; - res: Integer; -begin - b := TBar.Create; - res := b.TestFoo; - Writeln('b.TestFoo: ', res); - if res <> 4 then - Halt(1); - Writeln('ok'); -end. diff --git a/tests/test/tchlp9.pp b/tests/test/tchlp9.pp index ad43dbba7f..1d0e122c29 100644 --- a/tests/test/tchlp9.pp +++ b/tests/test/tchlp9.pp @@ -1,32 +1,22 @@ -{%NORUN} +{ %FAIL } -{ class helper inheritance syntax } +{ inside a helper's declaration the methods/fields of the extended class can't + be accessed } program tchlp9; {$ifdef fpc} - {$mode objfpc} + {$mode delphi} {$endif} type - TObjectHelperA = class helper for TObject - procedure SomeMethodA; + TTest = class + Test: Integer; + function GetTest: Integer; end; - TObjectHelperB = class helper(TObjectHelperA) for TObject - procedure SomeMethodB; + TTestHelper = class helper for TTest + property AccessTest: Integer read Test; end; -procedure TObjectHelperA.SomeMethodA; begin - -end; - -procedure TObjectHelperB.SomeMethodB; -begin - -end; - -begin - end. - diff --git a/tests/test/tchlp90.pp b/tests/test/tchlp90.pp deleted file mode 100644 index 55c8e5ca05..0000000000 --- a/tests/test/tchlp90.pp +++ /dev/null @@ -1,51 +0,0 @@ -{ a helper of a parent class hides methods in the child class if its also a - parent of the helper for the child class } -program tchlp90; - -{$ifdef fpc} - {$mode delphi} -{$endif} -{$apptype console} - -type - TFoo = class - function TestFoo: Integer; - end; - - TBar = class(TFoo) - function TestFoo: Integer; - end; - - TFooHelper = class helper for TFoo - function TestFoo: Integer; - end; - - TBarHelper = class helper(TFooHelper) for TBar - end; - -function TFoo.TestFoo: Integer; -begin - Result := 1; -end; - -function TBar.TestFoo: Integer; -begin - Result := 4; -end; - -function TFooHelper.TestFoo: Integer; -begin - Result := 2; -end; - -var - b: TBar; - res: Integer; -begin - b := TBar.Create; - res := b.TestFoo; - Writeln('b.TestFoo: ', res); - if res <> 2 then - Halt(1); - Writeln('ok'); -end. diff --git a/tests/test/thlp1.pp b/tests/test/thlp1.pp new file mode 100644 index 0000000000..464b241e28 --- /dev/null +++ b/tests/test/thlp1.pp @@ -0,0 +1,18 @@ +{ %NORUN } + +{ tests the inheritance syntax of helpers } +program thlp1; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + end; + + TObjectHelperSub = class helper(TObjectHelper) for TObject + end; + +begin +end. diff --git a/tests/test/thlp10.pp b/tests/test/thlp10.pp new file mode 100644 index 0000000000..0cfd816404 --- /dev/null +++ b/tests/test/thlp10.pp @@ -0,0 +1,20 @@ +{ %FAIL } + +{ destructors are not allowed } +program thlp10; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + destructor Destroy; + end; + +destructor TObjectHelper.Destroy; +begin +end; + +begin +end. diff --git a/tests/test/thlp11.pp b/tests/test/thlp11.pp new file mode 100644 index 0000000000..dba6870445 --- /dev/null +++ b/tests/test/thlp11.pp @@ -0,0 +1,21 @@ +{ %FAIL } + +{ class destructors are not allowed } +program thlp11; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + class destructor Destroy; + end; + +class destructor TObjectHelper.Destroy; +begin +end; + +begin +end. + diff --git a/tests/test/thlp12.pp b/tests/test/thlp12.pp new file mode 100644 index 0000000000..73d7f252f9 --- /dev/null +++ b/tests/test/thlp12.pp @@ -0,0 +1,21 @@ +{ %FAIL } + +{ class constructors are not allowed } +program thlp12; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + class constructor Create; + end; + +class constructor TObjectHelper.Create; +begin +end; + +begin +end. + diff --git a/tests/test/thlp13.pp b/tests/test/thlp13.pp new file mode 100644 index 0000000000..74e1a187d1 --- /dev/null +++ b/tests/test/thlp13.pp @@ -0,0 +1,24 @@ +{ %NORUN } + +{ message methods are allowed in mode Delphi } +program thlp13; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TMessage = record + ID: Word; + end; + + TObjectHelper = class helper for TObject + procedure Message(var aMessage: TMessage); message 42; + end; + +procedure TObjectHelper.Message(var aMessage: TMessage); +begin +end; + +begin +end. diff --git a/tests/test/thlp14.pp b/tests/test/thlp14.pp new file mode 100644 index 0000000000..6aecf424ec --- /dev/null +++ b/tests/test/thlp14.pp @@ -0,0 +1,25 @@ +{ %FAIL } + +{ message methods are forbidden in mode ObjFPC } +program thlp14; + +{$ifdef fpc} + {$mode objfpc} +{$endif} + +type + TMessage = record + ID: Word; + end; + + TObjectHelper = class helper for TObject + procedure Message(var aMessage: TMessage); message 42; + end; + +procedure TObjectHelper.Message(var aMessage: TMessage); +begin +end; + +begin +end. + diff --git a/tests/test/thlp15.pp b/tests/test/thlp15.pp new file mode 100644 index 0000000000..27b3742f59 --- /dev/null +++ b/tests/test/thlp15.pp @@ -0,0 +1,18 @@ +{ %FAIL } + +{ helpers may not be referenced in any way - test 1 } +program thlp15; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + end; + +var + o: TObjectHelper; +begin +end. + diff --git a/tests/test/thlp16.pp b/tests/test/thlp16.pp new file mode 100644 index 0000000000..ff3bdb9821 --- /dev/null +++ b/tests/test/thlp16.pp @@ -0,0 +1,17 @@ +{ %FAIL } + +{ helpers may not be referenced in any way - test 2 } +program thlp16; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + end; + +begin + with TObjectHelper.Create do ; +end. + diff --git a/tests/test/thlp17.pp b/tests/test/thlp17.pp new file mode 100644 index 0000000000..55d78644d5 --- /dev/null +++ b/tests/test/thlp17.pp @@ -0,0 +1,23 @@ +{ %FAIL } + +{ helpers may not be referenced in any way - test 3 } +program thlp17; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + class procedure Test; + end; + +class procedure TObjectHelper.Test; +begin + +end; + +begin + TObjectHelper.Test; +end. + diff --git a/tests/test/thlp18.pp b/tests/test/thlp18.pp new file mode 100644 index 0000000000..c732db53a5 --- /dev/null +++ b/tests/test/thlp18.pp @@ -0,0 +1,21 @@ +{ %FAIL } + +{ helpers may not be referenced in any way - test 4 } +program thlp18; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + end; + +procedure SomeProc(aHelper: TObjectHelper); +begin + +end; + +begin +end. + diff --git a/tests/test/thlp19.pp b/tests/test/thlp19.pp new file mode 100644 index 0000000000..66907ed8a1 --- /dev/null +++ b/tests/test/thlp19.pp @@ -0,0 +1,20 @@ +{ %FAIL } + +{ helpers may not be referenced in any way - test 5 } +program thlp19; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + end; + + TSomeRec = record + helper: TObjectHelper; + end; + +begin +end. + diff --git a/tests/test/thlp2.pp b/tests/test/thlp2.pp new file mode 100644 index 0000000000..e852d0b49a --- /dev/null +++ b/tests/test/thlp2.pp @@ -0,0 +1,28 @@ +{ %NORUN } + +{ tests that helpers can introduce properties } +program thlp2; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + class function GetTest: Integer; static; + class procedure SetTest(aValue: Integer); static; + class property Test: Integer read GetTest write SetTest; + end; + +class function TObjectHelper.GetTest: Integer; +begin +end; + +class procedure TObjectHelper.SetTest(aValue: Integer); +begin + +end; + +begin + TObject.Test := TObject.Test; +end. diff --git a/tests/test/thlp20.pp b/tests/test/thlp20.pp new file mode 100644 index 0000000000..1b35a20406 --- /dev/null +++ b/tests/test/thlp20.pp @@ -0,0 +1,19 @@ +{ %FAIL } + +{ helpers may not be referenced in any way - test 6 } +program thlp20; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + end; + + TObjectHelperHelper = class helper for TObjectHelper + end; + +begin +end. + diff --git a/tests/test/thlp21.pp b/tests/test/thlp21.pp new file mode 100644 index 0000000000..19a938e8b0 --- /dev/null +++ b/tests/test/thlp21.pp @@ -0,0 +1,19 @@ +{ %FAIL } + +{ helpers may not be referenced in any way - test 7 } +program thlp21; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + end; + + TObjectHelperHelper = record helper for TObjectHelper + end; + +begin +end. + diff --git a/tests/test/thlp22.pp b/tests/test/thlp22.pp new file mode 100644 index 0000000000..82e846caf8 --- /dev/null +++ b/tests/test/thlp22.pp @@ -0,0 +1,19 @@ +{ %FAIL } + +{ helpers may not be referenced in any way - test 8 } +program thlp22; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + end; + + TObjectHelperSub = class(TObjectHelper) + end; + +begin +end. + diff --git a/tests/test/thlp23.pp b/tests/test/thlp23.pp new file mode 100644 index 0000000000..2eebaf7f30 --- /dev/null +++ b/tests/test/thlp23.pp @@ -0,0 +1,24 @@ +{ %FAIL } + +{ helpers may not be referenced in any way - test 9 } +program thlp23; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + procedure Test; + end; + +procedure TObjectHelper.Test; +begin + +end; + +var + o: TObject; +begin + TObjectHelper(o).Test; +end. diff --git a/tests/test/tchlp69.pp b/tests/test/thlp24.pp similarity index 85% rename from tests/test/tchlp69.pp rename to tests/test/thlp24.pp index 70eb4f8922..5b54b0de47 100644 --- a/tests/test/tchlp69.pp +++ b/tests/test/thlp24.pp @@ -1,12 +1,11 @@ { %FAIL } { a helper can not extend inline defined generics } -program tchlp69; +program thlp24; {$ifdef fpc} {$mode delphi} {$endif} -{$apptype console} type TFoo = class diff --git a/tests/test/tchlp70.pp b/tests/test/thlp25.pp similarity index 85% rename from tests/test/tchlp70.pp rename to tests/test/thlp25.pp index 1d07aa5ca0..e82321bf2d 100644 --- a/tests/test/tchlp70.pp +++ b/tests/test/thlp25.pp @@ -1,12 +1,11 @@ { %FAIL } { a helper can not extend unspecialized generics } -program tchlp70; +program thlp25; {$ifdef fpc} {$mode delphi} {$endif} -{$apptype console} type TFoo = class diff --git a/tests/test/tchlp71.pp b/tests/test/thlp26.pp similarity index 59% rename from tests/test/tchlp71.pp rename to tests/test/thlp26.pp index aaa4e3693c..cf56d68c8d 100644 --- a/tests/test/tchlp71.pp +++ b/tests/test/thlp26.pp @@ -1,12 +1,12 @@ -{ %FAIL } +{ %NORUN } -{ a helper can not extend specialized generics } -program tchlp71; +{ a helper may extend specialized generics } +{ Note: this does currently not compile in Delphi } +program thlp26; {$ifdef fpc} {$mode delphi} {$endif} -{$apptype console} type TFoo = class diff --git a/tests/test/tchlp72.pp b/tests/test/thlp27.pp similarity index 88% rename from tests/test/tchlp72.pp rename to tests/test/thlp27.pp index ec8fe14acf..8cf175013c 100644 --- a/tests/test/tchlp72.pp +++ b/tests/test/thlp27.pp @@ -1,12 +1,11 @@ { %NORUN } { a helper can extend the subclass of a specialized generic } -program tchlp72; +program thlp27; {$ifdef fpc} {$mode delphi} {$endif} -{$apptype console} type TFoo = class diff --git a/tests/test/tchlp73.pp b/tests/test/thlp28.pp similarity index 87% rename from tests/test/tchlp73.pp rename to tests/test/thlp28.pp index b8b11ca2d2..4425c59d45 100644 --- a/tests/test/tchlp73.pp +++ b/tests/test/thlp28.pp @@ -1,12 +1,11 @@ { %FAIL } { a helper may not be defined as a generic type } -program tchlp73; +program thlp28; {$ifdef fpc} {$mode delphi} {$endif} -{$apptype console} type TFoo = class diff --git a/tests/test/tchlp74.pp b/tests/test/thlp29.pp similarity index 52% rename from tests/test/tchlp74.pp rename to tests/test/thlp29.pp index 4b1672f9d1..6ca2b15d16 100644 --- a/tests/test/tchlp74.pp +++ b/tests/test/thlp29.pp @@ -1,24 +1,22 @@ -{ %SKIP } -{ .%NORUN } +{ %NORUN } { a helper may contain generic methods } -program tchlp74; +program thlp29; {$ifdef fpc} {$mode delphi} {$endif} -{$apptype console} type - TFoo = class + TTest = class end; - TFooHelper = class helper for TFoo + TTestHelper = class helper for TTest function Test: T; end; -function TFooHelper.Test: T; +function TTestHelper.Test: T; begin end; diff --git a/tests/test/thlp3.pp b/tests/test/thlp3.pp new file mode 100644 index 0000000000..a6c273f0ec --- /dev/null +++ b/tests/test/thlp3.pp @@ -0,0 +1,28 @@ +{ %NORUN } + +{ test that virtual methods can be defined in mode Delphi } +program thlp3; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp3; + +type + TObjectHelperSub = class helper(TObjectHelper) for TObject + procedure TestOverride; override; + procedure TestFinal; override; final; + end; + +procedure TObjectHelperSub.TestOverride; +begin +end; + +procedure TObjectHelperSub.TestFinal; +begin +end; + +begin +end. diff --git a/tests/test/tchlp75.pp b/tests/test/thlp30.pp similarity index 79% rename from tests/test/tchlp75.pp rename to tests/test/thlp30.pp index 9e6ccc5588..1a49394b29 100644 --- a/tests/test/tchlp75.pp +++ b/tests/test/thlp30.pp @@ -1,13 +1,11 @@ -{ %SKIP } -{ .%FAIL } +{ %FAIL } { helpers can not extend type parameters even if they can only be classes } -program tchlp75; +program thlp30; {$ifdef fpc} {$mode delphi} {$endif} -{$apptype console} type TFoo = class diff --git a/tests/test/thlp31.pp b/tests/test/thlp31.pp new file mode 100644 index 0000000000..cdab213691 --- /dev/null +++ b/tests/test/thlp31.pp @@ -0,0 +1,18 @@ +{ %FAIL } + +{ access to helper methods adheres to visibility rules (here: strict private) } +program thlp31; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp31; + +var + f: TFoo; +begin + f := TFoo.Create; + f.Test1; +end. diff --git a/tests/test/thlp32.pp b/tests/test/thlp32.pp new file mode 100644 index 0000000000..adc6d77c4a --- /dev/null +++ b/tests/test/thlp32.pp @@ -0,0 +1,18 @@ +{ %FAIL } + +{ access to helper methods adheres to visibility rules (here: private) } +program thlp32; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp31; + +var + f: TFoo; +begin + f := TFoo.Create; + f.Test2; +end. diff --git a/tests/test/thlp33.pp b/tests/test/thlp33.pp new file mode 100644 index 0000000000..28fe78cdf5 --- /dev/null +++ b/tests/test/thlp33.pp @@ -0,0 +1,18 @@ +{ %FAIL } + +{ access to helper methods adheres to visibility rules (here: strict protected)} +program thlp33; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp31; + +var + f: TFoo; +begin + f := TFoo.Create; + f.Test3; +end. diff --git a/tests/test/thlp34.pp b/tests/test/thlp34.pp new file mode 100644 index 0000000000..c88909a796 --- /dev/null +++ b/tests/test/thlp34.pp @@ -0,0 +1,18 @@ +{ %FAIL } + +{ access to helper methods adheres to visibility rules (here: protected) } +program thlp34; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp31; + +var + f: TFoo; +begin + f := TFoo.Create; + f.Test4; +end. diff --git a/tests/test/thlp35.pp b/tests/test/thlp35.pp new file mode 100644 index 0000000000..3a23f966c6 --- /dev/null +++ b/tests/test/thlp35.pp @@ -0,0 +1,18 @@ +{ %NORUN } + +{ access to helper methods adheres to visibility rules (here: public) } +program thlp35; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp31; + +var + f: TFoo; +begin + f := TFoo.Create; + f.Test5; +end. diff --git a/tests/test/thlp36.pp b/tests/test/thlp36.pp new file mode 100644 index 0000000000..006cd31581 --- /dev/null +++ b/tests/test/thlp36.pp @@ -0,0 +1,18 @@ +{ %NORUN } + +{ access to helper methods adheres to visibility rules (here: published) } +program thlp36; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp31; + +var + f: TFoo; +begin + f := TFoo.Create; + f.Test6; +end. diff --git a/tests/test/tchlp80.pp b/tests/test/thlp37.pp similarity index 74% rename from tests/test/tchlp80.pp rename to tests/test/thlp37.pp index 8411982dea..c41d0048d7 100644 --- a/tests/test/tchlp80.pp +++ b/tests/test/thlp37.pp @@ -1,4 +1,5 @@ -program tchlp80; +{ published properties/methods are available in the helper's RTTI } +program thlp37; {$ifdef fpc} {$mode delphi} @@ -36,15 +37,17 @@ begin Writeln('TypeInfo is Nil'); Halt(1); end; - if ti^.Kind = tkClass then begin - Writeln('Type kind is a class'); - Writeln(ti^.Name); + if ti^.Kind <> tkHelper then begin + Writeln('Type kind is not a helper'); + Halt(2); end; td := GetTypeData(ti); if td = Nil then begin Writeln('TypeData is Nil'); - Halt(2); + Halt(3); end; Writeln('Property count: ', td^.PropCount); + if td^.PropCount <> 1 then + Halt(4); Writeln('ok'); end. diff --git a/tests/test/thlp38.pp b/tests/test/thlp38.pp new file mode 100644 index 0000000000..5fa0b3504a --- /dev/null +++ b/tests/test/thlp38.pp @@ -0,0 +1,59 @@ +{ the parent in the RTTI of a non derived helper is Nil, otherwise it is the + typeinfo of the parent helper; also the type info of the extended type is + available through ExtendedInfo } +program thlp38; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + typinfo; + +type + TTest = class + + end; + + TTestHelper = class helper for TTest + end; + + TTestHelperSub = class helper(TTestHelper) for TTest + end; + +var + titest, titesthelper, titesthelpersub: PTypeInfo; + td: PTypeData; + ti: PTypeInfo; +begin + titest := TypeInfo(TTest); + titesthelper := TypeInfo(TTestHelper); + titesthelpersub := TypeInfo(TTestHelperSub); + + if titesthelper^.Kind <> tkHelper then begin + Writeln('Type is not a helper'); + Halt(1); + end; + if titesthelpersub^.Kind <> tkHelper then begin + Writeln('Type is not a helper'); + Halt(2); + end; + + td := GetTypeData(titesthelper); + if td^.ExtendedInfo <> titest then begin + Writeln('Extends wrong type'); + Halt(4); + end; + + td := GetTypeData(titesthelpersub); + if td^.ExtendedInfo <> titest then begin + Writeln('Extends wrong type'); + Halt(6); + end; + if td^.HelperParent <> titesthelper then begin + Writeln('Wrong parent of helper'); + Halt(7); + end; + + Writeln('ok'); +end. diff --git a/tests/test/thlp39.pp b/tests/test/thlp39.pp new file mode 100644 index 0000000000..7cb5f2a5cb --- /dev/null +++ b/tests/test/thlp39.pp @@ -0,0 +1,15 @@ +{ %FAIL } + +{ This tests that the bottom most helper in another unit is used for a type } +program thlp39; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp39; + +begin + TObject.Test1; +end. diff --git a/tests/test/thlp4.pp b/tests/test/thlp4.pp new file mode 100644 index 0000000000..d64b93c26a --- /dev/null +++ b/tests/test/thlp4.pp @@ -0,0 +1,20 @@ +{ %FAIL } + +{ virtual methods are forbidden in mode objfpc } +program thlp4; + +{$ifdef fpc} + {$mode objfpc} +{$endif} + +type + TObjectHelper = class helper for TObject + procedure TestVirtual; virtual; + end; + +procedure TObjectHelper.TestVirtual; +begin +end; + +begin +end. diff --git a/tests/test/thlp40.pp b/tests/test/thlp40.pp new file mode 100644 index 0000000000..315db06745 --- /dev/null +++ b/tests/test/thlp40.pp @@ -0,0 +1,16 @@ +{ %NORUN } + +{ This tests that the bottom most helper in another unit is used for a type } +program thlp40; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp39; + +begin + TObject.Test2; +end. + diff --git a/tests/test/thlp41.pp b/tests/test/thlp41.pp new file mode 100644 index 0000000000..2371634ac2 --- /dev/null +++ b/tests/test/thlp41.pp @@ -0,0 +1,16 @@ +{ %FAIL } + +{ This tests that latest added helper in other units is used for a type } +program thlp41; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp41a, uhlp41b; + +begin + TObject.Test1; +end. + diff --git a/tests/test/thlp42.pp b/tests/test/thlp42.pp new file mode 100644 index 0000000000..301cbb7053 --- /dev/null +++ b/tests/test/thlp42.pp @@ -0,0 +1,16 @@ +{ %FAIL } + +{ This tests that latest added helper in other units is used for a type } +program thlp42; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + uhlp41b, uhlp41a; + +begin + TObject.Test1; +end. + diff --git a/tests/test/thlp43.pp b/tests/test/thlp43.pp new file mode 100644 index 0000000000..cba9a5d0ef --- /dev/null +++ b/tests/test/thlp43.pp @@ -0,0 +1,21 @@ +{ this tests that a helper in an implementation section takes precedence over a + helper defined in the interface section } +program thlp43; + +{$ifdef fpc} + {$mode delphi} +{$endif} +{$apptype console} + +uses + uhlp43; + +var + res: Integer; +begin + res := DoTest; + Writeln('DoTest: ', res); + if res <> 2 then + Halt(1); + Writeln('ok'); +end. diff --git a/tests/test/thlp44.pp b/tests/test/thlp44.pp new file mode 100644 index 0000000000..c10b75ea52 --- /dev/null +++ b/tests/test/thlp44.pp @@ -0,0 +1,32 @@ +{ %NORUN } + +{ this tests that methods defined in the parent of a helper are available in the + child helper as well } +program thlp44; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + class procedure Test; + end; + + TObjectHelperSub = class helper(TObjectHelper) for TObject + class procedure DoTest; + end; + +class procedure TObjectHelper.Test; +begin + +end; + +class procedure TObjectHelperSub.DoTest; +begin + Test; +end; + +begin + TObject.DoTest; +end. diff --git a/tests/test/thlp5.pp b/tests/test/thlp5.pp new file mode 100644 index 0000000000..2fb29775e1 --- /dev/null +++ b/tests/test/thlp5.pp @@ -0,0 +1,23 @@ +{ %FAIL } + +{ overriding methods is forbidden in mode objfpc } +program thlp5; + +{$ifdef fpc} + {$modeswitch objfpc} +{$endif} + +uses + uhlp3; + +type + TObjectHelperSub = class helper(TObjectHelper) for TObject + procedure TestOverride; override; + end; + +procedure TObjectHelperSub.TestOverride; +begin +end; + +begin +end. diff --git a/tests/test/thlp6.pp b/tests/test/thlp6.pp new file mode 100644 index 0000000000..2885ea5e4d --- /dev/null +++ b/tests/test/thlp6.pp @@ -0,0 +1,24 @@ +{ %FAIL } + +{ overriding methods is forbidden in mode objfpc } +program thlp6; + +{$ifdef fpc} + {$modeswitch objfpc} +{$endif} + +uses + uhlp3; + +type + TObjectHelperSub = class helper(TObjectHelper) for TObject + procedure TestFinal; override; final; + end; + +procedure TObjectHelperSub.TestFinal; +begin +end; + +begin +end. + diff --git a/tests/test/thlp7.pp b/tests/test/thlp7.pp new file mode 100644 index 0000000000..cda1fea23b --- /dev/null +++ b/tests/test/thlp7.pp @@ -0,0 +1,20 @@ +{ %FAIL } + +{ abstract methods are forbidden } +program thlp7; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +{ Note: Delphi complains that forward declaration is not solved, + but if you add a implementation it complains that + "abstract" is not allowed } + +type + TObjectHelper = class helper for TObject + procedure Test; virtual; abstract; + end; + +begin +end. diff --git a/tests/test/thlp8.pp b/tests/test/thlp8.pp new file mode 100644 index 0000000000..32c0e200de --- /dev/null +++ b/tests/test/thlp8.pp @@ -0,0 +1,16 @@ +{ %FAIL } + +{ Fields are not allowed in helpers } +program thlp8; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TObjectHelper = class helper for TObject + Field: Integer; + end; + +begin +end. diff --git a/tests/test/thlp9.pp b/tests/test/thlp9.pp new file mode 100644 index 0000000000..bcaf41dc6b --- /dev/null +++ b/tests/test/thlp9.pp @@ -0,0 +1,17 @@ +{ %FAIL } + +{ forward declarations are not allowed } +program thlp9; + +{$ifdef fpc} + {$mode objfpc} +{$endif} + +type + TObjectHelper = class helper; + + TObjectHelper = class helper for TObject + end; + +begin +end. diff --git a/tests/test/trhlp1.pp b/tests/test/trhlp1.pp new file mode 100644 index 0000000000..ae39930df2 --- /dev/null +++ b/tests/test/trhlp1.pp @@ -0,0 +1,28 @@ +{ %NORUN } + +{ this tests that helpers can introduce instance methods for records - mode + Delphi } +program trhlp1; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + end; + + TTestHelper = record helper for TTest + procedure Test; + end; + +procedure TTestHelper.Test; +begin + +end; + +var + t: TTest; +begin + t.Test; +end. diff --git a/tests/test/tchlp81.pp b/tests/test/trhlp10.pp similarity index 57% rename from tests/test/tchlp81.pp rename to tests/test/trhlp10.pp index 5fe5a69ac8..7d72c76779 100644 --- a/tests/test/tchlp81.pp +++ b/tests/test/trhlp10.pp @@ -1,36 +1,36 @@ { helpers may introduce new default properties (includes default properties - introudced by the helper's parent) } -program tchlp81; + introduced by the helper's parent) } +program trhlp10; {$ifdef fpc} - {$mode delphi} + {$mode objfpc} + {$modeswitch advancedrecords} {$endif} {$apptype console} type - TFoo = class + TTest = record end; - TObjectHelper = class helper for TObject + TTestHelper = record helper for TTest function GetTest(aIndex: Integer): Integer; property Test[Index: Integer]: Integer read GetTest; default; end; - TFooHelper = class helper(TObjectHelper) for TFoo + TTestHelperSub = record helper(TTestHelper) for TTest end; -function TObjectHelper.GetTest(aIndex: Integer): Integer; +function TTestHelper.GetTest(aIndex: Integer): Integer; begin Result := aIndex; end; var - f: TFoo; + t: TTest; res: Integer; begin - f := TFoo.Create; - res := f[3]; + res := t[3]; Writeln('value: ', res); if res <> 3 then Halt(1); diff --git a/tests/test/tchlp59.pp b/tests/test/trhlp11.pp similarity index 62% rename from tests/test/tchlp59.pp rename to tests/test/trhlp11.pp index 5c23cfc58f..5211348497 100644 --- a/tests/test/tchlp59.pp +++ b/tests/test/trhlp11.pp @@ -1,21 +1,19 @@ { %FAIL } -{ inside a helper's declaration the methods/fields of the extended class can't +{ inside a helper's declaration the methods/fields of the extended record can't be accessed } -program tchlp59; +program trhlp11; {$ifdef fpc} {$mode delphi} {$endif} -{$apptype console} type - TFoo = class + TTest = record Test: Integer; - function GetTest: Integer; end; - TFooHelper = class helper for TFoo + TTestHelper = record helper for TTest property AccessTest: Integer read Test; end; diff --git a/tests/test/trhlp12.pp b/tests/test/trhlp12.pp new file mode 100644 index 0000000000..c25d68dba3 --- /dev/null +++ b/tests/test/trhlp12.pp @@ -0,0 +1,25 @@ +{ %FAIL } + +{ for now constructors are forbidden in record helpers } +program trhlp12; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + + end; + + TTestHelper = record helper for TTest + constructor CreateHelped(aTest: Integer); + end; + +constructor TTestHelper.CreateHelped(aTest: Integer); +begin + +end; + +begin +end. diff --git a/tests/test/trhlp13.pp b/tests/test/trhlp13.pp new file mode 100644 index 0000000000..e723d47959 --- /dev/null +++ b/tests/test/trhlp13.pp @@ -0,0 +1,15 @@ +{ %FAIL } + +{ it's not allowed for a record helper to extend a class } +program trhlp13; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTestHelper = record helper for TObject + end; + +begin +end. diff --git a/tests/test/trhlp14.pp b/tests/test/trhlp14.pp new file mode 100644 index 0000000000..9ef2d2765a --- /dev/null +++ b/tests/test/trhlp14.pp @@ -0,0 +1,24 @@ +{ %FAIL } + +{ record helpers can access only public fields - here: strict private } +program trhlp14; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + urhlp14; + +type + TTestHelper = record helper for TTest + function AccessTest: Integer; + end; + +function TTestHelper.AccessTest: Integer; +begin + Result := Test1; +end; + +begin +end. diff --git a/tests/test/trhlp15.pp b/tests/test/trhlp15.pp new file mode 100644 index 0000000000..4084031c62 --- /dev/null +++ b/tests/test/trhlp15.pp @@ -0,0 +1,25 @@ +{ %FAIL } + +{ record helpers can access only public fields - here: private } +program trhlp15; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + urhlp14; + +type + TTestHelper = record helper for TTest + function AccessTest: Integer; + end; + +function TTestHelper.AccessTest: Integer; +begin + Result := Test2; +end; + +begin +end. + diff --git a/tests/test/trhlp16.pp b/tests/test/trhlp16.pp new file mode 100644 index 0000000000..1fb63a19c8 --- /dev/null +++ b/tests/test/trhlp16.pp @@ -0,0 +1,25 @@ +{ %NORUN } + +{ record helpers can access only public fields - here: public } +program trhlp16; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + urhlp14; + +type + TTestHelper = record helper for TTest + function AccessTest: Integer; + end; + +function TTestHelper.AccessTest: Integer; +begin + Result := Test3; +end; + +begin +end. + diff --git a/tests/test/trhlp17.pp b/tests/test/trhlp17.pp new file mode 100644 index 0000000000..790dc9b091 --- /dev/null +++ b/tests/test/trhlp17.pp @@ -0,0 +1,14 @@ +{ %FAIL } + +{ usage of nested helpers adheres to visibility rules as well - here: + strict private } +program trhlp17; + +uses + urhlp17; + +var + t: TTest1; +begin + t.Test; +end. diff --git a/tests/test/trhlp18.pp b/tests/test/trhlp18.pp new file mode 100644 index 0000000000..64a0eb7e70 --- /dev/null +++ b/tests/test/trhlp18.pp @@ -0,0 +1,15 @@ +{ %FAIL } + +{ usage of nested helpers adheres to visibility rules as well - here: + private } +program trhlp18; + +uses + urhlp17; + +var + t: TTest2; +begin + t.Test; +end. + diff --git a/tests/test/trhlp19.pp b/tests/test/trhlp19.pp new file mode 100644 index 0000000000..df8693f8f7 --- /dev/null +++ b/tests/test/trhlp19.pp @@ -0,0 +1,15 @@ +{ %NORUN } + +{ usage of nested helpers adheres to visibility rules as well - here: + public } +program trhlp19; + +uses + urhlp17; + +var + t: TTest3; +begin + t.Test; +end. + diff --git a/tests/test/trhlp2.pp b/tests/test/trhlp2.pp new file mode 100644 index 0000000000..92305bbede --- /dev/null +++ b/tests/test/trhlp2.pp @@ -0,0 +1,30 @@ +{ %NORUN } + +{ this tests that helpers can introduce instance methods for records - mode + ObjFPC } +program trhlp2; + +{$ifdef fpc} + {$mode objfpc} + {$modeswitch advancedrecords} +{$endif} + +type + TTest = record + end; + + TTestHelper = record helper for TTest + procedure Test; + end; + +procedure TTestHelper.Test; +begin + +end; + +var + t: TTest; +begin + t.Test; +end. + diff --git a/tests/test/trhlp20.pp b/tests/test/trhlp20.pp new file mode 100644 index 0000000000..06037f08d7 --- /dev/null +++ b/tests/test/trhlp20.pp @@ -0,0 +1,26 @@ +{ %NORUN } + +{ although records can't have (strict) protected, record helpers can } +program trhlp20; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + + end; + + TTestHelper = record helper for TTest + strict protected + procedure Test; + end; + +procedure TTestHelper.Test; +begin + +end; + +begin +end. diff --git a/tests/test/trhlp21.pp b/tests/test/trhlp21.pp new file mode 100644 index 0000000000..17fa641623 --- /dev/null +++ b/tests/test/trhlp21.pp @@ -0,0 +1,27 @@ +{ %NORUN } + +{ although records can't have (strict) protected, record helpers can } +program trhlp21; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + + end; + + TTestHelper = record helper for TTest + protected + procedure Test; + end; + +procedure TTestHelper.Test; +begin + +end; + +begin +end. + diff --git a/tests/test/trhlp22.pp b/tests/test/trhlp22.pp new file mode 100644 index 0000000000..350696be8b --- /dev/null +++ b/tests/test/trhlp22.pp @@ -0,0 +1,30 @@ +{ %NORUN } + +{ although records can't use published members, record helpers can } +program trhlp22; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + + end; + +{$M+} + TTestHelper = record helper for TTest + private + function GetTest: Integer; + published + property Test: Integer read GetTest; + end; +{$M-} + +function TTestHelper.GetTest: Integer; +begin + +end; + +begin +end. diff --git a/tests/test/trhlp23.pp b/tests/test/trhlp23.pp new file mode 100644 index 0000000000..3653cba5d4 --- /dev/null +++ b/tests/test/trhlp23.pp @@ -0,0 +1,23 @@ +{ %NORUN } + +{ inheritance is supported for record helpers only in mode ObjFPC } +program trhlp23; + +{$ifdef fpc} + {$mode objfpc} + {$modeswitch advancedrecords} +{$endif} + +type + TTest = record + + end; + + TTestHelper = record helper for TTest + end; + + TTestHelperSub = record helper(TTestHelper) for TTest + end; + +begin +end. diff --git a/tests/test/trhlp24.pp b/tests/test/trhlp24.pp new file mode 100644 index 0000000000..a1bc829b57 --- /dev/null +++ b/tests/test/trhlp24.pp @@ -0,0 +1,22 @@ +{ %FAIL } + +{ inheritance is supported for record helpers only in mode ObjFPC } +program trhlp24; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + + end; + + TTestHelper = record helper for TTest + end; + + TTestHelperSub = record helper(TTestHelper) for TTest + end; + +begin +end. diff --git a/tests/test/trhlp25.pp b/tests/test/trhlp25.pp new file mode 100644 index 0000000000..6b0680bf8b --- /dev/null +++ b/tests/test/trhlp25.pp @@ -0,0 +1,20 @@ +{ %FAIL } + +{ record helpers may only inherit from other record helpers } +program trhlp25; + +{$ifdef fpc} + {$mode objfpc} + {$modeswitch advancedrecords} +{$endif} + +type + TTest = record + + end; + + TTestHelper = record helper(TTest) for TTest + end; + +begin +end. diff --git a/tests/test/trhlp26.pp b/tests/test/trhlp26.pp new file mode 100644 index 0000000000..2f2bc966e1 --- /dev/null +++ b/tests/test/trhlp26.pp @@ -0,0 +1,27 @@ +{ %FAIL } + +{ inherited record helpers must extend the same record } +program trhlp26; + +{$ifdef fpc} + {$mode objfpc} + {$modeswitch advancedrecords} +{$endif} + +type + TTest1 = record + + end; + + TTest2 = record + + end; + + TTest1Helper = record helper for TTest1 + end; + + TTest2Helper = record helpen(TTest1Helper) for TTest2 + end; + +begin +end. diff --git a/tests/test/trhlp27.pp b/tests/test/trhlp27.pp new file mode 100644 index 0000000000..5877e3595e --- /dev/null +++ b/tests/test/trhlp27.pp @@ -0,0 +1,36 @@ +{ record helpers hide methods of the extended record } +program trhlp27; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + function Test: Integer; + end; + + TTestHelper = record helper for TTest + function Test: Integer; + end; + +function TTest.Test: Integer; +begin + Result := 1; +end; + +function TTestHelper.Test: Integer; +begin + Result := 2; +end; + +var + t: TTest; + res: Integer; +begin + res := t.Test; + Writeln('t.Test: ', res); + if res <> 2 then + Halt(1); + Writeln('ok'); +end. diff --git a/tests/test/trhlp28.pp b/tests/test/trhlp28.pp new file mode 100644 index 0000000000..9c77d885c7 --- /dev/null +++ b/tests/test/trhlp28.pp @@ -0,0 +1,35 @@ +{ %FAIL } + +{ overloading needs to be enabled explicitly } +program trhlp28; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = class + procedure Test(const aTest: String); + end; + + TTestHelper = class helper for TTest + procedure Test; + end; + +procedure TTest.Test(const aTest: String); +begin + +end; + +procedure TTestHelper.Test; +begin + +end; + +var + t: TTest; +begin + t := TTest.Create; + t.Test('Foo'); +end. + diff --git a/tests/test/trhlp29.pp b/tests/test/trhlp29.pp new file mode 100644 index 0000000000..950cfc050d --- /dev/null +++ b/tests/test/trhlp29.pp @@ -0,0 +1,36 @@ +{ %NORUN } + +{ overloading needs to be enabled explicitly } +program trhlp29; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = class + procedure Test(const aTest: String); + end; + + TTestHelper = class helper for TTest + procedure Test; overload; + end; + +procedure TTest.Test(const aTest: String); +begin + +end; + +procedure TTestHelper.Test; +begin + +end; + +var + t: TTest; +begin + t := TTest.Create; + t.Test; + t.Test('Foo'); +end. + diff --git a/tests/test/trhlp3.pp b/tests/test/trhlp3.pp new file mode 100644 index 0000000000..e61da54708 --- /dev/null +++ b/tests/test/trhlp3.pp @@ -0,0 +1,27 @@ +{ %NORUN } + +{ this tests that helpers can introduce class methods for records - mode + Delphi } +program trhlp3; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + end; + + TTestHelper = record helper for TTest + class procedure Test; static; + end; + +class procedure TTestHelper.Test; +begin + +end; + +begin + TTest.Test; +end. + diff --git a/tests/test/trhlp30.pp b/tests/test/trhlp30.pp new file mode 100644 index 0000000000..2ba427b5c6 --- /dev/null +++ b/tests/test/trhlp30.pp @@ -0,0 +1,30 @@ +{ %NORUN } + +{ a helper can already be accessed when implementing a record's methods } +program trhlp30; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = class + procedure Test; + end; + + TTestHelper = class helper for TTest + procedure DoTest; + end; + +procedure TTest.Test; +begin + DoTest; +end; + +procedure TTestHelper.DoTest; +begin + +end; + +begin +end. diff --git a/tests/test/trhlp31.pp b/tests/test/trhlp31.pp new file mode 100644 index 0000000000..de7a576d64 --- /dev/null +++ b/tests/test/trhlp31.pp @@ -0,0 +1,40 @@ +{ methods introduced by the helper's parent hide the record methods as well } +program trhlp31; + +{$ifdef fpc} + {$mode objfpc} + {$modeswitch advancedrecords} +{$endif} + +type + TTest = record + function Test: Integer; + end; + + TTestHelper = record helper for TTest + function Test: Integer; + end; + + TTestHelperSub = record helper(TTestHelper) for TTest + end; + +function TTest.Test: Integer; +begin + Result := 1; +end; + +function TTestHelper.Test: Integer; +begin + Result := 2; +end; + +var + t: TTest; + res: Integer; +begin + res := t.Test; + Writeln('t.Test: ', res); + if res <> 2 then + Halt(1); + Writeln('ok'); +end. diff --git a/tests/test/trhlp32.pp b/tests/test/trhlp32.pp new file mode 100644 index 0000000000..1ed5a12b24 --- /dev/null +++ b/tests/test/trhlp32.pp @@ -0,0 +1,42 @@ +{ methods of the extended record can be called using "inherited", but only in + mode ObjFPC } +program trhlp32; + +{$ifdef fpc} + {$mode objfpc} + {$modeswitch advancedrecords} +{$endif} +{$apptype console} + +type + TTest = record + function Test(aRecurse: Boolean): Integer; + end; + + TTestHelper = record helper for TTest + function Test(aRecurse: Boolean): Integer; + end; + +function TTest.Test(aRecurse: Boolean): Integer; +begin + Result := 1; +end; + +function TTestHelper.Test(aRecurse: Boolean): Integer; +begin + if aRecurse then + Result := inherited Test(False) + else + Result := 2; +end; + +var + t: TTest; + res: Integer; +begin + res := t.Test(True); + Writeln('t.Test: ', res); + if res <> 1 then + Halt(1); + Writeln('ok'); +end. diff --git a/tests/test/trhlp33.pp b/tests/test/trhlp33.pp new file mode 100644 index 0000000000..35e50b3aad --- /dev/null +++ b/tests/test/trhlp33.pp @@ -0,0 +1,34 @@ +{ %FAIL } + +{ methods of the extended record can be called using "inherited", but only in + mode ObjFPC } +program trhlp33; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + function Test(aRecurse: Boolean): Integer; + end; + + TTestHelper = record helper for TTest + function Test(aRecurse: Boolean): Integer; + end; + +function TTest.Test(aRecurse: Boolean): Integer; +begin + Result := 1; +end; + +function TTestHelper.Test(aRecurse: Boolean): Integer; +begin + if aRecurse then + Result := inherited Test(False) + else + Result := 2; +end; + +begin +end. diff --git a/tests/test/trhlp34.pp b/tests/test/trhlp34.pp new file mode 100644 index 0000000000..9ec5c78017 --- /dev/null +++ b/tests/test/trhlp34.pp @@ -0,0 +1,51 @@ +{ the extended record has higher priority than the parent helper when + searching for symbols } +program trhlp34; + +{$ifdef fpc} + {$mode objfpc} + {$modeswitch advancedrecords} +{$endif} +{$apptype console} + +type + TTest = record + function Test(aRecurse: Boolean): Integer; + end; + + TTestHelper = record helper for TTest + function Test(aRecurse: Boolean): Integer; + end; + + TTestHelperSub = record helper(TTestHelper) for TTest + function Test(aRecurse: Boolean): Integer; + end; + +function TTest.Test(aRecurse: Boolean): Integer; +begin + Result := 1; +end; + +function TTestHelper.Test(aRecurse: Boolean): Integer; +begin + Result := 2; +end; + +function TTestHelperSub.Test(aRecurse: Boolean): Integer; +begin + if aRecurse then + Result := inherited Test(False) + else + Result := 3; +end; + +var + t: TTest; + res: Integer; +begin + res := t.Test(True); + Writeln('t.Test: ', res); + if res <> 1 then + Halt(1); + Writeln('ok'); +end. diff --git a/tests/test/trhlp35.pp b/tests/test/trhlp35.pp new file mode 100644 index 0000000000..a2a6f57a2c --- /dev/null +++ b/tests/test/trhlp35.pp @@ -0,0 +1,34 @@ +{ %NORUN } + +{ for helpers Self always refers to the extended record } +program trhlp35; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + procedure DoTest(aTest: TTest); + end; + + TTestHelper = record helper for TTest + procedure Test; + end; + +procedure TTest.DoTest(aTest: TTest); +begin + +end; + +procedure TTestHelper.Test; +begin + DoTest(Self); +end; + +var + t: TTest; +begin + t.Test; +end. + diff --git a/tests/test/trhlp36.pp b/tests/test/trhlp36.pp new file mode 100644 index 0000000000..0f77393bf5 --- /dev/null +++ b/tests/test/trhlp36.pp @@ -0,0 +1,36 @@ +{ %NORUN } + +{ tests whether the methods of a parent helper are usable in a derived helper } +program trhlp36; + +{$ifdef fpc} + {$mode objfpc} + {$modeswitch advancedrecords} +{$endif} +{$apptype console} + +type + TTest = record + + end; + + TTestHelper = record helper for TTest + procedure Test; + end; + + TTestHelperSub = record helper(TTestHelper) for TTest + procedure AccessTest; + end; + +procedure TTestHelper.Test; +begin + +end; + +procedure TTestHelperSub.AccessTest; +begin + Test; +end; + +begin +end. diff --git a/tests/test/tchlp61.pp b/tests/test/trhlp37.pp similarity index 55% rename from tests/test/tchlp61.pp rename to tests/test/trhlp37.pp index adc2058ec8..3430e549bd 100644 --- a/tests/test/tchlp61.pp +++ b/tests/test/trhlp37.pp @@ -1,31 +1,32 @@ { test that helpers can access the methods of the parent helper using "inherited" } -program tchlp61; +program trhlp37; {$ifdef fpc} - {$mode delphi} + {$mode objfpc} + {$modeswitch advancedrecords} {$endif} {$apptype console} type - TFoo = class + TTest = record end; - TFooHelper = class helper for TFoo + TTestHelper = record helper for TTest function Test(aRecurse: Boolean): Integer; end; - TFooBarHelper = class helper(TFooHelper) for TFoo + TTestHelperSub = record helper(TTestHelper) for TTest function Test(aRecurse: Boolean): Integer; end; -function TFooHelper.Test(aRecurse: Boolean): Integer; +function TTestHelper.Test(aRecurse: Boolean): Integer; begin Result := 1; end; -function TFooBarHelper.Test(aRecurse: Boolean): Integer; +function TTestHelperSub.Test(aRecurse: Boolean): Integer; begin if aRecurse then Result := inherited Test(False) @@ -34,12 +35,11 @@ begin end; var - f: TFoo; + t: TTest; res: Integer; begin - f := TFoo.Create; - res := f.Test(True); - Writeln('f.Test: ', res); + res := t.Test(True); + Writeln('t.Test: ', res); if res <> 1 then Halt(1); Writeln('ok'); diff --git a/tests/test/tchlp65.pp b/tests/test/trhlp38.pp similarity index 62% rename from tests/test/tchlp65.pp rename to tests/test/trhlp38.pp index fb8afc8809..7f3648a6b5 100644 --- a/tests/test/tchlp65.pp +++ b/tests/test/trhlp38.pp @@ -1,5 +1,5 @@ { without "inherited" the methods of the helper are called first } -program tchlp65; +program trhlp38; {$ifdef fpc} {$mode delphi} @@ -7,20 +7,20 @@ program tchlp65; {$apptype console} type - TFoo = class + TTest = record function Test(aRecurse: Boolean): Integer; end; - TFooHelper = class helper for TFoo + TTestHelper = record helper for TTest function Test(aRecurse: Boolean): Integer; end; -function TFoo.Test(aRecurse: Boolean): Integer; +function TTest.Test(aRecurse: Boolean): Integer; begin Result := 1; end; -function TFooHelper.Test(aRecurse: Boolean): Integer; +function TTestHelper.Test(aRecurse: Boolean): Integer; begin if aRecurse then Result := Test(False) @@ -29,12 +29,11 @@ begin end; var - f: TFoo; + t: TTest; res: Integer; begin - f := TFoo.Create; - res := f.Test(True); - Writeln('f.Test: ', res); + res := t.Test(True); + Writeln('t.Test: ', res); if res <> 2 then Halt(1); Writeln('ok'); diff --git a/tests/test/tchlp66.pp b/tests/test/trhlp39.pp similarity index 63% rename from tests/test/tchlp66.pp rename to tests/test/trhlp39.pp index 8b0587f811..62e86c7561 100644 --- a/tests/test/tchlp66.pp +++ b/tests/test/trhlp39.pp @@ -1,6 +1,6 @@ { methods defined in a helper have higher priority than those defined in the extended type } -program tchlp66; +program trhlp39; {$ifdef fpc} {$mode delphi} @@ -8,39 +8,38 @@ program tchlp66; {$apptype console} type - TFoo = class + TTest = record function Test: Integer; end; - TFooHelper = class helper for TFoo + TTestHelper = record helper for TTest private function Test: Integer; public function AccessTest: Integer; end; -function TFoo.Test: Integer; +function TTest.Test: Integer; begin Result := 1; end; -function TFooHelper.Test: Integer; +function TTestHelper.Test: Integer; begin Result := 2; end; -function TFooHelper.AccessTest: Integer; +function TTestHelper.AccessTest: Integer; begin Result := Test; end; var - f: TFoo; + t: TTest; res: Integer; begin - f := TFoo.Create; - res := f.AccessTest; - Writeln('f.AccessTest: ', res); + res := t.AccessTest; + Writeln('t.AccessTest: ', res); if res <> 2 then Halt(1); Writeln('ok'); diff --git a/tests/test/trhlp4.pp b/tests/test/trhlp4.pp new file mode 100644 index 0000000000..40a74c3d7d --- /dev/null +++ b/tests/test/trhlp4.pp @@ -0,0 +1,28 @@ +{ %NORUN } + +{ this tests that helpers can introduce class methods for records - mode + ObjFPC } +program trhlp4; + +{$ifdef fpc} + {$mode objfpc} + {$modeswitch advancedrecords} +{$endif} + +type + TTest = record + end; + + TTestHelper = record helper for TTest + class procedure Test; static; + end; + +class procedure TTestHelper.Test; +begin + +end; + +begin + TTest.Test; +end. + diff --git a/tests/test/trhlp40.pp b/tests/test/trhlp40.pp new file mode 100644 index 0000000000..ec7965328a --- /dev/null +++ b/tests/test/trhlp40.pp @@ -0,0 +1,74 @@ +{ %NORUN } + +{ a helper may introduce an enumerator } +program trhlp40; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TContainer = record + Contents: array[0..5] of Integer; + procedure Init; + end; + PContainer = ^TContainer; + + TContainerEnum = class + private + fIndex: Integer; + fContainer: PContainer; + public + constructor Create(aContainer: PContainer); + function GetCurrent: Integer; + function MoveNext: Boolean; + property Current: Integer read GetCurrent; + end; + + TContainerHelper = record helper for TContainer + function GetEnumerator: TContainerEnum; + end; + +{ TContainer } + +procedure TContainer.Init; +var + i: Integer; +begin + for i := Low(Contents) to High(Contents) do + Contents[i] := i; +end; + +{ TContainerHelper } + +function TContainerHelper.GetEnumerator: TContainerEnum; +begin + Result := TContainerEnum.Create(@Self); +end; + +{ TContainerEnum } + +constructor TContainerEnum.Create(aContainer: PContainer); +begin + fContainer := aContainer; + fIndex := Low(fContainer^.Contents) - 1; +end; + +function TContainerEnum.GetCurrent: Integer; +begin + Result := fContainer^.Contents[fIndex]; +end; + +function TContainerEnum.MoveNext: Boolean; +begin + Inc(fIndex); + Result := fIndex <= High(fContainer^.Contents); +end; + +var + cont: TContainer; + i: Integer; +begin + cont.Init; + for i in cont do ; +end. diff --git a/tests/test/trhlp41.pp b/tests/test/trhlp41.pp new file mode 100644 index 0000000000..92b67103ae --- /dev/null +++ b/tests/test/trhlp41.pp @@ -0,0 +1,97 @@ +{ a helper hides an existing enumerator } +program trhlp41; + +{$ifdef fpc} + {$mode delphi} +{$endif} +{$apptype console} + +type + PContainer = ^TContainer; + + TContainerEnum = class + private + fIndex: Integer; + fContainer: PContainer; + fForward: Boolean; + public + constructor Create(aContainer: PContainer; aForward: Boolean); + function GetCurrent: Integer; + function MoveNext: Boolean; + property Current: Integer read GetCurrent; + end; + + TContainer = record + Contents: array[0..5] of Integer; + function GetEnumerator: TContainerEnum; + procedure Init; + end; + + TContainerHelper = record helper for TContainer + function GetEnumerator: TContainerEnum; + end; + +{ TContainer } + +procedure TContainer.Init; +var + i: Integer; +begin + for i := Low(Contents) to High(Contents) do + Contents[i] := i; +end; + +function TContainer.GetEnumerator: TContainerEnum; +begin + Result := TContainerEnum.Create(@Self, True); +end; + +{ TContainerHelper } + +function TContainerHelper.GetEnumerator: TContainerEnum; +begin + Result := TContainerEnum.Create(@Self, False); +end; + +{ TContainerEnum } + +constructor TContainerEnum.Create(aContainer: PContainer; aForward: Boolean); +begin + fContainer := aContainer; + fForward := aForward; + if fForward then + fIndex := Low(fContainer^.Contents) - 1 + else + fIndex := High(fContainer^.Contents) + 1; +end; + +function TContainerEnum.GetCurrent: Integer; +begin + Result := fContainer^.Contents[fIndex]; +end; + +function TContainerEnum.MoveNext: Boolean; +begin + if fForward then begin + Inc(fIndex); + Result := fIndex <= High(fContainer^.Contents); + end else begin + Dec(fIndex); + Result := fIndex >= Low(fContainer^.Contents); + end; +end; + +var + cont: TContainer; + i, c: Integer; +begin + cont.Init; + c := 5; + for i in cont do begin + if c <> i then + Halt(1); + Writeln(i); + Dec(c); + end; + Writeln('ok'); +end. diff --git a/tests/test/trhlp5.pp b/tests/test/trhlp5.pp new file mode 100644 index 0000000000..84ee4019b5 --- /dev/null +++ b/tests/test/trhlp5.pp @@ -0,0 +1,20 @@ +{ %FAIL } + +{ in mode ObjFPC the modeswitch advancedrecords is necessary for record + helpers } +program trhlp5; + +{$ifdef fpc} + {$mode objfpc} +{$endif} + +type + TTest = record + + end; + + TTestHelper = record helper for TTest + end; + +begin +end. diff --git a/tests/test/trhlp6.pp b/tests/test/trhlp6.pp new file mode 100644 index 0000000000..3cc3e1f2ac --- /dev/null +++ b/tests/test/trhlp6.pp @@ -0,0 +1,25 @@ +{ %FAIL } + +{ instance methods in record helpers must be static } +program trhlp6; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +type + TTest = record + + end; + + TTestHelper = record helper for TTest + class procedure Test; + end; + +class procedure TTestHelper.Test; +begin + +end; + +begin +end. diff --git a/tests/test/trhlp7.pp b/tests/test/trhlp7.pp new file mode 100644 index 0000000000..0f1d8b852d --- /dev/null +++ b/tests/test/trhlp7.pp @@ -0,0 +1,29 @@ +{ the size of a record helper is equivalent to that of a pointer } +program trhlp7; + +{$ifdef fpc} + {$mode delphi} +{$endif} +{$apptype console} + +type + TTest = packed record + s: String; + i32: Integer; + b: Boolean; + i64: Int64; + end; + + TTestHelper = record helper for TTest + end; + +var + res: Integer; +begin + res := SizeOf(TTestHelper); + Writeln('SizeOf(TTest): ', SizeOf(TTest)); + Writeln('SizeOf(TTestHelper): ', res); + if res <> SizeOf(Pointer) then + Halt(1); + Writeln('ok'); +end. diff --git a/tests/test/tchlp76.pp b/tests/test/trhlp8.pp similarity index 69% rename from tests/test/tchlp76.pp rename to tests/test/trhlp8.pp index d94d0ad497..4ba7bbe115 100644 --- a/tests/test/tchlp76.pp +++ b/tests/test/trhlp8.pp @@ -1,5 +1,5 @@ { helpers may introduce new default properties } -program tchlp76; +program trhlp8; {$ifdef fpc} {$mode delphi} @@ -7,26 +7,25 @@ program tchlp76; {$apptype console} type - TFoo = class + TTest = record end; - TFooHelper = class helper for TFoo + TTestHelper = record helper for TTest function GetTest(aIndex: Integer): Integer; property Test[Index: Integer]: Integer read GetTest; default; end; -function TFooHelper.GetTest(aIndex: Integer): Integer; +function TTestHelper.GetTest(aIndex: Integer): Integer; begin Result := aIndex; end; var - f: TFoo; + t: TTest; res: Integer; begin - f := TFoo.Create; - res := f[3]; + res := t[3]; Writeln('value: ', res); if res <> 3 then Halt(1); diff --git a/tests/test/tchlp77.pp b/tests/test/trhlp9.pp similarity index 71% rename from tests/test/tchlp77.pp rename to tests/test/trhlp9.pp index cabbb2f998..07f8bb2a9c 100644 --- a/tests/test/tchlp77.pp +++ b/tests/test/trhlp9.pp @@ -1,5 +1,5 @@ { helpers may override existing default properties } -program tchlp77; +program trhlp9; {$ifdef fpc} {$mode delphi} @@ -7,34 +7,33 @@ program tchlp77; {$apptype console} type - TFoo = class + TTest = record private function GetTest(aIndex: Integer): Integer; public property Test[Index: Integer]: Integer read GetTest; default; end; - TFooHelper = class helper for TFoo + TTestHelper = record helper for TTest function GetTest(aIndex: Integer): Integer; property Test[Index: Integer]: Integer read GetTest; default; end; -function TFoo.GetTest(aIndex: Integer): Integer; +function TTest.GetTest(aIndex: Integer): Integer; begin Result := - aIndex; end; -function TFooHelper.GetTest(aIndex: Integer): Integer; +function TTestHelper.GetTest(aIndex: Integer): Integer; begin Result := aIndex; end; var - f: TFoo; + t: TTest; res: Integer; begin - f := TFoo.Create; - res := f[3]; + res := t[3]; Writeln('value: ', res); if res <> 3 then Halt(1); diff --git a/tests/test/uchlp12.pp b/tests/test/uchlp12.pp new file mode 100644 index 0000000000..141274a85c --- /dev/null +++ b/tests/test/uchlp12.pp @@ -0,0 +1,36 @@ +unit uchlp12; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +interface + +type +{$M+} + TTest = class + private + function GetTest6: Integer; + strict private + Test1: Integer; + private + Test2: Integer; + strict protected + Test3: Integer; + protected + Test4: Integer; + public + Test5: Integer; + published + property Test6: Integer read GetTest6; + end; +{$M-} + +implementation + +function TTest.GetTest6: Integer; +begin + Result := 0; +end; + +end. diff --git a/tests/test/uchlp18.pp b/tests/test/uchlp18.pp new file mode 100644 index 0000000000..1de523d509 --- /dev/null +++ b/tests/test/uchlp18.pp @@ -0,0 +1,95 @@ +unit uchlp18; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +interface + +type + TTest1 = class + end; + + TTest2 = class + end; + + TTest3 = class + end; + + TTest4 = class + end; + + TTest5 = class + end; + + TTest6 = class + end; + +{$M+} + TTestHub = class + strict private + type + TTest1Helper = class helper for TTest1 + procedure Test; + end; + private + type + TTest2Helper = class helper for TTest2 + procedure Test; + end; + strict protected + type + TTest3Helper = class helper for TTest3 + procedure Test; + end; + protected + type + TTest4Helper = class helper for TTest4 + procedure Test; + end; + public + type + TTest5Helper = class helper for TTest5 + procedure Test; + end; + published + type + TTest6Helper = class helper for TTest6 + procedure Test; + end; + end; +{$M-} + +implementation + +procedure TTestHub.TTest1Helper.Test; +begin + +end; + +procedure TTestHub.TTest2Helper.Test; +begin + +end; + +procedure TTestHub.TTest3Helper.Test; +begin + +end; + +procedure TTestHub.TTest4Helper.Test; +begin + +end; + +procedure TTestHub.TTest5Helper.Test; +begin + +end; + +procedure TTestHub.TTest6Helper.Test; +begin + +end; + +end. diff --git a/tests/test/uchlp27a.pp b/tests/test/uchlp27a.pp deleted file mode 100644 index 335fc345f5..0000000000 --- a/tests/test/uchlp27a.pp +++ /dev/null @@ -1,24 +0,0 @@ -unit uchlp27a; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -type - TFoo = class - function Test: Integer; - end; - -implementation - -{ TFoo } - -function TFoo.Test: Integer; -begin - Result := 1; -end; - -end. - diff --git a/tests/test/uchlp27b.pp b/tests/test/uchlp27b.pp deleted file mode 100644 index c702155e21..0000000000 --- a/tests/test/uchlp27b.pp +++ /dev/null @@ -1,25 +0,0 @@ -unit uchlp27b; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -uses - uchlp27a; - -type - TFooHelper = class helper for TFoo - function Test: Integer; - end; - -implementation - -function TFooHelper.Test: Integer; -begin - Result := 2; -end; - -end. - diff --git a/tests/test/uchlp27c.pp b/tests/test/uchlp27c.pp deleted file mode 100644 index d41fa38a2c..0000000000 --- a/tests/test/uchlp27c.pp +++ /dev/null @@ -1,27 +0,0 @@ -unit uchlp27c; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -uses - uchlp27a; - -type - TBar = class(TFoo) - function Test: Integer; - end; - -implementation - -{ TBar } - -function TBar.Test: Integer; -begin - Result := 3; -end; - -end. - diff --git a/tests/test/uchlp32a.pp b/tests/test/uchlp32a.pp deleted file mode 100644 index e1c6bcc8ca..0000000000 --- a/tests/test/uchlp32a.pp +++ /dev/null @@ -1,16 +0,0 @@ -unit uchlp32a; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -type - TFoo = class - end; - -implementation - -end. - diff --git a/tests/test/uchlp32b.pp b/tests/test/uchlp32b.pp deleted file mode 100644 index 0407594cbc..0000000000 --- a/tests/test/uchlp32b.pp +++ /dev/null @@ -1,25 +0,0 @@ -unit uchlp32b; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -uses - uchlp32a; - -type - TFooHelperA = class helper for TFoo - procedure Method1; - end; - -implementation - -procedure TFooHelperA.Method1; -begin - -end; - -end. - diff --git a/tests/test/uchlp32c.pp b/tests/test/uchlp32c.pp deleted file mode 100644 index 7fe941841b..0000000000 --- a/tests/test/uchlp32c.pp +++ /dev/null @@ -1,25 +0,0 @@ -unit uchlp32c; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -uses - uchlp32a; - -type - TFooHelperB = class helper for TFoo - procedure Method2; - end; - -implementation - -procedure TFooHelperB.Method2; -begin - -end; - -end. - diff --git a/tests/test/uchlp33a.pp b/tests/test/uchlp33a.pp deleted file mode 100644 index 18183f5491..0000000000 --- a/tests/test/uchlp33a.pp +++ /dev/null @@ -1,16 +0,0 @@ -unit uchlp33a; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -type - TFoo = class - end; - -implementation - -end. - diff --git a/tests/test/uchlp33b.pp b/tests/test/uchlp33b.pp deleted file mode 100644 index 7db270eccb..0000000000 --- a/tests/test/uchlp33b.pp +++ /dev/null @@ -1,25 +0,0 @@ -unit uchlp33b; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -uses - uchlp33a; - -type - TFooHelper = class helper for TFoo - function Test: Integer; - end; - -implementation - -function TFooHelper.Test: Integer; -begin - Result := 1; -end; - -end. - diff --git a/tests/test/uchlp33c.pp b/tests/test/uchlp33c.pp deleted file mode 100644 index c092061c25..0000000000 --- a/tests/test/uchlp33c.pp +++ /dev/null @@ -1,25 +0,0 @@ -unit uchlp33c; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -uses - uchlp33a, uchlp33b; - -type - TFooHelper2 = class helper(TFooHelper) for TFoo - function Test: Integer; - end; - -implementation - -function TFooHelper2.Test: Integer; -begin - Result := 2; -end; - -end. - diff --git a/tests/test/uchlp35.pp b/tests/test/uchlp35.pp deleted file mode 100644 index 2db0c23dde..0000000000 --- a/tests/test/uchlp35.pp +++ /dev/null @@ -1,28 +0,0 @@ -unit uchlp35; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -type - TObjectHelperA = class helper for TObject - function Test: Integer; - function VirtualTest: Integer; virtual; - end; - -implementation - -function TObjectHelperA.Test: Integer; -begin - Result := VirtualTest; -end; - -function TObjectHelperA.VirtualTest: Integer; -begin - Result := 1; -end; - -end. - diff --git a/tests/test/uchlp50.pp b/tests/test/uchlp50.pp deleted file mode 100644 index 6ece733c21..0000000000 --- a/tests/test/uchlp50.pp +++ /dev/null @@ -1,34 +0,0 @@ -unit uchlp50; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -type - TFoo = class - end; - - TFooHelper1 = class helper for TFoo - function Test: Integer; - end; - - TFooHelper2 = class helper for TFoo - function Test: Integer; - end; - -implementation - -function TFooHelper1.Test: Integer; -begin - Result := 1; -end; - -function TFooHelper2.Test: Integer; -begin - Result := 2; -end; - -end. - diff --git a/tests/test/uchlp51a.pp b/tests/test/uchlp51a.pp deleted file mode 100644 index 2b6da6fdf9..0000000000 --- a/tests/test/uchlp51a.pp +++ /dev/null @@ -1,22 +0,0 @@ -unit uchlp51a; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -type - TFoo = class - function Test: Integer; - end; - -implementation - -function TFoo.Test: Integer; -begin - Result := 1; -end; - -end. - diff --git a/tests/test/uchlp51b.pp b/tests/test/uchlp51b.pp deleted file mode 100644 index e589913ad6..0000000000 --- a/tests/test/uchlp51b.pp +++ /dev/null @@ -1,25 +0,0 @@ -unit uchlp51b; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -uses - uchlp51a; - -type - TFooHelper = class helper for TFoo - function Test: Integer; - end; - -implementation - -function TFooHelper.Test: Integer; -begin - Result := 2; -end; - -end. - diff --git a/tests/test/uchlp51c.pp b/tests/test/uchlp51c.pp deleted file mode 100644 index da5e19236a..0000000000 --- a/tests/test/uchlp51c.pp +++ /dev/null @@ -1,28 +0,0 @@ -unit uchlp51c; - -{$ifdef fpc} - {$mode objfpc}{$H+} -{$endif} - -interface - -uses - uchlp51a; - -type - TFooHelper2 = class helper for TFoo - function AccessTest: Integer; - end; - -implementation - -uses - uchlp51b; - -function TFooHelper2.AccessTest: Integer; -begin - Result := Test; -end; - -end. - diff --git a/tests/test/uhlp3.pp b/tests/test/uhlp3.pp new file mode 100644 index 0000000000..4a50a9b8b5 --- /dev/null +++ b/tests/test/uhlp3.pp @@ -0,0 +1,25 @@ +unit uhlp3; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +interface + +type + TObjectHelper = class helper for TObject + procedure TestOverride; virtual; + procedure TestFinal; virtual; + end; + +implementation + +procedure TObjectHelper.TestOverride; +begin +end; + +procedure TObjectHelper.TestFinal; +begin +end; + +end. diff --git a/tests/test/uchlp45.pp b/tests/test/uhlp31.pp similarity index 80% rename from tests/test/uchlp45.pp rename to tests/test/uhlp31.pp index 7095b10260..b494712d85 100644 --- a/tests/test/uchlp45.pp +++ b/tests/test/uhlp31.pp @@ -1,7 +1,7 @@ -unit uchlp45; +unit uhlp31; {$ifdef fpc} - {$mode objfpc}{$H+} + {$mode delphi}{$H+} {$endif} interface @@ -10,6 +10,7 @@ type TFoo = class end; +{$M+} TFooHelper = class helper for TFoo strict private procedure Test1; @@ -21,7 +22,10 @@ type procedure Test4; public procedure Test5; + published + procedure Test6; end; +{$M-} implementation @@ -50,5 +54,10 @@ begin end; +procedure TFooHelper.Test6; +begin + +end; + end. diff --git a/tests/test/uhlp39.pp b/tests/test/uhlp39.pp new file mode 100644 index 0000000000..408193ae8d --- /dev/null +++ b/tests/test/uhlp39.pp @@ -0,0 +1,30 @@ +unit uhlp39; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +interface + +type + TObjectHelper1 = class helper for TObject + class procedure Test1; + end; + + TObjectHelper2 = class helper for TObject + class procedure Test2; + end; + +implementation + +class procedure TObjectHelper1.Test1; +begin + +end; + +class procedure TObjectHelper2.Test2; +begin + +end; + +end. diff --git a/tests/test/uhlp41a.pp b/tests/test/uhlp41a.pp new file mode 100644 index 0000000000..1828454437 --- /dev/null +++ b/tests/test/uhlp41a.pp @@ -0,0 +1,21 @@ +unit uhlp41a; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +interface + +type + TObjectHelper1 = class helper for TObject + class procedure Test1; + end; + +implementation + +class procedure TObjectHelper1.Test1; +begin + +end; + +end. diff --git a/tests/test/uhlp41b.pp b/tests/test/uhlp41b.pp new file mode 100644 index 0000000000..cc012e29b8 --- /dev/null +++ b/tests/test/uhlp41b.pp @@ -0,0 +1,17 @@ +unit uhlp41b; + +interface + +type + TObjectHelper2 = class helper for TObject + class procedure Test2; + end; + +implementation + +class procedure TObjectHelper2.Test2; +begin + +end; + +end. diff --git a/tests/test/uhlp43.pp b/tests/test/uhlp43.pp new file mode 100644 index 0000000000..a56b24e687 --- /dev/null +++ b/tests/test/uhlp43.pp @@ -0,0 +1,38 @@ +unit uhlp43; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +interface + +type + TInterfaceHelper = class helper for TObject + class function Test: Integer; + end; + +function DoTest: Integer; + +implementation + +class function TInterfaceHelper.Test: Integer; +begin + Result := 1; +end; + +type + TImplementationHelper = class helper for TObject + class function Test: Integer; + end; + +class function TImplementationHelper.Test: Integer; +begin + Result := 2; +end; + +function DoTest: Integer; +begin + Result := TObject.Test; +end; + +end. diff --git a/tests/test/uchlp82.pp b/tests/test/urhlp14.pp similarity index 60% rename from tests/test/uchlp82.pp rename to tests/test/urhlp14.pp index 8c4085cbb5..eaf1e5ad09 100644 --- a/tests/test/uchlp82.pp +++ b/tests/test/urhlp14.pp @@ -1,24 +1,21 @@ -unit uchlp82; +unit urhlp14; {$ifdef fpc} - {$mode objfpc}{$H+} + {$mode delphi} {$endif} interface type - TFoo = class + TTest = record strict private Test1: Integer; private Test2: Integer; - strict protected + public Test3: Integer; - protected - Test4: Integer; end; implementation end. - diff --git a/tests/test/urhlp17.pp b/tests/test/urhlp17.pp new file mode 100644 index 0000000000..166d4c08aa --- /dev/null +++ b/tests/test/urhlp17.pp @@ -0,0 +1,54 @@ +unit urhlp17; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +interface + +type + TTest1 = record + end; + + TTest2 = record + end; + + TTest3 = record + end; + + TTestHub = record + strict private + type + TTest1Helper = record helper for TTest1 + procedure Test; + end; + private + type + TTest2Helper = record helper for TTest2 + procedure Test; + end; + public + type + TTest3Helper = record helper for TTest3 + procedure Test; + end; + end; + +implementation + +procedure TTestHub.TTest1Helper.Test; +begin + +end; + +procedure TTestHub.TTest2Helper.Test; +begin + +end; + +procedure TTestHub.TTest3Helper.Test; +begin + +end; + +end.