From 0ff33da805881f90d7498cc372bfd74c526f48f9 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Mon, 9 Feb 2009 11:19:11 +0000 Subject: Rename ext/Devel/PPPort to ext/Devel-PPPort It has its tentacles in many other places. --- MANIFEST | 324 +++--- Makefile.SH | 2 +- Porting/Maintainers.pl | 2 +- Porting/makerel | 4 +- Porting/pumpkin.pod | 2 +- ext/.gitignore | 2 + ext/Devel-PPPort/.gitignore | 5 + ext/Devel-PPPort/Changes | 717 ++++++++++++ ext/Devel-PPPort/HACKERS | 326 ++++++ ext/Devel-PPPort/MANIFEST.SKIP | 18 + ext/Devel-PPPort/Makefile.PL | 142 +++ ext/Devel-PPPort/PPPort.xs | 3 + ext/Devel-PPPort/PPPort_pm.PL | 663 +++++++++++ ext/Devel-PPPort/PPPort_xs.PL | 140 +++ ext/Devel-PPPort/README | 78 ++ ext/Devel-PPPort/TODO | 347 ++++++ ext/Devel-PPPort/apicheck_c.PL | 29 + ext/Devel-PPPort/devel/buildperl.pl | 539 +++++++++ ext/Devel-PPPort/devel/devtools.pl | 129 ++ ext/Devel-PPPort/devel/mkapidoc.sh | 87 ++ ext/Devel-PPPort/devel/mktodo | 62 + ext/Devel-PPPort/devel/mktodo.pl | 346 ++++++ ext/Devel-PPPort/devel/regenerate | 161 +++ ext/Devel-PPPort/devel/scanprov | 77 ++ ext/Devel-PPPort/mktests.PL | 116 ++ ext/Devel-PPPort/module2.c | 60 + ext/Devel-PPPort/module3.c | 77 ++ ext/Devel-PPPort/parts/apicheck.pl | 322 +++++ ext/Devel-PPPort/parts/apidoc.fnc | 327 ++++++ ext/Devel-PPPort/parts/base/5004000 | 88 ++ ext/Devel-PPPort/parts/base/5004010 | 1 + ext/Devel-PPPort/parts/base/5004020 | 1 + ext/Devel-PPPort/parts/base/5004030 | 1 + ext/Devel-PPPort/parts/base/5004040 | 1 + ext/Devel-PPPort/parts/base/5004050 | 43 + ext/Devel-PPPort/parts/base/5005000 | 36 + ext/Devel-PPPort/parts/base/5005010 | 1 + ext/Devel-PPPort/parts/base/5005020 | 1 + ext/Devel-PPPort/parts/base/5005030 | 4 + ext/Devel-PPPort/parts/base/5005040 | 1 + ext/Devel-PPPort/parts/base/5006000 | 288 +++++ ext/Devel-PPPort/parts/base/5006001 | 14 + ext/Devel-PPPort/parts/base/5006002 | 1 + ext/Devel-PPPort/parts/base/5007000 | 1 + ext/Devel-PPPort/parts/base/5007001 | 24 + ext/Devel-PPPort/parts/base/5007002 | 73 ++ ext/Devel-PPPort/parts/base/5007003 | 85 ++ ext/Devel-PPPort/parts/base/5008000 | 8 + ext/Devel-PPPort/parts/base/5008001 | 26 + ext/Devel-PPPort/parts/base/5008002 | 1 + ext/Devel-PPPort/parts/base/5008003 | 3 + ext/Devel-PPPort/parts/base/5008004 | 1 + ext/Devel-PPPort/parts/base/5008005 | 1 + ext/Devel-PPPort/parts/base/5008006 | 1 + ext/Devel-PPPort/parts/base/5008007 | 1 + ext/Devel-PPPort/parts/base/5008008 | 1 + ext/Devel-PPPort/parts/base/5009000 | 6 + ext/Devel-PPPort/parts/base/5009001 | 8 + ext/Devel-PPPort/parts/base/5009002 | 32 + ext/Devel-PPPort/parts/base/5009003 | 62 + ext/Devel-PPPort/parts/base/5009004 | 29 + ext/Devel-PPPort/parts/base/5009005 | 32 + ext/Devel-PPPort/parts/base/5010000 | 7 + ext/Devel-PPPort/parts/base/5011000 | 32 + ext/Devel-PPPort/parts/embed.fnc | 2004 ++++++++++++++++++++++++++++++++ ext/Devel-PPPort/parts/inc/MY_CXT | 192 +++ ext/Devel-PPPort/parts/inc/SvPV | 524 +++++++++ ext/Devel-PPPort/parts/inc/SvREFCNT | 130 +++ ext/Devel-PPPort/parts/inc/Sv_set | 124 ++ ext/Devel-PPPort/parts/inc/call | 367 ++++++ ext/Devel-PPPort/parts/inc/cop | 84 ++ ext/Devel-PPPort/parts/inc/exception | 74 ++ ext/Devel-PPPort/parts/inc/format | 70 ++ ext/Devel-PPPort/parts/inc/grok | 677 +++++++++++ ext/Devel-PPPort/parts/inc/limits | 331 ++++++ ext/Devel-PPPort/parts/inc/mPUSH | 138 +++ ext/Devel-PPPort/parts/inc/magic | 369 ++++++ ext/Devel-PPPort/parts/inc/memory | 84 ++ ext/Devel-PPPort/parts/inc/misc | 536 +++++++++ ext/Devel-PPPort/parts/inc/newCONSTSUB | 111 ++ ext/Devel-PPPort/parts/inc/newRV | 74 ++ ext/Devel-PPPort/parts/inc/newSVpv | 115 ++ ext/Devel-PPPort/parts/inc/podtest | 52 + ext/Devel-PPPort/parts/inc/ppphbin | 828 +++++++++++++ ext/Devel-PPPort/parts/inc/ppphdoc | 353 ++++++ ext/Devel-PPPort/parts/inc/ppphtest | 901 ++++++++++++++ ext/Devel-PPPort/parts/inc/pv_tools | 281 +++++ ext/Devel-PPPort/parts/inc/pvs | 99 ++ ext/Devel-PPPort/parts/inc/shared_pv | 91 ++ ext/Devel-PPPort/parts/inc/snprintf | 70 ++ ext/Devel-PPPort/parts/inc/sprintf | 62 + ext/Devel-PPPort/parts/inc/strlfuncs | 114 ++ ext/Devel-PPPort/parts/inc/sv_xpvf | 321 +++++ ext/Devel-PPPort/parts/inc/threads | 75 ++ ext/Devel-PPPort/parts/inc/uv | 129 ++ ext/Devel-PPPort/parts/inc/variables | 449 +++++++ ext/Devel-PPPort/parts/inc/version | 58 + ext/Devel-PPPort/parts/inc/warn | 175 +++ ext/Devel-PPPort/parts/ppport.fnc | 29 + ext/Devel-PPPort/parts/ppptools.pl | 400 +++++++ ext/Devel-PPPort/parts/todo/5004000 | 68 ++ ext/Devel-PPPort/parts/todo/5004010 | 1 + ext/Devel-PPPort/parts/todo/5004020 | 1 + ext/Devel-PPPort/parts/todo/5004030 | 1 + ext/Devel-PPPort/parts/todo/5004040 | 1 + ext/Devel-PPPort/parts/todo/5004050 | 4 + ext/Devel-PPPort/parts/todo/5005000 | 27 + ext/Devel-PPPort/parts/todo/5005010 | 1 + ext/Devel-PPPort/parts/todo/5005020 | 1 + ext/Devel-PPPort/parts/todo/5005030 | 4 + ext/Devel-PPPort/parts/todo/5005040 | 1 + ext/Devel-PPPort/parts/todo/5006000 | 150 +++ ext/Devel-PPPort/parts/todo/5006001 | 11 + ext/Devel-PPPort/parts/todo/5006002 | 1 + ext/Devel-PPPort/parts/todo/5007000 | 1 + ext/Devel-PPPort/parts/todo/5007001 | 19 + ext/Devel-PPPort/parts/todo/5007002 | 16 + ext/Devel-PPPort/parts/todo/5007003 | 62 + ext/Devel-PPPort/parts/todo/5008000 | 5 + ext/Devel-PPPort/parts/todo/5008001 | 14 + ext/Devel-PPPort/parts/todo/5008002 | 1 + ext/Devel-PPPort/parts/todo/5008003 | 3 + ext/Devel-PPPort/parts/todo/5008004 | 1 + ext/Devel-PPPort/parts/todo/5008005 | 1 + ext/Devel-PPPort/parts/todo/5008006 | 1 + ext/Devel-PPPort/parts/todo/5008007 | 1 + ext/Devel-PPPort/parts/todo/5008008 | 1 + ext/Devel-PPPort/parts/todo/5009000 | 6 + ext/Devel-PPPort/parts/todo/5009001 | 6 + ext/Devel-PPPort/parts/todo/5009002 | 9 + ext/Devel-PPPort/parts/todo/5009003 | 26 + ext/Devel-PPPort/parts/todo/5009004 | 8 + ext/Devel-PPPort/parts/todo/5009005 | 31 + ext/Devel-PPPort/parts/todo/5010000 | 7 + ext/Devel-PPPort/parts/todo/5011000 | 17 + ext/Devel-PPPort/ppport_h.PL | 25 + ext/Devel-PPPort/soak | 606 ++++++++++ ext/Devel-PPPort/t/MY_CXT.t | 54 + ext/Devel-PPPort/t/SvPV.t | 116 ++ ext/Devel-PPPort/t/SvREFCNT.t | 54 + ext/Devel-PPPort/t/Sv_set.t | 71 ++ ext/Devel-PPPort/t/call.t | 107 ++ ext/Devel-PPPort/t/cop.t | 62 + ext/Devel-PPPort/t/exception.t | 67 ++ ext/Devel-PPPort/t/format.t | 55 + ext/Devel-PPPort/t/grok.t | 62 + ext/Devel-PPPort/t/limits.t | 55 + ext/Devel-PPPort/t/mPUSH.t | 62 + ext/Devel-PPPort/t/magic.t | 95 ++ ext/Devel-PPPort/t/memory.t | 52 + ext/Devel-PPPort/t/misc.t | 125 ++ ext/Devel-PPPort/t/newCONSTSUB.t | 59 + ext/Devel-PPPort/t/newRV.t | 53 + ext/Devel-PPPort/t/newSVpv.t | 78 ++ ext/Devel-PPPort/t/podtest.t | 83 ++ ext/Devel-PPPort/t/ppphtest.t | 932 +++++++++++++++ ext/Devel-PPPort/t/pv_tools.t | 74 ++ ext/Devel-PPPort/t/pvs.t | 68 ++ ext/Devel-PPPort/t/shared_pv.t | 52 + ext/Devel-PPPort/t/snprintf.t | 54 + ext/Devel-PPPort/t/sprintf.t | 54 + ext/Devel-PPPort/t/strlfuncs.t | 65 ++ ext/Devel-PPPort/t/sv_xpvf.t | 78 ++ ext/Devel-PPPort/t/testutil.pl | 48 + ext/Devel-PPPort/t/threads.t | 54 + ext/Devel-PPPort/t/uv.t | 61 + ext/Devel-PPPort/t/variables.t | 107 ++ ext/Devel-PPPort/t/warn.t | 78 ++ ext/Devel-PPPort/typemap | 35 + ext/Devel/.gitignore | 2 - ext/Devel/PPPort/.gitignore | 5 - ext/Devel/PPPort/Changes | 717 ------------ ext/Devel/PPPort/HACKERS | 326 ------ ext/Devel/PPPort/MANIFEST.SKIP | 18 - ext/Devel/PPPort/Makefile.PL | 142 --- ext/Devel/PPPort/PPPort.xs | 3 - ext/Devel/PPPort/PPPort_pm.PL | 663 ----------- ext/Devel/PPPort/PPPort_xs.PL | 140 --- ext/Devel/PPPort/README | 78 -- ext/Devel/PPPort/TODO | 347 ------ ext/Devel/PPPort/apicheck_c.PL | 29 - ext/Devel/PPPort/devel/buildperl.pl | 539 --------- ext/Devel/PPPort/devel/devtools.pl | 129 -- ext/Devel/PPPort/devel/mkapidoc.sh | 87 -- ext/Devel/PPPort/devel/mktodo | 62 - ext/Devel/PPPort/devel/mktodo.pl | 346 ------ ext/Devel/PPPort/devel/regenerate | 161 --- ext/Devel/PPPort/devel/scanprov | 77 -- ext/Devel/PPPort/mktests.PL | 116 -- ext/Devel/PPPort/module2.c | 60 - ext/Devel/PPPort/module3.c | 77 -- ext/Devel/PPPort/parts/apicheck.pl | 322 ----- ext/Devel/PPPort/parts/apidoc.fnc | 327 ------ ext/Devel/PPPort/parts/base/5004000 | 88 -- ext/Devel/PPPort/parts/base/5004010 | 1 - ext/Devel/PPPort/parts/base/5004020 | 1 - ext/Devel/PPPort/parts/base/5004030 | 1 - ext/Devel/PPPort/parts/base/5004040 | 1 - ext/Devel/PPPort/parts/base/5004050 | 43 - ext/Devel/PPPort/parts/base/5005000 | 36 - ext/Devel/PPPort/parts/base/5005010 | 1 - ext/Devel/PPPort/parts/base/5005020 | 1 - ext/Devel/PPPort/parts/base/5005030 | 4 - ext/Devel/PPPort/parts/base/5005040 | 1 - ext/Devel/PPPort/parts/base/5006000 | 288 ----- ext/Devel/PPPort/parts/base/5006001 | 14 - ext/Devel/PPPort/parts/base/5006002 | 1 - ext/Devel/PPPort/parts/base/5007000 | 1 - ext/Devel/PPPort/parts/base/5007001 | 24 - ext/Devel/PPPort/parts/base/5007002 | 73 -- ext/Devel/PPPort/parts/base/5007003 | 85 -- ext/Devel/PPPort/parts/base/5008000 | 8 - ext/Devel/PPPort/parts/base/5008001 | 26 - ext/Devel/PPPort/parts/base/5008002 | 1 - ext/Devel/PPPort/parts/base/5008003 | 3 - ext/Devel/PPPort/parts/base/5008004 | 1 - ext/Devel/PPPort/parts/base/5008005 | 1 - ext/Devel/PPPort/parts/base/5008006 | 1 - ext/Devel/PPPort/parts/base/5008007 | 1 - ext/Devel/PPPort/parts/base/5008008 | 1 - ext/Devel/PPPort/parts/base/5009000 | 6 - ext/Devel/PPPort/parts/base/5009001 | 8 - ext/Devel/PPPort/parts/base/5009002 | 32 - ext/Devel/PPPort/parts/base/5009003 | 62 - ext/Devel/PPPort/parts/base/5009004 | 29 - ext/Devel/PPPort/parts/base/5009005 | 32 - ext/Devel/PPPort/parts/base/5010000 | 7 - ext/Devel/PPPort/parts/base/5011000 | 32 - ext/Devel/PPPort/parts/embed.fnc | 2004 -------------------------------- ext/Devel/PPPort/parts/inc/MY_CXT | 192 --- ext/Devel/PPPort/parts/inc/SvPV | 524 --------- ext/Devel/PPPort/parts/inc/SvREFCNT | 130 --- ext/Devel/PPPort/parts/inc/Sv_set | 124 -- ext/Devel/PPPort/parts/inc/call | 367 ------ ext/Devel/PPPort/parts/inc/cop | 84 -- ext/Devel/PPPort/parts/inc/exception | 74 -- ext/Devel/PPPort/parts/inc/format | 70 -- ext/Devel/PPPort/parts/inc/grok | 677 ----------- ext/Devel/PPPort/parts/inc/limits | 331 ------ ext/Devel/PPPort/parts/inc/mPUSH | 138 --- ext/Devel/PPPort/parts/inc/magic | 369 ------ ext/Devel/PPPort/parts/inc/memory | 84 -- ext/Devel/PPPort/parts/inc/misc | 536 --------- ext/Devel/PPPort/parts/inc/newCONSTSUB | 111 -- ext/Devel/PPPort/parts/inc/newRV | 74 -- ext/Devel/PPPort/parts/inc/newSVpv | 115 -- ext/Devel/PPPort/parts/inc/podtest | 52 - ext/Devel/PPPort/parts/inc/ppphbin | 828 ------------- ext/Devel/PPPort/parts/inc/ppphdoc | 353 ------ ext/Devel/PPPort/parts/inc/ppphtest | 901 -------------- ext/Devel/PPPort/parts/inc/pv_tools | 281 ----- ext/Devel/PPPort/parts/inc/pvs | 99 -- ext/Devel/PPPort/parts/inc/shared_pv | 91 -- ext/Devel/PPPort/parts/inc/snprintf | 70 -- ext/Devel/PPPort/parts/inc/sprintf | 62 - ext/Devel/PPPort/parts/inc/strlfuncs | 114 -- ext/Devel/PPPort/parts/inc/sv_xpvf | 321 ----- ext/Devel/PPPort/parts/inc/threads | 75 -- ext/Devel/PPPort/parts/inc/uv | 129 -- ext/Devel/PPPort/parts/inc/variables | 449 ------- ext/Devel/PPPort/parts/inc/version | 58 - ext/Devel/PPPort/parts/inc/warn | 175 --- ext/Devel/PPPort/parts/ppport.fnc | 29 - ext/Devel/PPPort/parts/ppptools.pl | 400 ------- ext/Devel/PPPort/parts/todo/5004000 | 68 -- ext/Devel/PPPort/parts/todo/5004010 | 1 - ext/Devel/PPPort/parts/todo/5004020 | 1 - ext/Devel/PPPort/parts/todo/5004030 | 1 - ext/Devel/PPPort/parts/todo/5004040 | 1 - ext/Devel/PPPort/parts/todo/5004050 | 4 - ext/Devel/PPPort/parts/todo/5005000 | 27 - ext/Devel/PPPort/parts/todo/5005010 | 1 - ext/Devel/PPPort/parts/todo/5005020 | 1 - ext/Devel/PPPort/parts/todo/5005030 | 4 - ext/Devel/PPPort/parts/todo/5005040 | 1 - ext/Devel/PPPort/parts/todo/5006000 | 150 --- ext/Devel/PPPort/parts/todo/5006001 | 11 - ext/Devel/PPPort/parts/todo/5006002 | 1 - ext/Devel/PPPort/parts/todo/5007000 | 1 - ext/Devel/PPPort/parts/todo/5007001 | 19 - ext/Devel/PPPort/parts/todo/5007002 | 16 - ext/Devel/PPPort/parts/todo/5007003 | 62 - ext/Devel/PPPort/parts/todo/5008000 | 5 - ext/Devel/PPPort/parts/todo/5008001 | 14 - ext/Devel/PPPort/parts/todo/5008002 | 1 - ext/Devel/PPPort/parts/todo/5008003 | 3 - ext/Devel/PPPort/parts/todo/5008004 | 1 - ext/Devel/PPPort/parts/todo/5008005 | 1 - ext/Devel/PPPort/parts/todo/5008006 | 1 - ext/Devel/PPPort/parts/todo/5008007 | 1 - ext/Devel/PPPort/parts/todo/5008008 | 1 - ext/Devel/PPPort/parts/todo/5009000 | 6 - ext/Devel/PPPort/parts/todo/5009001 | 6 - ext/Devel/PPPort/parts/todo/5009002 | 9 - ext/Devel/PPPort/parts/todo/5009003 | 26 - ext/Devel/PPPort/parts/todo/5009004 | 8 - ext/Devel/PPPort/parts/todo/5009005 | 31 - ext/Devel/PPPort/parts/todo/5010000 | 7 - ext/Devel/PPPort/parts/todo/5011000 | 17 - ext/Devel/PPPort/ppport_h.PL | 25 - ext/Devel/PPPort/soak | 606 ---------- ext/Devel/PPPort/t/MY_CXT.t | 54 - ext/Devel/PPPort/t/SvPV.t | 116 -- ext/Devel/PPPort/t/SvREFCNT.t | 54 - ext/Devel/PPPort/t/Sv_set.t | 71 -- ext/Devel/PPPort/t/call.t | 107 -- ext/Devel/PPPort/t/cop.t | 62 - ext/Devel/PPPort/t/exception.t | 67 -- ext/Devel/PPPort/t/format.t | 55 - ext/Devel/PPPort/t/grok.t | 62 - ext/Devel/PPPort/t/limits.t | 55 - ext/Devel/PPPort/t/mPUSH.t | 62 - ext/Devel/PPPort/t/magic.t | 95 -- ext/Devel/PPPort/t/memory.t | 52 - ext/Devel/PPPort/t/misc.t | 125 -- ext/Devel/PPPort/t/newCONSTSUB.t | 59 - ext/Devel/PPPort/t/newRV.t | 53 - ext/Devel/PPPort/t/newSVpv.t | 78 -- ext/Devel/PPPort/t/podtest.t | 83 -- ext/Devel/PPPort/t/ppphtest.t | 932 --------------- ext/Devel/PPPort/t/pv_tools.t | 74 -- ext/Devel/PPPort/t/pvs.t | 68 -- ext/Devel/PPPort/t/shared_pv.t | 52 - ext/Devel/PPPort/t/snprintf.t | 54 - ext/Devel/PPPort/t/sprintf.t | 54 - ext/Devel/PPPort/t/strlfuncs.t | 65 -- ext/Devel/PPPort/t/sv_xpvf.t | 78 -- ext/Devel/PPPort/t/testutil.pl | 48 - ext/Devel/PPPort/t/threads.t | 54 - ext/Devel/PPPort/t/uv.t | 61 - ext/Devel/PPPort/t/variables.t | 107 -- ext/Devel/PPPort/t/warn.t | 78 -- ext/Devel/PPPort/typemap | 35 - mkppport | 4 +- 334 files changed, 20557 insertions(+), 20557 deletions(-) create mode 100644 ext/Devel-PPPort/.gitignore create mode 100644 ext/Devel-PPPort/Changes create mode 100644 ext/Devel-PPPort/HACKERS create mode 100644 ext/Devel-PPPort/MANIFEST.SKIP create mode 100644 ext/Devel-PPPort/Makefile.PL create mode 100644 ext/Devel-PPPort/PPPort.xs create mode 100644 ext/Devel-PPPort/PPPort_pm.PL create mode 100644 ext/Devel-PPPort/PPPort_xs.PL create mode 100644 ext/Devel-PPPort/README create mode 100644 ext/Devel-PPPort/TODO create mode 100644 ext/Devel-PPPort/apicheck_c.PL create mode 100644 ext/Devel-PPPort/devel/buildperl.pl create mode 100644 ext/Devel-PPPort/devel/devtools.pl create mode 100644 ext/Devel-PPPort/devel/mkapidoc.sh create mode 100644 ext/Devel-PPPort/devel/mktodo create mode 100644 ext/Devel-PPPort/devel/mktodo.pl create mode 100644 ext/Devel-PPPort/devel/regenerate create mode 100644 ext/Devel-PPPort/devel/scanprov create mode 100644 ext/Devel-PPPort/mktests.PL create mode 100644 ext/Devel-PPPort/module2.c create mode 100644 ext/Devel-PPPort/module3.c create mode 100644 ext/Devel-PPPort/parts/apicheck.pl create mode 100644 ext/Devel-PPPort/parts/apidoc.fnc create mode 100644 ext/Devel-PPPort/parts/base/5004000 create mode 100644 ext/Devel-PPPort/parts/base/5004010 create mode 100644 ext/Devel-PPPort/parts/base/5004020 create mode 100644 ext/Devel-PPPort/parts/base/5004030 create mode 100644 ext/Devel-PPPort/parts/base/5004040 create mode 100644 ext/Devel-PPPort/parts/base/5004050 create mode 100644 ext/Devel-PPPort/parts/base/5005000 create mode 100644 ext/Devel-PPPort/parts/base/5005010 create mode 100644 ext/Devel-PPPort/parts/base/5005020 create mode 100644 ext/Devel-PPPort/parts/base/5005030 create mode 100644 ext/Devel-PPPort/parts/base/5005040 create mode 100644 ext/Devel-PPPort/parts/base/5006000 create mode 100644 ext/Devel-PPPort/parts/base/5006001 create mode 100644 ext/Devel-PPPort/parts/base/5006002 create mode 100644 ext/Devel-PPPort/parts/base/5007000 create mode 100644 ext/Devel-PPPort/parts/base/5007001 create mode 100644 ext/Devel-PPPort/parts/base/5007002 create mode 100644 ext/Devel-PPPort/parts/base/5007003 create mode 100644 ext/Devel-PPPort/parts/base/5008000 create mode 100644 ext/Devel-PPPort/parts/base/5008001 create mode 100644 ext/Devel-PPPort/parts/base/5008002 create mode 100644 ext/Devel-PPPort/parts/base/5008003 create mode 100644 ext/Devel-PPPort/parts/base/5008004 create mode 100644 ext/Devel-PPPort/parts/base/5008005 create mode 100644 ext/Devel-PPPort/parts/base/5008006 create mode 100644 ext/Devel-PPPort/parts/base/5008007 create mode 100644 ext/Devel-PPPort/parts/base/5008008 create mode 100644 ext/Devel-PPPort/parts/base/5009000 create mode 100644 ext/Devel-PPPort/parts/base/5009001 create mode 100644 ext/Devel-PPPort/parts/base/5009002 create mode 100644 ext/Devel-PPPort/parts/base/5009003 create mode 100644 ext/Devel-PPPort/parts/base/5009004 create mode 100644 ext/Devel-PPPort/parts/base/5009005 create mode 100644 ext/Devel-PPPort/parts/base/5010000 create mode 100644 ext/Devel-PPPort/parts/base/5011000 create mode 100644 ext/Devel-PPPort/parts/embed.fnc create mode 100644 ext/Devel-PPPort/parts/inc/MY_CXT create mode 100644 ext/Devel-PPPort/parts/inc/SvPV create mode 100644 ext/Devel-PPPort/parts/inc/SvREFCNT create mode 100644 ext/Devel-PPPort/parts/inc/Sv_set create mode 100644 ext/Devel-PPPort/parts/inc/call create mode 100644 ext/Devel-PPPort/parts/inc/cop create mode 100644 ext/Devel-PPPort/parts/inc/exception create mode 100644 ext/Devel-PPPort/parts/inc/format create mode 100644 ext/Devel-PPPort/parts/inc/grok create mode 100644 ext/Devel-PPPort/parts/inc/limits create mode 100644 ext/Devel-PPPort/parts/inc/mPUSH create mode 100644 ext/Devel-PPPort/parts/inc/magic create mode 100644 ext/Devel-PPPort/parts/inc/memory create mode 100644 ext/Devel-PPPort/parts/inc/misc create mode 100644 ext/Devel-PPPort/parts/inc/newCONSTSUB create mode 100644 ext/Devel-PPPort/parts/inc/newRV create mode 100644 ext/Devel-PPPort/parts/inc/newSVpv create mode 100644 ext/Devel-PPPort/parts/inc/podtest create mode 100644 ext/Devel-PPPort/parts/inc/ppphbin create mode 100644 ext/Devel-PPPort/parts/inc/ppphdoc create mode 100644 ext/Devel-PPPort/parts/inc/ppphtest create mode 100644 ext/Devel-PPPort/parts/inc/pv_tools create mode 100644 ext/Devel-PPPort/parts/inc/pvs create mode 100644 ext/Devel-PPPort/parts/inc/shared_pv create mode 100644 ext/Devel-PPPort/parts/inc/snprintf create mode 100644 ext/Devel-PPPort/parts/inc/sprintf create mode 100644 ext/Devel-PPPort/parts/inc/strlfuncs create mode 100644 ext/Devel-PPPort/parts/inc/sv_xpvf create mode 100644 ext/Devel-PPPort/parts/inc/threads create mode 100644 ext/Devel-PPPort/parts/inc/uv create mode 100644 ext/Devel-PPPort/parts/inc/variables create mode 100644 ext/Devel-PPPort/parts/inc/version create mode 100644 ext/Devel-PPPort/parts/inc/warn create mode 100644 ext/Devel-PPPort/parts/ppport.fnc create mode 100644 ext/Devel-PPPort/parts/ppptools.pl create mode 100644 ext/Devel-PPPort/parts/todo/5004000 create mode 100644 ext/Devel-PPPort/parts/todo/5004010 create mode 100644 ext/Devel-PPPort/parts/todo/5004020 create mode 100644 ext/Devel-PPPort/parts/todo/5004030 create mode 100644 ext/Devel-PPPort/parts/todo/5004040 create mode 100644 ext/Devel-PPPort/parts/todo/5004050 create mode 100644 ext/Devel-PPPort/parts/todo/5005000 create mode 100644 ext/Devel-PPPort/parts/todo/5005010 create mode 100644 ext/Devel-PPPort/parts/todo/5005020 create mode 100644 ext/Devel-PPPort/parts/todo/5005030 create mode 100644 ext/Devel-PPPort/parts/todo/5005040 create mode 100644 ext/Devel-PPPort/parts/todo/5006000 create mode 100644 ext/Devel-PPPort/parts/todo/5006001 create mode 100644 ext/Devel-PPPort/parts/todo/5006002 create mode 100644 ext/Devel-PPPort/parts/todo/5007000 create mode 100644 ext/Devel-PPPort/parts/todo/5007001 create mode 100644 ext/Devel-PPPort/parts/todo/5007002 create mode 100644 ext/Devel-PPPort/parts/todo/5007003 create mode 100644 ext/Devel-PPPort/parts/todo/5008000 create mode 100644 ext/Devel-PPPort/parts/todo/5008001 create mode 100644 ext/Devel-PPPort/parts/todo/5008002 create mode 100644 ext/Devel-PPPort/parts/todo/5008003 create mode 100644 ext/Devel-PPPort/parts/todo/5008004 create mode 100644 ext/Devel-PPPort/parts/todo/5008005 create mode 100644 ext/Devel-PPPort/parts/todo/5008006 create mode 100644 ext/Devel-PPPort/parts/todo/5008007 create mode 100644 ext/Devel-PPPort/parts/todo/5008008 create mode 100644 ext/Devel-PPPort/parts/todo/5009000 create mode 100644 ext/Devel-PPPort/parts/todo/5009001 create mode 100644 ext/Devel-PPPort/parts/todo/5009002 create mode 100644 ext/Devel-PPPort/parts/todo/5009003 create mode 100644 ext/Devel-PPPort/parts/todo/5009004 create mode 100644 ext/Devel-PPPort/parts/todo/5009005 create mode 100644 ext/Devel-PPPort/parts/todo/5010000 create mode 100644 ext/Devel-PPPort/parts/todo/5011000 create mode 100644 ext/Devel-PPPort/ppport_h.PL create mode 100644 ext/Devel-PPPort/soak create mode 100644 ext/Devel-PPPort/t/MY_CXT.t create mode 100644 ext/Devel-PPPort/t/SvPV.t create mode 100644 ext/Devel-PPPort/t/SvREFCNT.t create mode 100644 ext/Devel-PPPort/t/Sv_set.t create mode 100644 ext/Devel-PPPort/t/call.t create mode 100644 ext/Devel-PPPort/t/cop.t create mode 100644 ext/Devel-PPPort/t/exception.t create mode 100644 ext/Devel-PPPort/t/format.t create mode 100644 ext/Devel-PPPort/t/grok.t create mode 100644 ext/Devel-PPPort/t/limits.t create mode 100644 ext/Devel-PPPort/t/mPUSH.t create mode 100644 ext/Devel-PPPort/t/magic.t create mode 100644 ext/Devel-PPPort/t/memory.t create mode 100644 ext/Devel-PPPort/t/misc.t create mode 100644 ext/Devel-PPPort/t/newCONSTSUB.t create mode 100644 ext/Devel-PPPort/t/newRV.t create mode 100644 ext/Devel-PPPort/t/newSVpv.t create mode 100644 ext/Devel-PPPort/t/podtest.t create mode 100644 ext/Devel-PPPort/t/ppphtest.t create mode 100644 ext/Devel-PPPort/t/pv_tools.t create mode 100644 ext/Devel-PPPort/t/pvs.t create mode 100644 ext/Devel-PPPort/t/shared_pv.t create mode 100644 ext/Devel-PPPort/t/snprintf.t create mode 100644 ext/Devel-PPPort/t/sprintf.t create mode 100644 ext/Devel-PPPort/t/strlfuncs.t create mode 100644 ext/Devel-PPPort/t/sv_xpvf.t create mode 100644 ext/Devel-PPPort/t/testutil.pl create mode 100644 ext/Devel-PPPort/t/threads.t create mode 100644 ext/Devel-PPPort/t/uv.t create mode 100644 ext/Devel-PPPort/t/variables.t create mode 100644 ext/Devel-PPPort/t/warn.t create mode 100644 ext/Devel-PPPort/typemap delete mode 100644 ext/Devel/.gitignore delete mode 100644 ext/Devel/PPPort/.gitignore delete mode 100644 ext/Devel/PPPort/Changes delete mode 100644 ext/Devel/PPPort/HACKERS delete mode 100644 ext/Devel/PPPort/MANIFEST.SKIP delete mode 100644 ext/Devel/PPPort/Makefile.PL delete mode 100644 ext/Devel/PPPort/PPPort.xs delete mode 100644 ext/Devel/PPPort/PPPort_pm.PL delete mode 100644 ext/Devel/PPPort/PPPort_xs.PL delete mode 100644 ext/Devel/PPPort/README delete mode 100644 ext/Devel/PPPort/TODO delete mode 100644 ext/Devel/PPPort/apicheck_c.PL delete mode 100644 ext/Devel/PPPort/devel/buildperl.pl delete mode 100644 ext/Devel/PPPort/devel/devtools.pl delete mode 100644 ext/Devel/PPPort/devel/mkapidoc.sh delete mode 100644 ext/Devel/PPPort/devel/mktodo delete mode 100644 ext/Devel/PPPort/devel/mktodo.pl delete mode 100644 ext/Devel/PPPort/devel/regenerate delete mode 100644 ext/Devel/PPPort/devel/scanprov delete mode 100644 ext/Devel/PPPort/mktests.PL delete mode 100644 ext/Devel/PPPort/module2.c delete mode 100644 ext/Devel/PPPort/module3.c delete mode 100644 ext/Devel/PPPort/parts/apicheck.pl delete mode 100644 ext/Devel/PPPort/parts/apidoc.fnc delete mode 100644 ext/Devel/PPPort/parts/base/5004000 delete mode 100644 ext/Devel/PPPort/parts/base/5004010 delete mode 100644 ext/Devel/PPPort/parts/base/5004020 delete mode 100644 ext/Devel/PPPort/parts/base/5004030 delete mode 100644 ext/Devel/PPPort/parts/base/5004040 delete mode 100644 ext/Devel/PPPort/parts/base/5004050 delete mode 100644 ext/Devel/PPPort/parts/base/5005000 delete mode 100644 ext/Devel/PPPort/parts/base/5005010 delete mode 100644 ext/Devel/PPPort/parts/base/5005020 delete mode 100644 ext/Devel/PPPort/parts/base/5005030 delete mode 100644 ext/Devel/PPPort/parts/base/5005040 delete mode 100644 ext/Devel/PPPort/parts/base/5006000 delete mode 100644 ext/Devel/PPPort/parts/base/5006001 delete mode 100644 ext/Devel/PPPort/parts/base/5006002 delete mode 100644 ext/Devel/PPPort/parts/base/5007000 delete mode 100644 ext/Devel/PPPort/parts/base/5007001 delete mode 100644 ext/Devel/PPPort/parts/base/5007002 delete mode 100644 ext/Devel/PPPort/parts/base/5007003 delete mode 100644 ext/Devel/PPPort/parts/base/5008000 delete mode 100644 ext/Devel/PPPort/parts/base/5008001 delete mode 100644 ext/Devel/PPPort/parts/base/5008002 delete mode 100644 ext/Devel/PPPort/parts/base/5008003 delete mode 100644 ext/Devel/PPPort/parts/base/5008004 delete mode 100644 ext/Devel/PPPort/parts/base/5008005 delete mode 100644 ext/Devel/PPPort/parts/base/5008006 delete mode 100644 ext/Devel/PPPort/parts/base/5008007 delete mode 100644 ext/Devel/PPPort/parts/base/5008008 delete mode 100644 ext/Devel/PPPort/parts/base/5009000 delete mode 100644 ext/Devel/PPPort/parts/base/5009001 delete mode 100644 ext/Devel/PPPort/parts/base/5009002 delete mode 100644 ext/Devel/PPPort/parts/base/5009003 delete mode 100644 ext/Devel/PPPort/parts/base/5009004 delete mode 100644 ext/Devel/PPPort/parts/base/5009005 delete mode 100644 ext/Devel/PPPort/parts/base/5010000 delete mode 100644 ext/Devel/PPPort/parts/base/5011000 delete mode 100644 ext/Devel/PPPort/parts/embed.fnc delete mode 100644 ext/Devel/PPPort/parts/inc/MY_CXT delete mode 100644 ext/Devel/PPPort/parts/inc/SvPV delete mode 100644 ext/Devel/PPPort/parts/inc/SvREFCNT delete mode 100644 ext/Devel/PPPort/parts/inc/Sv_set delete mode 100644 ext/Devel/PPPort/parts/inc/call delete mode 100644 ext/Devel/PPPort/parts/inc/cop delete mode 100644 ext/Devel/PPPort/parts/inc/exception delete mode 100644 ext/Devel/PPPort/parts/inc/format delete mode 100644 ext/Devel/PPPort/parts/inc/grok delete mode 100644 ext/Devel/PPPort/parts/inc/limits delete mode 100644 ext/Devel/PPPort/parts/inc/mPUSH delete mode 100644 ext/Devel/PPPort/parts/inc/magic delete mode 100644 ext/Devel/PPPort/parts/inc/memory delete mode 100644 ext/Devel/PPPort/parts/inc/misc delete mode 100644 ext/Devel/PPPort/parts/inc/newCONSTSUB delete mode 100644 ext/Devel/PPPort/parts/inc/newRV delete mode 100644 ext/Devel/PPPort/parts/inc/newSVpv delete mode 100644 ext/Devel/PPPort/parts/inc/podtest delete mode 100644 ext/Devel/PPPort/parts/inc/ppphbin delete mode 100644 ext/Devel/PPPort/parts/inc/ppphdoc delete mode 100644 ext/Devel/PPPort/parts/inc/ppphtest delete mode 100644 ext/Devel/PPPort/parts/inc/pv_tools delete mode 100644 ext/Devel/PPPort/parts/inc/pvs delete mode 100644 ext/Devel/PPPort/parts/inc/shared_pv delete mode 100644 ext/Devel/PPPort/parts/inc/snprintf delete mode 100644 ext/Devel/PPPort/parts/inc/sprintf delete mode 100644 ext/Devel/PPPort/parts/inc/strlfuncs delete mode 100644 ext/Devel/PPPort/parts/inc/sv_xpvf delete mode 100644 ext/Devel/PPPort/parts/inc/threads delete mode 100644 ext/Devel/PPPort/parts/inc/uv delete mode 100644 ext/Devel/PPPort/parts/inc/variables delete mode 100644 ext/Devel/PPPort/parts/inc/version delete mode 100644 ext/Devel/PPPort/parts/inc/warn delete mode 100644 ext/Devel/PPPort/parts/ppport.fnc delete mode 100644 ext/Devel/PPPort/parts/ppptools.pl delete mode 100644 ext/Devel/PPPort/parts/todo/5004000 delete mode 100644 ext/Devel/PPPort/parts/todo/5004010 delete mode 100644 ext/Devel/PPPort/parts/todo/5004020 delete mode 100644 ext/Devel/PPPort/parts/todo/5004030 delete mode 100644 ext/Devel/PPPort/parts/todo/5004040 delete mode 100644 ext/Devel/PPPort/parts/todo/5004050 delete mode 100644 ext/Devel/PPPort/parts/todo/5005000 delete mode 100644 ext/Devel/PPPort/parts/todo/5005010 delete mode 100644 ext/Devel/PPPort/parts/todo/5005020 delete mode 100644 ext/Devel/PPPort/parts/todo/5005030 delete mode 100644 ext/Devel/PPPort/parts/todo/5005040 delete mode 100644 ext/Devel/PPPort/parts/todo/5006000 delete mode 100644 ext/Devel/PPPort/parts/todo/5006001 delete mode 100644 ext/Devel/PPPort/parts/todo/5006002 delete mode 100644 ext/Devel/PPPort/parts/todo/5007000 delete mode 100644 ext/Devel/PPPort/parts/todo/5007001 delete mode 100644 ext/Devel/PPPort/parts/todo/5007002 delete mode 100644 ext/Devel/PPPort/parts/todo/5007003 delete mode 100644 ext/Devel/PPPort/parts/todo/5008000 delete mode 100644 ext/Devel/PPPort/parts/todo/5008001 delete mode 100644 ext/Devel/PPPort/parts/todo/5008002 delete mode 100644 ext/Devel/PPPort/parts/todo/5008003 delete mode 100644 ext/Devel/PPPort/parts/todo/5008004 delete mode 100644 ext/Devel/PPPort/parts/todo/5008005 delete mode 100644 ext/Devel/PPPort/parts/todo/5008006 delete mode 100644 ext/Devel/PPPort/parts/todo/5008007 delete mode 100644 ext/Devel/PPPort/parts/todo/5008008 delete mode 100644 ext/Devel/PPPort/parts/todo/5009000 delete mode 100644 ext/Devel/PPPort/parts/todo/5009001 delete mode 100644 ext/Devel/PPPort/parts/todo/5009002 delete mode 100644 ext/Devel/PPPort/parts/todo/5009003 delete mode 100644 ext/Devel/PPPort/parts/todo/5009004 delete mode 100644 ext/Devel/PPPort/parts/todo/5009005 delete mode 100644 ext/Devel/PPPort/parts/todo/5010000 delete mode 100644 ext/Devel/PPPort/parts/todo/5011000 delete mode 100644 ext/Devel/PPPort/ppport_h.PL delete mode 100644 ext/Devel/PPPort/soak delete mode 100644 ext/Devel/PPPort/t/MY_CXT.t delete mode 100644 ext/Devel/PPPort/t/SvPV.t delete mode 100644 ext/Devel/PPPort/t/SvREFCNT.t delete mode 100644 ext/Devel/PPPort/t/Sv_set.t delete mode 100644 ext/Devel/PPPort/t/call.t delete mode 100644 ext/Devel/PPPort/t/cop.t delete mode 100644 ext/Devel/PPPort/t/exception.t delete mode 100644 ext/Devel/PPPort/t/format.t delete mode 100644 ext/Devel/PPPort/t/grok.t delete mode 100644 ext/Devel/PPPort/t/limits.t delete mode 100644 ext/Devel/PPPort/t/mPUSH.t delete mode 100644 ext/Devel/PPPort/t/magic.t delete mode 100644 ext/Devel/PPPort/t/memory.t delete mode 100644 ext/Devel/PPPort/t/misc.t delete mode 100644 ext/Devel/PPPort/t/newCONSTSUB.t delete mode 100644 ext/Devel/PPPort/t/newRV.t delete mode 100644 ext/Devel/PPPort/t/newSVpv.t delete mode 100644 ext/Devel/PPPort/t/podtest.t delete mode 100644 ext/Devel/PPPort/t/ppphtest.t delete mode 100644 ext/Devel/PPPort/t/pv_tools.t delete mode 100644 ext/Devel/PPPort/t/pvs.t delete mode 100644 ext/Devel/PPPort/t/shared_pv.t delete mode 100644 ext/Devel/PPPort/t/snprintf.t delete mode 100644 ext/Devel/PPPort/t/sprintf.t delete mode 100644 ext/Devel/PPPort/t/strlfuncs.t delete mode 100644 ext/Devel/PPPort/t/sv_xpvf.t delete mode 100644 ext/Devel/PPPort/t/testutil.pl delete mode 100644 ext/Devel/PPPort/t/threads.t delete mode 100644 ext/Devel/PPPort/t/uv.t delete mode 100644 ext/Devel/PPPort/t/variables.t delete mode 100644 ext/Devel/PPPort/t/warn.t delete mode 100644 ext/Devel/PPPort/typemap diff --git a/MANIFEST b/MANIFEST index 9a316765d9..b89b3ebc89 100644 --- a/MANIFEST +++ b/MANIFEST @@ -209,168 +209,168 @@ ext/Devel/Peek/Makefile.PL Data debugging tool, makefile writer ext/Devel/Peek/Peek.pm Data debugging tool, module and pod ext/Devel/Peek/Peek.xs Data debugging tool, externals ext/Devel/Peek/t/Peek.t See if Devel::Peek works -ext/Devel/PPPort/apicheck_c.PL Devel::PPPort apicheck generator -ext/Devel/PPPort/Changes Devel::PPPort changes -ext/Devel/PPPort/devel/buildperl.pl Devel::PPPort perl version builder -ext/Devel/PPPort/devel/devtools.pl Devel::PPPort development utilities -ext/Devel/PPPort/devel/mkapidoc.sh Devel::PPPort apidoc collector -ext/Devel/PPPort/devel/mktodo Devel::PPPort baseline/todo generator -ext/Devel/PPPort/devel/mktodo.pl Devel::PPPort baseline/todo generator -ext/Devel/PPPort/devel/regenerate Devel::PPPort API re-generator -ext/Devel/PPPort/devel/scanprov Devel::PPPort provided API scanner -ext/Devel/PPPort/HACKERS Devel::PPPort hackers documentation -ext/Devel/PPPort/Makefile.PL Devel::PPPort makefile writer -ext/Devel/PPPort/MANIFEST.SKIP Devel::PPPort Manifest skip specs -ext/Devel/PPPort/mktests.PL Devel::PPPort test file writer -ext/Devel/PPPort/module2.c Devel::PPPort test file -ext/Devel/PPPort/module3.c Devel::PPPort test file -ext/Devel/PPPort/parts/apicheck.pl Devel::PPPort apicheck generator -ext/Devel/PPPort/parts/apidoc.fnc Devel::PPPort Perl API listing -ext/Devel/PPPort/parts/base/5004000 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5004010 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5004020 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5004030 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5004040 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5004050 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5005000 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5005010 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5005020 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5005030 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5005040 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5006000 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5006001 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5006002 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5007000 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5007001 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5007002 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5007003 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5008000 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5008001 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5008002 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5008003 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5008004 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5008005 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5008006 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5008007 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5008008 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5009000 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5009001 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5009002 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5009003 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5009004 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5009005 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5010000 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/base/5011000 Devel::PPPort baseline todo file -ext/Devel/PPPort/parts/embed.fnc Devel::PPPort Perl API listing -ext/Devel/PPPort/parts/inc/call Devel::PPPort include -ext/Devel/PPPort/parts/inc/cop Devel::PPPort include -ext/Devel/PPPort/parts/inc/exception Devel::PPPort include -ext/Devel/PPPort/parts/inc/format Devel::PPPort include -ext/Devel/PPPort/parts/inc/grok Devel::PPPort include -ext/Devel/PPPort/parts/inc/limits Devel::PPPort include -ext/Devel/PPPort/parts/inc/magic Devel::PPPort include -ext/Devel/PPPort/parts/inc/memory Devel::PPPort include -ext/Devel/PPPort/parts/inc/misc Devel::PPPort include -ext/Devel/PPPort/parts/inc/mPUSH Devel::PPPort include -ext/Devel/PPPort/parts/inc/MY_CXT Devel::PPPort include -ext/Devel/PPPort/parts/inc/newCONSTSUB Devel::PPPort include -ext/Devel/PPPort/parts/inc/newRV Devel::PPPort include -ext/Devel/PPPort/parts/inc/newSVpv Devel::PPPort include -ext/Devel/PPPort/parts/inc/podtest Devel::PPPort include -ext/Devel/PPPort/parts/inc/ppphbin Devel::PPPort include -ext/Devel/PPPort/parts/inc/ppphdoc Devel::PPPort include -ext/Devel/PPPort/parts/inc/ppphtest Devel::PPPort include -ext/Devel/PPPort/parts/inc/pvs Devel::PPPort include -ext/Devel/PPPort/parts/inc/pv_tools Devel::PPPort include -ext/Devel/PPPort/parts/inc/shared_pv Devel::PPPort include -ext/Devel/PPPort/parts/inc/snprintf Devel::PPPort include -ext/Devel/PPPort/parts/inc/sprintf Devel::PPPort include -ext/Devel/PPPort/parts/inc/strlfuncs Devel::PPPort include -ext/Devel/PPPort/parts/inc/SvPV Devel::PPPort include -ext/Devel/PPPort/parts/inc/SvREFCNT Devel::PPPort include -ext/Devel/PPPort/parts/inc/Sv_set Devel::PPPort include -ext/Devel/PPPort/parts/inc/sv_xpvf Devel::PPPort include -ext/Devel/PPPort/parts/inc/threads Devel::PPPort include -ext/Devel/PPPort/parts/inc/uv Devel::PPPort include -ext/Devel/PPPort/parts/inc/variables Devel::PPPort include -ext/Devel/PPPort/parts/inc/version Devel::PPPort include -ext/Devel/PPPort/parts/inc/warn Devel::PPPort include -ext/Devel/PPPort/parts/ppport.fnc Devel::PPPort API listing -ext/Devel/PPPort/parts/ppptools.pl Devel::PPPort various utilities -ext/Devel/PPPort/parts/todo/5004000 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5004010 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5004020 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5004030 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5004040 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5004050 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5005000 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5005010 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5005020 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5005030 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5005040 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5006000 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5006001 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5006002 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5007000 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5007001 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5007002 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5007003 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5008000 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5008001 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5008002 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5008003 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5008004 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5008005 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5008006 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5008007 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5008008 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5009000 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5009001 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5009002 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5009003 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5009004 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5009005 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5010000 Devel::PPPort todo file -ext/Devel/PPPort/parts/todo/5011000 Devel::PPPort todo file -ext/Devel/PPPort/ppport_h.PL Devel::PPPort ppport.h writer -ext/Devel/PPPort/PPPort_pm.PL Devel::PPPort PPPort.pm writer -ext/Devel/PPPort/PPPort.xs Devel::PPPort dummy PPPort.xs -ext/Devel/PPPort/PPPort_xs.PL Devel::PPPort RealPPPort.xs writer -ext/Devel/PPPort/README Devel::PPPort Readme -ext/Devel/PPPort/soak Devel::PPPort Test Harness to run under various Perls -ext/Devel/PPPort/t/call.t Devel::PPPort test file -ext/Devel/PPPort/t/cop.t Devel::PPPort test file -ext/Devel/PPPort/t/exception.t Devel::PPPort test file -ext/Devel/PPPort/t/format.t Devel::PPPort test file -ext/Devel/PPPort/t/grok.t Devel::PPPort test file -ext/Devel/PPPort/t/limits.t Devel::PPPort test file -ext/Devel/PPPort/t/magic.t Devel::PPPort test file -ext/Devel/PPPort/t/memory.t Devel::PPPort test file -ext/Devel/PPPort/t/misc.t Devel::PPPort test file -ext/Devel/PPPort/t/mPUSH.t Devel::PPPort test file -ext/Devel/PPPort/t/MY_CXT.t Devel::PPPort test file -ext/Devel/PPPort/t/newCONSTSUB.t Devel::PPPort test file -ext/Devel/PPPort/t/newRV.t Devel::PPPort test file -ext/Devel/PPPort/t/newSVpv.t Devel::PPPort test file -ext/Devel/PPPort/TODO Devel::PPPort Todo -ext/Devel/PPPort/t/podtest.t Devel::PPPort test file -ext/Devel/PPPort/t/ppphtest.t Devel::PPPort test file -ext/Devel/PPPort/t/pvs.t Devel::PPPort test file -ext/Devel/PPPort/t/pv_tools.t Devel::PPPort test file -ext/Devel/PPPort/t/shared_pv.t Devel::PPPort test file -ext/Devel/PPPort/t/snprintf.t Devel::PPPort test file -ext/Devel/PPPort/t/sprintf.t Devel::PPPort test file -ext/Devel/PPPort/t/strlfuncs.t Devel::PPPort test file -ext/Devel/PPPort/t/SvPV.t Devel::PPPort test file -ext/Devel/PPPort/t/SvREFCNT.t Devel::PPPort test file -ext/Devel/PPPort/t/Sv_set.t Devel::PPPort test file -ext/Devel/PPPort/t/sv_xpvf.t Devel::PPPort test file -ext/Devel/PPPort/t/testutil.pl Devel::PPPort test utilities -ext/Devel/PPPort/t/threads.t Devel::PPPort test file -ext/Devel/PPPort/t/uv.t Devel::PPPort test file -ext/Devel/PPPort/t/variables.t Devel::PPPort test file -ext/Devel/PPPort/t/warn.t Devel::PPPort test file -ext/Devel/PPPort/typemap Devel::PPPort Typemap +ext/Devel-PPPort/apicheck_c.PL Devel::PPPort apicheck generator +ext/Devel-PPPort/Changes Devel::PPPort changes +ext/Devel-PPPort/devel/buildperl.pl Devel::PPPort perl version builder +ext/Devel-PPPort/devel/devtools.pl Devel::PPPort development utilities +ext/Devel-PPPort/devel/mkapidoc.sh Devel::PPPort apidoc collector +ext/Devel-PPPort/devel/mktodo Devel::PPPort baseline/todo generator +ext/Devel-PPPort/devel/mktodo.pl Devel::PPPort baseline/todo generator +ext/Devel-PPPort/devel/regenerate Devel::PPPort API re-generator +ext/Devel-PPPort/devel/scanprov Devel::PPPort provided API scanner +ext/Devel-PPPort/HACKERS Devel::PPPort hackers documentation +ext/Devel-PPPort/Makefile.PL Devel::PPPort makefile writer +ext/Devel-PPPort/MANIFEST.SKIP Devel::PPPort Manifest skip specs +ext/Devel-PPPort/mktests.PL Devel::PPPort test file writer +ext/Devel-PPPort/module2.c Devel::PPPort test file +ext/Devel-PPPort/module3.c Devel::PPPort test file +ext/Devel-PPPort/parts/apicheck.pl Devel::PPPort apicheck generator +ext/Devel-PPPort/parts/apidoc.fnc Devel::PPPort Perl API listing +ext/Devel-PPPort/parts/base/5004000 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5004010 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5004020 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5004030 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5004040 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5004050 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5005000 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5005010 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5005020 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5005030 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5005040 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5006000 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5006001 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5006002 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5007000 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5007001 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5007002 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5007003 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5008000 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5008001 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5008002 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5008003 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5008004 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5008005 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5008006 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5008007 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5008008 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5009000 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5009001 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5009002 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5009003 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5009004 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5009005 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5010000 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/base/5011000 Devel::PPPort baseline todo file +ext/Devel-PPPort/parts/embed.fnc Devel::PPPort Perl API listing +ext/Devel-PPPort/parts/inc/call Devel::PPPort include +ext/Devel-PPPort/parts/inc/cop Devel::PPPort include +ext/Devel-PPPort/parts/inc/exception Devel::PPPort include +ext/Devel-PPPort/parts/inc/format Devel::PPPort include +ext/Devel-PPPort/parts/inc/grok Devel::PPPort include +ext/Devel-PPPort/parts/inc/limits Devel::PPPort include +ext/Devel-PPPort/parts/inc/magic Devel::PPPort include +ext/Devel-PPPort/parts/inc/memory Devel::PPPort include +ext/Devel-PPPort/parts/inc/misc Devel::PPPort include +ext/Devel-PPPort/parts/inc/mPUSH Devel::PPPort include +ext/Devel-PPPort/parts/inc/MY_CXT Devel::PPPort include +ext/Devel-PPPort/parts/inc/newCONSTSUB Devel::PPPort include +ext/Devel-PPPort/parts/inc/newRV Devel::PPPort include +ext/Devel-PPPort/parts/inc/newSVpv Devel::PPPort include +ext/Devel-PPPort/parts/inc/podtest Devel::PPPort include +ext/Devel-PPPort/parts/inc/ppphbin Devel::PPPort include +ext/Devel-PPPort/parts/inc/ppphdoc Devel::PPPort include +ext/Devel-PPPort/parts/inc/ppphtest Devel::PPPort include +ext/Devel-PPPort/parts/inc/pvs Devel::PPPort include +ext/Devel-PPPort/parts/inc/pv_tools Devel::PPPort include +ext/Devel-PPPort/parts/inc/shared_pv Devel::PPPort include +ext/Devel-PPPort/parts/inc/snprintf Devel::PPPort include +ext/Devel-PPPort/parts/inc/sprintf Devel::PPPort include +ext/Devel-PPPort/parts/inc/strlfuncs Devel::PPPort include +ext/Devel-PPPort/parts/inc/SvPV Devel::PPPort include +ext/Devel-PPPort/parts/inc/SvREFCNT Devel::PPPort include +ext/Devel-PPPort/parts/inc/Sv_set Devel::PPPort include +ext/Devel-PPPort/parts/inc/sv_xpvf Devel::PPPort include +ext/Devel-PPPort/parts/inc/threads Devel::PPPort include +ext/Devel-PPPort/parts/inc/uv Devel::PPPort include +ext/Devel-PPPort/parts/inc/variables Devel::PPPort include +ext/Devel-PPPort/parts/inc/version Devel::PPPort include +ext/Devel-PPPort/parts/inc/warn Devel::PPPort include +ext/Devel-PPPort/parts/ppport.fnc Devel::PPPort API listing +ext/Devel-PPPort/parts/ppptools.pl Devel::PPPort various utilities +ext/Devel-PPPort/parts/todo/5004000 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5004010 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5004020 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5004030 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5004040 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5004050 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5005000 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5005010 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5005020 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5005030 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5005040 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5006000 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5006001 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5006002 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5007000 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5007001 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5007002 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5007003 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5008000 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5008001 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5008002 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5008003 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5008004 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5008005 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5008006 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5008007 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5008008 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5009000 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5009001 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5009002 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5009003 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5009004 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5009005 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5010000 Devel::PPPort todo file +ext/Devel-PPPort/parts/todo/5011000 Devel::PPPort todo file +ext/Devel-PPPort/ppport_h.PL Devel::PPPort ppport.h writer +ext/Devel-PPPort/PPPort_pm.PL Devel::PPPort PPPort.pm writer +ext/Devel-PPPort/PPPort.xs Devel::PPPort dummy PPPort.xs +ext/Devel-PPPort/PPPort_xs.PL Devel::PPPort RealPPPort.xs writer +ext/Devel-PPPort/README Devel::PPPort Readme +ext/Devel-PPPort/soak Devel::PPPort Test Harness to run under various Perls +ext/Devel-PPPort/t/call.t Devel::PPPort test file +ext/Devel-PPPort/t/cop.t Devel::PPPort test file +ext/Devel-PPPort/t/exception.t Devel::PPPort test file +ext/Devel-PPPort/t/format.t Devel::PPPort test file +ext/Devel-PPPort/t/grok.t Devel::PPPort test file +ext/Devel-PPPort/t/limits.t Devel::PPPort test file +ext/Devel-PPPort/t/magic.t Devel::PPPort test file +ext/Devel-PPPort/t/memory.t Devel::PPPort test file +ext/Devel-PPPort/t/misc.t Devel::PPPort test file +ext/Devel-PPPort/t/mPUSH.t Devel::PPPort test file +ext/Devel-PPPort/t/MY_CXT.t Devel::PPPort test file +ext/Devel-PPPort/t/newCONSTSUB.t Devel::PPPort test file +ext/Devel-PPPort/t/newRV.t Devel::PPPort test file +ext/Devel-PPPort/t/newSVpv.t Devel::PPPort test file +ext/Devel-PPPort/TODO Devel::PPPort Todo +ext/Devel-PPPort/t/podtest.t Devel::PPPort test file +ext/Devel-PPPort/t/ppphtest.t Devel::PPPort test file +ext/Devel-PPPort/t/pvs.t Devel::PPPort test file +ext/Devel-PPPort/t/pv_tools.t Devel::PPPort test file +ext/Devel-PPPort/t/shared_pv.t Devel::PPPort test file +ext/Devel-PPPort/t/snprintf.t Devel::PPPort test file +ext/Devel-PPPort/t/sprintf.t Devel::PPPort test file +ext/Devel-PPPort/t/strlfuncs.t Devel::PPPort test file +ext/Devel-PPPort/t/SvPV.t Devel::PPPort test file +ext/Devel-PPPort/t/SvREFCNT.t Devel::PPPort test file +ext/Devel-PPPort/t/Sv_set.t Devel::PPPort test file +ext/Devel-PPPort/t/sv_xpvf.t Devel::PPPort test file +ext/Devel-PPPort/t/testutil.pl Devel::PPPort test utilities +ext/Devel-PPPort/t/threads.t Devel::PPPort test file +ext/Devel-PPPort/t/uv.t Devel::PPPort test file +ext/Devel-PPPort/t/variables.t Devel::PPPort test file +ext/Devel-PPPort/t/warn.t Devel::PPPort test file +ext/Devel-PPPort/typemap Devel::PPPort Typemap ext/Digest/MD5/Changes Digest::MD5 extension changes ext/Digest/MD5/hints/dec_osf.pl Hints for named architecture ext/Digest/MD5/hints/irix_6.pl Hints for named architecture diff --git a/Makefile.SH b/Makefile.SH index f8193a6fe1..f6dba00135 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -914,7 +914,7 @@ $spitshell >>$Makefile < { 'MAINTAINER' => 'mhx', - 'FILES' => q[ext/Devel/PPPort], + 'FILES' => q[ext/Devel-PPPort], 'CPAN' => 1, 'UPSTREAM' => undef, }, diff --git a/Porting/makerel b/Porting/makerel index ac80aaa385..390b92b1e7 100644 --- a/Porting/makerel +++ b/Porting/makerel @@ -125,8 +125,8 @@ my @writables = qw( pod/perltoc.pod perlapi.h perlapi.c - ext/Devel/PPPort/module2.c - ext/Devel/PPPort/module3.c + ext/Devel-PPPort/module2.c + ext/Devel-PPPort/module3.c reentr.c reentr.h regcharclass.h diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod index 3b0bb1165f..4dbbaa108d 100644 --- a/Porting/pumpkin.pod +++ b/Porting/pumpkin.pod @@ -557,7 +557,7 @@ Let's not force people to keep changing it. =head2 PPPort -F needs to be synchronized to include all +F needs to be synchronized to include all new macros added to .h files (normally perl.h and XSUB.h, but others as well). Since chances are that when a new macro is added the committer will forget to update F, it's the best to diff for diff --git a/ext/.gitignore b/ext/.gitignore index 616f315c6a..0910ea6144 100644 --- a/ext/.gitignore +++ b/ext/.gitignore @@ -5,3 +5,5 @@ blib pm_to_blib Makefile ppport.h +!/Devel-PPPort/module2.c +!/Devel-PPPort/module3.c diff --git a/ext/Devel-PPPort/.gitignore b/ext/Devel-PPPort/.gitignore new file mode 100644 index 0000000000..032b772d08 --- /dev/null +++ b/ext/Devel-PPPort/.gitignore @@ -0,0 +1,5 @@ +/PPPort.pm +#ignored in /ext +#/ppport.h +/module*.c +/RealPPPort.xs diff --git a/ext/Devel-PPPort/Changes b/ext/Devel-PPPort/Changes new file mode 100644 index 0000000000..86d85d1120 --- /dev/null +++ b/ext/Devel-PPPort/Changes @@ -0,0 +1,717 @@ +3.16 - 2009-01-23 + + * fix DEFSV_set() for threaded 5.005 perls + * add G_METHOD support to call_sv() + +3.15 - 2009-01-18 + + * added support for the following API + DEFSV_set + * fix --unstrip for development versions + +3.14_05 - 2008-10-31 + + * fix stupid bugs in pv_pretty tests (only the + tests were broken, ppport.h was find) + +3.14_04 - 2008-10-30 + + * added support for the following API + isALNUMC [depend] + isASCII + isBLANK + isCNTRL + isGRAPH + isPRINT + isPSXSPC + isPUNCT + isXDIGIT + PERL_PV_ESCAPE_ALL + PERL_PV_ESCAPE_FIRSTCHAR + PERL_PV_ESCAPE_NOBACKSLASH + PERL_PV_ESCAPE_NOCLEAR + PERL_PV_ESCAPE_QUOTE + PERL_PV_ESCAPE_RE + PERL_PV_ESCAPE_UNI + PERL_PV_ESCAPE_UNI_DETECT + PERL_PV_PRETTY_DUMP + PERL_PV_PRETTY_ELLIPSES + PERL_PV_PRETTY_LTGT + PERL_PV_PRETTY_NOCLEAR + PERL_PV_PRETTY_QUOTE + PERL_PV_PRETTY_REGPROP + pv_display + pv_escape + pv_pretty + +3.14_03 - 2008-10-21 + + * fix C++ compilation issue with last release + (spotted by Nicholas Clark) + * added support for the following API + Perl_ppaddr_t + Perl_check_t + CPERLscope + (fixes CPAN #40078) + +3.14_02 - 2008-10-12 + + * added support for the following API + my_sprintf + PL_linestr + PL_bufptr + PL_bufend + PL_lex_state + PL_lex_stuff + PL_tokenbuf + SvPV_renew + (fixes CPAN #39809 and CPAN #39808) + * add read/write support for + PL_expect + PL_copline + PL_rsfp + PL_rsfp_filters + (fixes CPAN #39802) + * sync my_snprintf implementation with bleadperl + +3.14_01 - 2008-07-11 + + * resolve CPAN #37451: add PERLIO_FUNCS_DECL and + PERLIO_FUNCS_CAST + * update API info + +3.14 - 2008-06-01 + + * fix CPAN #36197: filename nit in parse_partspec + (thanks to Craig A. Berry for providing a patch) + +3.13_03 - 2008-05-13 + + * fix CPAN #35835: SvPV_flags_const_nolen segfaults prior + to perl 5.8.8 + +3.13_02 - 2008-04-13 + + * fix NV[efg]f format string macros for perl-5.6.0 built + using -Duselongdouble (thanks to Zefram for figuring this + out and to Jarkko Hietaniemi for keeping me in sync) + * add --patch and --oneshot options to devel/buildperl.pl + +3.13_01 - 2008-01-04 + + * fix dependency detection algorithm for functions + * fix some potential memory leaks in the test suite + * no need to use *_mg functions for mX?PUSH macros + * added support for the following API + mPUSHs + mXPUSHs + newSVpvn_flags + newSVpvn_utf8 + newSVpvs_flags + SVf_UTF8 + * make sure soak works with cromfs + +3.13 - 2007-10-04 + + * fix cpan #29748: ppport.h problems with perl5.005_05 + (spotted by Slaven Rezić) + * fix a compiler warning + +3.12 - 2007-09-22 + + [released without changes] + +3.11_06 - 2007-09-11 + + * fix cpan #29302: Perl_croak_nocontext doesn't need aTHX_ + (spotted by Jerry D. Hedden) + * fix a Win32 VC++ compiler warning (thanks to Steve Hay for + providing a patch) + * don't generate redundant specs for provided Perl_ functions + * fun with const and casts to avoid compiler warnings + * bump max supported version to 5.10.0 + +3.11_05 - 2007-08-20 + + * fix: PERL_HASH() was emitting a warning when passed in a + const char pointer + * fix: sv_magic_portable() was emitting a warning when + passed in a const char pointer + * fix: make sure arguments to sv_magic_portable() are only + evaluated once + +3.11_04 - 2007-08-20 + + * fix: ignore strings and XS comments when scanning and + patching files + * added support for the following API + newSVpvn_share + PERL_HASH + SvSHARED_HASH + * use PERL_BCDREVISION for version checking to save some + bytes in ppport.h + * improve the --strip option + - strip all C comments + - strip most superfluous whitespace + with these changes, the stripped ppport.h is now almost + 30% smaller: + 3.11_03 3.11_04 delta + ------------------------------------------ + uncompressed 87988 62573 -28.9% + gzip'd 17985 12725 -29.2% + +3.11_03 - 2007-08-14 + + * fix an infinite recursion in ppport.h that could be + triggered by circular dependencies + * fix PERL_BCDREVISION, which wasn't BCD but simply + shifted decimal (just in time for 5.10) + * fix detection of macros that are not listed in the + implementation/dontwarn sections + +3.11_02 - 2007-08-13 + + * fix cpan #25372: special case sv_magic(sv, obj, how, name, 0) + * fix cpan #27906: [PATCH] add UTF8_MAXBYTES + (thanks to Steve Peters for providing a patch) + * added support for the following API + sv_2pv_flags + sv_2pvbyte_nolen + SV_CONST_RETURN + SV_COW_DROP_PV + SV_COW_SHARED_HASH_KEYS + SV_GMAGIC + SV_HAS_TRAILING_NUL + SV_IMMEDIATE_UNREF + sv_magic_portable + SV_MUTABLE_RETURN + SV_NOSTEAL + sv_pvn_force_flags + SV_SMAGIC + SV_UTF8_NO_ENCODING + SvPV_const + SvPV_flags + SvPV_flags_const + SvPV_flags_const_nolen + SvPV_flags_mutable + SvPV_force + SvPV_force_flags + SvPV_force_flags_mutable + SvPV_force_flags_nolen + SvPV_force_mutable + SvPV_force_nolen + SvPV_force_nomg_nolen + SvPV_mutable + SvPV_nolen_const + SvPV_nomg_const + SvPV_nomg_const_nolen + SvUOK + UTF8_MAXBYTES + * provide compatibility macros for vanished variables + PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters + * add warnings support to ppport.h + * update ppport.h file searching logic + * add -c.inc and -xs.inc to the list of supported extensions + * document that --copy doesn't include the dot + * improve soak script and devel/buildperl.pl + +3.11_01 - 2007-03-23 + + * added support for the following API + PL_expect + load_module + vload_module + (thanks to Nicholas Clark for providing a patch) + +3.11 - 2007-02-14 + + * happy new year! + +3.10_02 - 2006-12-02 + + * add two missing files + +3.10_01 - 2006-12-02 + + * fix cpan #21239: Signals safe in Perl 5.8.0 + * fix PL_ppaddr and PL_no_modify support 5.005 perls + * added dTHXR, aTHXR and aTHXR_ for API that need + the context argument in pre-5.6.0 perls + * added support for the following API + PL_DBsignal + PL_DBtrace + PL_laststatval + PL_statcache + * added tests for all PL_* variables + * added progress indicator to soak script + * added --test-archives option to buildperl.pl script + * added comments to all autogenerated files that + clearly indicate their purpose and origin + +3.10 - 2006-08-14 + + * remove timestamp from generated ppport.h + +3.09_02 - 2006-07-25 + + * added support for the following API + my_strlcat + my_strlcpy + (thanks to Steve Peters for providing a patch) + +3.09_01 - 2006-07-21 + + * avoid using 'glob' when running under miniperl + +3.09 - 2006-07-08 + + * fix Makefile.PL's c_o override + * update API info + * improve soak script + - now counts warnings emitted during testing + - output is colored (can be turned off) + * add a section on integrating this module into + the core to the HACKERS file + +3.08_07 - 2006-07-03 + + * fix cpan #20179: Licensing information for PPPort is + unclear + * only --unstrip a stripped ppport.h if an appropriate + version of Devel::PPPort is installed + * add a --version option to ppport.h + +3.08_06 - 2006-06-25 + + * fix breakage on MSWin32, where generating XS files on + the fly doesn't seem to work the same way as under Linux + (thanks to Sadahiro Tomoyuki for providing a patch) + * load the shared files only when testing the module + * remove PPPort.xs from CPAN distribution + +3.08_05 - 2006-06-23 + + * when in the core, generate PPPort.pm and PPPort.xs + automatically + * PPPort.pm can now be loaded by miniperl + +3.08_04 - 2006-05-29 + + * update API info + * fix a bug in the automated API info generator that + caused slightly wrong output + * improve the speed of the automated API info generator; + we're now down from several hours to a few minutes + +3.08_03 - 2006-05-25 + + * update API info + * add devel/regenerate script to regenerate API info + * improve and speed up the development tools + +3.08_02 - 2006-05-22 + + * fix a POD error + * added POD test + * changed hv_stores() to omit the hash parameter + * improve soak script + - can now search directories for perl executables + - can use only perl binaries of at least a certain + revision using the --min option + - sorts tests by perl version + - shows a summary of failed versions + * added support for the following API + PERL_USE_GCC_BRACE_GROUPS + PoisonFree + PoisonNew + PoisonWith + SvREFCNT_inc + SvREFCNT_inc_NN + SvREFCNT_inc_simple + SvREFCNT_inc_simple_NN + SvREFCNT_inc_simple_void + SvREFCNT_inc_simple_void_NN + SvREFCNT_inc_void + SvREFCNT_inc_void_NN + +3.08_01 - 2006-05-20 + + * update NOOP and dNOOP to include lint directives + * update API info (for 5.8.8 and 5.9.3) + * added support for the following API + ckWARN + dVAR + hv_fetchs + hv_stores + my_snprintf + newSVpvs + packWARN + PERL_ABS + PERL_UNUSED_ARG + PERL_UNUSED_CONTEXT + PERL_UNUSED_VAR + STR_WITH_LEN + sv_catpvs + sv_setpvs + SVf + SvVSTRING_mg + warner + +3.08 - 2006-01-19 + + * thanks to Craig Berry for fixing my broken ppphtest + * add AUTHOR and ABSTRACT_FROM to Makefile.PL + +3.07 - 2006-01-16 + + * improve internals documentation in HACKERS + * minor internal cleanups + * thanks to Steve Peters for adding support for + the following API + SvMAGIC_set + SvPVX_const + SvPVX_mutable + SvRV_set + SvSTASH_set + SvUV_set + +3.06_04 - 2005-10-30 + + * add --strip / --unstrip options + * added support for the following API + Newx + Newxc + Newxz + XSRETURN + +3.06_03 - 2005-10-18 + + * fix extra ')' in PPPort_pm.PL + * fix compiler warnings + * fix test for PL_signals + * fix API listing + * more tests + +3.06_02 - 2005-10-18 + + * improve devel/buildperl.pl utility + * added support for the following API + dAXMARK + PL_signals + PERL_SIGNALS_UNSAFE_FLAG + XSprePUSH + +3.06_01 - 2005-06-25 + + * fix --compat-version argument checking + * filter files passed on the command line by default + to make sure 'perl ppport.h *' does something useful + * add --nofilter option to override the filtering + * testsuite now hopefully supports MacOS Classic + * check definedness of PERL_UNUSED_DECL + * update API info + +3.06 - 2005-02-02 + + * fix cpan #11327: make fails with syntax error + * fix XCPT_* macros + +3.05 - 2005-01-31 + + * fix a test for SvPV_nolen + * add more examples to tht documentation + * improve wording baseline information + * added support for the following API + dXCPT + dXSTARG + XCPT_CATCH + XCPT_RETHROW + XCPT_TRY_END + XCPT_TRY_START + +3.04 - 2004-12-29 + + * fix a hint for sv_pvn_force + * fix VMS problem with unquoted command line arguments + not preserving case (perl change #23367) + * add --api-info switch for ppport.h + +3.03 - 2004-09-08 + + * MY_CXT_CLONE was broken + +3.02 - 2004-09-08 + + * added support for the following API: + END_EXTERN_C + EXTERN_C + MY_CXT_CLONE + PERL_GCC_BRACE_GROUPS_FORBIDDEN + START_EXTERN_C + STMT_END + STMT_START + +3.01 - 2004-08-23 + + * patchlevel.h tweak + +3.00_03 - 2004-08-20 + + * make sure the @INC path is kept up-to-date when changing + directories while running in the core test suite + +3.00_02 - 2004-08-19 + + * remove PPPort.pm and PPPort.xs dependencies from Makefile.PL, + as they can be rebuilt with a "make regen" when neccessary + +3.00_01 - 2004-08-17 + + * fixed problems with $^X in t/ppphtest.t when building in + the core on OpenBSD + * fixed a "duplicate dependencies" bug that could lead to + global NEED_'s where static NEED_'s are sufficient + * added support for the following API: + PL_DBsingle + PL_DBsub + PL_debstash + PL_diehook + PL_errgv + PL_no_modify + PL_perl_destruct_level + PL_ppaddr + PL_stack_sp + PL_sv_arenaroot + PL_tainted + PL_tainting + PUSHu + sv_catpvf_mg + sv_catpvf_mg_nocontext + sv_setpvf_mg + sv_setpvf_mg_nocontext + sv_vcatpvf + sv_vcatpvf_mg + sv_vsetpvf + sv_vsetpvf_mg + vnewSVpvf + XPUSHu + +3.00 - 2004-08-16 + + * added support for dAX and dITEMS, which got lost while + working on the 3.00 internals + +2.99_07 - 2004-08-13 + + * improve/check documentation + * add tests for CopFILE and CopSTASHPV + * add file headers + * some code cleanups + +2.99_06 - 2004-08-11 + + * --compat-version now considers all macros/functions + provided by Devel::PPPort, not only the documented API + * fixed: PL_rsfp was PL_rsfpv + * turn __PPPORT_NAME__ back to ppport.h, because the former + looks ugly on search.cpan.org + +2.99_05 - 2004-08-10 + + * --compat-version now also hides compatibility warnings for + unsupported API calls + +2.99_04 - 2004-08-10 + + * added code to check for correct INSTALLDIRS + * added --compat-version option to ppport.h script to only + check for compatibility with at least the given Perl version + * some small adjustments + +2.99_03 - 2004-08-09 + + * remove useless dependency from Makefile.PL (spotted by + Craig A. Berry) + * added checking for and replacement of C++ comments as + well as --cplusplus option to suppress it to ppport.h + script + * added more diagnostic output to ppport.h script + * added a hint for gv_stashpvn + * fixed the thread tests (spotted by Craig A. Berry) + * added more tests + * renamed and documented DPPP_NAMESPACE + * renamed some files + +2.99_02 - 2004-08-08 + + * second beta + * feature complete for 3.00 + * implemented missing functionality for ppport.h script: + - can now perform global (i.e. multi-file) NEED_ checks + - checks source for missing aTHX arguments + - checks source for unsupported API calls + - can now lists provided and unsupported API + - can use Text::Diff on platforms without diff utility + - can use custom diff utility / options + - can write one patch against the module + - can write single copies with changes applied + * updated the documentation for Devel::PPPort and ppport.h + * added lots of tests for the ppport.h script + * merged tests for call_* eval_* from XS::APItest + * added HACKERS file to document internals + * now includes PPPort.pm, so you can read the full docs + using search.cpan.org + +2.99_01 - 2004-08-07 + + * first beta towards 3.00 + * complete rework of internals + * autogenerated API-checks + * autogenerated .pm, .xs and .t files + * ppport.h changes: + - no static/global functions without explicit NEED_ + - can now be run without -x + - now shows hints and dependencies + - now has POD documentation, so perldoc ppport.h works + - now has options + - now uses File::Find when available + * tested with multi-threaded (ithreads and 5.005-threads) perls + from 5.005 and single-threaded perls from 5.003 up to 5.9.x + * added support for the following API: + CopFILE + CopFILEAV + CopFILEGV + CopFILEGV_set + CopFILE_set + CopFILESV + CopSTASH + CopSTASH_eq + CopSTASHPV + CopSTASHPV_set + CopSTASH_set + CopyD + dUNDERBAR + IN_PERL_COMPILETIME + IV_MAX + IV_MIN + IVTYPE + memEQ + memNE + MoveD + mPUSHi + mPUSHn + mPUSHp + mPUSHu + mXPUSHi + mXPUSHn + mXPUSHp + mXPUSHu + newCONSTSUB + newSVuv + PERL_INT_MAX + PERL_INT_MIN + PERL_LONG_MAX + PERL_LONG_MIN + PERL_QUAD_MAX + PERL_QUAD_MIN + PERL_SHORT_MAX + PERL_SHORT_MIN + PERL_UCHAR_MAX + PERL_UCHAR_MIN + PERL_UINT_MAX + PERL_UINT_MIN + PERL_ULONG_MAX + PERL_ULONG_MIN + PERL_UQUAD_MAX + PERL_UQUAD_MIN + PERL_USHORT_MAX + PERL_USHORT_MIN + PL_hexdigit + PL_rsfp + Poison + PUSHmortal + sv_2pvbyte + sv_2pvbyte_nolen + sv_2pv_nolen + sv_2uv + sv_catpv_mg + sv_catpvn_mg + sv_catpvn_nomg + sv_catsv_mg + sv_catsv_nomg + SvGETMAGIC + SvIV_nomg + SvPV_force_nomg + sv_pvn + sv_pvn_force + sv_pvn_nomg + SvPV_nomg + sv_setiv_mg + sv_setnv_mg + sv_setpv_mg + sv_setpvn_mg + sv_setsv_mg + sv_setsv_nomg + sv_setuv + sv_setuv_mg + sv_usepvn_mg + sv_uv + SvUV + SvUV_nomg + SvUVx + SvUVX + SvUVXx + UNDERBAR + UV_MAX + UV_MIN + UVTYPE + XPUSHmortal + XSRETURN_UV + XST_mUV + ZeroD + +2.008 - 20th October 2003 + + * eval_(pv|sv) added + * PERL_MAGIC_* added + +2.007 - 18th September 2003 + + * small fix in grok_numeric_radix: variable was used uninitialized + +2.006 - 8th September 2003 + + * call_(pv|sv|method|argv) added + * still compiler-warnings for grok_??? and 5.6.x, fixed + +2.005 - 2nd September 2003 + + * Some tweaks to grok_(hex|oct|bin) to make compiler warnings + go away for older perls + * grok_number and grok_numeric_radix added + +2.004 - 22th August 2003 + + * Added grok_(hex|oct|bin) and related constants + +2.003 - 8th May 2003 + + * Added get_av, get_cv, get_hv and get_sv + +2.002 - 2nd December 2001 + + * More portability issues in Makefile.PL addresed. + * Merged the Harness sub-module into Devel::PPPort + * More documentation in PPPort.pm + +2.001 + + * Some portability issues in Makefile.PL addresed. + +2.000 + + * Initial port to the perl core. + +1.007 + + * Original version of the module by Kenneth Albanowski. diff --git a/ext/Devel-PPPort/HACKERS b/ext/Devel-PPPort/HACKERS new file mode 100644 index 0000000000..540947f4d1 --- /dev/null +++ b/ext/Devel-PPPort/HACKERS @@ -0,0 +1,326 @@ +=head1 NAME + +HACKERS - Devel::PPPort internals for hackers + +=head1 SYNOPSIS + +So you probably want to hack C? + +Well, here's some information to get you started with what's +lying around in this distribution. + +=head1 DESCRIPTION + +=head2 How to build 114 versions of Perl + +C supports Perl versions between 5.003 and bleadperl. +To guarantee this support, I need some of these versions on my +machine. I currently have 114 different Perl version/configuration +combinations installed on my laptop. + +As many of the old Perl distributions need patching to compile +cleanly on newer systems (and because building 114 Perls by hand +just isn't fun), I wrote a tool to build all the different +versions and configurations. You can find it in F. +It can currently build the following Perl releases: + + 5.003 + 5.004 - 5.004_05 + 5.005 - 5.005_04 + 5.6.x + 5.7.x + 5.8.x + 5.9.x + 5.10.x + +=head2 Fully automatic API checks + +Knowing which parts of the API are not backwards compatible and +probably need C support is another problem that's +not easy to deal with manually. If you run + + perl Makefile.PL --with-apicheck + +a C file is generated by F that is compiled +and linked with C. This C file has the purpose of +using each of the public API functions/macros once. + +The required information is derived from C (just +a copy of bleadperl's C), C (which +is generated by F and simply collects the rest +of the apidoc entries spread over the Perl source code) and +C (which lists all API provided purely by +Devel::PPPort). +The generated C file C is currently about 500k in size +and takes quite a while to compile. + +Usually, C won't compile with older perls. And even if +it compiles, there's still a good chance of the dynamic linker +failing at C time. But that's on purpose! + +We can use these failures to find changes in the API automatically. +The two Perl scripts F and F +repeatedly run C with the apicheck code through +all different versions of perl. Scanning the output of the compiler +and the dynamic linker for errors, the files in F are +generated. These files list all parts of the public API that don't +work with less than a certain version of Perl. + +This information is in turn used by F to mask +API calls in the generated C file for these versions, so the +process can be stopped by the time F compiles cleanly +and the dynamic linker is happy. (Actually, this process may generate +false positives, so by default each API call is checked once more +afterwards.) + +Running C takes about an hour, depending of course +on the machine you're running it on. If you run it with +the C<--nocheck> option, it won't recheck the API calls that failed +in the compilation stage and it'll take significantly less time. +Running with C<--nocheck> should usually be safe. + +When running C with the C<--base> option, it will +generate the I todo files by disabling all functionality +provided by C. These are required for implementing +the C<--compat-version> option of the C script. The +baseline todo files hold the information about which version of +Perl lacks a certain part of the API. + +However, only the documented public API can be checked this way. +And since C provides more macros, these would not be +affected by C<--compat-version>. It's the job of F +to figure out the baseline information for all remaining provided +macros by scanning the include files in the F directory of +various Perl versions. + +The whole process isn't platform independent. It has currently been +tested only under Linux, and it definitely requires at least C and +the C utility. + +It's not very often that one has to regenerate the baseline and todo +files. If you have to, you can either run F or just +execute the following steps by hand: + +=over 4 + +=item * + +You need a whole bunch of different Perls. The more, the better. +You can use F to build them. I keep my perls +in F, so most of the tools take this as a default. + +=item * + +You also need a freshly built bleadperl that is in the path under +exactly this name. (The name of the executable is currently hardcoded +in F and F.) + +=item * + +Remove all existing todo files in the F and +F directories. + +=item * + +Update the API information. Copy the latest F file from +bleadperl to the F directory and run F to +collect the remaining information in F. + +=item * + +Build the new baseline by running + + perl devel/mktodo --base + +in the root directory of the distribution. When it's finished, +move all files from the F directory to F. + +=item * + +Build the new todo files by running + + perl devel/mktodo + +in the root directory of the distribution. + +=item * + +Finally, add the remaining baseline information by running + + perl Makefile.PL && make + perl devel/scanprov write + +=back + +=head2 Implementation + +Residing in F is the "heart" of C. Each +of the files implements a part of the supported API, along with +hints, dependency information, XS code and tests. +The files are in a POD-like format that is parsed using the +functions in F. + +The scripts F, F and F all +use the information in F to generate the main module +F, the XS code in F and various test files +in F. + +All of these files could be generated on the fly while building +C, but not having the tests in C will confuse +TEST/harness in the core. Not having F will be bad for +viewing the docs on C. So unfortunately, it's +unavoidable to put some redundancy into the package. + +=head2 Adding stuff to Devel::PPPort + +First, check if the code you plan to add fits into one of the +existing files in F. If not, just start a new one and +remember to include it from within F. + +Each file holds all relevant data for implementing a certain part +of the API: + +=over 2 + +=item * + +A list of the provided API in the C<=provides> section. + +=item * + +The implementation to add to F in the C<=implementation> +section. + +=item * + +The code required to add to PPPort.xs for testing the implementation. +This code goes into the C<=xshead>, C<=xsinit>, C<=xsmisc>, C<=xsboot> +and C<=xsubs> section. Have a look at the template at the bottom +of F to see where the code ends up. + +=item * + +The tests in the C<=tests> section. Remember not to use any fancy +modules or syntax elements, as the test code should be able to run +with Perl 5.003, which, for example, doesn't support C in +C-loops: + + for my $x (1, 2, 3) { } # won't work with 5.003 + +You can use C to report success or failure: + + ok($got == 42); + ok($got, $expected); + +Regular expressions are not supported as the second argument to C, +because older perls do not support the C operator. + +=back + +It's usually the best approach to just copy an existing file and +use it as a template. + +=head2 Implementation Hints + +In the C<=implementation> section, you can use + + __UNDEFINED__ macro some definition + +instead of + + #ifndef macro + # define macro some definition + #endif + +The macro can have optional arguments and the definition can even +span multiple lines, like in + + __UNDEFINED__ SvMAGIC_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ + (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END + +This usually makes the code more compact and readable. And you +only have to add C<__UNDEFINED__> to the C<=provided> section. + +Version checking can be tricky if you want to do it correct. +You can use + + #if { VERSION < 5.9.3 } + +instead of + + #if ((PERL_VERSION < 9) || (PERL_VERSION == 9 && PERL_SUBVERSION < 3)) + +The version number can be either of the new form C<5.x.x> or of the older +form C<5.00x_yy>. Both are translated into the correct preprocessor +statements. It is also possible to combine this with other statements: + + #if { VERSION >= 5.004 } && !defined(sv_vcatpvf) + /* a */ + #elif { VERSION < 5.004_63 } && { VERSION != 5.004_05 } + /* b */ + #endif + +This not only works in the C<=implementation> section, but also in +the C<=xsubs>, C<=xsinit>, C<=xsmisc>, C<=xshead> and C<=xsboot> sections. + +=head2 Testing + +To automatically test C with lots of different Perl +versions, you can use the F script. Just pass it a list of +all Perl binaries you want to test. + +=head2 Special Makefile targets + +You can use + + make regen + +to regenerate all of the autogenerated files. To get rid of all +generated files (except for F and F), +use + + make purge_all + +That's it. + +=head2 Submitting Patches + +If you've added some functionality to C, please +consider submitting a patch with your work to either the author +(Emhx@cpan.orgE) or to the CPAN Request Tracker at +L. + +When submitting patches, please only add the relevant changes +and don't include the differences of the generated files. You +can use the C target to delete all autogenerated +files. + +=head2 Integrating into the Perl core + +When integrating this module into the Perl core, be sure to +remove the following files from the distribution. They are +either not needed or generated on the fly when building this +module in the core: + + MANIFEST + META.yml + PPPort.pm + +=head1 COPYRIGHT + +Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. + +Version 2.x, Copyright (C) 2001, Paul Marquess. + +Version 1.x, Copyright (C) 1999, Kenneth Albanowski. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +See L and L. + +=cut + diff --git a/ext/Devel-PPPort/MANIFEST.SKIP b/ext/Devel-PPPort/MANIFEST.SKIP new file mode 100644 index 0000000000..4df9284b91 --- /dev/null +++ b/ext/Devel-PPPort/MANIFEST.SKIP @@ -0,0 +1,18 @@ +^Makefile$ +~$ +\.old(?:\..*)?$ +\.swp$ +\.o$ +\.bs$ +\.bak$ +\.orig$ +\.cache\.cm$ +^blib +^pm_to_blib +^backup +^parts/todo- +^parts/base- +^ppport\.h$ +^PPPort\.c$ +^testing +Devel-PPPort.*\.tar\.gz$ diff --git a/ext/Devel-PPPort/Makefile.PL b/ext/Devel-PPPort/Makefile.PL new file mode 100644 index 0000000000..e2035b3594 --- /dev/null +++ b/ext/Devel-PPPort/Makefile.PL @@ -0,0 +1,142 @@ +################################################################################ +# +# Makefile.PL -- generate Makefile +# +################################################################################ +# +# $Revision: 29 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:49 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +require 5.003; + +use strict; +use ExtUtils::MakeMaker; + +use vars '%opt'; # needs to be global, and we can't use 'our' + +unless ($ENV{'PERL_CORE'}) { + $ENV{'PERL_CORE'} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV; +} + +@ARGV = map { /^--with-(apicheck)$/ && ++$opt{$1} ? () : $_ } @ARGV; + +WriteMakefile( + NAME => 'Devel::PPPort', + VERSION_FROM => 'PPPort_pm.PL', + PM => { 'PPPort.pm' => '$(INST_LIBDIR)/PPPort.pm' }, + H => [ qw(ppport.h) ], + OBJECT => 'RealPPPort$(OBJ_EXT) $(O_FILES)', + XSPROTOARG => '-noprototypes', + CONFIGURE => \&configure, +); + +sub configure +{ + my @clean = qw{ $(H_FILES) RealPPPort.xs RealPPPort.c }; + my %depend = ('$(OBJECT)' => '$(H_FILES)'); + my @C_FILES = qw{ module2.c module3.c }, + my %PL_FILES = ( + 'ppport_h.PL' => 'ppport.h', + 'PPPort_pm.PL' => 'PPPort.pm', + 'PPPort_xs.PL' => 'RealPPPort.xs', + ); + my @moreopts; + + if (eval $ExtUtils::MakeMaker::VERSION >= 6) { + push @moreopts, AUTHOR => 'Marcus Holland-Moritz '; + if (-f 'PPPort.pm') { + push @moreopts, ABSTRACT_FROM => 'PPPort.pm'; + } + } + + if (eval $ExtUtils::MakeMaker::VERSION >= 6.30_01) { + print "Setting license tag...\n"; + push @moreopts, LICENSE => 'perl'; + } + + if ($ENV{'PERL_CORE'}) { + # Pods will be built by installman. + push @moreopts, MAN3PODS => {}; + push @clean, 'PPPort.pm'; + } + else { + # Devel::PPPort is in the core since 5.7.3 + push @moreopts, INSTALLDIRS => ($] >= 5.007003 ? 'perl' : 'site'); + } + + if ($opt{'apicheck'}) { + $PL_FILES{'apicheck_c.PL'} = 'apicheck.c'; + push @C_FILES, qw{ apicheck.c }; + push @clean, qw{ apicheck.c apicheck.i }; + $depend{'apicheck.i'} = 'ppport.h'; + } + + return { + C => \@C_FILES, + XS => { 'RealPPPort.xs' => 'RealPPPort.c' }, + PL_FILES => \%PL_FILES, + depend => \%depend, + clean => { FILES => "@clean" }, + @moreopts, + }; +} + +sub MY::postamble +{ + package MY; + my $post = shift->SUPER::postamble(@_); + $post .= <<'POSTAMBLE'; + +purge_all: realclean + @$(RM_F) PPPort.pm t/*.t + +regen_pm: + $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_pm.PL + +regen_xs: + $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_xs.PL + +regen_tests: + $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) mktests.PL + +regen_h: + $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) ppport_h.PL + +regen: regen_pm regen_xs regen_tests regen_h + +POSTAMBLE + return $post; +} + +sub MY::c_o +{ + package MY; + my $co = shift->SUPER::c_o(@_); + + if ($::opt{'apicheck'} && $co !~ /^\.c\.i:/m) { + print "Adding custom rule for preprocessed apicheck file...\n"; + + $co .= <<'CO' + +.SUFFIXES: .i + +.c.i: + $(CCCMD) -E -I$(PERL_INC) $(DEFINE) $*.c > $*.i +CO + } + + return $co; +} + diff --git a/ext/Devel-PPPort/PPPort.xs b/ext/Devel-PPPort/PPPort.xs new file mode 100644 index 0000000000..2586824ebb --- /dev/null +++ b/ext/Devel-PPPort/PPPort.xs @@ -0,0 +1,3 @@ +This is just a dummy file to let Configure know that Devel::PPPort +is an XS module. The real XS code is autogenerated from PPPort_xs.PL +when this module is built and will go to RealPPPort.xs. diff --git a/ext/Devel-PPPort/PPPort_pm.PL b/ext/Devel-PPPort/PPPort_pm.PL new file mode 100644 index 0000000000..fb818eaa91 --- /dev/null +++ b/ext/Devel-PPPort/PPPort_pm.PL @@ -0,0 +1,663 @@ +################################################################################ +# +# PPPort_pm.PL -- generate PPPort.pm +# +################################################################################ +# +# $Revision: 64 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:49 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; +$^W = 1; +require "parts/ppptools.pl"; + +my $INCLUDE = 'parts/inc'; +my $DPPP = 'DPPP_'; + +my %embed = map { ( $_->{name} => $_ ) } + parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc)); + +my(%provides, %prototypes, %explicit); + +my $data = do { local $/; }; +$data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$} + {eval "$1('$2', $3)" or die $@}gem; + +$data = expand($data); + +my @api = sort { lc $a cmp lc $b } keys %provides; + +$data =~ s{^(.*)__PROVIDED_API__(\s*?)^} + {join '', map "$1$_\n", @api}gem; + +{ + my $len = 0; + for (keys %explicit) { + length > $len and $len = length; + } + my $format = sprintf '%%-%ds %%-%ds %%s', $len+2, $len+5; + $len = 3*$len + 23; + +$data =~ s!^(.*)__EXPLICIT_API__(\s*?)^! + sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') . + $1 . '-'x$len . "\n" . + join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" } + sort keys %explicit) + !gem; +} + +my %raw_base = %{&parse_todo('parts/base')}; +my %raw_todo = %{&parse_todo('parts/todo')}; + +my %todo; +for (keys %raw_todo) { + push @{$todo{$raw_todo{$_}}}, $_; +} + +# check consistency +for (@api) { + if (exists $raw_todo{$_} and exists $raw_base{$_}) { + if ($raw_base{$_} eq $raw_todo{$_}) { + warn "$INCLUDE/$provides{$_} provides $_, which is still marked " + . "todo for " . format_version($raw_todo{$_}) . "\n"; + } + else { + check(2, "$_ was ported back to " . format_version($raw_todo{$_}) . + " (baseline revision: " . format_version($raw_base{$_}) . ")."); + } + } +} + +my @perl_api; +for (keys %provides) { + next if /^Perl_(.*)/ && exists $embed{$1}; + next if exists $embed{$_}; + push @perl_api, $_; + check(2, "No API definition for provided element $_ found."); +} + +push @perl_api, keys %embed; + +for (@perl_api) { + if (exists $provides{$_} && !exists $raw_base{$_}) { + check(2, "Mmmh, $_ doesn't seem to need backporting."); + } + my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|'; + $line .= ($raw_todo{$_} || '') . '|'; + $line .= 'p' if exists $provides{$_}; + if (exists $embed{$_}) { + my $e = $embed{$_}; + if (exists $e->{flags}{p}) { + my $args = $e->{args}; + $line .= 'v' if @$args && $args->[-1][0] eq '...'; + } + $line .= 'n' if exists $e->{flags}{n}; + } + $_ = $line; +} + +$data =~ s/^([\t ]*)__PERL_API__(\s*?)$/ + join "\n", map "$1$_", sort @perl_api + /gem; + +my @todo; +for (reverse sort keys %todo) { + my $ver = format_version($_); + my $todo = "=item perl $ver\n\n"; + for (sort @{$todo{$_}}) { + $todo .= " $_\n"; + } + push @todo, $todo; +} + +$data =~ s{^__UNSUPPORTED_API__(\s*?)^} + {join "\n", @todo}gem; + +$data =~ s{__MIN_PERL__}{5.003}g; +$data =~ s{__MAX_PERL__}{5.10.0}g; + +open FH, ">PPPort.pm" or die "PPPort.pm: $!\n"; +print FH $data; +close FH; + +exit 0; + +sub include +{ + my($file, $opt) = @_; + + print "including $file\n"; + + my $data = parse_partspec("$INCLUDE/$file"); + + for (@{$data->{provides}}) { + if (exists $provides{$_}) { + if ($provides{$_} ne $file) { + warn "$file: $_ already provided by $provides{$_}\n"; + } + } + else { + $provides{$_} = $file; + } + } + + for (keys %{$data->{prototypes}}) { + $prototypes{$_} = $data->{prototypes}{$_}; + $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg; + } + + my $out = $data->{implementation}; + + if (exists $opt->{indent}) { + $out =~ s/^/$opt->{indent}/gm; + } + + return $out; +} + +sub expand +{ + my $code = shift; + $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem; + $code =~ s{^\s* + __UNDEFINED__ + \s+ + ( + ( \w+ ) + (?: \( [^)]* \) )? + ) + [^\r\n\S]* + ( + (?:[^\r\n\\]|\\[^\r\n])* + (?: + \\ + (?:\r\n|[\r\n]) + (?:[^\r\n\\]|\\[^\r\n])* + )* + ) + \s*$} + {expand_undefined($2, $1, $3)}gemx; + $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$} + {expand_need_var($1, $3, $2, $4)}gem; + $code =~ s{^([^\S\r\n]*)__NEED_DUMMY_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$} + {expand_need_dummy_var($1, $3, $2, $4)}gem; + return $code; +} + +sub expand_need_var +{ + my($indent, $var, $type, $init) = @_; + + $explicit{$var} = 'var'; + + my $myvar = "$DPPP(my_$var)"; + $init = defined $init ? " = $init" : ""; + + my $code = <{name}; + my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} }; + my $lastarg = ${$f->{args}}[-1]; + + if ($f->{flags}{n}) { + if ($f->{flags}{p}) { + return "#define $n $DPPP(my_$n)\n" . + "#define Perl_$n $DPPP(my_$n)"; + } + else { + return "#define $n $DPPP(my_$n)"; + } + } + else { + my $undef = <{flags}{p}) { + if ($f->{flags}{f}) { + return "#define Perl_$n $DPPP(my_$n)"; + } + elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) { + return $undef . "#define $n $DPPP(my_$n)\n" . + "#define Perl_$n $DPPP(my_$n)"; + } + else { + return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" . + "#define Perl_$n $DPPP(my_$n)"; + } + } + else { + return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)"; + } + } +} + +sub check +{ + my $level = shift; + + if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) { + print STDERR @_, "\n"; + } +} + +__DATA__ +################################################################################ +# +# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!! +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ +# +# Perl/Pollution/Portability +# +################################################################################ +# +# $Revision: 64 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:49 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +=head1 NAME + +Devel::PPPort - Perl/Pollution/Portability + +=head1 SYNOPSIS + + Devel::PPPort::WriteFile(); # defaults to ./ppport.h + Devel::PPPort::WriteFile('someheader.h'); + +=head1 DESCRIPTION + +Perl's API has changed over time, gaining new features, new functions, +increasing its flexibility, and reducing the impact on the C namespace +environment (reduced pollution). The header file written by this module, +typically F, attempts to bring some of the newer Perl API +features to older versions of Perl, so that you can worry less about +keeping track of old releases, but users can still reap the benefit. + +C contains a single function, called C. Its +only purpose is to write the F C header file. This file +contains a series of macros and, if explicitly requested, functions that +allow XS modules to be built using older versions of Perl. Currently, +Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported. + +This module is used by C to write the file F. + +=head2 Why use ppport.h? + +You should use F in modern code so that your code will work +with the widest range of Perl interpreters possible, without significant +additional work. + +You should attempt older code to fully use F, because the +reduced pollution of newer Perl versions is an important thing. It's so +important that the old polluting ways of original Perl modules will not be +supported very far into the future, and your module will almost certainly +break! By adapting to it now, you'll gain compatibility and a sense of +having done the electronic ecology some good. + +=head2 How to use ppport.h + +Don't direct the users of your module to download C. +They are most probably no XS writers. Also, don't make F +optional. Rather, just take the most recent copy of F that +you can find (e.g. by generating it with the latest C +release from CPAN), copy it into your project, adjust your project to +use it, and distribute the header along with your module. + +=head2 Running ppport.h + +But F is more than just a C header. It's also a Perl script +that can check your source code. It will suggest hints and portability +notes, and can even make suggestions on how to change your code. You +can run it like any other Perl program: + + perl ppport.h [options] [files] + +It also has embedded documentation, so you can use + + perldoc ppport.h + +to find out more about how to use it. + +=head1 FUNCTIONS + +=head2 WriteFile + +C takes one optional argument. When called with one +argument, it expects to be passed a filename. When called with +no arguments, it defaults to the filename F. + +The function returns a true value if the file was written successfully. +Otherwise it returns a false value. + +=head1 COMPATIBILITY + +F supports Perl versions from __MIN_PERL__ to __MAX_PERL__ +in threaded and non-threaded configurations. + +=head2 Provided Perl compatibility API + +The header file written by this module, typically F, provides +access to the following elements of the Perl API that is not available +in older Perl releases: + + __PROVIDED_API__ + +=head2 Perl API not supported by ppport.h + +There is still a big part of the API not supported by F. +Either because it doesn't make sense to back-port that part of the API, +or simply because it hasn't been implemented yet. Patches welcome! + +Here's a list of the currently unsupported API, and also the version of +Perl below which it is unsupported: + +=over 4 + +__UNSUPPORTED_API__ + +=back + +=head1 BUGS + +If you find any bugs, C doesn't seem to build on your +system or any of its tests fail, please use the CPAN Request Tracker +at L to create a ticket for the module. + +=head1 AUTHORS + +=over 2 + +=item * + +Version 1.x of Devel::PPPort was written by Kenneth Albanowski. + +=item * + +Version 2.x was ported to the Perl core by Paul Marquess. + +=item * + +Version 3.x was ported back to CPAN by Marcus Holland-Moritz. + +=back + +=head1 COPYRIGHT + +Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. + +Version 2.x, Copyright (C) 2001, Paul Marquess. + +Version 1.x, Copyright (C) 1999, Kenneth Albanowski. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +See L, L. + +=cut + +package Devel::PPPort; + +use strict; +use vars qw($VERSION $data); + +$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.16 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; + +sub _init_data +{ + $data = do { local $/; }; + my $pkg = 'Devel::PPPort'; + $data =~ s/__PERL_VERSION__/$]/g; + $data =~ s/__VERSION__/$VERSION/g; + $data =~ s/__PKG__/$pkg/g; + $data =~ s/^\|>//gm; +} + +sub WriteFile +{ + my $file = shift || 'ppport.h'; + defined $data or _init_data(); + my $copy = $data; + $copy =~ s/\bppport\.h\b/$file/g; + + open F, ">$file" or return undef; + print F $copy; + close F; + + return 1; +} + +1; + +__DATA__ +#if 0 +<<'SKIP'; +#endif +/* +---------------------------------------------------------------------- + + ppport.h -- Perl/Pollution/Portability Version __VERSION__ + + Automatically created by __PKG__ running under perl __PERL_VERSION__. + + Do NOT edit this file directly! -- Edit PPPort_pm.PL and the + includes in parts/inc/ instead. + + Use 'perldoc ppport.h' to view the documentation below. + +---------------------------------------------------------------------- + +SKIP + +%include ppphdoc { indent => '|>' } + +%include ppphbin + +__DATA__ +*/ + +#ifndef _P_P_PORTABILITY_H_ +#define _P_P_PORTABILITY_H_ + +#ifndef DPPP_NAMESPACE +# define DPPP_NAMESPACE DPPP_ +#endif + +#define DPPP_CAT2(x,y) CAT2(x,y) +#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) + +%include version + +%include threads + +%include limits + +%include uv + +%include memory + +%include misc + +%include variables + +%include mPUSH + +%include call + +%include newRV + +%include newCONSTSUB + +%include MY_CXT + +%include format + +%include SvREFCNT + +%include newSVpv + +%include SvPV + +%include Sv_set + +%include sv_xpvf + +%include shared_pv + +%include warn + +%include pvs + +%include magic + +%include cop + +%include grok + +%include snprintf + +%include sprintf + +%include exception + +%include strlfuncs + +%include pv_tools + +#endif /* _P_P_PORTABILITY_H_ */ + +/* End of File ppport.h */ diff --git a/ext/Devel-PPPort/PPPort_xs.PL b/ext/Devel-PPPort/PPPort_xs.PL new file mode 100644 index 0000000000..8d9fd4f674 --- /dev/null +++ b/ext/Devel-PPPort/PPPort_xs.PL @@ -0,0 +1,140 @@ +################################################################################ +# +# PPPort_xs.PL -- generate RealPPPort.xs +# +################################################################################ +# +# $Revision: 15 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:48 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; +$^W = 1; +require "parts/ppptools.pl"; + +my %SECTION = ( + xshead => { code => '', header => "/* ---- code from __FILE__ ---- */" }, + xsinit => { code => '', header => "/* ---- code from __FILE__ ---- */" }, + xsmisc => { code => '', header => "/* ---- code from __FILE__ ---- */" }, + xsboot => { code => '', header => "/* ---- code from __FILE__ ---- */", indent => "\t" }, + xsubs => { code => '', header => <{$sec}) { + $msg++ or print "adding XS code from $file\n"; + if (exists $SECTION{$sec}{header}) { + my $header = $SECTION{$sec}{header}; + $header =~ s/__FILE__/$file/g; + $SECTION{$sec}{code} .= $header . "\n"; + } + $SECTION{$sec}{code} .= $spec->{$sec} . "\n"; + } + } +} + +my $data = do { local $/; }; + +for $sec (keys %SECTION) { + my $code = $SECTION{$sec}{code}; + if (exists $SECTION{$sec}{indent}) { + $code =~ s/^/$SECTION{$sec}{indent}/gm; + } + $code =~ s/[\r\n]+$//; + $data =~ s/^__\U$sec\E__$/$code/m; +} + +open FH, ">RealPPPort.xs" or die "RealPPPort.xs: $!\n"; +print FH $data; +close FH; + +exit 0; + +__DATA__ +/******************************************************************************* +* +* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!! +* +* This file was automatically generated from the definition files in the +* parts/inc/ subdirectory by PPPort_xs.PL. To learn more about how all this +* works, please read the F file that came with this distribution. +* +******************************************************************************** +* +* Perl/Pollution/Portability +* +******************************************************************************** +* +* $Revision: 15 $ +* $Author: mhx $ +* $Date: 2009/01/18 14:10:48 +0100 $ +* +******************************************************************************** +* +* Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +* Version 2.x, Copyright (C) 2001, Paul Marquess. +* Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +* +* This program is free software; you can redistribute it and/or +* modify it under the same terms as Perl itself. +* +*******************************************************************************/ + +/* ========== BEGIN XSHEAD ================================================== */ + +__XSHEAD__ + +/* =========== END XSHEAD =================================================== */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +/* ========== BEGIN XSINIT ================================================== */ + +__XSINIT__ + +/* =========== END XSINIT =================================================== */ + +#include "ppport.h" + +/* ========== BEGIN XSMISC ================================================== */ + +__XSMISC__ + +/* =========== END XSMISC =================================================== */ + +MODULE = Devel::PPPort PACKAGE = Devel::PPPort + +BOOT: +__XSBOOT__ + +__XSUBS__ diff --git a/ext/Devel-PPPort/README b/ext/Devel-PPPort/README new file mode 100644 index 0000000000..fc24309964 --- /dev/null +++ b/ext/Devel-PPPort/README @@ -0,0 +1,78 @@ + + ------------------------------------------------------ + Devel::PPPort - Perl/Pollution/Portability Version 3 + ------------------------------------------------------ + +CONTENTS + +1. DESCRIPTION +2. INSTALLATION +3. DOCUMENTATION +4. BUGS +5. COPYRIGHT + + +-------------- +1. DESCRIPTION +-------------- + +Perl's API has changed over time, gaining new features, new functions, +increasing its flexibility, and reducing the impact on the C namespace +environment (reduced pollution). The header file written by this module, +typically F, attempts to bring some of the newer Perl API +features to older versions of Perl, so that you can worry less about +keeping track of old releases, but users can still reap the benefit. + +--------------- +2. INSTALLATION +--------------- + +Installation of the Devel::PPPort module follows the standard Perl Way +and should not be harder than: + + perl Makefile.PL + make + make test + make install + +Note that you may need to become superuser to 'make install'. + +If you're building the module under Windows, you may need to use a +different make program, such as 'nmake', instead of 'make'. + +---------------- +3. DOCUMENTATION +---------------- + +To see the documentation, use the perldoc command: + + perldoc Devel::PPPort + +You can also visit CPAN Search and see the documentation online as +pretty nice HTML. This is also where you will find the most recent +version of this module: + + http://search.cpan.org/~mhx/Devel-PPPort/ + +------- +4. BUGS +------- + +If you find any bugs, Devel::PPPort doesn't seem to build on your +system or any of its tests fail, please use the CPAN Request Tracker + + http://rt.cpan.org/ + +to create a ticket for the module. + +------------ +5. COPYRIGHT +------------ + +Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +Version 2.x, Copyright (C) 2001, Paul Marquess. +Version 1.x, Copyright (C) 1999, Kenneth Albanowski. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + diff --git a/ext/Devel-PPPort/TODO b/ext/Devel-PPPort/TODO new file mode 100644 index 0000000000..961acd918c --- /dev/null +++ b/ext/Devel-PPPort/TODO @@ -0,0 +1,347 @@ +TODO: + +* > 3. In several cases, "perl ppport.h --copy=.new" output a new file in + > which the only change was the addition of "#include "ppport.h"". In each + > case, that actually wasn't necessary because the source file in question + > already #included another source file which #included ppport.h itself. + > Would it be possible for the analyzer to follow #include directives to + > spot cases like this? + + Uh, well, I guess it would be possible. But I have some concerns: + + 1. ppport.h is already too big. :-) + + 2. There is code in ppport.h to actually remove an + + #include "ppport.h" + + if it appears not to be needed. If it's not needed in your + included file, it might be dropped from there and moved to + the other file that included the first one. This would make + the logic much more complicated. + + 3. As ppport.h is configurable, it's not (always) a good idea + to put it into a file that's included from another file. + + I guess I'll have to think about this a little more. Maybe I can + come up with a fancy solution that doesn't increase the code size + too much. + + +* On 14/12/06, Nicholas Clark wrote: + > On Thu, Dec 14, 2006 at 05:03:24AM +0100, Andreas J. Koenig wrote: + > + > > Params::Validate and Clone suffer from the same cold: + > + > The same patch will make both compile and pass tests. + > I'm wondering if it might be better to totally drop SVt_PBVM and let source + > code fail to compile. + + I don't think so. Because : + 1. your redefinition of SVt_PBVM is probably what most XS modules want + 2. anyway, if we remove it from the core, it might appear in Devel::PPPort :) + + +* maybe backport bytes_from_utf8() for 5.6.0 (or even before)? + +* check which of the following we need to support: + + amagic_generation + AMG_names + an + Argv + argvgv + argvoutgv + basetime + beginav + block_type + bodytarget + bufend + bufptr + check + chopset + Cmd + compcv + compiling + comppad + comppad_name + comppad_name_fill + copline + cop_seqmax + cryptseen + cshlen + cshname + curcop + curinterp + curpad + curpm + curstash + curstname + dbargs + DBgv + DBline + DBsignal + DBsingle + DBsub + DBtrace + debstash + debug + defgv + defoutgv + defstash + delaymagic + diehook + dirty + doextract + doswitches + do_undump + dowarn + egid + encoding + endav + envgv + errgv + error_count + errors + euid + eval_root + evalseq + eval_start + expect + fdpid + filemode + firstgv + fold + forkprocess + formfeed + formtarget + freq + generation + gensym + gid + hexdigit + hints + incgv + in_eval + in_my + inplace + lastfd + last_in_gv + last_lop + last_lop_op + lastscream + laststatval + laststype + last_uni + lex_brackets + lex_brackstack + lex_casemods + lex_casestack + lex_defer + lex_dojoin + lex_expect + lex_formbrack + lex_inpat + lex_inwhat + lex_op + lex_repl + lex_starts + lex_state + lex_stuff + lineary + linestr + localizing + main_cv + main_root + mainstack + main_start + markstack + markstack_max + markstack_ptr + max_intro_pending + maxo + maxscream + maxsysfd + min_intro_pending + minus_a + minus_c + minus_F + minus_l + minus_n + minus_p + multi_close + multi_end + multi_open + multi_start + na + nexttoke + nexttype + nextval + nice_chunk + nice_chunk_size + No + no_aelem + no_dir_func + no_func + no_mem + nomemok + no_modify + no_myglob + no_security + no_sock_func + no_symref + no_usym + no_wrongref + nrs + oldbufptr + oldname + oldoldbufptr + op + opargs + op_desc + op_mask + op_name + op_seq + origalen + origargc + origargv + origenviron + origfilename + osname + padix + padix_floor + pad_reset_pending + patchlevel + patleave + perldb + perl_destruct_level + pidstatus + ppaddr + preambleav + preambled + preprocess + profiledata + regdummy + regendp + regeol + reginput + regkind + reglastparen + regsize + regstartp + restartop + rs + rsfp + rsfp_filters + runops + savestack + savestack_ix + savestack_max + sawampersand + scopestack + scopestack_ix + scopestack_max + screamfirst + screamnext + secondgv + signals + sig_name + sig_num + simple + sortcop + sortstash + splitstr + stack_base + stack_max + stack_sp + statbuf + statcache + statgv + statname + statusvalue + stdingv + sub_generation + subline + subname + Sv + sv_arenaroot + sv_count + sv_no + sv_objcount + sv_root + sv_undef + sv_yes + tainted + tainting + timesbuf + tmps_floor + tmps_ix + tmps_max + tmps_stack + tokenbuf + top_env + toptarget + uid + unsafe + varies + vtbl_amagic + vtbl_amagicelem + vtbl_arylen + vtbl_bm + vtbl_dbline + vtbl_env + vtbl_envelem + vtbl_glob + vtbl_isa + vtbl_isaelem + vtbl_mglob + vtbl_pack + vtbl_packelem + vtbl_pos + vtbl_sig + vtbl_sigelem + vtbl_substr + vtbl_sv + vtbl_taint + vtbl_uvar + vtbl_vec + warnhook + warn_nl + warn_nosemi + warn_reserved + warn_uninit + watchaddr + watchok + Xpv + Yes + +* have an --env option for soak to set env variable combinations + +* only overwrite generated files if they actually changed + +* try to make parts/apicheck.pl automatically find NEED_ #defines + +* add support for my_vsnprintf? + +* try to perform some core consistency checks: + + - check if 'd' flag in embed.fnc matches with + supplied documentation + + - check if all public API is documented + +* check (during make regen?) if MAX_PERL in PPPort_pm.PL + needs to be updated + +* see if we can implement sv_catpvf() for < 5.004 + +* MULTICALL ? + +* improve apicheck (things like utf8_mg_pos_init() are + not currently checked) + +* more documentation, more tests + +* Resolve dependencies in Makefile.PL and remind of + running 'make regen' + diff --git a/ext/Devel-PPPort/apicheck_c.PL b/ext/Devel-PPPort/apicheck_c.PL new file mode 100644 index 0000000000..e4d861e18a --- /dev/null +++ b/ext/Devel-PPPort/apicheck_c.PL @@ -0,0 +1,29 @@ +################################################################################ +# +# apicheck_c.PL -- generate apicheck.c +# +################################################################################ +# +# $Revision: 11 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:49 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; + +my $out = 'apicheck.c'; +my @api = map { /^--api=(\w+)$/ ? ($1) : () } @ARGV; +print "creating $out", (@api ? " (@api)" : ''), "\n"; +system $^X, 'parts/apicheck.pl', @api, $out + and die "couldn't create $out\n"; + diff --git a/ext/Devel-PPPort/devel/buildperl.pl b/ext/Devel-PPPort/devel/buildperl.pl new file mode 100644 index 0000000000..49b7fbbf29 --- /dev/null +++ b/ext/Devel-PPPort/devel/buildperl.pl @@ -0,0 +1,539 @@ +#!/usr/bin/perl -w +################################################################################ +# +# buildperl.pl -- build various versions of perl automatically +# +################################################################################ +# +# $Revision: 15 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; +use Getopt::Long; +use Pod::Usage; +use File::Find; +use File::Path; +use Data::Dumper; +use IO::File; +use Cwd; + +# TODO: - extra arguments to Configure + +# +# --test-archives=1 check if archives can be read +# --test-archives=2 like 1, but also extract archives +# --test-archives=3 like 2, but also apply patches +# + +my %opt = ( + prefix => '/tmp/perl/install//', + build => '/tmp/perl/build/', + source => '/tmp/perl/source', + force => 0, + test => 0, + install => 1, + oneshot => 0, + configure => 0, + 'test-archives' => 0, +); + +my %config = ( + default => { + config_args => '-des', + }, + thread => { + config_args => '-des -Dusethreads', + masked_versions => [ qr/^5\.00[01234]/ ], + }, + thread5005 => { + config_args => '-des -Duse5005threads', + masked_versions => [ qr/^5\.00[012345]|^5.(9|\d\d)/ ], + }, + debug => { + config_args => '-des -Doptimize=-g', + }, +); + +my @patch = ( + { + perl => [ + qr/^5\.00[01234]/, + qw/ + 5.005 + 5.005_01 + 5.005_02 + 5.005_03 + /, + ], + subs => [ + [ \&patch_db, 1 ], + ], + }, + { + perl => [ + qw/ + 5.6.0 + 5.6.1 + 5.7.0 + 5.7.1 + 5.7.2 + 5.7.3 + 5.8.0 + /, + ], + subs => [ + [ \&patch_db, 3 ], + ], + }, + { + perl => [ + qr/^5\.004_0[1234]$/, + ], + subs => [ + [ \&patch_doio ], + ], + }, + { + perl => [ + qw/ + 5.005 + 5.005_01 + 5.005_02 + /, + ], + subs => [ + [ \&patch_sysv, old_format => 1 ], + ], + }, + { + perl => [ + qw/ + 5.005_03 + 5.005_04 + /, + qr/^5\.6\.[0-2]$/, + qr/^5\.7\.[0-3]$/, + qr/^5\.8\.[0-8]$/, + qr/^5\.9\.[0-5]$/ + ], + subs => [ + [ \&patch_sysv ], + ], + }, +); + +my(%perl, @perls); + +GetOptions(\%opt, qw( + config=s@ + prefix=s + build=s + source=s + perl=s@ + force + test + install! + test-archives=i + patch! + oneshot +)) or pod2usage(2); + +my %current; + +if ($opt{patch} || $opt{oneshot}) { + @{$opt{perl}} == 1 or die "Exactly one --perl must be given with --patch or --oneshot\n"; + my $perl = $opt{perl}[0]; + patch_source($perl) if !exists $opt{patch} || $opt{patch}; + if (exists $opt{oneshot}) { + eval { require String::ShellQuote }; + die "--oneshot requires String::ShellQuote to be installed\n" if $@; + %current = (config => 'oneshot', version => $perl); + $config{oneshot} = { config_args => String::ShellQuote::shell_quote(@ARGV) }; + build_and_install($perl{$perl}); + } + exit 0; +} + +if (exists $opt{config}) { + for my $cfg (@{$opt{config}}) { + exists $config{$cfg} or die "Unknown configuration: $cfg\n"; + } +} +else { + $opt{config} = [sort keys %config]; +} + +find(sub { + /^(perl-?(5\..*))\.tar\.(gz|bz2)$/ or return; + $perl{$1} = { version => $2, source => $File::Find::name, compress => $3 }; +}, $opt{source}); + +if (exists $opt{perl}) { + for my $perl (@{$opt{perl}}) { + my $p = $perl; + exists $perl{$p} or $p = "perl$perl"; + exists $perl{$p} or $p = "perl-$perl"; + exists $perl{$p} or die "Cannot find perl: $perl\n"; + push @perls, $p; + } +} +else { + @perls = sort keys %perl; +} + +if ($opt{'test-archives'}) { + my $test = 'test'; + my $cwd = cwd; + -d $test or mkpath($test); + chdir $test or die "chdir $test: $!\n"; + for my $perl (@perls) { + eval { + my $d = extract_source($perl{$perl}); + if ($opt{'test-archives'} > 2) { + my $cwd2 = cwd; + chdir $d or die "chdir $d: $!\n"; + patch_source($perl{$perl}{version}); + chdir $cwd2 or die "chdir $cwd2:$!\n" + } + rmtree($d) if -e $d; + }; + warn $@ if $@; + } + chdir $cwd or die "chdir $cwd: $!\n"; + print STDERR "cleaning up\n"; + rmtree($test); + exit 0; +} + +for my $cfg (@{$opt{config}}) { + for my $perl (@perls) { + my $config = $config{$cfg}; + %current = (config => $cfg, perl => $perl, version => $perl{$perl}{version}); + + if (is($config->{masked_versions}, $current{version})) { + print STDERR "skipping $perl for configuration $cfg (masked)\n"; + next; + } + + if (-d expand($opt{prefix}) and !$opt{force}) { + print STDERR "skipping $perl for configuration $cfg (already installed)\n"; + next; + } + + my $cwd = cwd; + + my $build = expand($opt{build}); + -d $build or mkpath($build); + chdir $build or die "chdir $build: $!\n"; + + print STDERR "building $perl with configuration $cfg\n"; + buildperl($perl, $config); + + chdir $cwd or die "chdir $cwd: $!\n"; + } +} + +sub expand +{ + my $in = shift; + $in =~ s/(<(\w+)>)/exists $current{$2} ? $current{$2} : $1/eg; + return $in; +} + +sub is +{ + my($s1, $s2) = @_; + + defined $s1 != defined $s2 and return 0; + + ref $s2 and ($s1, $s2) = ($s2, $s1); + + if (ref $s1) { + if (ref $s1 eq 'ARRAY') { + is($_, $s2) and return 1 for @$s1; + return 0; + } + return $s2 =~ $s1; + } + + return $s1 eq $s2; +} + +sub buildperl +{ + my($perl, $cfg) = @_; + + my $d = extract_source($perl{$perl}); + chdir $d or die "chdir $d: $!\n"; + + patch_source($perl{$perl}{version}); + + build_and_install($perl{$perl}); +} + +sub extract_source +{ + eval { require Archive::Tar }; + die "Archive processing requires Archive::Tar to be installed\n" if $@; + + my $perl = shift; + + my $what = $opt{'test-archives'} ? 'test' : 'read'; + print "${what}ing $perl->{source}\n"; + + my $target; + + for my $f (Archive::Tar->list_archive($perl->{source})) { + my($t) = $f =~ /^([^\\\/]+)/ or die "ooops, should always match...\n"; + die "refusing to extract $perl->{source}, as it would not extract to a single directory\n" + if defined $target and $target ne $t; + $target = $t; + } + + if ($opt{'test-archives'} == 0 || $opt{'test-archives'} > 1) { + if (-d $target) { + print "removing old build directory $target\n"; + rmtree($target); + } + + print "extracting $perl->{source}\n"; + + Archive::Tar->extract_archive($perl->{source}) + or die "extract failed: " . Archive::Tar->error() . "\n"; + + -d $target or die "oooops, $target not found\n"; + } + + return $target; +} + +sub patch_source +{ + my $version = shift; + + for my $p (@patch) { + if (is($p->{perl}, $version)) { + for my $s (@{$p->{subs}}) { + my($sub, @args) = @$s; + $sub->(@args); + } + } + } +} + +sub build_and_install +{ + my $perl = shift; + my $prefix = expand($opt{prefix}); + + print "building perl $perl->{version} ($current{config})\n"; + + run_or_die("./Configure $config{$current{config}}{config_args} -Dusedevel -Uinstallusrbinperl -Dprefix=$prefix"); + run_or_die("sed -i -e '/^.*/d' -e '/^.*/d' makefile x2p/makefile"); + run_or_die("make all"); + run("make test") if $opt{test}; + if ($opt{install}) { + run_or_die("make install"); + } + else { + print "\n*** NOT INSTALLING PERL ***\n\n"; + } +} + +sub patch_db +{ + my $ver = shift; + print "patching ext/DB_File/DB_File.xs\n"; + run_or_die("sed -i -e 's///' ext/DB_File/DB_File.xs"); +} + +sub patch_doio +{ + patch(<<'END'); +--- doio.c.org 2004-06-07 23:14:45.000000000 +0200 ++++ doio.c 2003-11-04 08:03:03.000000000 +0100 +@@ -75,6 +75,16 @@ + # endif + #endif + ++#if _SEM_SEMUN_UNDEFINED ++union semun ++{ ++ int val; ++ struct semid_ds *buf; ++ unsigned short int *array; ++ struct seminfo *__buf; ++}; ++#endif ++ + bool + do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp) + GV *gv; +END +} + +sub patch_sysv +{ + my %opt = @_; + + # check if patching is required + return if $^O ne 'linux' or -f '/usr/include/asm/page.h'; + + if ($opt{old_format}) { + patch(<<'END'); +--- ext/IPC/SysV/SysV.xs.org 1998-07-20 10:20:07.000000000 +0200 ++++ ext/IPC/SysV/SysV.xs 2007-08-12 10:51:06.000000000 +0200 +@@ -3,9 +3,6 @@ + #include "XSUB.h" + + #include +-#ifdef __linux__ +-#include +-#endif + #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + #include + #ifdef HAS_MSG +END + } + else { + patch(<<'END'); +--- ext/IPC/SysV/SysV.xs.org 2007-08-11 00:12:46.000000000 +0200 ++++ ext/IPC/SysV/SysV.xs 2007-08-11 00:10:51.000000000 +0200 +@@ -3,9 +3,6 @@ + #include "XSUB.h" + + #include +-#ifdef __linux__ +-# include +-#endif + #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + #ifndef HAS_SEM + # include +END + } +} + +sub patch +{ + my($patch) = @_; + print "patching $_\n" for $patch =~ /^\+{3}\s+(\S+)/gm; + my $diff = 'tmp.diff'; + write_or_die($diff, $patch); + run_or_die("patch -s -p0 <$diff"); + unlink $diff or die "unlink $diff: $!\n"; +} + +sub write_or_die +{ + my($file, $data) = @_; + my $fh = new IO::File ">$file" or die "$file: $!\n"; + $fh->print($data); +} + +sub run_or_die +{ + # print "[running @_]\n"; + system "@_" and die "@_: $?\n"; +} + +sub run +{ + # print "[running @_]\n"; + system "@_" and warn "@_: $?\n"; +} + +__END__ + +=head1 NAME + +buildperl.pl - build/install perl distributions + +=head1 SYNOPSIS + + perl buildperl.pl [options] + + --help show this help + + --source=directory directory containing source tarballs + [default: /tmp/perl/source] + + --build=directory directory used for building perls [EXPAND] + [default: /tmp/perl/build/] + + --prefix=directory use this installation prefix [EXPAND] + [default: /tmp/perl/install//] + + --config=configuration build this configuration [MULTI] + [default: all possible configurations] + + --perl=version build this version of perl [MULTI] + [default: all possible versions] + + --force rebuild and install already installed versions + + --test run test suite after building + + --noinstall don't install after building + + --patch only patch the perl source in the current directory + + --oneshot build from the perl source in the current directory + (extra arguments are passed to Configure) + + options tagged with [MULTI] can be given multiple times + + options tagged with [EXPAND] expand the following items + + versioned perl directory (e.g. 'perl-5.6.1') + perl version (e.g. '5.6.1') + name of the configuration (e.g. 'default') + +=head1 EXAMPLES + +The following examples assume that your Perl source tarballs are +in F. If they are somewhere else, use the C<--source> +option to specify a different source directory. + +To build a default configuration of perl5.004_05 and install it +to F, you would say: + + buildperl.pl --prefix='/opt/' --perl=5.004_05 --config=default + +To build debugging configurations of all perls in the source directory +and install them to F, use: + + buildperl.pl --prefix='/opt/' --config=debug + +To build all configurations for perl-5.8.5 and perl-5.8.6, test them +and don't install them, run: + + buildperl.pl --perl=5.8.5 --perl=5.8.6 --test --noinstall + +To build and install a single version of perl with special configuration +options, use: + + buildperl.pl --perl=5.6.0 --prefix=/opt/p560ld --oneshot -- -des -Duselongdouble + +=head1 COPYRIGHT + +Copyright (c) 2004-2009, Marcus Holland-Moritz. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +See L and L. + diff --git a/ext/Devel-PPPort/devel/devtools.pl b/ext/Devel-PPPort/devel/devtools.pl new file mode 100644 index 0000000000..a87c172000 --- /dev/null +++ b/ext/Devel-PPPort/devel/devtools.pl @@ -0,0 +1,129 @@ +################################################################################ +# +# devtools.pl -- various utility functions +# +################################################################################ +# +# $Revision: 5 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use IO::File; + +eval "use Term::ANSIColor"; +$@ and eval "sub colored { pop; @_ }"; + +my @argvcopy = @ARGV; + +sub verbose +{ + if ($opt{verbose}) { + my @out = @_; + s/^(.*)/colored("($0) ", 'bold blue').colored($1, 'blue')/eg for @out; + print STDERR @out; + } +} + +sub ddverbose +{ + return $opt{verbose} ? ('--verbose') : (); +} + +sub runtool +{ + my $opt = ref $_[0] ? shift @_ : {}; + my($prog, @args) = @_; + my $sysstr = join ' ', map { "'$_'" } $prog, @args; + $sysstr .= " >$opt->{'out'}" if exists $opt->{'out'}; + $sysstr .= " 2>$opt->{'err'}" if exists $opt->{'err'}; + verbose("running $sysstr\n"); + my $rv = system $sysstr; + verbose("$prog => exit code $rv\n"); + return not $rv; +} + +sub runperl +{ + my $opt = ref $_[0] ? shift @_ : {}; + runtool($opt, $^X, @_); +} + +sub run +{ + my $prog = shift; + my @args = @_; + + runtool({ 'out' => 'tmp.out', 'err' => 'tmp.err' }, $prog, @args); + + my $out = IO::File->new("tmp.out") or die "tmp.out: $!\n"; + my $err = IO::File->new("tmp.err") or die "tmp.err: $!\n"; + + my %rval = ( + status => $? >> 8, + stdout => [<$out>], + stderr => [<$err>], + didnotrun => 0, + ); + + unlink "tmp.out", "tmp.err"; + + $? & 128 and $rval{core} = 1; + $? & 127 and $rval{signal} = $? & 127; + + return \%rval; +} + +sub ident_str +{ + return "$^X $0 @argvcopy"; +} + +sub identify +{ + verbose(ident_str() . "\n"); +} + +sub ask($) +{ + my $q = shift; + my $a; + local $| = 1; + print "\n$q [y/n] "; + do { $a = <>; } while ($a !~ /^\s*([yn])\s*$/i); + return lc $1 eq 'y'; +} + +sub quit_now +{ + print "\nSorry, cannot continue.\n\n"; + exit 1; +} + +sub ask_or_quit +{ + quit_now unless &ask; +} + +sub eta +{ + my($start, $i, $n) = @_; + return "--:--:--" if $i < 3; + my $elapsed = tv_interval($start); + my $h = int($elapsed*($n-$i)/$i); + my $s = $h % 60; $h /= 60; + my $m = $h % 60; $h /= 60; + return sprintf "%02d:%02d:%02d", $h, $m, $s; +} + +1; diff --git a/ext/Devel-PPPort/devel/mkapidoc.sh b/ext/Devel-PPPort/devel/mkapidoc.sh new file mode 100644 index 0000000000..a4de2b4a27 --- /dev/null +++ b/ext/Devel-PPPort/devel/mkapidoc.sh @@ -0,0 +1,87 @@ +#!/bin/bash +################################################################################ +# +# mkapidoc.sh -- generate apidoc.fnc from scanning the Perl source +# +################################################################################ +# +# $Revision: 13 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +function isperlroot +{ + [ -f "$1/embed.fnc" ] && [ -f "$1/perl.h" ] +} + +function usage +{ + echo "USAGE: $0 [perlroot] [output-file] [embed.fnc]" + exit 0 +} + +if [ -z "$1" ]; then + if isperlroot "../../.."; then + PERLROOT=../../.. + else + PERLROOT=. + fi +else + PERLROOT=$1 +fi + +if [ -z "$2" ]; then + if [ -f "parts/apidoc.fnc" ]; then + OUTPUT="parts/apidoc.fnc" + else + usage + fi +else + OUTPUT=$2 +fi + +if [ -z "$3" ]; then + if [ -f "parts/embed.fnc" ]; then + EMBED="parts/embed.fnc" + else + usage + fi +else + EMBED=$3 +fi + +if isperlroot $PERLROOT; then + cat >$OUTPUT < file that came with this distribution. +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +: +: This file lists all API functions/macros that are documented in the Perl +: source code, but are not contained in F. +: + +EOF + grep -hr '^=for apidoc' $PERLROOT | sed -e 's/=for apidoc //' | grep '|' | sort | uniq \ + | perl -e'$f=pop;open(F,$f)||die"$f:$!";while(){(split/\|/)[2]=~/(\w+)/;$h{$1}++} + while(<>){s/[ \t]+$//;(split/\|/)[2]=~/(\w+)/;$h{$1}||print}' $EMBED >>$OUTPUT +else + usage +fi diff --git a/ext/Devel-PPPort/devel/mktodo b/ext/Devel-PPPort/devel/mktodo new file mode 100644 index 0000000000..d2bf8b8d8c --- /dev/null +++ b/ext/Devel-PPPort/devel/mktodo @@ -0,0 +1,62 @@ +#!/usr/bin/perl -w +################################################################################ +# +# mktodo -- generate baseline and todo files by running mktodo.pl +# +################################################################################ +# +# $Revision: 16 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; +use Getopt::Long; + +require 'devel/devtools.pl'; + +our %opt = ( + base => 0, + check => 1, + verbose => 0, +); + +GetOptions(\%opt, qw( base check! verbose )) or die; + +identify(); + +my $outdir = 'parts/todo'; + +my $install = '/tmp/perl/install/default'; +# my $install = '/tmp/perl/install/thread'; + +my @perls = sort { $b->{version} <=> $a->{version} } + map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } } + ('bleadperl', glob "$install/*/bin/perl5.*"); + +for (1 .. $#perls) { + $perls[$_]{todo} = $perls[$_-1]{version}; +} + +shift @perls; + +for (@perls) { + my $todo = do { my $v = $_->{todo}; $v =~ s/\D+//g; $v }; + -e "$outdir/$todo" and next; + my @args = ('--perl', $_->{path}, '--todo', "$outdir/$todo", '--version', "$_->{todo}"); + push @args, '--base' if $opt{base}; + push @args, '--verbose' if $opt{verbose}; + push @args, '--nocheck' unless $opt{check}; + runperl('devel/mktodo.pl', @args) or die "error running mktodo.pl [$!] [$?]\n"; +} + diff --git a/ext/Devel-PPPort/devel/mktodo.pl b/ext/Devel-PPPort/devel/mktodo.pl new file mode 100644 index 0000000000..156a1c8518 --- /dev/null +++ b/ext/Devel-PPPort/devel/mktodo.pl @@ -0,0 +1,346 @@ +#!/usr/bin/perl -w +################################################################################ +# +# mktodo.pl -- generate baseline and todo files +# +################################################################################ +# +# $Revision: 16 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:51 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; +use Getopt::Long; +use Data::Dumper; +use IO::File; +use IO::Select; +use Config; +use Time::HiRes qw( gettimeofday tv_interval ); + +require 'devel/devtools.pl'; + +our %opt = ( + debug => 0, + base => 0, + verbose => 0, + check => 1, + shlib => 'blib/arch/auto/Devel/PPPort/PPPort.so', +); + +GetOptions(\%opt, qw( + perl=s todo=s version=s shlib=s debug base verbose check! + )) or die; + +identify(); + +print "\n", ident_str(), "\n\n"; + +my $fullperl = `which $opt{perl}`; +chomp $fullperl; + +$ENV{SKIP_SLOW_TESTS} = 1; + +regen_all(); + +my %sym; +for (`$Config{nm} $fullperl`) { + chomp; + /\s+T\s+(\w+)\s*$/ and $sym{$1}++; +} +keys %sym >= 50 or die "less than 50 symbols found in $fullperl\n"; + +my %all = %{load_todo($opt{todo}, $opt{version})}; +my @recheck; + +my $symmap = get_apicheck_symbol_map(); + +for (;;) { + my $retry = 1; + my $trynm = 1; + regen_apicheck(); + +retry: + my(@new, @tmp, %seen); + + my $r = run(qw(make)); + $r->{didnotrun} and die "couldn't run make: $!\n"; + + for my $l (@{$r->{stderr}}) { + if ($l =~ /_DPPP_test_(\w+)/) { + if (!$seen{$1}++) { + my @s = grep { exists $sym{$_} } $1, "Perl_$1", "perl_$1"; + if (@s) { + push @tmp, [$1, "E (@s)"]; + } + else { + push @new, [$1, "E"]; + } + } + } + } + + if ($r->{status} == 0) { + my @u; + my @usym; + + if ($trynm) { + @u = eval { find_undefined_symbols($fullperl, $opt{shlib}) }; + warn "warning: $@" if $@; + $trynm = 0; + } + + unless (@u) { + $r = run(qw(make test)); + $r->{didnotrun} and die "couldn't run make test: $!\n"; + $r->{status} == 0 and last; + + for my $l (@{$r->{stderr}}) { + if ($l =~ /undefined symbol: (\w+)/) { + push @u, $1; + } + } + } + + for my $u (@u) { + for my $m (keys %{$symmap->{$u}}) { + if (!$seen{$m}++) { + my $pl = $m; + $pl =~ s/^[Pp]erl_//; + my @s = grep { exists $sym{$_} } $pl, "Perl_$pl", "perl_$pl"; + push @new, [$m, @s ? "U (@s)" : "U"]; + } + } + } + } + + @new = grep !$all{$_->[0]}, @new; + + unless (@new) { + @new = grep !$all{$_->[0]}, @tmp; + } + + unless (@new) { + if ($retry > 0) { + $retry--; + regen_all(); + goto retry; + } + print Dumper($r); + die "no new TODO symbols found..."; + } + + # don't recheck undefined symbols reported by the dynamic linker + push @recheck, map { $_->[0] } grep { $_->[1] !~ /^U/ } @new; + + for (@new) { + sym('new', @$_); + $all{$_->[0]} = $_->[1]; + } + + write_todo($opt{todo}, $opt{version}, \%all); +} + +if ($opt{check}) { + my $ifmt = '%' . length(scalar @recheck) . 'd'; + my $t0 = [gettimeofday]; + + RECHECK: for my $i (0 .. $#recheck) { + my $sym = $recheck[$i]; + my $cur = delete $all{$sym}; + + sym('chk', $sym, $cur, sprintf(" [$ifmt/$ifmt, ETA %s]", + $i + 1, scalar @recheck, eta($t0, $i, scalar @recheck))); + + write_todo($opt{todo}, $opt{version}, \%all); + + if ($cur eq "E (Perl_$sym)") { + # we can try a shortcut here + regen_apicheck($sym); + + my $r = run(qw(make test)); + + if (!$r->{didnotrun} && $r->{status} == 0) { + sym('del', $sym, $cur); + next RECHECK; + } + } + + # run the full test + regen_all(); + + my $r = run(qw(make test)); + + $r->{didnotrun} and die "couldn't run make test: $!\n"; + + if ($r->{status} == 0) { + sym('del', $sym, $cur); + } + else { + $all{$sym} = $cur; + } + } +} + +write_todo($opt{todo}, $opt{version}, \%all); + +run(qw(make realclean)); + +exit 0; + +sub sym +{ + my($what, $sym, $reason, $extra) = @_; + $extra ||= ''; + my %col = ( + 'new' => 'bold red', + 'chk' => 'bold magenta', + 'del' => 'bold green', + ); + $what = colored("$what symbol", $col{$what}); + + printf "[%s] %s %-30s # %s%s\n", + $opt{version}, $what, $sym, $reason, $extra; +} + +sub regen_all +{ + my @mf_arg = ('--with-apicheck', 'OPTIMIZE=-O0 -w'); + push @mf_arg, qw( DEFINE=-DDPPP_APICHECK_NO_PPPORT_H ) if $opt{base}; + + # just to be sure + run(qw(make realclean)); + run($fullperl, "Makefile.PL", @mf_arg)->{status} == 0 + or die "cannot run Makefile.PL: $!\n"; +} + +sub regen_apicheck +{ + unlink qw(apicheck.c apicheck.o); + runtool({ out => '/dev/null' }, $fullperl, 'apicheck_c.PL', map { "--api=$_" } @_) + or die "cannot regenerate apicheck.c\n"; +} + +sub load_todo +{ + my($file, $expver) = @_; + + if (-e $file) { + my $f = new IO::File $file or die "cannot open $file: $!\n"; + my $ver = <$f>; + chomp $ver; + if ($ver eq $expver) { + my %sym; + while (<$f>) { + chomp; + /^(\w+)\s+#\s+(.*)/ or goto nuke_file; + exists $sym{$1} and goto nuke_file; + $sym{$1} = $2; + } + return \%sym; + } + +nuke_file: + undef $f; + unlink $file or die "cannot remove $file: $!\n"; + } + + return {}; +} + +sub write_todo +{ + my($file, $ver, $sym) = @_; + my $f; + + $f = new IO::File ">$file" or die "cannot open $file: $!\n"; + $f->print("$ver\n"); + + for (sort keys %$sym) { + $f->print(sprintf "%-30s # %s\n", $_, $sym->{$_}); + } +} + +sub find_undefined_symbols +{ + my($perl, $shlib) = @_; + + my $ps = read_sym(file => $perl, options => [qw( --defined-only )]); + my $ls = read_sym(file => $shlib, options => [qw( --undefined-only )]); + + my @undefined; + + for my $sym (keys %$ls) { + unless (exists $ps->{$sym}) { + if ($sym !~ /\@/ and $sym !~ /^_/) { + push @undefined, $sym; + } + } + } + + return @undefined; +} + +sub read_sym +{ + my %opt = ( options => [], @_ ); + + my $r = run($Config{nm}, @{$opt{options}}, $opt{file}); + + if ($r->{didnotrun} or $r->{status}) { + die "cannot run $Config{nm}"; + } + + my %sym; + + for (@{$r->{stdout}}) { + chomp; + my($adr, $fmt, $sym) = /^\s*([[:xdigit:]]+)?\s+([ABCDGINRSTUVW?-])\s+(\S+)\s*$/i + or die "cannot parse $Config{nm} output:\n[$_]\n"; + $sym{$sym} = { format => $fmt }; + $sym{$sym}{address} = $adr if defined $adr; + } + + return \%sym; +} + +sub get_apicheck_symbol_map +{ + my $r = run(qw(make apicheck.i)); + + if ($r->{didnotrun} or $r->{status}) { + die "cannot run make apicheck.i"; + } + + my $fh = IO::File->new('apicheck.i') + or die "cannot open apicheck.i: $!"; + + local $_; + my %symmap; + my $cur; + + while (<$fh>) { + next if /^#/; + if (defined $cur) { + for my $sym (/\b([A-Za-z_]\w+)\b/g) { + $symmap{$sym}{$cur}++; + } + undef $cur if /^}$/; + } + else { + /_DPPP_test_(\w+)/ and $cur = $1; + } + } + + return \%symmap; +} diff --git a/ext/Devel-PPPort/devel/regenerate b/ext/Devel-PPPort/devel/regenerate new file mode 100644 index 0000000000..31765055cd --- /dev/null +++ b/ext/Devel-PPPort/devel/regenerate @@ -0,0 +1,161 @@ +#!/usr/bin/perl -w +################################################################################ +# +# regenerate -- regenerate baseline and todo files +# +################################################################################ +# +# $Revision: 8 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; +use File::Path; +use File::Copy; +use Getopt::Long; +use Pod::Usage; + +require 'devel/devtools.pl'; + +our %opt = ( + check => 1, + verbose => 0, +); + +GetOptions(\%opt, qw( check! verbose )) or die pod2usage(); + +identify(); + +unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') { + print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n"; + quit_now(); +} + +ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?"); + +my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo ); + +my(@notwr, @wr); +for my $f (map @$_, values %files) { + push @{-w $f ? \@wr : \@notwr}, $f; +} + +if (@notwr) { + if (@wr) { + print "\nThe following files are not writable:\n\n"; + print " $_\n" for @notwr; + print "\nAre you sure you have checked out these files?\n"; + } + else { + print "\nAll baseline / todo file are not writable.\n"; + ask_or_quit("Do you want to try to check out these files?"); + unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) { + print "\nSomething went wrong while checking out the files.\n"; + quit_now(); + } + } +} + +for my $dir (qw( base todo )) { + my $cur = "parts/$dir"; + my $old = "$cur-old"; + if (-e $old) { + ask_or_quit("Do you want me to remove the old $old directory?"); + rmtree($old); + } + mkdir $old; + print "\nBacking up $cur in $old.\n"; + for my $src (@{$files{$dir}}) { + my $dst = $src; + $dst =~ s/\E$cur/$old/ or die "Ooops!"; + move($src, $dst) or die "Moving $src to $dst failed: $!\n"; + } +} + +my $T0 = time; +my @args = ddverbose(); +push @args, '--nocheck' unless $opt{check}; + +print "\nBuilding baseline files...\n\n"; + +unless (runperl('devel/mktodo', '--base', @args)) { + print "\nSomething went wrong while building the baseline files.\n"; + quit_now(); +} + +print "\nMoving baseline files...\n\n"; + +for my $src (glob 'parts/todo/5*') { + my $dst = $src; + $dst =~ s/todo/base/ or die "Ooops!"; + move($src, $dst) or die "Moving $src to $dst failed: $!\n"; +} + +print "\nBuilding todo files...\n\n"; + +unless (runperl('devel/mktodo', @args)) { + print "\nSomething went wrong while building the baseline files.\n"; + quit_now(); +} + +print "\nAdding remaining baseline info...\n\n"; + +unless (runperl('Makefile.PL') and + runtool('make') and + runperl('devel/scanprov', 'write')) { + print "\nSomething went wrong while adding the baseline info.\n"; + quit_now(); +} + +my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times); +my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys; +$usr = sprintf "%.2f", $usr + $cusr; +$sys = sprintf "%.2f", $sys + $csys; + +print < and L. + +=cut + diff --git a/ext/Devel-PPPort/devel/scanprov b/ext/Devel-PPPort/devel/scanprov new file mode 100644 index 0000000000..19d294472a --- /dev/null +++ b/ext/Devel-PPPort/devel/scanprov @@ -0,0 +1,77 @@ +#!/usr/bin/perl -w +################################################################################ +# +# scanprov -- scan Perl headers for provided macros +# +################################################################################ +# +# $Revision: 9 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; +require 'parts/ppptools.pl'; + +die "Usage: $0 [check|write]\n" unless @ARGV && $ARGV[0] =~ /^(check|write)$/; +my $mode = $1; + +my %embed = map { ( $_->{name} => 1 ) } + parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc )); + +my @provided = grep { !exists $embed{$_} } + map { /^(\w+)/ ? $1 : () } + `$^X ppport.h --list-provided`; + +my $install = '/tmp/perl/install/default'; + +my @perls = sort { $b->{version} <=> $a->{version} } + map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } } + ('bleadperl', glob "$install/*/bin/perl5.*"); + +for (1 .. $#perls) { + $perls[$_]{todo} = $perls[$_-1]{version}; +} + +shift @perls; + +my %v; + +for my $p (@perls) { + print "checking perl $p->{version}...\n"; + my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`; + chomp $archlib; + local @ARGV = glob "$archlib/CORE/*.h"; + my %sym; + while (<>) { $sym{$_}++ for /(\w+)/g; } + @provided = map { $sym{$_} or $v{$p->{todo}}{$_}++; $sym{$_} ? $_ : () } @provided; +} + +my $out = 'parts/base'; +my $todo = parse_todo($out); + +for my $v (keys %v) { + my @new = sort grep { !exists $todo->{$_} } keys %{$v{$v}}; + @new or next; + my $file = $v; + $file =~ s/\.//g; + $file = "$out/$file"; + -e $file or die "non-existent: $file\n"; + print "-- $file --\n"; + $mode eq 'write' and (open F, ">>$file" or die "$file: $!\n"); + for (@new) { + print "adding $_\n"; + $mode eq 'write' and printf F "%-30s # added by $0\n", $_; + } + $mode eq 'write' and close F; +} diff --git a/ext/Devel-PPPort/mktests.PL b/ext/Devel-PPPort/mktests.PL new file mode 100644 index 0000000000..b134d2f1ca --- /dev/null +++ b/ext/Devel-PPPort/mktests.PL @@ -0,0 +1,116 @@ +################################################################################ +# +# mktests.PL -- generate test files for Devel::PPPort +# +################################################################################ +# +# $Revision: 30 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:49 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; +$^W = 1; +require "parts/ppptools.pl"; + +my $template = do { local $/; }; + +generate_tests(); + +sub generate_tests +{ + my @tests; + my $file; + + for $file (all_files_in_dir('parts/inc')) { + my($testfile) = $file =~ /(\w+)\.?$/; # VMS has a trailing dot + $testfile = "t/$testfile.t"; + + my $spec = parse_partspec($file); + my $plan = 0; + + if (exists $spec->{tests}) { + exists $spec->{OPTIONS}{tests} && + exists $spec->{OPTIONS}{tests}{plan} + or die "No plan for tests in $file\n"; + + print "generating $testfile\n"; + + my $tmpl = $template; + $tmpl =~ s/__SOURCE__/$file/mg; + $tmpl =~ s/__PLAN__/$spec->{OPTIONS}{tests}{plan}/mg; + $tmpl =~ s/^__TESTS__$/$spec->{tests}/mg; + + open FH, ">$testfile" or die "$testfile: $!\n"; + print FH $tmpl; + close FH; + + push @tests, $testfile; + } + } + + return @tests; +} + +__DATA__ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or __SOURCE__ instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (__PLAN__) { + load(); + plan(tests => __PLAN__); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +__TESTS__ diff --git a/ext/Devel-PPPort/module2.c b/ext/Devel-PPPort/module2.c new file mode 100644 index 0000000000..e5f4ef607c --- /dev/null +++ b/ext/Devel-PPPort/module2.c @@ -0,0 +1,60 @@ +/******************************************************************************* +* +* Perl/Pollution/Portability +* +******************************************************************************** +* +* $Revision: 12 $ +* $Author: mhx $ +* $Date: 2009/01/18 14:10:49 +0100 $ +* +******************************************************************************** +* +* Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +* Version 2.x, Copyright (C) 2001, Paul Marquess. +* Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +* +* This program is free software; you can redistribute it and/or +* modify it under the same terms as Perl itself. +* +*******************************************************************************/ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifndef PATCHLEVEL +#include "patchlevel.h" +#endif + +#define NEED_newCONSTSUB_GLOBAL +#define NEED_PL_signals_GLOBAL +#define NEED_PL_parser +#define DPPP_PL_parser_NO_DUMMY +#include "ppport.h" + +void call_newCONSTSUB_2(void) +{ + newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_2", newSViv(2)); +} + +U32 get_PL_signals_2(void) +{ + return PL_signals; +} + +int no_dummy_parser_vars(int check) +{ + if (check == 0 || PL_parser) + { + line_t volatile my_copline; + line_t volatile *my_p_copline; + my_copline = PL_copline; + my_p_copline = &PL_copline; + PL_copline = my_copline; + PL_copline = *my_p_copline; + return 1; + } + + return 0; +} diff --git a/ext/Devel-PPPort/module3.c b/ext/Devel-PPPort/module3.c new file mode 100644 index 0000000000..bcfbcd08b3 --- /dev/null +++ b/ext/Devel-PPPort/module3.c @@ -0,0 +1,77 @@ +/******************************************************************************* +* +* Perl/Pollution/Portability +* +******************************************************************************** +* +* $Revision: 12 $ +* $Author: mhx $ +* $Date: 2009/01/18 14:10:49 +0100 $ +* +******************************************************************************** +* +* Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +* Version 2.x, Copyright (C) 2001, Paul Marquess. +* Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +* +* This program is free software; you can redistribute it and/or +* modify it under the same terms as Perl itself. +* +*******************************************************************************/ + +#include "EXTERN.h" +#include "perl.h" + +#define NEED_PL_parser +#define NO_XSLOCKS +#include "XSUB.h" + +#include "ppport.h" + +static void throws_exception(int throw_e) +{ + if (throw_e) + croak("boo\n"); +} + +int exception(int throw_e) +{ + dTHR; + dXCPT; + SV *caught = get_sv("Devel::PPPort::exception_caught", 0); + + XCPT_TRY_START { + throws_exception(throw_e); + } XCPT_TRY_END + + XCPT_CATCH + { + sv_setiv(caught, 1); + XCPT_RETHROW; + } + + sv_setiv(caught, 0); + + return 42; +} + +void call_newCONSTSUB_3(void) +{ + newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_3", newSViv(3)); +} + +U32 get_PL_signals_3(void) +{ + return PL_signals; +} + +int dummy_parser_warning(void) +{ + char * volatile my_bufptr; + char * volatile *my_p_bufptr; + my_bufptr = PL_bufptr; + my_p_bufptr = &PL_bufptr; + PL_bufptr = my_bufptr; + PL_bufptr = *my_p_bufptr; + return &PL_bufptr != NULL; +} diff --git a/ext/Devel-PPPort/parts/apicheck.pl b/ext/Devel-PPPort/parts/apicheck.pl new file mode 100644 index 0000000000..35901425e5 --- /dev/null +++ b/ext/Devel-PPPort/parts/apicheck.pl @@ -0,0 +1,322 @@ +#!/usr/bin/perl -w +################################################################################ +# +# apicheck.pl -- generate C source for automated API check +# +################################################################################ +# +# $Revision: 34 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:51 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; +require 'parts/ppptools.pl'; + +if (@ARGV) { + my $file = pop @ARGV; + open OUT, ">$file" or die "$file: $!\n"; +} +else { + *OUT = \*STDOUT; +} + +my @f = parse_embed(qw( parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc )); + +my %todo = %{&parse_todo}; + +my %tmap = ( + void => 'int', +); + +my %amap = ( + SP => 'SP', + type => 'int', + cast => 'int', +); + +my %void = ( + void => 1, + Free_t => 1, + Signal_t => 1, +); + +my %castvoid = ( + map { ($_ => 1) } qw( + Nullav + Nullcv + Nullhv + Nullch + Nullsv + HEf_SVKEY + SP + MARK + SVt_PV + SVt_IV + SVt_NV + SVt_PVMG + SVt_PVAV + SVt_PVHV + SVt_PVCV + SvUOK + G_SCALAR + G_ARRAY + G_VOID + G_DISCARD + G_EVAL + G_NOARGS + XS_VERSION + ), +); + +my %ignorerv = ( + map { ($_ => 1) } qw( + newCONSTSUB + ), +); + +my %stack = ( + ORIGMARK => ['dORIGMARK;'], + POPpx => ['STRLEN n_a;'], + POPpbytex => ['STRLEN n_a;'], + PUSHp => ['dTARG;'], + PUSHn => ['dTARG;'], + PUSHi => ['dTARG;'], + PUSHu => ['dTARG;'], + XPUSHp => ['dTARG;'], + XPUSHn => ['dTARG;'], + XPUSHi => ['dTARG;'], + XPUSHu => ['dTARG;'], + UNDERBAR => ['dUNDERBAR;'], + XCPT_TRY_START => ['dXCPT;'], + XCPT_TRY_END => ['dXCPT;'], + XCPT_CATCH => ['dXCPT;'], + XCPT_RETHROW => ['dXCPT;'], +); + +my %ignore = ( + map { ($_ => 1) } qw( + svtype + items + ix + dXSI32 + XS + CLASS + THIS + RETVAL + StructCopy + ), +); + +print OUT < 0) } @ARGV; + @f = grep { exists $want{$_->{name}} } @f; + for (@f) { $want{$_->{name}}++ } + for (keys %want) { + die "nothing found for '$_'\n" unless $want{$_}; + } +} + +my $f; +for $f (@f) { + $ignore{$f->{name}} and next; + $f->{flags}{A} or next; # only public API members + + $ignore{$f->{name}} = 1; # ignore duplicates + + my $Perl_ = $f->{flags}{p} ? 'Perl_' : ''; + + my $stack = ''; + my @arg; + my $aTHX = ''; + + my $i = 1; + my $ca; + my $varargs = 0; + for $ca (@{$f->{args}}) { + my $a = $ca->[0]; + if ($a eq '...') { + $varargs = 1; + push @arg, qw(VARarg1 VARarg2 VARarg3); + last; + } + my($n, $p, $d) = $a =~ /^ (\w+(?:\s+\w+)*)\s* # type name => $n + (\**) # pointer => $p + (?:\s*const\s*)? # const + ((?:\[[^\]]*\])*) # dimension => $d + $/x + or die "$0 - cannot parse argument: [$a]\n"; + if (exists $amap{$n}) { + push @arg, $amap{$n}; + next; + } + $n = $tmap{$n} || $n; + if ($n eq 'const char' and $p eq '*' and !$f->{flags}{f}) { + push @arg, '"foo"'; + } + else { + my $v = 'arg' . $i++; + push @arg, $v; + $stack .= " static $n $p$v$d;\n"; + } + } + + unless ($f->{flags}{n} || $f->{flags}{'m'}) { + $stack = " dTHX;\n$stack"; + $aTHX = @arg ? 'aTHX_ ' : 'aTHX'; + } + + if ($stack{$f->{name}}) { + my $s = ''; + for (@{$stack{$f->{name}}}) { + $s .= " $_\n"; + } + $stack = "$s$stack"; + } + + my $args = join ', ', @arg; + my $rvt = $f->{ret} || 'void'; + my $ret; + if ($void{$rvt}) { + $ret = $castvoid{$f->{name}} ? '(void) ' : ''; + } + else { + $stack .= " $rvt rval;\n"; + $ret = $ignorerv{$f->{name}} ? '(void) ' : "rval = "; + } + my $aTHX_args = "$aTHX$args"; + + unless ($f->{flags}{'m'} and @arg == 0) { + $args = "($args)"; + $aTHX_args = "($aTHX_args)"; + } + + print OUT <{name} +* +******************************************************************************/ + +HEAD + + if ($todo{$f->{name}}) { + my($ver,$sub) = $todo{$f->{name}} =~ /^5\.(\d{3})(\d{3})$/ or die; + for ($ver, $sub) { + s/^0+(\d)/$1/ + } + if ($ver < 6 && $sub > 0) { + $sub =~ s/0$// or die; + } + print OUT "#if PERL_VERSION > $ver || (PERL_VERSION == $ver && PERL_SUBVERSION >= $sub) /* TODO */\n"; + } + + my $final = $varargs + ? "$Perl_$f->{name}$aTHX_args" + : "$f->{name}$args"; + + $f->{cond} and print OUT "#if $f->{cond}\n"; + + print OUT <{name} (void) +{ + dXSARGS; +$stack + { +#ifdef $f->{name} + $ret$f->{name}$args; +#endif + } + + { +#ifdef $f->{name} + $ret$final; +#else + $ret$Perl_$f->{name}$aTHX_args; +#endif + } +} +END + + $f->{cond} and print OUT "#endif\n"; + $todo{$f->{name}} and print OUT "#endif\n"; + + print OUT "\n"; +} + +@ARGV and close OUT; + diff --git a/ext/Devel-PPPort/parts/apidoc.fnc b/ext/Devel-PPPort/parts/apidoc.fnc new file mode 100644 index 0000000000..63b97468b8 --- /dev/null +++ b/ext/Devel-PPPort/parts/apidoc.fnc @@ -0,0 +1,327 @@ +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!! +: +: This file was automatically generated from the API documentation scattered +: all over the Perl source code. To learn more about how all this works, +: please read the F file that came with this distribution. +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +: +: This file lists all API functions/macros that are documented in the Perl +: source code, but are not contained in F. +: + +Ama|char*|savepvs|const char* s +Ama|SV*|newSVpvs|const char* s +Ama|SV*|newSVpvs_flags|const char* s|U32 flags +Ama|SV*|newSVpvs_share|const char* s +Am|bool|isALNUM|char ch +Am|bool|isALPHA|char ch +Am|bool|isDIGIT|char ch +Am|bool|isLOWER|char ch +Am|bool|isSPACE|char ch +Am|bool|isUPPER|char ch +Am|bool|strEQ|char* s1|char* s2 +Am|bool|strGE|char* s1|char* s2 +Am|bool|strGT|char* s1|char* s2 +Am|bool|strLE|char* s1|char* s2 +Am|bool|strLT|char* s1|char* s2 +Am|bool|strNE|char* s1|char* s2 +Am|bool|strnEQ|char* s1|char* s2|STRLEN len +Am|bool|strnNE|char* s1|char* s2|STRLEN len +Am|bool|SvIOK_notUV|SV* sv +Am|bool|SvIOK_UV|SV* sv +Am|bool|SvIsCOW_shared_hash|SV* sv +Am|bool|SvIsCOW|SV* sv +Am|bool|SvRXOK|SV* sv +Am|bool|SvTAINTED|SV* sv +Am|bool|SvTRUE|SV* sv +Am|bool|SvUOK|SV* sv +Am|bool|SvVOK|SV* sv +Am|char*|HePV|HE* he|STRLEN len +Am|char*|HeUTF8|HE* he|STRLEN len +Am|char*|HvNAME|HV* stash +Am|char*|SvEND|SV* sv +Am|char*|SvGAMAGIC|SV* sv +Am|char *|SvGROW|SV* sv|STRLEN len +Am|char*|SvPVbyte_force|SV* sv|STRLEN len +Am|char*|SvPVbyte_nolen|SV* sv +Am|char*|SvPVbyte|SV* sv|STRLEN len +Am|char*|SvPVbytex_force|SV* sv|STRLEN len +Am|char*|SvPVbytex|SV* sv|STRLEN len +Am|char*|SvPV_force_nomg|SV* sv|STRLEN len +Am|char*|SvPV_force|SV* sv|STRLEN len +Am|char*|SvPV_nolen|SV* sv +Am|char*|SvPV_nomg|SV* sv|STRLEN len +Am|char*|SvPV|SV* sv|STRLEN len +Am|char*|SvPVutf8_force|SV* sv|STRLEN len +Am|char*|SvPVutf8_nolen|SV* sv +Am|char*|SvPVutf8|SV* sv|STRLEN len +Am|char*|SvPVutf8x_force|SV* sv|STRLEN len +Am|char*|SvPVutf8x|SV* sv|STRLEN len +Am|char*|SvPVX|SV* sv +Am|char*|SvPVx|SV* sv|STRLEN len +Am|char|toLOWER|char ch +Am|char|toUPPER|char ch +Am|HV*|CvSTASH|CV* cv +Am|HV*|gv_stashpvs|const char* name|I32 create +Am|HV*|SvSTASH|SV* sv +Am|int|AvFILL|AV* av +Am|IV|SvIV_nomg|SV* sv +Am|IV|SvIV|SV* sv +Am|IV|SvIVx|SV* sv +Am|IV|SvIVX|SV* sv +Amn|char*|CLASS +Amn|char*|POPp +Amn|char*|POPpbytex +Amn|char*|POPpx +Amn|HV*|PL_modglobal +Amn|I32|ax +Amn|I32|items +Amn|I32|ix +Amn|IV|POPi +Amn|long|POPl +Amn|NV|POPn +Amn|STRLEN|PL_na +Amn|SV|PL_sv_no +Amn|SV|PL_sv_undef +Amn|SV|PL_sv_yes +Amn|SV*|POPs +Amn|U32|GIMME +Amn|U32|GIMME_V +Am|NV|SvNV|SV* sv +Am|NV|SvNVx|SV* sv +Am|NV|SvNVX|SV* sv +Amn|(whatever)|RETVAL +Amn|(whatever)|THIS +Am|REGEXP *|SvRX|SV *sv +Ams||dAX +Ams||dAXMARK +Ams||dITEMS +Ams||dMARK +Ams||dMULTICALL +Ams||dORIGMARK +Ams||dSP +Ams||dUNDERBAR +Ams||dXCPT +Ams||dXSARGS +Ams||dXSI32 +Ams||ENTER +Ams||FREETMPS +Ams||LEAVE +Ams||MULTICALL +Ams||POP_MULTICALL +Ams||PUSH_MULTICALL +Ams||PUTBACK +Ams||SAVETMPS +Ams||SPAGAIN +Am|STRLEN|HeKLEN|HE* he +Am|STRLEN|SvCUR|SV* sv +Am|STRLEN|SvLEN|SV* sv +Am|SV*|GvSV|GV* gv +Am|SV*|HeSVKEY_force|HE* he +Am|SV*|HeSVKEY|HE* he +Am|SV*|HeSVKEY_set|HE* he|SV* sv +Am|SV*|HeVAL|HE* he +Am|SV**|hv_fetchs|HV* tb|const char* key|I32 lval +Am|SV**|hv_stores|HV* tb|const char* key|NULLOK SV* val +Am|SV*|newRV_inc|SV* sv +Am|SV*|newSVpvn_utf8|NULLOK const char* s|STRLEN len|U32 utf8 +Am|SV*|ST|int ix +Am|SV*|SvREFCNT_inc_NN|SV* sv +Am|SV*|SvREFCNT_inc_simple_NN|SV* sv +Am|SV*|SvREFCNT_inc_simple|SV* sv +Am|SV*|SvREFCNT_inc|SV* sv +Am|SV*|SvRV|SV* sv +Am|svtype|SvTYPE|SV* sv +Ams||XCPT_RETHROW +Ams||XSRETURN_EMPTY +Ams||XSRETURN_NO +Ams||XSRETURN_UNDEF +Ams||XSRETURN_YES +Ams||XS_VERSION_BOOTCHECK +Am|U32|HeHASH|HE* he +Am|U32|SvIOKp|SV* sv +Am|U32|SvIOK|SV* sv +Am|U32|SvNIOKp|SV* sv +Am|U32|SvNIOK|SV* sv +Am|U32|SvNOKp|SV* sv +Am|U32|SvNOK|SV* sv +Am|U32|SvOK|SV* sv +Am|U32|SvOOK|SV* sv +Am|U32|SvPOKp|SV* sv +Am|U32|SvPOK|SV* sv +Am|U32|SvREFCNT|SV* sv +Am|U32|SvROK|SV* sv +Am|U32|SvUTF8|SV* sv +AmU||G_ARRAY +AmU||G_DISCARD +AmU||G_EVAL +AmU||G_NOARGS +AmU||G_SCALAR +AmU||G_VOID +AmU||HEf_SVKEY +AmU||MARK +AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto +AmU||Nullav +AmU||Nullch +AmU||Nullcv +AmU||Nullhv +AmU||Nullsv +AmU||ORIGMARK +AmU||SP +AmU||SVt_IV +AmU||SVt_NV +AmU||SVt_PV +AmU||SVt_PVAV +AmU||SVt_PVCV +AmU||SVt_PVHV +AmU||SVt_PVMG +AmU||svtype +AmU||UNDERBAR +Am|UV|SvUV_nomg|SV* sv +Am|UV|SvUV|SV* sv +Am|UV|SvUVx|SV* sv +Am|UV|SvUVX|SV* sv +AmU||XCPT_CATCH +AmU||XCPT_TRY_END +AmU||XCPT_TRY_START +AmU||XS +AmU||XS_VERSION +Am|void *|CopyD|void* src|void* dest|int nitems|type +Am|void|Copy|void* src|void* dest|int nitems|type +Am|void|EXTEND|SP|int nitems +Am|void*|HeKEY|HE* he +Am|void *|MoveD|void* src|void* dest|int nitems|type +Am|void|Move|void* src|void* dest|int nitems|type +Am|void|mPUSHi|IV iv +Am|void|mPUSHn|NV nv +Am|void|mPUSHp|char* str|STRLEN len +Am|void|mPUSHs|SV* sv +Am|void|mPUSHu|UV uv +Am|void|mXPUSHi|IV iv +Am|void|mXPUSHn|NV nv +Am|void|mXPUSHp|char* str|STRLEN len +Am|void|mXPUSHs|SV* sv +Am|void|mXPUSHu|UV uv +Am|void|Newxc|void* ptr|int nitems|type|cast +Am|void|Newx|void* ptr|int nitems|type +Am|void|Newxz|void* ptr|int nitems|type +Am|void|PoisonFree|void* dest|int nitems|type +Am|void|PoisonNew|void* dest|int nitems|type +Am|void|Poison|void* dest|int nitems|type +Am|void|PoisonWith|void* dest|int nitems|type|U8 byte +Am|void|PUSHi|IV iv +Am|void|PUSHMARK|SP +Am|void|PUSHmortal +Am|void|PUSHn|NV nv +Am|void|PUSHp|char* str|STRLEN len +Am|void|PUSHs|SV* sv +Am|void|PUSHu|UV uv +Am|void|Renewc|void* ptr|int nitems|type|cast +Am|void|Renew|void* ptr|int nitems|type +Am|void|Safefree|void* ptr +Am|void|StructCopy|type src|type dest|type +Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len +Am|void|sv_catpvs|SV* sv|const char* s +Am|void|sv_catsv_nomg|SV* dsv|SV* ssv +Am|void|SvCUR_set|SV* sv|STRLEN len +Am|void|SvGETMAGIC|SV* sv +Am|void|SvIOK_off|SV* sv +Am|void|SvIOK_only|SV* sv +Am|void|SvIOK_only_UV|SV* sv +Am|void|SvIOK_on|SV* sv +Am|void|SvIV_set|SV* sv|IV val +Am|void|SvLEN_set|SV* sv|STRLEN len +Am|void|SvLOCK|SV* sv +Am|void|SvMAGIC_set|SV* sv|MAGIC* val +Am|void|SvNIOK_off|SV* sv +Am|void|SvNOK_off|SV* sv +Am|void|SvNOK_only|SV* sv +Am|void|SvNOK_on|SV* sv +Am|void|SvNV_set|SV* sv|NV val +Am|void|SvOOK_offset|NN SV*sv|STRLEN len +Am|void|SvPOK_off|SV* sv +Am|void|SvPOK_only|SV* sv +Am|void|SvPOK_only_UTF8|SV* sv +Am|void|SvPOK_on|SV* sv +Am|void|SvPV_set|SV* sv|char* val +Am|void|SvREFCNT_dec|SV* sv +Am|void|SvREFCNT_inc_simple_void_NN|SV* sv +Am|void|SvREFCNT_inc_simple_void|SV* sv +Am|void|SvREFCNT_inc_void_NN|SV* sv +Am|void|SvREFCNT_inc_void|SV* sv +Am|void|SvROK_off|SV* sv +Am|void|SvROK_on|SV* sv +Am|void|SvRV_set|SV* sv|SV* val +Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv +Am|void|SvSETMAGIC|SV* sv +Am|void|SvSetMagicSV|SV* dsb|SV* ssv +Am|void|sv_setpvs|SV* sv|const char* s +Am|void|sv_setsv_nomg|SV* dsv|SV* ssv +Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv +Am|void|SvSetSV|SV* dsb|SV* ssv +Am|void|SvSHARE|SV* sv +Am|void|SvSTASH_set|SV* sv|HV* val +Am|void|SvTAINTED_off|SV* sv +Am|void|SvTAINTED_on|SV* sv +Am|void|SvTAINT|SV* sv +Am|void|SvUNLOCK|SV* sv +Am|void|SvUPGRADE|SV* sv|svtype type +Am|void|SvUTF8_off|SV *sv +Am|void|SvUTF8_on|SV *sv +Am|void|SvUV_set|SV* sv|UV val +Am|void|XPUSHi|IV iv +Am|void|XPUSHmortal +Am|void|XPUSHn|NV nv +Am|void|XPUSHp|char* str|STRLEN len +Am|void|XPUSHs|SV* sv +Am|void|XPUSHu|UV uv +Am|void|XSRETURN|int nitems +Am|void|XSRETURN_IV|IV iv +Am|void|XSRETURN_NV|NV nv +Am|void|XSRETURN_PV|char* str +Am|void|XSRETURN_UV|IV uv +Am|void|XST_mIV|int pos|IV iv +Am|void|XST_mNO|int pos +Am|void|XST_mNV|int pos|NV nv +Am|void|XST_mPV|int pos|char* str +Am|void|XST_mUNDEF|int pos +Am|void|XST_mYES|int pos +Am|void *|ZeroD|void* dest|int nitems|type +Am|void|Zero|void* dest|int nitems|type +m|AV *|CvPADLIST|CV *cv +m|bool|CvWEAKOUTSIDE|CV *cv +m|char *|PAD_COMPNAME_PV|PADOFFSET po +m|HV *|PAD_COMPNAME_OURSTASH|PADOFFSET po +m|HV *|PAD_COMPNAME_TYPE|PADOFFSET po +mn|bool|PL_dowarn +mn|GV *|PL_DBsub +mn|GV*|PL_last_in_gv +mn|SV *|PL_DBsingle +mn|SV *|PL_DBtrace +mn|SV*|PL_ofs_sv +mn|SV*|PL_rs +ms||djSP +m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po +m|STRLEN|PAD_COMPNAME_GEN_set|PADOFFSET po|int gen +m|SV *|CX_CURPAD_SV|struct context|PADOFFSET po +m|SV *|PAD_BASE_SV |PADLIST padlist|PADOFFSET po +m|SV *|PAD_SETSV |PADOFFSET po|SV* sv +m|SV *|PAD_SVl |PADOFFSET po +m|U32|PAD_COMPNAME_FLAGS|PADOFFSET po +mU||LVRET +m|void|CX_CURPAD_SAVE|struct context +m|void|PAD_CLONE_VARS|PerlInterpreter *proto_perl|CLONE_PARAMS* param +m|void|PAD_DUP|PADLIST dstpad|PADLIST srcpad|CLONE_PARAMS* param +m|void|PAD_RESTORE_LOCAL|PAD *opad +m|void|PAD_SAVE_LOCAL|PAD *opad|PAD *npad +m|void|PAD_SAVE_SETNULLPAD +m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n +m|void|PAD_SET_CUR |PADLIST padlist|I32 n +m|void|PAD_SV |PADOFFSET po +m|void|SAVECLEARSV |SV **svp +m|void|SAVECOMPPAD +m|void|SAVEPADSV |PADOFFSET po diff --git a/ext/Devel-PPPort/parts/base/5004000 b/ext/Devel-PPPort/parts/base/5004000 new file mode 100644 index 0000000000..a196371bfe --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5004000 @@ -0,0 +1,88 @@ +5.004000 +GIMME_V # E +G_VOID # E +HEf_SVKEY # E +HeHASH # U +HeKEY # U +HeKLEN # U +HePV # U +HeSVKEY # U +HeSVKEY_force # U +HeSVKEY_set # U +HeVAL # U +PUSHu # U +SvSetMagicSV # U +SvSetMagicSV_nosteal # U +SvSetSV_nosteal # U +SvTAINTED # U +SvTAINTED_off # U +SvTAINTED_on # U +SvUV # U +SvUVX # U +SvUVx # U +XPUSHu # U +block_gimme # E +call_list # E +cv_const_sv # E +delimcpy # E +do_open # E (Perl_do_open) +gv_autoload4 # E +gv_efullname3 # U +gv_fetchmethod_autoload # E +gv_fullname3 # U +gv_stashpvn # E +hv_delayfree_ent # E +hv_delete_ent # U +hv_exists_ent # U +hv_fetch_ent # U +hv_free_ent # E +hv_iterkeysv # E +hv_ksplit # E +hv_store_ent # U +ibcmp_locale # E +my_failure_exit # E +my_memcmp # U +my_pclose # E (Perl_my_pclose) +my_popen # E (Perl_my_popen) +newRV_inc # U +newRV_noinc # E +rsignal # E +rsignal_state # E +save_I16 # E +save_gp # E +share_hek # E +start_subparse # E (Perl_start_subparse) +sv_2uv # U +sv_cmp_locale # E +sv_derived_from # E +sv_gets # E (Perl_sv_gets) +sv_setuv # E +sv_taint # U +sv_tainted # E +sv_untaint # E +sv_vcatpvfn # E +sv_vsetpvfn # E +unsharepvn # E +PERL_HASH # added by devel/scanprov +PERL_INT_MAX # added by devel/scanprov +PERL_INT_MIN # added by devel/scanprov +PERL_LONG_MAX # added by devel/scanprov +PERL_LONG_MIN # added by devel/scanprov +PERL_QUAD_MAX # added by devel/scanprov +PERL_QUAD_MIN # added by devel/scanprov +PERL_SHORT_MAX # added by devel/scanprov +PERL_SHORT_MIN # added by devel/scanprov +PERL_UCHAR_MAX # added by devel/scanprov +PERL_UCHAR_MIN # added by devel/scanprov +PERL_UINT_MAX # added by devel/scanprov +PERL_UINT_MIN # added by devel/scanprov +PERL_ULONG_MAX # added by devel/scanprov +PERL_ULONG_MIN # added by devel/scanprov +PERL_UQUAD_MAX # added by devel/scanprov +PERL_UQUAD_MIN # added by devel/scanprov +PERL_USHORT_MAX # added by devel/scanprov +PERL_USHORT_MIN # added by devel/scanprov +SvUVXx # added by devel/scanprov +boolSV # added by devel/scanprov +memEQ # added by devel/scanprov +memNE # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5004010 b/ext/Devel-PPPort/parts/base/5004010 new file mode 100644 index 0000000000..8c29866603 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5004010 @@ -0,0 +1 @@ +5.004010 diff --git a/ext/Devel-PPPort/parts/base/5004020 b/ext/Devel-PPPort/parts/base/5004020 new file mode 100644 index 0000000000..4b43fdf8e4 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5004020 @@ -0,0 +1 @@ +5.004020 diff --git a/ext/Devel-PPPort/parts/base/5004030 b/ext/Devel-PPPort/parts/base/5004030 new file mode 100644 index 0000000000..e45facbb1f --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5004030 @@ -0,0 +1 @@ +5.004030 diff --git a/ext/Devel-PPPort/parts/base/5004040 b/ext/Devel-PPPort/parts/base/5004040 new file mode 100644 index 0000000000..69ccd5d62c --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5004040 @@ -0,0 +1 @@ +5.004040 diff --git a/ext/Devel-PPPort/parts/base/5004050 b/ext/Devel-PPPort/parts/base/5004050 new file mode 100644 index 0000000000..992642b633 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5004050 @@ -0,0 +1,43 @@ +5.004050 +PL_na # E +PL_sv_no # E +PL_sv_undef # E +PL_sv_yes # E +SvGETMAGIC # U +do_binmode # E +newCONSTSUB # E +newSVpvn # E +save_aelem # E +save_helem # E +sv_catpv_mg # E +sv_catpvn_mg # U +sv_catsv_mg # U +sv_setiv_mg # E +sv_setpv_mg # E +sv_setpvn_mg # E +sv_setsv_mg # E +sv_setuv_mg # E +sv_usepvn_mg # U +AvFILLp # added by devel/scanprov +DEFSV # added by devel/scanprov +ERRSV # added by devel/scanprov +PL_compiling # added by devel/scanprov +PL_curcop # added by devel/scanprov +PL_curstash # added by devel/scanprov +PL_debstash # added by devel/scanprov +PL_defgv # added by devel/scanprov +PL_diehook # added by devel/scanprov +PL_dirty # added by devel/scanprov +PL_errgv # added by devel/scanprov +PL_perl_destruct_level # added by devel/scanprov +PL_perldb # added by devel/scanprov +PL_rsfp # added by devel/scanprov +PL_rsfp_filters # added by devel/scanprov +PL_stack_base # added by devel/scanprov +PL_stack_sp # added by devel/scanprov +PL_stdingv # added by devel/scanprov +PL_sv_arenaroot # added by devel/scanprov +PL_tainted # added by devel/scanprov +PL_tainting # added by devel/scanprov +SAVE_DEFSV # added by devel/scanprov +dTHR # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5005000 b/ext/Devel-PPPort/parts/base/5005000 new file mode 100644 index 0000000000..3c96370a4c --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5005000 @@ -0,0 +1,36 @@ +5.005000 +PL_modglobal # E +cx_dump # U +debop # U +debprofdump # U +fbm_compile # E (Perl_fbm_compile) +fbm_instr # E (Perl_fbm_instr) +get_op_descs # E +get_op_names # E +init_stacks # E +mg_length # E +mg_size # E +newHVhv # E +new_stackinfo # E +regdump # U +regexec_flags # E +regnext # E (Perl_regnext) +runops_debug # E +runops_standard # E +save_iv # E (save_iv) +screaminstr # E (Perl_screaminstr) +sv_iv # E +sv_peek # U +sv_pvn # E +sv_true # E +sv_uv # E +END_EXTERN_C # added by devel/scanprov +EXTERN_C # added by devel/scanprov +NOOP # added by devel/scanprov +PL_DBsignal # added by devel/scanprov +PL_Sv # added by devel/scanprov +PL_hexdigit # added by devel/scanprov +PL_hints # added by devel/scanprov +PL_laststatval # added by devel/scanprov +PL_statcache # added by devel/scanprov +START_EXTERN_C # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5005010 b/ext/Devel-PPPort/parts/base/5005010 new file mode 100644 index 0000000000..deebff5bf8 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5005010 @@ -0,0 +1 @@ +5.005010 diff --git a/ext/Devel-PPPort/parts/base/5005020 b/ext/Devel-PPPort/parts/base/5005020 new file mode 100644 index 0000000000..d19ff2ae09 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5005020 @@ -0,0 +1 @@ +5.005020 diff --git a/ext/Devel-PPPort/parts/base/5005030 b/ext/Devel-PPPort/parts/base/5005030 new file mode 100644 index 0000000000..f268c751da --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5005030 @@ -0,0 +1,4 @@ +5.005030 +POPpx # E +get_vtbl # E +save_generic_svref # E diff --git a/ext/Devel-PPPort/parts/base/5005040 b/ext/Devel-PPPort/parts/base/5005040 new file mode 100644 index 0000000000..8a165c2033 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5005040 @@ -0,0 +1 @@ +5.005040 diff --git a/ext/Devel-PPPort/parts/base/5006000 b/ext/Devel-PPPort/parts/base/5006000 new file mode 100644 index 0000000000..b2a93bf246 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5006000 @@ -0,0 +1,288 @@ +5.006000 +POPn # E +PUSHn # E +SvIOK_UV # U +SvIOK_notUV # U +SvIOK_only_UV # U +SvNV # E +SvNVX # E +SvNV_set # E +SvNVx # E +SvPOK_only_UTF8 # U +SvPV_nolen # U +SvPVbyte # U +SvPVbyte_nolen # U +SvPVbytex # U +SvPVbytex_force # U +SvPVutf8 # U +SvPVutf8_force # U +SvPVutf8_nolen # U +SvPVutf8x # U +SvPVutf8x_force # U +SvUTF8 # U +SvUTF8_off # U +SvUTF8_on # U +XPUSHn # E +XSRETURN_NV # E +XST_mNV # E +av_delete # E +av_exists # E +call_argv # E (perl_call_argv) +call_atexit # E +call_method # E (perl_call_method) +call_pv # E (perl_call_pv) +call_sv # E (perl_call_sv) +cast_i32 # E (cast_i32) +cast_iv # E (cast_iv) +cast_ulong # E +cast_uv # E (cast_uv) +croak # E (Perl_croak) +die # E (Perl_die) +do_gv_dump # E +do_gvgv_dump # E +do_hv_dump # E +do_magic_dump # E +do_op_dump # E +do_open9 # E +do_pmop_dump # E +do_sv_dump # E +dump_all # U +dump_eval # U +dump_form # U +dump_indent # E +dump_packsubs # U +dump_sub # U +dump_vindent # E +eval_pv # E (perl_eval_pv) +eval_sv # E (perl_eval_sv) +form # E (Perl_form) +get_av # E (perl_get_av) +get_context # U +get_cv # E (perl_get_cv) +get_hv # E (perl_get_hv) +get_ppaddr # E +get_sv # E (perl_get_sv) +gv_dump # E +init_i18nl10n # E (perl_init_i18nl10n) +init_i18nl14n # E (perl_init_i18nl14n) +is_uni_alnum # E +is_uni_alnum_lc # E +is_uni_alnumc # E +is_uni_alnumc_lc # E +is_uni_alpha # E +is_uni_alpha_lc # E +is_uni_ascii # E +is_uni_ascii_lc # E +is_uni_cntrl # E +is_uni_cntrl_lc # E +is_uni_digit # E +is_uni_digit_lc # E +is_uni_graph # E +is_uni_graph_lc # E +is_uni_idfirst # E +is_uni_idfirst_lc # E +is_uni_lower # E +is_uni_lower_lc # E +is_uni_print # E +is_uni_print_lc # E +is_uni_punct # E +is_uni_punct_lc # E +is_uni_space # E +is_uni_space_lc # E +is_uni_upper # E +is_uni_upper_lc # E +is_uni_xdigit # E +is_uni_xdigit_lc # E +is_utf8_alnum # E +is_utf8_alnumc # E +is_utf8_alpha # E +is_utf8_ascii # E +is_utf8_char # E +is_utf8_cntrl # E +is_utf8_digit # E +is_utf8_graph # E +is_utf8_idfirst # E +is_utf8_lower # E +is_utf8_mark # E +is_utf8_print # E +is_utf8_punct # E +is_utf8_space # E +is_utf8_upper # E +is_utf8_xdigit # E +load_module # E +magic_dump # E +mess # E (Perl_mess) +my_atof # E +my_fflush_all # E +newANONATTRSUB # E +newATTRSUB # E +newSVnv # E (Perl_newSVnv) +newSVpvf # E (Perl_newSVpvf) +newSVuv # E +newXS # E (Perl_newXS) +newXSproto # E +new_collate # E (perl_new_collate) +new_ctype # E (perl_new_ctype) +new_numeric # E (perl_new_numeric) +op_dump # E +perl_parse # E (perl_parse) +pmop_dump # E +pv_display # E +re_intuit_string # E +reginitcolors # E +require_pv # E (perl_require_pv) +safesyscalloc # U +safesysfree # U +safesysmalloc # U +safesysrealloc # U +save_I8 # E +save_alloc # E +save_destructor # E (Perl_save_destructor) +save_destructor_x # E +save_re_context # E +save_vptr # E +scan_bin # E +scan_hex # E (Perl_scan_hex) +scan_oct # E (Perl_scan_oct) +set_context # U +set_numeric_local # E (perl_set_numeric_local) +set_numeric_radix # E +set_numeric_standard # E (perl_set_numeric_standard) +str_to_version # E +sv_2nv # E (Perl_sv_2nv) +sv_2pv_nolen # U +sv_2pvbyte # E +sv_2pvbyte_nolen # U +sv_2pvutf8 # E +sv_2pvutf8_nolen # U +sv_catpvf # E (Perl_sv_catpvf) +sv_catpvf_mg # E (Perl_sv_catpvf_mg) +sv_force_normal # U +sv_len_utf8 # E +sv_nv # E (Perl_sv_nv) +sv_pos_b2u # E +sv_pos_u2b # E +sv_pv # U +sv_pvbyte # U +sv_pvbyten # E +sv_pvbyten_force # E +sv_pvutf8 # U +sv_pvutf8n # E +sv_pvutf8n_force # E +sv_rvweaken # E +sv_setnv # E (Perl_sv_setnv) +sv_setnv_mg # E (Perl_sv_setnv_mg) +sv_setpvf # E (Perl_sv_setpvf) +sv_setpvf_mg # E (Perl_sv_setpvf_mg) +sv_setref_nv # E (Perl_sv_setref_nv) +sv_utf8_decode # E +sv_utf8_downgrade # E +sv_utf8_encode # E +sv_vcatpvf # E +sv_vcatpvf_mg # E +sv_vsetpvf # E +sv_vsetpvf_mg # E +swash_init # E +tmps_grow # E +to_uni_lower_lc # E +to_uni_title_lc # E +to_uni_upper_lc # E +utf8_distance # E +utf8_hop # E +vcroak # E +vform # E +vload_module # E +vmess # E +vnewSVpvf # E +vwarn # E +vwarner # E +warn # E (Perl_warn) +warner # E +CopFILE # added by devel/scanprov +CopFILEAV # added by devel/scanprov +CopFILEGV # added by devel/scanprov +CopFILEGV_set # added by devel/scanprov +CopFILESV # added by devel/scanprov +CopFILE_set # added by devel/scanprov +CopSTASH # added by devel/scanprov +CopSTASHPV # added by devel/scanprov +CopSTASHPV_set # added by devel/scanprov +CopSTASH_eq # added by devel/scanprov +CopSTASH_set # added by devel/scanprov +INT2PTR # added by devel/scanprov +IVSIZE # added by devel/scanprov +IVTYPE # added by devel/scanprov +IVdf # added by devel/scanprov +NUM2PTR # added by devel/scanprov +NVTYPE # added by devel/scanprov +PERL_REVISION # added by devel/scanprov +PERL_SUBVERSION # added by devel/scanprov +PERL_VERSION # added by devel/scanprov +PL_no_modify # added by devel/scanprov +PL_ppaddr # added by devel/scanprov +PTR2IV # added by devel/scanprov +PTR2NV # added by devel/scanprov +PTR2UV # added by devel/scanprov +PTRV # added by devel/scanprov +SVf # added by devel/scanprov +SVf_UTF8 # added by devel/scanprov +UVSIZE # added by devel/scanprov +UVTYPE # added by devel/scanprov +UVof # added by devel/scanprov +UVuf # added by devel/scanprov +UVxf # added by devel/scanprov +WARN_ALL # added by devel/scanprov +WARN_AMBIGUOUS # added by devel/scanprov +WARN_BAREWORD # added by devel/scanprov +WARN_CLOSED # added by devel/scanprov +WARN_CLOSURE # added by devel/scanprov +WARN_DEBUGGING # added by devel/scanprov +WARN_DEPRECATED # added by devel/scanprov +WARN_DIGIT # added by devel/scanprov +WARN_EXEC # added by devel/scanprov +WARN_EXITING # added by devel/scanprov +WARN_GLOB # added by devel/scanprov +WARN_INPLACE # added by devel/scanprov +WARN_INTERNAL # added by devel/scanprov +WARN_IO # added by devel/scanprov +WARN_MALLOC # added by devel/scanprov +WARN_MISC # added by devel/scanprov +WARN_NEWLINE # added by devel/scanprov +WARN_NUMERIC # added by devel/scanprov +WARN_ONCE # added by devel/scanprov +WARN_OVERFLOW # added by devel/scanprov +WARN_PACK # added by devel/scanprov +WARN_PARENTHESIS # added by devel/scanprov +WARN_PIPE # added by devel/scanprov +WARN_PORTABLE # added by devel/scanprov +WARN_PRECEDENCE # added by devel/scanprov +WARN_PRINTF # added by devel/scanprov +WARN_PROTOTYPE # added by devel/scanprov +WARN_QW # added by devel/scanprov +WARN_RECURSION # added by devel/scanprov +WARN_REDEFINE # added by devel/scanprov +WARN_REGEXP # added by devel/scanprov +WARN_RESERVED # added by devel/scanprov +WARN_SEMICOLON # added by devel/scanprov +WARN_SEVERE # added by devel/scanprov +WARN_SIGNAL # added by devel/scanprov +WARN_SUBSTR # added by devel/scanprov +WARN_SYNTAX # added by devel/scanprov +WARN_TAINT # added by devel/scanprov +WARN_UNINITIALIZED # added by devel/scanprov +WARN_UNOPENED # added by devel/scanprov +WARN_UNPACK # added by devel/scanprov +WARN_UNTIE # added by devel/scanprov +WARN_UTF8 # added by devel/scanprov +WARN_VOID # added by devel/scanprov +XSprePUSH # added by devel/scanprov +aTHX # added by devel/scanprov +aTHX_ # added by devel/scanprov +ckWARN # added by devel/scanprov +dNOOP # added by devel/scanprov +dTHX # added by devel/scanprov +dTHXa # added by devel/scanprov +dTHXoa # added by devel/scanprov +dXSTARG # added by devel/scanprov +pTHX # added by devel/scanprov +pTHX_ # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5006001 b/ext/Devel-PPPort/parts/base/5006001 new file mode 100644 index 0000000000..a6369d517e --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5006001 @@ -0,0 +1,14 @@ +5.006001 +SvGAMAGIC # U +apply_attrs_string # U +bytes_to_utf8 # U +gv_efullname4 # U +gv_fullname4 # U +is_utf8_string # U +save_generic_pvref # U +utf16_to_utf8 # E (Perl_utf16_to_utf8) +utf16_to_utf8_reversed # E (Perl_utf16_to_utf8_reversed) +utf8_to_bytes # U +NVef # added by devel/scanprov +NVff # added by devel/scanprov +NVgf # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5006002 b/ext/Devel-PPPort/parts/base/5006002 new file mode 100644 index 0000000000..dfe09ce2c5 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5006002 @@ -0,0 +1 @@ +5.006002 diff --git a/ext/Devel-PPPort/parts/base/5007000 b/ext/Devel-PPPort/parts/base/5007000 new file mode 100644 index 0000000000..49d08465db --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5007000 @@ -0,0 +1 @@ +5.007000 diff --git a/ext/Devel-PPPort/parts/base/5007001 b/ext/Devel-PPPort/parts/base/5007001 new file mode 100644 index 0000000000..19ae691d12 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5007001 @@ -0,0 +1,24 @@ +5.007001 +POPpbytex # E +SvUOK # U +bytes_from_utf8 # U +despatch_signals # U +do_openn # U +gv_handler # U +is_lvalue_sub # U +my_popen_list # U +newSVpvn_share # U +save_mortalizesv # U +scan_num # E (Perl_scan_num) +sv_force_normal_flags # U +sv_setref_uv # U +sv_unref_flags # U +sv_utf8_upgrade # E (Perl_sv_utf8_upgrade) +utf8_length # U +utf8_to_uvchr # U +utf8_to_uvuni # U +utf8n_to_uvuni # U +uvuni_to_utf8 # U +PTR2ul # added by devel/scanprov +SV_IMMEDIATE_UNREF # added by devel/scanprov +UVXf # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5007002 b/ext/Devel-PPPort/parts/base/5007002 new file mode 100644 index 0000000000..9d31a24f09 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5007002 @@ -0,0 +1,73 @@ +5.007002 +SvPV_force_nomg # U +SvPV_nomg # U +calloc # U +dAX # E +dITEMS # E +getcwd_sv # U +grok_number # U +grok_numeric_radix # U +init_tm # U +malloc # U +mfree # U +mini_mktime # U +my_atof2 # U +my_strftime # U +op_null # U +realloc # U +sv_2pv_flags # U +sv_catpvn_flags # U +sv_catpvn_nomg # U +sv_catsv_flags # U +sv_catsv_nomg # U +sv_pvn_force_flags # U +sv_setsv_flags # U +sv_setsv_nomg # U +sv_utf8_upgrade_flags # U +swash_fetch # E (Perl_swash_fetch) +GROK_NUMERIC_RADIX # added by devel/scanprov +IN_LOCALE # added by devel/scanprov +IN_LOCALE_COMPILETIME # added by devel/scanprov +IN_LOCALE_RUNTIME # added by devel/scanprov +IS_NUMBER_GREATER_THAN_UV_MAX # added by devel/scanprov +IS_NUMBER_INFINITY # added by devel/scanprov +IS_NUMBER_IN_UV # added by devel/scanprov +IS_NUMBER_NEG # added by devel/scanprov +IS_NUMBER_NOT_INT # added by devel/scanprov +PERL_MAGIC_arylen # added by devel/scanprov +PERL_MAGIC_backref # added by devel/scanprov +PERL_MAGIC_bm # added by devel/scanprov +PERL_MAGIC_collxfrm # added by devel/scanprov +PERL_MAGIC_dbfile # added by devel/scanprov +PERL_MAGIC_dbline # added by devel/scanprov +PERL_MAGIC_defelem # added by devel/scanprov +PERL_MAGIC_env # added by devel/scanprov +PERL_MAGIC_envelem # added by devel/scanprov +PERL_MAGIC_ext # added by devel/scanprov +PERL_MAGIC_fm # added by devel/scanprov +PERL_MAGIC_isa # added by devel/scanprov +PERL_MAGIC_isaelem # added by devel/scanprov +PERL_MAGIC_nkeys # added by devel/scanprov +PERL_MAGIC_overload # added by devel/scanprov +PERL_MAGIC_overload_elem # added by devel/scanprov +PERL_MAGIC_overload_table # added by devel/scanprov +PERL_MAGIC_pos # added by devel/scanprov +PERL_MAGIC_qr # added by devel/scanprov +PERL_MAGIC_regdata # added by devel/scanprov +PERL_MAGIC_regdatum # added by devel/scanprov +PERL_MAGIC_regex_global # added by devel/scanprov +PERL_MAGIC_sig # added by devel/scanprov +PERL_MAGIC_sigelem # added by devel/scanprov +PERL_MAGIC_substr # added by devel/scanprov +PERL_MAGIC_sv # added by devel/scanprov +PERL_MAGIC_taint # added by devel/scanprov +PERL_MAGIC_tied # added by devel/scanprov +PERL_MAGIC_tiedelem # added by devel/scanprov +PERL_MAGIC_tiedscalar # added by devel/scanprov +PERL_MAGIC_uvar # added by devel/scanprov +PERL_MAGIC_vec # added by devel/scanprov +PERL_UNUSED_DECL # added by devel/scanprov +PERL_UNUSED_VAR # added by devel/scanprov +SV_GMAGIC # added by devel/scanprov +SvPV_flags # added by devel/scanprov +SvPV_force_flags # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5007003 b/ext/Devel-PPPort/parts/base/5007003 new file mode 100644 index 0000000000..325f06ad93 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5007003 @@ -0,0 +1,85 @@ +5.007003 +PerlIO_clearerr # U (PerlIO_clearerr) +PerlIO_close # U (PerlIO_close) +PerlIO_eof # U (PerlIO_eof) +PerlIO_error # U (PerlIO_error) +PerlIO_fileno # U (PerlIO_fileno) +PerlIO_fill # U (PerlIO_fill) +PerlIO_flush # U (PerlIO_flush) +PerlIO_get_base # U (PerlIO_get_base) +PerlIO_get_bufsiz # U (PerlIO_get_bufsiz) +PerlIO_get_cnt # U (PerlIO_get_cnt) +PerlIO_get_ptr # U (PerlIO_get_ptr) +PerlIO_read # U (PerlIO_read) +PerlIO_seek # U (PerlIO_seek) +PerlIO_set_cnt # U (PerlIO_set_cnt) +PerlIO_set_ptrcnt # U (PerlIO_set_ptrcnt) +PerlIO_setlinebuf # U (PerlIO_setlinebuf) +PerlIO_stderr # U (PerlIO_stderr) +PerlIO_stdin # U (PerlIO_stdin) +PerlIO_stdout # U (PerlIO_stdout) +PerlIO_tell # U (PerlIO_tell) +PerlIO_unread # U (PerlIO_unread) +PerlIO_write # U (PerlIO_write) +SvLOCK # U +SvSHARE # U +SvUNLOCK # U +atfork_lock # U +atfork_unlock # U +custom_op_desc # U +custom_op_name # U +deb # U +debstack # U +debstackptrs # U +grok_bin # U +grok_hex # U +grok_oct # U +gv_fetchmeth_autoload # U +ibcmp_utf8 # U +my_fork # U +my_socketpair # U +pack_cat # U +perl_destruct # E (perl_destruct) +pv_uni_display # U +save_shared_pvref # U +savesharedpv # U +sortsv # U +sv_copypv # U +sv_magicext # U +sv_nolocking # U +sv_nosharing # U +sv_pvn_nomg # U +sv_recode_to_utf8 # U +sv_uni_display # U +to_uni_fold # U +to_uni_lower # E (Perl_to_uni_lower) +to_uni_title # E (Perl_to_uni_title) +to_uni_upper # E (Perl_to_uni_upper) +to_utf8_case # U +to_utf8_fold # U +to_utf8_lower # E (Perl_to_utf8_lower) +to_utf8_title # E (Perl_to_utf8_title) +to_utf8_upper # E (Perl_to_utf8_upper) +unpack_str # U +uvchr_to_utf8_flags # U +uvuni_to_utf8_flags # U +vdeb # U +IS_NUMBER_NAN # added by devel/scanprov +MY_CXT # added by devel/scanprov +MY_CXT_INIT # added by devel/scanprov +PERL_MAGIC_shared # added by devel/scanprov +PERL_MAGIC_shared_scalar # added by devel/scanprov +PERL_MAGIC_uvar_elem # added by devel/scanprov +PERL_SCAN_ALLOW_UNDERSCORES # added by devel/scanprov +PERL_SCAN_DISALLOW_PREFIX # added by devel/scanprov +PERL_SCAN_GREATER_THAN_UV_MAX # added by devel/scanprov +START_MY_CXT # added by devel/scanprov +_aMY_CXT # added by devel/scanprov +_pMY_CXT # added by devel/scanprov +aMY_CXT # added by devel/scanprov +aMY_CXT_ # added by devel/scanprov +dMY_CXT # added by devel/scanprov +dMY_CXT_SV # added by devel/scanprov +pMY_CXT # added by devel/scanprov +pMY_CXT_ # added by devel/scanprov +packWARN # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5008000 b/ext/Devel-PPPort/parts/base/5008000 new file mode 100644 index 0000000000..8af2dfae4d --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5008000 @@ -0,0 +1,8 @@ +5.008000 +Poison # E +hv_iternext_flags # U +hv_store_flags # U +is_utf8_idcont # U +nothreadhook # U +WARN_LAYER # added by devel/scanprov +WARN_THREADS # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5008001 b/ext/Devel-PPPort/parts/base/5008001 new file mode 100644 index 0000000000..a389fd85da --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5008001 @@ -0,0 +1,26 @@ +5.008001 +SvVOK # U +XSRETURN_UV # U +doing_taint # U +find_runcv # U +is_utf8_string_loc # U +packlist # U +save_bool # U +savestack_grow_cnt # U +seed # U +sv_cat_decode # U +sv_compile_2op # E (Perl_sv_compile_2op) +sv_setpviv # U +sv_setpviv_mg # U +unpackstring # U +IN_PERL_COMPILETIME # added by devel/scanprov +PERL_ABS # added by devel/scanprov +PERL_GCC_BRACE_GROUPS_FORBIDDEN # added by devel/scanprov +PERL_MAGIC_utf8 # added by devel/scanprov +PERL_MAGIC_vstring # added by devel/scanprov +PERL_SCAN_SILENT_ILLDIGIT # added by devel/scanprov +PERL_SIGNALS_UNSAFE_FLAG # added by devel/scanprov +PL_signals # added by devel/scanprov +SV_COW_DROP_PV # added by devel/scanprov +SV_UTF8_NO_ENCODING # added by devel/scanprov +XST_mUV # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5008002 b/ext/Devel-PPPort/parts/base/5008002 new file mode 100644 index 0000000000..63aac525fe --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5008002 @@ -0,0 +1 @@ +5.008002 diff --git a/ext/Devel-PPPort/parts/base/5008003 b/ext/Devel-PPPort/parts/base/5008003 new file mode 100644 index 0000000000..50c6ce1aa1 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5008003 @@ -0,0 +1,3 @@ +5.008003 +SvIsCOW # U +SvIsCOW_shared_hash # U diff --git a/ext/Devel-PPPort/parts/base/5008004 b/ext/Devel-PPPort/parts/base/5008004 new file mode 100644 index 0000000000..bb7bcdf66a --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5008004 @@ -0,0 +1 @@ +5.008004 diff --git a/ext/Devel-PPPort/parts/base/5008005 b/ext/Devel-PPPort/parts/base/5008005 new file mode 100644 index 0000000000..7bd2029f4b --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5008005 @@ -0,0 +1 @@ +5.008005 diff --git a/ext/Devel-PPPort/parts/base/5008006 b/ext/Devel-PPPort/parts/base/5008006 new file mode 100644 index 0000000000..ba5cad07ed --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5008006 @@ -0,0 +1 @@ +5.008006 diff --git a/ext/Devel-PPPort/parts/base/5008007 b/ext/Devel-PPPort/parts/base/5008007 new file mode 100644 index 0000000000..7d656f0b9e --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5008007 @@ -0,0 +1 @@ +5.008007 diff --git a/ext/Devel-PPPort/parts/base/5008008 b/ext/Devel-PPPort/parts/base/5008008 new file mode 100644 index 0000000000..f17b19ff4b --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5008008 @@ -0,0 +1 @@ +5.008008 diff --git a/ext/Devel-PPPort/parts/base/5009000 b/ext/Devel-PPPort/parts/base/5009000 new file mode 100644 index 0000000000..28bc85958e --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5009000 @@ -0,0 +1,6 @@ +5.009000 +new_version # U +save_set_svflags # U +vcmp # U +vnumify # U +vstringify # U diff --git a/ext/Devel-PPPort/parts/base/5009001 b/ext/Devel-PPPort/parts/base/5009001 new file mode 100644 index 0000000000..0666184e1d --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5009001 @@ -0,0 +1,8 @@ +5.009001 +SvIV_nomg # U +SvUV_nomg # U +hv_clear_placeholders # U +hv_scalar # U +scan_version # E (Perl_scan_version) +sv_2iv_flags # U +sv_2uv_flags # U diff --git a/ext/Devel-PPPort/parts/base/5009002 b/ext/Devel-PPPort/parts/base/5009002 new file mode 100644 index 0000000000..65d7de9072 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5009002 @@ -0,0 +1,32 @@ +5.009002 +CopyD # E +MoveD # E +PUSHmortal # E +SvPVbyte_force # U +UNDERBAR # E +XCPT_CATCH # E +XCPT_RETHROW # E +XCPT_TRY_END # E +XCPT_TRY_START # E +XPUSHmortal # E +ZeroD # E +dUNDERBAR # E +dXCPT # E +find_rundefsvoffset # U +gv_fetchpvn_flags # U +gv_fetchsv # U +mPUSHi # U +mPUSHn # U +mPUSHp # U +mPUSHu # U +mXPUSHi # U +mXPUSHn # U +mXPUSHp # U +mXPUSHu # U +op_refcnt_lock # U +op_refcnt_unlock # U +savesvpv # U +vnormal # U +MY_CXT_CLONE # added by devel/scanprov +SV_NOSTEAL # added by devel/scanprov +UTF8_MAXBYTES # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5009003 b/ext/Devel-PPPort/parts/base/5009003 new file mode 100644 index 0000000000..bbf2a61bf6 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5009003 @@ -0,0 +1,62 @@ +5.009003 +Newx # E +Newxc # E +Newxz # E +SvMAGIC_set # U +SvRV_set # U +SvSTASH_set # U +SvUV_set # U +av_arylen_p # U +ckwarn # U +ckwarn_d # U +csighandler # E (Perl_csighandler) +dAXMARK # E +dMULTICALL # E +doref # U +gv_const_sv # U +gv_stashpvs # U +hv_eiter_p # U +hv_eiter_set # U +hv_fetchs # U +hv_name_set # U +hv_placeholders_get # U +hv_placeholders_p # U +hv_placeholders_set # U +hv_riter_p # U +hv_riter_set # U +is_utf8_string_loclen # U +my_sprintf # U +newGIVENOP # U +newSVhek # U +newSVpvs # U +newSVpvs_share # U +newWHENOP # U +newWHILEOP # E (Perl_newWHILEOP) +savepvs # U +sortsv_flags # U +sv_catpvs # U +vverify # U +PERLIO_FUNCS_CAST # added by devel/scanprov +PERLIO_FUNCS_DECL # added by devel/scanprov +PERL_UNUSED_ARG # added by devel/scanprov +STR_WITH_LEN # added by devel/scanprov +SV_CONST_RETURN # added by devel/scanprov +SV_MUTABLE_RETURN # added by devel/scanprov +SV_SMAGIC # added by devel/scanprov +SvPVX_const # added by devel/scanprov +SvPVX_mutable # added by devel/scanprov +SvPV_const # added by devel/scanprov +SvPV_flags_const # added by devel/scanprov +SvPV_flags_const_nolen # added by devel/scanprov +SvPV_flags_mutable # added by devel/scanprov +SvPV_force_flags_mutable # added by devel/scanprov +SvPV_force_flags_nolen # added by devel/scanprov +SvPV_force_mutable # added by devel/scanprov +SvPV_force_nolen # added by devel/scanprov +SvPV_force_nomg_nolen # added by devel/scanprov +SvPV_mutable # added by devel/scanprov +SvPV_nolen_const # added by devel/scanprov +SvPV_nomg_const # added by devel/scanprov +SvPV_nomg_const_nolen # added by devel/scanprov +SvSHARED_HASH # added by devel/scanprov +dVAR # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5009004 b/ext/Devel-PPPort/parts/base/5009004 new file mode 100644 index 0000000000..65dbc853f5 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5009004 @@ -0,0 +1,29 @@ +5.009004 +PerlIO_context_layers # U +PoisonFree # E +PoisonNew # E +PoisonWith # E +SvREFCNT_inc_NN # U +SvREFCNT_inc_simple # U +SvREFCNT_inc_simple_NN # U +SvREFCNT_inc_simple_void # U +SvREFCNT_inc_simple_void_NN # U +SvREFCNT_inc_void # U +SvREFCNT_inc_void_NN # U +gv_name_set # U +hv_stores # U +my_snprintf # U +my_strlcat # U +my_strlcpy # U +my_vsnprintf # U +newXS_flags # U +pv_escape # U +pv_pretty # U +regclass_swash # E (Perl_regclass_swash) +sv_does # U +sv_setpvs # U +sv_usepvn_flags # U +PERL_UNUSED_CONTEXT # added by devel/scanprov +PERL_USE_GCC_BRACE_GROUPS # added by devel/scanprov +SV_HAS_TRAILING_NUL # added by devel/scanprov +SvVSTRING_mg # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5009005 b/ext/Devel-PPPort/parts/base/5009005 new file mode 100644 index 0000000000..eb5da81ff4 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5009005 @@ -0,0 +1,32 @@ +5.009005 +Perl_signbit # U +SvRX # U +SvRXOK # U +av_create_and_push # U +av_create_and_unshift_one # U +get_cvn_flags # U +gv_fetchfile_flags # U +mro_get_linear_isa # U +mro_method_changed_in # U +my_dirfd # U +newSV_type # U +pregcomp # E (Perl_pregcomp) +ptr_table_clear # U +ptr_table_fetch # U +ptr_table_free # U +ptr_table_new # U +ptr_table_split # U +ptr_table_store # U +re_compile # U +re_intuit_start # E (Perl_re_intuit_start) +reg_named_buff_all # U +reg_named_buff_exists # U +reg_named_buff_fetch # U +reg_named_buff_firstkey # U +reg_named_buff_nextkey # U +reg_named_buff_scalar # U +regfree_internal # U +savesharedpvn # U +scan_vstring # E (Perl_scan_vstring) +upg_version # E (Perl_upg_version) +SV_COW_SHARED_HASH_KEYS # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/base/5010000 b/ext/Devel-PPPort/parts/base/5010000 new file mode 100644 index 0000000000..737f374ef0 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5010000 @@ -0,0 +1,7 @@ +5.010000 +hv_common # U +hv_common_key_len # U +sv_destroyable # U +sys_init # U +sys_init3 # U +sys_term # U diff --git a/ext/Devel-PPPort/parts/base/5011000 b/ext/Devel-PPPort/parts/base/5011000 new file mode 100644 index 0000000000..c9ba122660 --- /dev/null +++ b/ext/Devel-PPPort/parts/base/5011000 @@ -0,0 +1,32 @@ +5.011000 +HeUTF8 # U +MULTICALL # E +POP_MULTICALL # E +PUSH_MULTICALL # E +SvOOK_offset # U +av_iter_p # U +croak_xs_usage # U +fetch_cop_label # U +gv_fetchmethod_flags # U +hv_assert # U +mPUSHs # U +mXPUSHs # U +newSVpvn_flags # U +newSVpvn_utf8 # U +newSVpvs_flags # U +pad_sv # U +pregfree2 # U +ref # U (Perl_ref) +save_padsv_and_mortalize # U +stashpv_hvname_match # U +sv_insert_flags # U +sv_magic_portable # U +PERL_BCDVERSION # added by devel/scanprov +PERL_MAGIC_glob # added by devel/scanprov +PERL_MAGIC_mutex # added by devel/scanprov +PL_copline # added by devel/scanprov +PL_expect # added by devel/scanprov +WARN_ASSERTIONS # added by devel/scanprov +aTHXR # added by devel/scanprov +aTHXR_ # added by devel/scanprov +dTHXR # added by devel/scanprov diff --git a/ext/Devel-PPPort/parts/embed.fnc b/ext/Devel-PPPort/parts/embed.fnc new file mode 100644 index 0000000000..f08dfef1a5 --- /dev/null +++ b/ext/Devel-PPPort/parts/embed.fnc @@ -0,0 +1,2004 @@ +: BEGIN {die "You meant to run embed.pl"} # Stop early if fed to perl. +: +: Lines are of the form: +: flags|return_type|function_name|arg1|arg2|...|argN +: +: A line may be continued on another by ending it with a backslash. +: Leading and trailing whitespace will be ignored in each component. +: +: flags are single letters with following meanings: +: A member of public API +: m Implemented as a macro - no export, no +: proto, no #define +: d function has documentation with its source +: s static function, should have an S_ prefix in +: source file; for macros (m), suffix the usage +: example with a semicolon +: n has no implicit interpreter/thread context argument +: p function has a Perl_ prefix +: f function takes printf style format string, varargs +: r function never returns +: o has no compatibility macro (#define foo Perl_foo) +: x not exported +: X explicitly exported +: M may change +: E visible to extensions included in the Perl core +: b binary backward compatibility; function is a macro +: but has also Perl_ implementation (which is exported) +: U suppress usage example in autogenerated documentation +: a allocates memory a la malloc/calloc. Is also "R". +: R Return value must not be ignored. +: P pure function: no effects except the return value; +: return value depends only on parms and/or globals +: (see also L for those flags.) +: +: Pointer parameters that must not be passed NULLs should be prefixed with NN. +: +: Pointer parameters that may be NULL should be prefixed with NULLOK. This has +: no effect on output yet. It's a notation for the maintainers to know "I have +: defined whether NULL is OK or not" rather than having neither NULL or NULLOK, +: which is ambiguous. +: +: Individual flags may be separated by whitespace. + +START_EXTERN_C + +#if defined(PERL_IMPLICIT_SYS) +Ano |PerlInterpreter*|perl_alloc_using \ + |NN struct IPerlMem *ipM \ + |NN struct IPerlMem *ipMS \ + |NN struct IPerlMem *ipMP \ + |NN struct IPerlEnv *ipE \ + |NN struct IPerlStdIO *ipStd \ + |NN struct IPerlLIO *ipLIO \ + |NN struct IPerlDir *ipD \ + |NN struct IPerlSock *ipS \ + |NN struct IPerlProc *ipP +#endif +Anod |PerlInterpreter* |perl_alloc +Anod |void |perl_construct |NN PerlInterpreter *my_perl +Anod |int |perl_destruct |NN PerlInterpreter *my_perl +Anod |void |perl_free |NN PerlInterpreter *my_perl +Anod |int |perl_run |NN PerlInterpreter *my_perl +Anod |int |perl_parse |NN PerlInterpreter *my_perl|XSINIT_t xsinit \ + |int argc|NULLOK char** argv|NULLOK char** env +AnpR |bool |doing_taint |int argc|NULLOK char** argv|NULLOK char** env +#if defined(USE_ITHREADS) +Anod |PerlInterpreter*|perl_clone|NN PerlInterpreter *proto_perl|UV flags +# if defined(PERL_IMPLICIT_SYS) +Ano |PerlInterpreter*|perl_clone_using \ + |NN PerlInterpreter *proto_perl \ + |UV flags \ + |NN struct IPerlMem* ipM \ + |NN struct IPerlMem* ipMS \ + |NN struct IPerlMem* ipMP \ + |NN struct IPerlEnv* ipE \ + |NN struct IPerlStdIO* ipStd \ + |NN struct IPerlLIO* ipLIO \ + |NN struct IPerlDir* ipD \ + |NN struct IPerlSock* ipS \ + |NN struct IPerlProc* ipP +# endif +#endif + +Aanop |Malloc_t|malloc |MEM_SIZE nbytes +Aanop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size +Aanop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes +Anop |Free_t |mfree |Malloc_t where +#if defined(MYMALLOC) +npR |MEM_SIZE|malloced_size |NN void *p +npR |MEM_SIZE|malloc_good_size |size_t nbytes +#endif + +AnpR |void* |get_context +Anp |void |set_context |NN void *t + +END_EXTERN_C + +/* functions with flag 'n' should come before here */ +START_EXTERN_C +# include "pp_proto.h" +Ap |SV* |amagic_call |NN SV* left|NN SV* right|int method|int dir +Ap |bool |Gv_AMupdate |NN HV* stash +ApR |CV* |gv_handler |NULLOK HV* stash|I32 id +p |OP* |append_elem |I32 optype|NULLOK OP* first|NULLOK OP* last +p |OP* |append_list |I32 optype|NULLOK LISTOP* first|NULLOK LISTOP* last +p |I32 |apply |I32 type|NN SV** mark|NN SV** sp +ApM |void |apply_attrs_string|NN const char *stashpv|NN CV *cv|NN const char *attrstr|STRLEN len +Apd |void |av_clear |NN AV *av +Apd |SV* |av_delete |NN AV *av|I32 key|I32 flags +ApdR |bool |av_exists |NN AV *av|I32 key +Apd |void |av_extend |NN AV *av|I32 key +pR |AV* |av_fake |I32 size|NN SV **strp +ApdR |SV** |av_fetch |NN AV *av|I32 key|I32 lval +Apd |void |av_fill |NN AV *av|I32 fill +ApdR |I32 |av_len |NN const AV *av +ApdR |AV* |av_make |I32 size|NN SV **strp +Apd |SV* |av_pop |NN AV *av +ApdoxM |void |av_create_and_push|NN AV **const avp|NN SV *const val +Apd |void |av_push |NN AV *av|NN SV *val +EXp |void |av_reify |NN AV *av +ApdR |SV* |av_shift |NN AV *av +Apd |SV** |av_store |NN AV *av|I32 key|NULLOK SV *val +Apd |void |av_undef |NN AV *av +ApdoxM |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val +Apd |void |av_unshift |NN AV *av|I32 num +Apo |SV** |av_arylen_p |NN AV *av +Apo |IV* |av_iter_p |NN AV *av +#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) +s |MAGIC* |get_aux_mg |NN AV *av +#endif +pR |OP* |bind_match |I32 type|NN OP *left|NN OP *right +pR |OP* |block_end |I32 floor|NULLOK OP* seq +ApR |I32 |block_gimme +pR |int |block_start |int full +p |void |boot_core_UNIVERSAL +p |void |boot_core_PerlIO +Ap |void |call_list |I32 oldscope|NN AV *paramList +pR |bool |cando |Mode_t mode|bool effective|NN const Stat_t* statbufp +ApR |U32 |cast_ulong |NV f +ApR |I32 |cast_i32 |NV f +ApR |IV |cast_iv |NV f +ApR |UV |cast_uv |NV f +#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) +ApR |I32 |my_chsize |int fd|Off_t length +#endif +pR |OP* |convert |I32 optype|I32 flags|NULLOK OP* o +pM |PERL_CONTEXT* |create_eval_scope|U32 flags +: croak()'s first parm can be NULL. Otherwise, mod_perl breaks. +Afprd |void |croak |NULLOK const char* pat|... +Apr |void |vcroak |NULLOK const char* pat|NULLOK va_list* args +Aprd |void |croak_xs_usage |NN const CV *const cv \ + |NN const char *const params + +#if defined(PERL_IMPLICIT_CONTEXT) +Afnrp |void |croak_nocontext|NULLOK const char* pat|... +Afnp |OP* |die_nocontext |NN const char* pat|... +Afnp |void |deb_nocontext |NN const char* pat|... +Afnp |char* |form_nocontext |NN const char* pat|... +Anp |void |load_module_nocontext|U32 flags|NN SV* name|NULLOK SV* ver|... +Afnp |SV* |mess_nocontext |NN const char* pat|... +Afnp |void |warn_nocontext |NN const char* pat|... +Afnp |void |warner_nocontext|U32 err|NN const char* pat|... +Afnp |SV* |newSVpvf_nocontext|NN const char *const pat|... +Afnp |void |sv_catpvf_nocontext|NN SV *const sv|NN const char *const pat|... +Afnp |void |sv_setpvf_nocontext|NN SV *const sv|NN const char *const pat|... +Afnp |void |sv_catpvf_mg_nocontext|NN SV *const sv|NN const char *const pat|... +Afnp |void |sv_setpvf_mg_nocontext|NN SV *const sv|NN const char *const pat|... +Afnp |int |fprintf_nocontext|NN PerlIO *stream|NN const char *format|... +Afnp |int |printf_nocontext|NN const char *format|... +#endif +bp |void |cv_ckproto |NN const CV* cv|NULLOK const GV* gv\ + |NULLOK const char* p +p |void |cv_ckproto_len |NN const CV* cv|NULLOK const GV* gv\ + |NULLOK const char* p|const STRLEN len +pd |CV* |cv_clone |NN CV* proto +ApdR |SV* |gv_const_sv |NN GV* gv +ApdR |SV* |cv_const_sv |NULLOK CV* cv +pR |SV* |op_const_sv |NULLOK const OP* o|NULLOK CV* cv +Apd |void |cv_undef |NN CV* cv +Ap |void |cx_dump |NN PERL_CONTEXT* cx +Ap |SV* |filter_add |NULLOK filter_t funcp|NULLOK SV* datasv +Ap |void |filter_del |NN filter_t funcp +ApR |I32 |filter_read |int idx|NN SV *buf_sv|int maxlen +ApPR |char** |get_op_descs +ApPR |char** |get_op_names +pPR |const char* |get_no_modify +pPR |U32* |get_opargs +ApPR |PPADDR_t*|get_ppaddr +EXpR |I32 |cxinc +Afp |void |deb |NN const char* pat|... +Ap |void |vdeb |NN const char* pat|NULLOK va_list* args +Ap |void |debprofdump +Ap |I32 |debop |NN const OP* o +Ap |I32 |debstack +Ap |I32 |debstackptrs +Ap |char* |delimcpy |NN char* to|NN const char* toend|NN const char* from \ + |NN const char* fromend|int delim|NN I32* retlen +pM |void |delete_eval_scope +p |void |deprecate |NN const char *const s +p |void |deprecate_old |NN const char *const s +Afp |OP* |die |NULLOK const char* pat|... +p |OP* |vdie |NULLOK const char* pat|NULLOK va_list* args +p |OP* |die_where |NULLOK const char* message|STRLEN msglen +Ap |void |dounwind |I32 cxix +pmb |bool |do_aexec |NULLOK SV* really|NN SV** mark|NN SV** sp +p |bool |do_aexec5 |NULLOK SV* really|NN SV** mark|NN SV** sp|int fd|int do_report +Ap |int |do_binmode |NN PerlIO *fp|int iotype|int mode +p |void |do_chop |NN SV *astr|NN SV *sv +Ap |bool |do_close |NULLOK GV* gv|bool not_implicit +p |bool |do_eof |NN GV* gv + +#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION +pmb |bool |do_exec |NN const char* cmd +#else +p |bool |do_exec |NN const char* cmd +#endif + +#if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS) +Ap |int |do_aspawn |NULLOK SV* really|NN SV** mark|NN SV** sp +Ap |int |do_spawn |NN char* cmd +Ap |int |do_spawn_nowait|NN char* cmd +#endif +#if !defined(WIN32) +p |bool |do_exec3 |NN const char *incmd|int fd|int do_report +#endif +p |void |do_execfree +#ifdef PERL_IN_DOIO_C +s |void |exec_failed |NN const char *cmd|int fd|int do_report +#endif +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) +p |I32 |do_ipcctl |I32 optype|NN SV** mark|NN SV** sp +p |I32 |do_ipcget |I32 optype|NN SV** mark|NN SV** sp +p |I32 |do_msgrcv |NN SV** mark|NN SV** sp +p |I32 |do_msgsnd |NN SV** mark|NN SV** sp +p |I32 |do_semop |NN SV** mark|NN SV** sp +p |I32 |do_shmio |I32 optype|NN SV** mark|NN SV** sp +#endif +Ap |void |do_join |NN SV *sv|NN SV *delim|NN SV **mark|NN SV **sp +p |OP* |do_kv +Apmb |bool |do_open |NN GV* gv|NN const char* name|I32 len|int as_raw \ + |int rawmode|int rawperm|NULLOK PerlIO* supplied_fp +Ap |bool |do_open9 |NN GV *gv|NN const char *name|I32 len|int as_raw \ + |int rawmode|int rawperm|NULLOK PerlIO *supplied_fp \ + |NN SV *svs|I32 num +Ap |bool |do_openn |NN GV *gv|NN const char *oname|I32 len \ + |int as_raw|int rawmode|int rawperm \ + |NULLOK PerlIO *supplied_fp|NULLOK SV **svp \ + |I32 num +p |bool |do_print |NULLOK SV* sv|NN PerlIO* fp +pR |OP* |do_readline +p |I32 |do_chomp |NN SV* sv +p |bool |do_seek |NULLOK GV* gv|Off_t pos|int whence +Ap |void |do_sprintf |NN SV* sv|I32 len|NN SV** sarg +p |Off_t |do_sysseek |NN GV* gv|Off_t pos|int whence +pR |Off_t |do_tell |NN GV* gv +p |I32 |do_trans |NN SV* sv +p |UV |do_vecget |NN SV* sv|I32 offset|I32 size +p |void |do_vecset |NN SV* sv +p |void |do_vop |I32 optype|NN SV* sv|NN SV* left|NN SV* right +p |OP* |dofile |NN OP* term|I32 force_builtin +ApR |I32 |dowantarray +Ap |void |dump_all +Ap |void |dump_eval +#if defined(DUMP_FDS) +Ap |void |dump_fds |NN char* s +#endif +Ap |void |dump_form |NN const GV* gv +Ap |void |gv_dump |NN GV* gv +Ap |void |op_dump |NN const OP *o +Ap |void |pmop_dump |NULLOK PMOP* pm +Ap |void |dump_packsubs |NN const HV* stash +Ap |void |dump_sub |NN const GV* gv +Apd |void |fbm_compile |NN SV* sv|U32 flags +ApdR |char* |fbm_instr |NN unsigned char* big|NN unsigned char* bigend \ + |NN SV* littlestr|U32 flags +p |char* |find_script |NN const char *scriptname|bool dosearch \ + |NULLOK const char *const *const search_ext|I32 flags +p |OP* |force_list |NULLOK OP* arg +p |OP* |fold_constants |NN OP *o +Afpd |char* |form |NN const char* pat|... +Ap |char* |vform |NN const char* pat|NULLOK va_list* args +Ap |void |free_tmps +p |OP* |gen_constant_list|NULLOK OP* o +#if !defined(HAS_GETENV_LEN) +p |char* |getenv_len |NN const char *env_elem|NN unsigned long *len +#endif +pox |void |get_db_sub |NULLOK SV **svp|NN CV *cv +Ap |void |gp_free |NULLOK GV* gv +Ap |GP* |gp_ref |NULLOK GP* gp +Ap |GV* |gv_AVadd |NN GV* gv +Ap |GV* |gv_HVadd |NN GV* gv +Ap |GV* |gv_IOadd |NN GV* gv +ApR |GV* |gv_autoload4 |NULLOK HV* stash|NN const char* name|STRLEN len|I32 method +Ap |void |gv_check |NN const HV* stash +Ap |void |gv_efullname |NN SV* sv|NN const GV* gv +Apmb |void |gv_efullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix +Ap |void |gv_efullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain +Ap |GV* |gv_fetchfile |NN const char* name +Ap |GV* |gv_fetchfile_flags|NN const char *const name|const STRLEN len\ + |const U32 flags +Apd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level +Apd |GV* |gv_fetchmeth_autoload |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level +Apdmb |GV* |gv_fetchmethod |NN HV* stash|NN const char* name +Apd |GV* |gv_fetchmethod_autoload|NN HV* stash|NN const char* name \ + |I32 autoload +ApdM |GV* |gv_fetchmethod_flags|NN HV* stash|NN const char* name \ + |U32 flags +Ap |GV* |gv_fetchpv |NN const char *nambeg|I32 add|const svtype sv_type +Ap |void |gv_fullname |NN SV* sv|NN const GV* gv +Apmb |void |gv_fullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix +Ap |void |gv_fullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain +pMox |GP * |newGP |NN GV *const gv +Ap |void |gv_init |NN GV* gv|NULLOK HV* stash|NN const char* name|STRLEN len|int multi +Ap |void |gv_name_set |NN GV* gv|NN const char *name|U32 len|U32 flags +Apd |HV* |gv_stashpv |NN const char* name|I32 flags +Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags +Apd |HV* |gv_stashsv |NN SV* sv|I32 flags +Apd |void |hv_clear |NULLOK HV *hv +poM |HV * |hv_copy_hints_hv|NULLOK HV *const ohv +Ap |void |hv_delayfree_ent|NN HV *hv|NULLOK HE *entry +Abmd |SV* |hv_delete |NULLOK HV *hv|NN const char *key|I32 klen \ + |I32 flags +Abmd |SV* |hv_delete_ent |NULLOK HV *hv|NN SV *keysv|I32 flags|U32 hash +AbmdR |bool |hv_exists |NULLOK HV *hv|NN const char *key|I32 klen +AbmdR |bool |hv_exists_ent |NULLOK HV *hv|NN SV *keysv|U32 hash +Abmd |SV** |hv_fetch |NULLOK HV *hv|NN const char *key|I32 klen \ + |I32 lval +Abmd |HE* |hv_fetch_ent |NULLOK HV *hv|NN SV *keysv|I32 lval|U32 hash +Ap |void* |hv_common |NULLOK HV *hv|NULLOK SV *keysv \ + |NULLOK const char* key|STRLEN klen|int flags \ + |int action|NULLOK SV *val|U32 hash +Ap |void* |hv_common_key_len|NULLOK HV *hv|NN const char *key \ + |I32 klen_i32|const int action|NULLOK SV *val \ + |const U32 hash +Ap |void |hv_free_ent |NN HV *hv|NULLOK HE *entryK +Apd |I32 |hv_iterinit |NN HV *hv +ApdR |char* |hv_iterkey |NN HE* entry|NN I32* retlen +ApdR |SV* |hv_iterkeysv |NN HE* entry +ApdRbm |HE* |hv_iternext |NN HV *hv +ApdR |SV* |hv_iternextsv |NN HV *hv|NN char **key|NN I32 *retlen +ApMdR |HE* |hv_iternext_flags|NN HV *hv|I32 flags +ApdR |SV* |hv_iterval |NN HV *hv|NN HE *entry +Ap |void |hv_ksplit |NN HV *hv|IV newmax +Apdbm |void |hv_magic |NN HV *hv|NULLOK GV *gv|int how +XEdpoM |HV * |refcounted_he_chain_2hv|NULLOK const struct refcounted_he *c +XEpoM |SV * |refcounted_he_fetch|NULLOK const struct refcounted_he *chain \ + |NULLOK SV *keysv|NULLOK const char *key \ + |STRLEN klen, int flags, U32 hash +dpoM |void |refcounted_he_free|NULLOK struct refcounted_he *he +XEdpoM |struct refcounted_he *|refcounted_he_new \ + |NULLOK struct refcounted_he *const parent \ + |NULLOK SV *const key|NULLOK SV *const value +#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) +s |struct refcounted_he * |refcounted_he_new_common \ + |NULLOK struct refcounted_he *const parent \ + |NN const char *const key_p \ + |const STRLEN key_len|const char flags \ + |char value_type|NN const void *value \ + |const STRLEN value_len +#endif +Abmd |SV** |hv_store |NULLOK HV *hv|NULLOK const char *key \ + |I32 klen|NULLOK SV *val|U32 hash +Abmd |HE* |hv_store_ent |NULLOK HV *hv|NULLOK SV *key|NULLOK SV *val\ + |U32 hash +AbmdM |SV** |hv_store_flags |NULLOK HV *hv|NULLOK const char *key \ + |I32 klen|NULLOK SV *val|U32 hash|int flags +Apd |void |hv_undef |NULLOK HV *hv +ApP |I32 |ibcmp |NN const char* a|NN const char* b|I32 len +ApP |I32 |ibcmp_locale |NN const char* a|NN const char* b|I32 len +Apd |I32 |ibcmp_utf8 |NN const char *s1|NULLOK char **pe1|UV l1 \ + |bool u1|NN const char *s2|NULLOK char **pe2 \ + |UV l2|bool u2 +pR |bool |ingroup |Gid_t testgid|bool effective +p |void |init_argv_symbols|int argc|NN char **argv +p |void |init_debugger +Ap |void |init_stacks +Ap |void |init_tm |NN struct tm *ptm +pd |U32 |intro_my +ApPR |char* |instr |NN const char* big|NN const char* little +p |bool |io_close |NN IO* io|bool not_implicit +pR |OP* |invert |NULLOK OP* cmd +dpR |bool |is_gv_magical |NN const char *name|STRLEN len|U32 flags +ApR |I32 |is_lvalue_sub +ApPR |U32 |to_uni_upper_lc|U32 c +ApPR |U32 |to_uni_title_lc|U32 c +ApPR |U32 |to_uni_lower_lc|U32 c +ApPR |bool |is_uni_alnum |UV c +ApPR |bool |is_uni_alnumc |UV c +ApPR |bool |is_uni_idfirst |UV c +ApPR |bool |is_uni_alpha |UV c +ApPR |bool |is_uni_ascii |UV c +ApPR |bool |is_uni_space |UV c +ApPR |bool |is_uni_cntrl |UV c +ApPR |bool |is_uni_graph |UV c +ApPR |bool |is_uni_digit |UV c +ApPR |bool |is_uni_upper |UV c +ApPR |bool |is_uni_lower |UV c +ApPR |bool |is_uni_print |UV c +ApPR |bool |is_uni_punct |UV c +ApPR |bool |is_uni_xdigit |UV c +Ap |UV |to_uni_upper |UV c|NN U8 *p|NN STRLEN *lenp +Ap |UV |to_uni_title |UV c|NN U8 *p|NN STRLEN *lenp +Ap |UV |to_uni_lower |UV c|NN U8 *p|NN STRLEN *lenp +Ap |UV |to_uni_fold |UV c|NN U8 *p|NN STRLEN *lenp +ApPR |bool |is_uni_alnum_lc|UV c +ApPR |bool |is_uni_alnumc_lc|UV c +ApPR |bool |is_uni_idfirst_lc|UV c +ApPR |bool |is_uni_alpha_lc|UV c +ApPR |bool |is_uni_ascii_lc|UV c +ApPR |bool |is_uni_space_lc|UV c +ApPR |bool |is_uni_cntrl_lc|UV c +ApPR |bool |is_uni_graph_lc|UV c +ApPR |bool |is_uni_digit_lc|UV c +ApPR |bool |is_uni_upper_lc|UV c +ApPR |bool |is_uni_lower_lc|UV c +ApPR |bool |is_uni_print_lc|UV c +ApPR |bool |is_uni_punct_lc|UV c +ApPR |bool |is_uni_xdigit_lc|UV c +Apd |STRLEN |is_utf8_char |NN const U8 *s +Apd |bool |is_utf8_string |NN const U8 *s|STRLEN len +Apdmb |bool |is_utf8_string_loc|NN const U8 *s|STRLEN len|NULLOK const U8 **p +Apd |bool |is_utf8_string_loclen|NN const U8 *s|STRLEN len|NULLOK const U8 **ep|NULLOK STRLEN *el +ApR |bool |is_utf8_alnum |NN const U8 *p +ApR |bool |is_utf8_alnumc |NN const U8 *p +ApR |bool |is_utf8_idfirst|NN const U8 *p +ApR |bool |is_utf8_idcont |NN const U8 *p +ApR |bool |is_utf8_alpha |NN const U8 *p +ApR |bool |is_utf8_ascii |NN const U8 *p +ApR |bool |is_utf8_space |NN const U8 *p +ApR |bool |is_utf8_cntrl |NN const U8 *p +ApR |bool |is_utf8_digit |NN const U8 *p +ApR |bool |is_utf8_graph |NN const U8 *p +ApR |bool |is_utf8_upper |NN const U8 *p +ApR |bool |is_utf8_lower |NN const U8 *p +ApR |bool |is_utf8_print |NN const U8 *p +ApR |bool |is_utf8_punct |NN const U8 *p +ApR |bool |is_utf8_xdigit |NN const U8 *p +ApR |bool |is_utf8_mark |NN const U8 *p +p |OP* |jmaybe |NN OP *o +pP |I32 |keyword |NN const char *name|I32 len|bool all_keywords +Ap |void |leave_scope |I32 base +EXp |void |lex_end +p |void |lex_start |NULLOK SV* line|NULLOK PerlIO *rsfp|bool new_filter +Ap |void |op_null |NN OP* o +EXp |void |op_clear |NN OP* o +Ap |void |op_refcnt_lock +Ap |void |op_refcnt_unlock +p |OP* |linklist |NN OP* o +p |OP* |list |NULLOK OP* o +p |OP* |listkids |NULLOK OP* o +Apd |void |load_module|U32 flags|NN SV* name|NULLOK SV* ver|... +Ap |void |vload_module|U32 flags|NN SV* name|NULLOK SV* ver|NULLOK va_list* args +p |OP* |localize |NN OP *o|I32 lex +ApdR |I32 |looks_like_number|NN SV *const sv +Apd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +Apd |int |grok_number |NN const char *pv|STRLEN len|NULLOK UV *valuep +ApdR |bool |grok_numeric_radix|NN const char **sp|NN const char *send +Apd |UV |grok_oct |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +p |int |magic_clearenv |NN SV* sv|NN MAGIC* mg +p |int |magic_clear_all_env|NN SV* sv|NN MAGIC* mg +dp |int |magic_clearhint|NN SV* sv|NN MAGIC* mg +p |int |magic_clearisa |NN SV* sv|NN MAGIC* mg +p |int |magic_clearpack|NN SV* sv|NN MAGIC* mg +p |int |magic_clearsig |NN SV* sv|NN MAGIC* mg +p |int |magic_existspack|NN SV* sv|NN const MAGIC* mg +p |int |magic_freeovrld|NN SV* sv|NN MAGIC* mg +p |int |magic_get |NN SV* sv|NN MAGIC* mg +p |int |magic_getarylen|NN SV* sv|NN const MAGIC* mg +p |int |magic_getdefelem|NN SV* sv|NN MAGIC* mg +p |int |magic_getnkeys |NN SV* sv|NN MAGIC* mg +p |int |magic_getpack |NN SV* sv|NN MAGIC* mg +p |int |magic_getpos |NN SV* sv|NN MAGIC* mg +p |int |magic_getsig |NN SV* sv|NN MAGIC* mg +p |int |magic_getsubstr|NN SV* sv|NN MAGIC* mg +p |int |magic_gettaint |NN SV* sv|NN MAGIC* mg +p |int |magic_getuvar |NN SV* sv|NN MAGIC* mg +p |int |magic_getvec |NN SV* sv|NN MAGIC* mg +p |U32 |magic_len |NN SV* sv|NN MAGIC* mg +p |int |magic_nextpack |NN SV *sv|NN MAGIC *mg|NN SV *key +p |U32 |magic_regdata_cnt|NN SV* sv|NN MAGIC* mg +p |int |magic_regdatum_get|NN SV* sv|NN MAGIC* mg +pr |int |magic_regdatum_set|NN SV* sv|NN MAGIC* mg +p |int |magic_set |NN SV* sv|NN MAGIC* mg +p |int |magic_setamagic|NN SV* sv|NN MAGIC* mg +p |int |magic_setarylen|NN SV* sv|NN MAGIC* mg +p |int |magic_freearylen_p|NN SV* sv|NN MAGIC* mg +p |int |magic_setdbline|NN SV* sv|NN MAGIC* mg +p |int |magic_setdefelem|NN SV* sv|NN MAGIC* mg +p |int |magic_setenv |NN SV* sv|NN MAGIC* mg +dp |int |magic_sethint |NN SV* sv|NN MAGIC* mg +p |int |magic_setisa |NN SV* sv|NN MAGIC* mg +p |int |magic_setmglob |NN SV* sv|NN MAGIC* mg +p |int |magic_setnkeys |NN SV* sv|NN MAGIC* mg +p |int |magic_setpack |NN SV* sv|NN MAGIC* mg +p |int |magic_setpos |NN SV* sv|NN MAGIC* mg +p |int |magic_setregexp|NN SV* sv|NN MAGIC* mg +p |int |magic_setsig |NN SV* sv|NN MAGIC* mg +p |int |magic_setsubstr|NN SV* sv|NN MAGIC* mg +p |int |magic_settaint |NN SV* sv|NN MAGIC* mg +p |int |magic_setuvar |NN SV* sv|NN MAGIC* mg +p |int |magic_setvec |NN SV* sv|NN MAGIC* mg +p |int |magic_setutf8 |NN SV* sv|NN MAGIC* mg +p |int |magic_set_all_env|NN SV* sv|NN MAGIC* mg +p |U32 |magic_sizepack |NN SV* sv|NN MAGIC* mg +p |int |magic_wipepack |NN SV* sv|NN MAGIC* mg +p |void |magicname |NN const char* sym|NULLOK const char* name|I32 namlen +Ap |void |markstack_grow +#if defined(USE_LOCALE_COLLATE) +p |int |magic_setcollxfrm|NN SV* sv|NN MAGIC* mg +p |char* |mem_collxfrm |NN const char* s|STRLEN len|NN STRLEN* xlen +#endif +Afp |SV* |mess |NN const char* pat|... +Ap |SV* |vmess |NN const char* pat|NULLOK va_list* args +EXp |void |qerror |NN SV* err +Apd |void |sortsv |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp +Apd |void |sortsv_flags |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U32 flags +Apd |int |mg_clear |NN SV* sv +Apd |int |mg_copy |NN SV *sv|NN SV *nsv|NULLOK const char *key \ + |I32 klen +pd |void |mg_localize |NN SV* sv|NN SV* nsv +ApdR |MAGIC* |mg_find |NULLOK const SV* sv|int type +Apd |int |mg_free |NN SV* sv +Apd |int |mg_get |NN SV* sv +Apd |U32 |mg_length |NN SV* sv +Apd |void |mg_magical |NN SV* sv +Apd |int |mg_set |NN SV* sv +Ap |I32 |mg_size |NN SV* sv +Ap |void |mini_mktime |NN struct tm *ptm +EXp |OP* |mod |NULLOK OP* o|I32 type +p |int |mode_from_discipline|NULLOK const char* s|STRLEN len +Ap |const char* |moreswitches |NN const char* s +p |OP* |my |NN OP* o +Ap |NV |my_atof |NN const char *s +#if (!defined(HAS_MEMCPY) && !defined(HAS_BCOPY)) || (!defined(HAS_MEMMOVE) && !defined(HAS_SAFE_MEMCPY) && !defined(HAS_SAFE_BCOPY)) +Anp |char* |my_bcopy |NN const char* from|NN char* to|I32 len +#endif +#if !defined(HAS_BZERO) && !defined(HAS_MEMSET) +Anp |char* |my_bzero |NN char* loc|I32 len +#endif +Apr |void |my_exit |U32 status +Apr |void |my_failure_exit +Ap |I32 |my_fflush_all +Anp |Pid_t |my_fork +Anp |void |atfork_lock +Anp |void |atfork_unlock +Ap |I32 |my_lstat +#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) +AnpP |I32 |my_memcmp |NN const char* s1|NN const char* s2|I32 len +#endif +#if !defined(HAS_MEMSET) +Anp |void* |my_memset |NN char* loc|I32 ch|I32 len +#endif +Ap |I32 |my_pclose |NULLOK PerlIO* ptr +Ap |PerlIO*|my_popen |NN const char* cmd|NN const char* mode +Ap |PerlIO*|my_popen_list |NN const char* mode|int n|NN SV ** args +Ap |void |my_setenv |NULLOK const char* nam|NULLOK const char* val +Ap |I32 |my_stat +Ap |char * |my_strftime |NN const char *fmt|int sec|int min|int hour|int mday|int mon|int year|int wday|int yday|int isdst +#if defined(MYSWAP) +ApPa |short |my_swap |short s +ApPa |long |my_htonl |long l +ApPa |long |my_ntohl |long l +#endif +p |void |my_unexec +Apa |OP* |newANONLIST |NULLOK OP* o +Apa |OP* |newANONHASH |NULLOK OP* o +Ap |OP* |newANONSUB |I32 floor|NULLOK OP* proto|NULLOK OP* block +Apa |OP* |newASSIGNOP |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right +Apa |OP* |newCONDOP |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop +Apd |CV* |newCONSTSUB |NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv +#ifdef PERL_MAD +Ap |OP* |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block +#else +Ap |void |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block +#endif +Apa |OP* |newFOROP |I32 flags|NULLOK char* label|line_t forline \ + |NULLOK OP* sv|NN OP* expr|NULLOK OP* block|NULLOK OP* cont +Apa |OP* |newGIVENOP |NN OP* cond|NN OP* block|PADOFFSET defsv_off +Apa |OP* |newLOGOP |I32 optype|I32 flags|NN OP *first|NN OP *other +Apa |OP* |newLOOPEX |I32 type|NN OP* label +Apa |OP* |newLOOPOP |I32 flags|I32 debuggable|NULLOK OP* expr|NULLOK OP* block +Apa |OP* |newNULLLIST +Apa |OP* |newOP |I32 optype|I32 flags +Ap |void |newPROG |NN OP* o +Apa |OP* |newRANGE |I32 flags|NN OP* left|NN OP* right +Apa |OP* |newSLICEOP |I32 flags|NULLOK OP* subscript|NULLOK OP* listop +Apa |OP* |newSTATEOP |I32 flags|NULLOK char* label|NULLOK OP* o +Ap |CV* |newSUB |I32 floor|NULLOK OP* o|NULLOK OP* proto|NULLOK OP* block +ApM |CV * |newXS_flags |NULLOK const char *name|NN XSUBADDR_t subaddr\ + |NN const char *const filename \ + |NULLOK const char *const proto|U32 flags +Apd |CV* |newXS |NULLOK const char *name|NN XSUBADDR_t subaddr\ + |NN const char *filename +AmdbR |AV* |newAV +Apa |OP* |newAVREF |NN OP* o +Apa |OP* |newBINOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last +Apa |OP* |newCVREF |I32 flags|NULLOK OP* o +Apa |OP* |newGVOP |I32 type|I32 flags|NN GV* gv +Apa |GV* |newGVgen |NN const char* pack +Apa |OP* |newGVREF |I32 type|NULLOK OP* o +ApaR |OP* |newHVREF |NN OP* o +AmdbR |HV* |newHV +ApaR |HV* |newHVhv |NULLOK HV *hv +Apa |IO* |newIO +Apa |OP* |newLISTOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last +#ifdef USE_ITHREADS +Apa |OP* |newPADOP |I32 type|I32 flags|NN SV* sv +#endif +Apa |OP* |newPMOP |I32 type|I32 flags +Apa |OP* |newPVOP |I32 type|I32 flags|NULLOK char* pv +Apa |SV* |newRV |NN SV *const sv +Apda |SV* |newRV_noinc |NN SV *const sv +Apda |SV* |newSV |const STRLEN len +Apa |OP* |newSVREF |NN OP* o +Apa |OP* |newSVOP |I32 type|I32 flags|NN SV* sv +Apda |SV* |newSViv |const IV i +Apda |SV* |newSVuv |const UV u +Apda |SV* |newSVnv |const NV n +Apda |SV* |newSVpv |NULLOK const char *const s|const STRLEN len +Apda |SV* |newSVpvn |NULLOK const char *const s|const STRLEN len +Apda |SV* |newSVpvn_flags |NULLOK const char *const s|const STRLEN len|const U32 flags +Apda |SV* |newSVhek |NULLOK const HEK *const hek +Apda |SV* |newSVpvn_share |NULLOK const char* s|I32 len|U32 hash +Afpda |SV* |newSVpvf |NN const char *const pat|... +Apa |SV* |vnewSVpvf |NN const char *const pat|NULLOK va_list *const args +Apd |SV* |newSVrv |NN SV *const rv|NULLOK const char *const classname +Apda |SV* |newSVsv |NULLOK SV *const old +Apda |SV* |newSV_type |const svtype type +Apa |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first +Apa |OP* |newWHENOP |NULLOK OP* cond|NN OP* block +Apa |OP* |newWHILEOP |I32 flags|I32 debuggable|NULLOK LOOP* loop \ + |I32 whileline|NULLOK OP* expr|NULLOK OP* block|NULLOK OP* cont \ + |I32 has_my +Apa |PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems +Ap |char* |scan_vstring |NN const char *s|NN const char *const e \ + |NN SV *sv +Apd |const char* |scan_version |NN const char *s|NN SV *rv|bool qv +Apd |SV* |new_version |NN SV *ver +Apd |SV* |upg_version |NN SV *ver|bool qv +Apd |bool |vverify |NN SV *vs +Apd |SV* |vnumify |NN SV *vs +Apd |SV* |vnormal |NN SV *vs +Apd |SV* |vstringify |NN SV *vs +Apd |int |vcmp |NN SV *lhv|NN SV *rhv +p |PerlIO*|nextargv |NN GV* gv +ApP |char* |ninstr |NN const char* big|NN const char* bigend \ + |NN const char* little|NN const char* lend +pr |OP* |oopsCV |NN OP* o +Ap |void |op_free |NULLOK OP* arg +#ifdef PERL_MAD +p |OP* |package |NN OP* o +#else +p |void |package |NN OP* o +#endif +pd |PADOFFSET|pad_alloc |I32 optype|U32 tmptype +p |PADOFFSET|allocmy |NN const char *const name +pdR |PADOFFSET|pad_findmy |NN const char* name +Ap |PADOFFSET|find_rundefsvoffset | +pR |OP* |oopsAV |NN OP* o +pR |OP* |oopsHV |NN OP* o +pd |void |pad_leavemy +Apd |SV* |pad_sv |PADOFFSET po +pd |void |pad_free |PADOFFSET po +pd |void |pad_reset +pd |void |pad_swipe |PADOFFSET po|bool refadjust +p |void |peep |NULLOK OP* o +dopM |PerlIO*|start_glob |NN SV *tmpglob|NN IO *io +#if defined(USE_REENTRANT_API) +Ap |void |reentrant_size +Ap |void |reentrant_init +Ap |void |reentrant_free +Anp |void* |reentrant_retry|NN const char *f|... +#endif +Ap |void |call_atexit |ATEXIT_t fn|NULLOK void *ptr +Apd |I32 |call_argv |NN const char* sub_name|I32 flags|NN char** argv +Apd |I32 |call_method |NN const char* methname|I32 flags +Apd |I32 |call_pv |NN const char* sub_name|I32 flags +Apd |I32 |call_sv |NN SV* sv|VOL I32 flags +Ap |void |despatch_signals +Ap |OP * |doref |NN OP *o|I32 type|bool set_op_ref +Apd |SV* |eval_pv |NN const char* p|I32 croak_on_error +Apd |I32 |eval_sv |NN SV* sv|I32 flags +Apd |SV* |get_sv |NN const char* name|I32 create +Apd |AV* |get_av |NN const char* name|I32 create +Apd |HV* |get_hv |NN const char* name|I32 create +Apd |CV* |get_cv |NN const char* name|I32 flags +Apd |CV* |get_cvn_flags |NN const char* name|STRLEN len|I32 flags +Ap |int |init_i18nl10n |int printwarn +Ap |int |init_i18nl14n |int printwarn +Ap |void |new_collate |NULLOK const char* newcoll +Ap |void |new_ctype |NN const char* newctype +Ap |void |new_numeric |NULLOK const char* newcoll +Ap |void |set_numeric_local +Ap |void |set_numeric_radix +Ap |void |set_numeric_standard +Apd |void |require_pv |NN const char* pv +Apd |void |pack_cat |NN SV *cat|NN const char *pat|NN const char *patend \ + |NN SV **beglist|NN SV **endlist|NN SV ***next_in_list|U32 flags +Apd |void |packlist |NN SV *cat|NN const char *pat|NN const char *patend|NN SV **beglist|NN SV **endlist +#ifdef PERL_USES_PL_PIDSTATUS +p |void |pidgone |Pid_t pid|int status +#endif +Ap |void |pmflag |NN U32* pmfl|int ch +p |OP* |pmruntime |NN OP *o|NN OP *expr|bool isreg +p |OP* |pmtrans |NN OP* o|NN OP* expr|NN OP* repl +Ap |void |pop_scope +p |OP* |prepend_elem |I32 optype|NULLOK OP* head|NULLOK OP* tail +Ap |void |push_scope +Amb |OP* |ref |NULLOK OP* o|I32 type +p |OP* |refkids |NULLOK OP* o|I32 type +Ap |void |regdump |NN const regexp* r +Ap |void |regdump |NN const regexp* r +Ap |SV* |regclass_swash |NULLOK const regexp *prog \ + |NN const struct regnode *node|bool doinit \ + |NULLOK SV **listsvp|NULLOK SV **altsvp +Ap |I32 |pregexec |NN REGEXP * const prog|NN char* stringarg \ + |NN char* strend|NN char* strbeg|I32 minend \ + |NN SV* screamer|U32 nosave +Ap |void |pregfree |NULLOK REGEXP* r +Ap |void |pregfree2 |NN REGEXP *rx +EXp |REGEXP*|reg_temp_copy |NN REGEXP* r +Ap |void |regfree_internal|NN REGEXP *const rx +#if defined(USE_ITHREADS) +Ap |void* |regdupe_internal|NN REGEXP * const r|NN CLONE_PARAMS* param +#endif +Ap |REGEXP*|pregcomp |NN const SV * const pattern|const U32 flags +Ap |REGEXP*|re_compile |NN const SV * const pattern|U32 flags +Ap |char* |re_intuit_start|NN REGEXP * const rx|NULLOK SV* sv|NN char* strpos \ + |NN char* strend|const U32 flags \ + |NULLOK re_scream_pos_data *data +Ap |SV* |re_intuit_string|NN REGEXP *const r +Ap |I32 |regexec_flags |NN REGEXP *const rx|NN char *stringarg \ + |NN char *strend|NN char *strbeg|I32 minend \ + |NN SV *sv|NULLOK void *data|U32 flags +ApR |regnode*|regnext |NULLOK regnode* p + +EXp |SV*|reg_named_buff |NN REGEXP * const rx|NULLOK SV * const key \ + |NULLOK SV * const value|const U32 flags +EXp |SV*|reg_named_buff_iter |NN REGEXP * const rx|NULLOK const SV * const lastkey \ + |const U32 flags +Ap |SV*|reg_named_buff_fetch |NN REGEXP * const rx|NN SV * const namesv|const U32 flags +Ap |bool|reg_named_buff_exists |NN REGEXP * const rx|NN SV * const key|const U32 flags +Ap |SV*|reg_named_buff_firstkey |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_nextkey |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_scalar |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_all |NN REGEXP * const rx|const U32 flags + +EXp |void|reg_numbered_buff_fetch|NN REGEXP * const rx|const I32 paren|NULLOK SV * const sv +EXp |void|reg_numbered_buff_store|NN REGEXP * const rx|const I32 paren|NULLOK SV const * const value +EXp |I32|reg_numbered_buff_length|NN REGEXP * const rx|NN const SV * const sv|const I32 paren + +EXp |SV*|reg_qr_package|NN REGEXP * const rx + +Ep |void |regprop |NULLOK const regexp *prog|NN SV* sv|NN const regnode* o +Ap |void |repeatcpy |NN char* to|NN const char* from|I32 len|I32 count +ApP |char* |rninstr |NN const char* big|NN const char* bigend \ + |NN const char* little|NN const char* lend +Ap |Sighandler_t|rsignal |int i|Sighandler_t t +p |int |rsignal_restore|int i|NULLOK Sigsave_t* t +p |int |rsignal_save |int i|Sighandler_t t1|NN Sigsave_t* save +Ap |Sighandler_t|rsignal_state|int i +p |void |rxres_free |NN void** rsp +p |void |rxres_restore |NN void **rsp|NN REGEXP *rx +p |void |rxres_save |NN void **rsp|NN REGEXP *rx +#if !defined(HAS_RENAME) +p |I32 |same_dirent |NN const char* a|NN const char* b +#endif +Apda |char* |savepv |NULLOK const char* pv +Apda |char* |savepvn |NULLOK const char* pv|I32 len +Apda |char* |savesharedpv |NULLOK const char* pv +Apda |char* |savesharedpvn |NN const char *const pv|const STRLEN len +Apda |char* |savesvpv |NN SV* sv +Ap |void |savestack_grow +Ap |void |savestack_grow_cnt |I32 need +Ap |void |save_aelem |NN AV* av|I32 idx|NN SV **sptr +Ap |I32 |save_alloc |I32 size|I32 pad +Ap |void |save_aptr |NN AV** aptr +Ap |AV* |save_ary |NN GV* gv +Ap |void |save_bool |NN bool* boolp +Ap |void |save_clearsv |NN SV** svp +Ap |void |save_delete |NN HV *hv|NN char *key|I32 klen +Ap |void |save_destructor|DESTRUCTORFUNC_NOCONTEXT_t f|NN void* p +Ap |void |save_destructor_x|DESTRUCTORFUNC_t f|NULLOK void* p +Ap |void |save_freesv |NULLOK SV* sv +p |void |save_freeop |NULLOK OP* o +Ap |void |save_freepv |NULLOK char* pv +Ap |void |save_generic_svref|NN SV** sptr +Ap |void |save_generic_pvref|NN char** str +Ap |void |save_shared_pvref|NN char** str +Ap |void |save_gp |NN GV* gv|I32 empty +Ap |HV* |save_hash |NN GV* gv +Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr +Ap |void |save_hptr |NN HV** hptr +Ap |void |save_I16 |NN I16* intp +Ap |void |save_I32 |NN I32* intp +Ap |void |save_I8 |NN I8* bytep +Ap |void |save_int |NN int* intp +Ap |void |save_item |NN SV* item +Ap |void |save_iv |NN IV *ivp +Ap |void |save_list |NN SV** sarg|I32 maxsarg +Ap |void |save_long |NN long* longp +Ap |void |save_mortalizesv|NN SV* sv +Ap |void |save_nogv |NN GV* gv +p |void |save_op +Ap |SV* |save_scalar |NN GV* gv +Ap |void |save_pptr |NN char** pptr +Ap |void |save_vptr |NN void *ptr +Ap |void |save_re_context +Ap |void |save_padsv_and_mortalize|PADOFFSET off +Ap |void |save_sptr |NN SV** sptr +Ap |SV* |save_svref |NN SV** sptr +p |OP* |sawparens |NULLOK OP* o +p |OP* |scalar |NULLOK OP* o +p |OP* |scalarkids |NULLOK OP* o +p |OP* |scalarseq |NULLOK OP* o +p |OP* |scalarvoid |NN OP* o +Apd |NV |scan_bin |NN const char* start|STRLEN len|NN STRLEN* retlen +Apd |NV |scan_hex |NN const char* start|STRLEN len|NN STRLEN* retlen +Ap |char* |scan_num |NN const char* s|NN YYSTYPE *lvalp +Apd |NV |scan_oct |NN const char* start|STRLEN len|NN STRLEN* retlen +p |OP* |scope |NULLOK OP* o +Ap |char* |screaminstr |NN SV *bigstr|NN SV *littlestr|I32 start_shift \ + |I32 end_shift|NN I32 *old_posp|I32 last +#if !defined(VMS) +p |I32 |setenv_getix |NN const char* nam +#endif +EXp |void |setdefout |NULLOK GV* gv +Ap |HEK* |share_hek |NN const char* str|I32 len|U32 hash +#if defined(HAS_SIGACTION) && defined(SA_SIGINFO) +np |Signal_t |sighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap +Anp |Signal_t |csighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap +#else +np |Signal_t |sighandler |int sig +Anp |Signal_t |csighandler |int sig +#endif +Ap |SV** |stack_grow |NN SV** sp|NN SV** p|int n +Ap |I32 |start_subparse |I32 is_format|U32 flags +p |void |sub_crush_depth|NN CV* cv +Apd |bool |sv_2bool |NN SV *const sv +Apd |CV* |sv_2cv |NULLOK SV* sv|NN HV **const st|NN GV **const gvp \ + |const I32 lref +Apd |IO* |sv_2io |NN SV *const sv +#ifdef PERL_IN_SV_C +s |bool |glob_2number |NN GV* const gv +s |char* |glob_2pv |NN GV* const gv|NULLOK STRLEN * const len +#endif +Amb |IV |sv_2iv |NULLOK SV *sv +Apd |IV |sv_2iv_flags |NULLOK SV *const sv|const I32 flags +Apd |SV* |sv_2mortal |NULLOK SV *const sv +Apd |NV |sv_2nv |NULLOK SV *const sv +pMd |SV* |sv_2num |NN SV *const sv +Amb |char* |sv_2pv |NULLOK SV *sv|NULLOK STRLEN *lp +Apd |char* |sv_2pv_flags |NULLOK SV *const sv|NULLOK STRLEN *const lp|const I32 flags +Apd |char* |sv_2pvutf8 |NN SV *const sv|NULLOK STRLEN *const lp +Apd |char* |sv_2pvbyte |NN SV *const sv|NULLOK STRLEN *const lp +Ap |char* |sv_pvn_nomg |NN SV* sv|NULLOK STRLEN* lp +Amb |UV |sv_2uv |NULLOK SV *sv +Apd |UV |sv_2uv_flags |NULLOK SV *const sv|const I32 flags +Apd |IV |sv_iv |NN SV* sv +Apd |UV |sv_uv |NN SV* sv +Apd |NV |sv_nv |NN SV* sv +Apd |char* |sv_pvn |NN SV *sv|NN STRLEN *lp +Apd |char* |sv_pvutf8n |NN SV *sv|NN STRLEN *lp +Apd |char* |sv_pvbyten |NN SV *sv|NN STRLEN *lp +Apd |I32 |sv_true |NULLOK SV *const sv +pd |void |sv_add_arena |NN char *const ptr|const U32 size|const U32 flags +Apd |int |sv_backoff |NN SV *const sv +Apd |SV* |sv_bless |NN SV *const sv|NN HV *const stash +Afpd |void |sv_catpvf |NN SV *const sv|NN const char *const pat|... +Apd |void |sv_vcatpvf |NN SV *const sv|NN const char *const pat \ + |NULLOK va_list *const args +Apd |void |sv_catpv |NN SV *const sv|NULLOK const char* ptr +Amdb |void |sv_catpvn |NN SV *dsv|NN const char *sstr|STRLEN len +Amdb |void |sv_catsv |NN SV *dstr|NULLOK SV *sstr +Apd |void |sv_chop |NN SV *const sv|NULLOK const char *const ptr +pd |I32 |sv_clean_all +pd |void |sv_clean_objs +Apd |void |sv_clear |NN SV *const sv +Apd |I32 |sv_cmp |NULLOK SV *const sv1|NULLOK SV *const sv2 +Apd |I32 |sv_cmp_locale |NULLOK SV *const sv1|NULLOK SV *const sv2 +#if defined(USE_LOCALE_COLLATE) +Apd |char* |sv_collxfrm |NN SV *const sv|NN STRLEN *const nxp +#endif +Ap |OP* |sv_compile_2op |NN SV *sv|NN OP **startop \ + |NN const char *code|NN PAD **padp +Apd |int |getcwd_sv |NN SV* sv +Apd |void |sv_dec |NULLOK SV *const sv +Ap |void |sv_dump |NN SV* sv +ApdR |bool |sv_derived_from|NN SV* sv|NN const char *const name +ApdR |bool |sv_does |NN SV* sv|NN const char *const name +Apd |I32 |sv_eq |NULLOK SV* sv1|NULLOK SV* sv2 +Apd |void |sv_free |NULLOK SV *const sv +poMX |void |sv_free2 |NN SV *const sv +pd |void |sv_free_arenas +Apd |char* |sv_gets |NN SV *const sv|NN PerlIO *const fp|I32 append +Apd |char* |sv_grow |NN SV *const sv|STRLEN newlen +Apd |void |sv_inc |NULLOK SV *const sv +Amdb |void |sv_insert |NN SV *const bigstr|const STRLEN offset \ + |const STRLEN len|NN const char *const little \ + |const STRLEN littlelen +Apd |void |sv_insert_flags|NN SV *const bigstr|const STRLEN offset|const STRLEN len \ + |NN const char *const little|const STRLEN littlelen|const U32 flags +Apd |int |sv_isa |NULLOK SV* sv|NN const char *const name +Apd |int |sv_isobject |NULLOK SV* sv +Apd |STRLEN |sv_len |NULLOK SV *const sv +Apd |STRLEN |sv_len_utf8 |NULLOK SV *const sv +Apd |void |sv_magic |NN SV *const sv|NULLOK SV *const obj|const int how \ + |NULLOK const char *const name|const I32 namlen +Apd |MAGIC *|sv_magicext |NN SV *const sv|NULLOK SV *const obj|const int how \ + |NULLOK const MGVTBL *const vtbl|NULLOK const char *const name \ + |const I32 namlen +ApdaR |SV* |sv_mortalcopy |NULLOK SV *const oldsv +ApdR |SV* |sv_newmortal +Apd |SV* |sv_newref |NULLOK SV *const sv +Ap |char* |sv_peek |NULLOK SV* sv +Apd |void |sv_pos_u2b |NULLOK SV *const sv|NN I32 *const offsetp|NULLOK I32 *const lenp +Apd |void |sv_pos_b2u |NULLOK SV *const sv|NN I32 *const offsetp +Amdb |char* |sv_pvn_force |NN SV* sv|NULLOK STRLEN* lp +Apd |char* |sv_pvutf8n_force|NN SV *const sv|NULLOK STRLEN *const lp +Apd |char* |sv_pvbyten_force|NN SV *const sv|NULLOK STRLEN *const lp +Apd |char* |sv_recode_to_utf8 |NN SV* sv|NN SV *encoding +Apd |bool |sv_cat_decode |NN SV* dsv|NN SV *encoding|NN SV *ssv|NN int *offset \ + |NN char* tstr|int tlen +ApdR |const char* |sv_reftype |NN const SV *const sv|const int ob +Apd |void |sv_replace |NN SV *const sv|NN SV *const nsv +Apd |void |sv_report_used +Apd |void |sv_reset |NN const char* s|NULLOK HV *const stash +Afpd |void |sv_setpvf |NN SV *const sv|NN const char *const pat|... +Apd |void |sv_vsetpvf |NN SV *const sv|NN const char *const pat|NULLOK va_list *const args +Apd |void |sv_setiv |NN SV *const sv|const IV num +Apdb |void |sv_setpviv |NN SV *const sv|const IV num +Apd |void |sv_setuv |NN SV *const sv|const UV num +Apd |void |sv_setnv |NN SV *const sv|const NV num +Apd |SV* |sv_setref_iv |NN SV *const rv|NULLOK const char *const classname|const IV iv +Apd |SV* |sv_setref_uv |NN SV *const rv|NULLOK const char *const classname|const UV uv +Apd |SV* |sv_setref_nv |NN SV *const rv|NULLOK const char *const classname|const NV nv +Apd |SV* |sv_setref_pv |NN SV *const rv|NULLOK const char *const classname \ + |NULLOK void *const pv +Apd |SV* |sv_setref_pvn |NN SV *const rv|NULLOK const char *const classname \ + |NN const char *const pv|const STRLEN n +Apd |void |sv_setpv |NN SV *const sv|NULLOK const char *const ptr +Apd |void |sv_setpvn |NN SV *const sv|NULLOK const char *const ptr|const STRLEN len +Amdb |void |sv_setsv |NN SV *dstr|NULLOK SV *sstr +Amdb |void |sv_taint |NN SV* sv +ApdR |bool |sv_tainted |NN SV *const sv +Apd |int |sv_unmagic |NN SV *const sv|const int type +Apdmb |void |sv_unref |NN SV* sv +Apd |void |sv_unref_flags |NN SV *const ref|const U32 flags +Apd |void |sv_untaint |NN SV *const sv +Apd |void |sv_upgrade |NN SV *const sv|svtype new_type +Apdmb |void |sv_usepvn |NN SV* sv|NULLOK char* ptr|STRLEN len +Apd |void |sv_usepvn_flags|NN SV *const sv|NULLOK char* ptr|const STRLEN len\ + |const U32 flags +Apd |void |sv_vcatpvfn |NN SV *const sv|NN const char *const pat|const STRLEN patlen \ + |NULLOK va_list *const args|NULLOK SV **const svargs|const I32 svmax \ + |NULLOK bool *const maybe_tainted +Apd |void |sv_vsetpvfn |NN SV *const sv|NN const char *const pat|const STRLEN patlen \ + |NULLOK va_list *const args|NULLOK SV **const svargs \ + |const I32 svmax|NULLOK bool *const maybe_tainted +ApR |NV |str_to_version |NN SV *sv +Ap |SV* |swash_init |NN const char* pkg|NN const char* name|NN SV* listsv|I32 minbits|I32 none +Ap |UV |swash_fetch |NN SV *swash|NN const U8 *ptr|bool do_utf8 +Ap |void |taint_env +Ap |void |taint_proper |NULLOK const char* f|NN const char *const s +Apd |UV |to_utf8_case |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp \ + |NN SV **swashp|NN const char *normal|NN const char *special +Apd |UV |to_utf8_lower |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +Apd |UV |to_utf8_upper |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +Apd |UV |to_utf8_title |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +Apd |UV |to_utf8_fold |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +#if defined(UNLINK_ALL_VERSIONS) +Ap |I32 |unlnk |NN const char* f +#endif +Apd |I32 |unpack_str |NN const char *pat|NN const char *patend|NN const char *s \ + |NULLOK const char *strbeg|NN const char *strend|NULLOK char **new_s \ + |I32 ocnt|U32 flags +Apd |I32 |unpackstring |NN const char *pat|NN const char *patend|NN const char *s \ + |NN const char *strend|U32 flags +Ap |void |unsharepvn |NULLOK const char* sv|I32 len|U32 hash +p |void |unshare_hek |NULLOK HEK* hek +#ifdef PERL_MAD +p |OP * |utilize |int aver|I32 floor|NULLOK OP* version \ + |NN OP* idop|NULLOK OP* arg +#else +p |void |utilize |int aver|I32 floor|NULLOK OP* version|NN OP* idop|NULLOK OP* arg +#endif +Ap |U8* |utf16_to_utf8 |NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen +Ap |U8* |utf16_to_utf8_reversed|NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen +AdpPR |STRLEN |utf8_length |NN const U8* s|NN const U8 *e +ApdPR |IV |utf8_distance |NN const U8 *a|NN const U8 *b +ApdPR |U8* |utf8_hop |NN const U8 *s|I32 off +ApMd |U8* |utf8_to_bytes |NN U8 *s|NN STRLEN *len +ApMd |U8* |bytes_from_utf8|NN const U8 *s|NN STRLEN *len|NULLOK bool *is_utf8 +ApMd |U8* |bytes_to_utf8 |NN const U8 *s|NN STRLEN *len +Apd |UV |utf8_to_uvchr |NN const U8 *s|NULLOK STRLEN *retlen +Apd |UV |utf8_to_uvuni |NN const U8 *s|NULLOK STRLEN *retlen + +#ifdef EBCDIC +Adp |UV |utf8n_to_uvchr |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags +#else +Adpbm |UV |utf8n_to_uvchr |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags +#endif + +Adp |UV |utf8n_to_uvuni |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags + +#ifdef EBCDIC +Apd |U8* |uvchr_to_utf8 |NN U8 *d|UV uv +#else +Apdbm |U8* |uvchr_to_utf8 |NN U8 *d|UV uv +#endif + +Apbm |U8* |uvuni_to_utf8 |NN U8 *d|UV uv +Ap |U8* |uvchr_to_utf8_flags |NN U8 *d|UV uv|UV flags +Apd |U8* |uvuni_to_utf8_flags |NN U8 *d|UV uv|UV flags +Apd |char* |pv_uni_display |NN SV *dsv|NN const U8 *spv|STRLEN len|STRLEN pvlim|UV flags +ApdR |char* |sv_uni_display |NN SV *dsv|NN SV *ssv|STRLEN pvlim|UV flags +EXp |void |vivify_defelem |NN SV* sv +p |void |vivify_ref |NN SV* sv|U32 to_what +p |I32 |wait4pid |Pid_t pid|NN int* statusp|int flags +p |U32 |parse_unicode_opts|NN const char **popt +Ap |U32 |seed +pR |UV |get_hash_seed +p |void |report_evil_fh |NULLOK const GV *gv|NULLOK const IO *io|I32 op +XEpd |void |report_uninit |NULLOK SV* uninit_sv +Afpd |void |warn |NN const char* pat|... +Ap |void |vwarn |NN const char* pat|NULLOK va_list* args +Afp |void |warner |U32 err|NN const char* pat|... +Ap |void |vwarner |U32 err|NN const char* pat|NULLOK va_list* args +p |void |watch |NN char** addr +Ap |I32 |whichsig |NN const char* sig +p |void |write_to_stderr|NN const char* message|int msglen +p |int |yyerror |NN const char *const s +EXp |int |yylex +p |int |yyparse +p |void |parser_free |NN const yy_parser *parser +p |int |yywarn |NN const char *const s +#if defined(MYMALLOC) +Ap |void |dump_mstats |NN const char* s +Ap |int |get_mstats |NN perl_mstats_t *buf|int buflen|int level +#endif +Anpa |Malloc_t|safesysmalloc |MEM_SIZE nbytes +Anpa |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size +Anpa |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes +Anp |Free_t |safesysfree |Malloc_t where +#if defined(PERL_GLOBAL_STRUCT) +Ap |struct perl_vars *|GetVars +Ap |struct perl_vars*|init_global_struct +Ap |void |free_global_struct|NN struct perl_vars *plvarsp +#endif +Ap |int |runops_standard +Ap |int |runops_debug +Afpd |void |sv_catpvf_mg |NN SV *const sv|NN const char *const pat|... +Apd |void |sv_vcatpvf_mg |NN SV *const sv|NN const char *const pat \ + |NULLOK va_list *const args +Apd |void |sv_catpv_mg |NN SV *const sv|NULLOK const char *const ptr +Apdbm |void |sv_catpvn_mg |NN SV *sv|NN const char *ptr|STRLEN len +Apdbm |void |sv_catsv_mg |NN SV *dsv|NULLOK SV *ssv +Afpd |void |sv_setpvf_mg |NN SV *const sv|NN const char *const pat|... +Apd |void |sv_vsetpvf_mg |NN SV *const sv|NN const char *const pat \ + |NULLOK va_list *const args +Apd |void |sv_setiv_mg |NN SV *const sv|const IV i +Apdb |void |sv_setpviv_mg |NN SV *const sv|const IV iv +Apd |void |sv_setuv_mg |NN SV *const sv|const UV u +Apd |void |sv_setnv_mg |NN SV *const sv|const NV num +Apd |void |sv_setpv_mg |NN SV *const sv|NULLOK const char *const ptr +Apd |void |sv_setpvn_mg |NN SV *const sv|NN const char *const ptr|const STRLEN len +Apd |void |sv_setsv_mg |NN SV *const dstr|NULLOK SV *const sstr +Apdbm |void |sv_usepvn_mg |NN SV *sv|NULLOK char *ptr|STRLEN len +ApR |MGVTBL*|get_vtbl |int vtbl_id +Apd |char* |pv_display |NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \ + |STRLEN pvlim +Apd |char* |pv_escape |NN SV *dsv|NN char const * const str\ + |const STRLEN count|const STRLEN max\ + |NULLOK STRLEN * const escaped\ + |const U32 flags +Apd |char* |pv_pretty |NN SV *dsv|NN char const * const str\ + |const STRLEN count|const STRLEN max\ + |NULLOK char const * const start_color\ + |NULLOK char const * const end_color\ + |const U32 flags +Afp |void |dump_indent |I32 level|NN PerlIO *file|NN const char* pat|... +Ap |void |dump_vindent |I32 level|NN PerlIO *file|NN const char* pat \ + |NULLOK va_list *args +Ap |void |do_gv_dump |I32 level|NN PerlIO *file|NN const char *name\ + |NULLOK GV *sv +Ap |void |do_gvgv_dump |I32 level|NN PerlIO *file|NN const char *name\ + |NULLOK GV *sv +Ap |void |do_hv_dump |I32 level|NN PerlIO *file|NN const char *name\ + |NULLOK HV *sv +Ap |void |do_magic_dump |I32 level|NN PerlIO *file|NN const MAGIC *mg|I32 nest \ + |I32 maxnest|bool dumpops|STRLEN pvlim +Ap |void |do_op_dump |I32 level|NN PerlIO *file|NULLOK const OP *o +Ap |void |do_pmop_dump |I32 level|NN PerlIO *file|NULLOK const PMOP *pm +Ap |void |do_sv_dump |I32 level|NN PerlIO *file|NULLOK SV *sv|I32 nest \ + |I32 maxnest|bool dumpops|STRLEN pvlim +Ap |void |magic_dump |NULLOK const MAGIC *mg +Ap |void |reginitcolors +ApdRmb |char* |sv_2pv_nolen |NN SV* sv +ApdRmb |char* |sv_2pvutf8_nolen|NN SV* sv +ApdRmb |char* |sv_2pvbyte_nolen|NN SV* sv +AmdbR |char* |sv_pv |NN SV *sv +AmdbR |char* |sv_pvutf8 |NN SV *sv +AmdbR |char* |sv_pvbyte |NN SV *sv +Amdb |STRLEN |sv_utf8_upgrade|NN SV *sv +ApdM |bool |sv_utf8_downgrade|NN SV *const sv|const bool fail_ok +Apd |void |sv_utf8_encode |NN SV *const sv +ApdM |bool |sv_utf8_decode |NN SV *const sv +Apdmb |void |sv_force_normal|NN SV *sv +Apd |void |sv_force_normal_flags|NN SV *const sv|const U32 flags +Ap |void |tmps_grow |I32 n +Apd |SV* |sv_rvweaken |NN SV *const sv +p |int |magic_killbackrefs|NN SV *sv|NN MAGIC *mg +Ap |OP* |newANONATTRSUB |I32 floor|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block +Ap |CV* |newATTRSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block +#ifdef PERL_MAD +Apr |OP * |newMYSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto \ + |NULLOK OP *attrs|NULLOK OP *block +#else +Apr |void |newMYSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block +#endif +p |OP * |my_attrs |NN OP *o|NULLOK OP *attrs +p |void |boot_core_xsutils +#if defined(USE_ITHREADS) +ApR |PERL_CONTEXT*|cx_dup |NULLOK PERL_CONTEXT* cx|I32 ix|I32 max|NN CLONE_PARAMS* param +ApR |PERL_SI*|si_dup |NULLOK PERL_SI* si|NN CLONE_PARAMS* param +Apa |ANY* |ss_dup |NN PerlInterpreter* proto_perl|NN CLONE_PARAMS* param +ApR |void* |any_dup |NULLOK void* v|NN const PerlInterpreter* proto_perl +ApR |HE* |he_dup |NULLOK const HE* e|bool shared|NN CLONE_PARAMS* param +ApR |HEK* |hek_dup |NULLOK HEK* e|NN CLONE_PARAMS* param +Ap |void |re_dup_guts |NN const REGEXP *sstr|NN REGEXP *dstr \ + |NN CLONE_PARAMS* param +Ap |PerlIO*|fp_dup |NULLOK PerlIO *const fp|const char type|NN CLONE_PARAMS *const param +ApR |DIR* |dirp_dup |NULLOK DIR *const dp +ApR |GP* |gp_dup |NULLOK GP *const gp|NN CLONE_PARAMS *const param +ApR |MAGIC* |mg_dup |NULLOK MAGIC *mg|NN CLONE_PARAMS *const param +ApR |SV* |sv_dup |NULLOK const SV *const sstr|NN CLONE_PARAMS *const param +Ap |void |rvpv_dup |NN SV *const dstr|NN const SV *const sstr|NN CLONE_PARAMS *const param +Ap |yy_parser*|parser_dup |NULLOK const yy_parser *const proto|NN CLONE_PARAMS *const param +#endif +Apa |PTR_TBL_t*|ptr_table_new +ApR |void* |ptr_table_fetch|NN PTR_TBL_t *const tbl|NULLOK const void *const sv +Ap |void |ptr_table_store|NN PTR_TBL_t *const tbl|NULLOK const void *const oldsv \ + |NN void *const newsv +Ap |void |ptr_table_split|NN PTR_TBL_t *const tbl +Ap |void |ptr_table_clear|NULLOK PTR_TBL_t *const tbl +Ap |void |ptr_table_free|NULLOK PTR_TBL_t *const tbl +#if defined(USE_ITHREADS) +# if defined(HAVE_INTERP_INTERN) +Ap |void |sys_intern_dup |NN struct interp_intern* src|NN struct interp_intern* dst +# endif +#endif +#if defined(HAVE_INTERP_INTERN) +Ap |void |sys_intern_clear +Ap |void |sys_intern_init +#endif + +ApR |const char * |custom_op_name |NN const OP *o +ApR |const char * |custom_op_desc |NN const OP *o + +Adp |void |sv_nosharing |NULLOK SV *sv +Adpbm |void |sv_nolocking |NULLOK SV *sv +Adp |bool |sv_destroyable |NULLOK SV *sv +#ifdef NO_MATHOMS +Adpbm |void |sv_nounlocking |NULLOK SV *sv +#else +Adpb |void |sv_nounlocking |NULLOK SV *sv +#endif +Adp |int |nothreadhook + +END_EXTERN_C + +#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) +sR |I32 |do_trans_simple |NN SV * const sv +sR |I32 |do_trans_count |NN SV * const sv +sR |I32 |do_trans_complex |NN SV * const sv +sR |I32 |do_trans_simple_utf8 |NN SV * const sv +sR |I32 |do_trans_count_utf8 |NN SV * const sv +sR |I32 |do_trans_complex_utf8 |NN SV * const sv +#endif + +#if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) +s |void |gv_init_sv |NN GV *gv|const svtype sv_type +s |HV* |gv_get_super_pkg|NN const char* name|I32 namelen +s |HV* |require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \ + |NN const char *methpv|const U32 flags +#endif + +: #if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) +paRxo |void* |get_arena |const size_t svtype|const U32 misc +: #endif + +#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) +s |void |hsplit |NN HV *hv +s |void |hfreeentries |NN HV *hv +sa |HE* |new_he +sanR |HEK* |save_hek_flags |NN const char *str|I32 len|U32 hash|int flags +sn |void |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store +s |void |unshare_hek_or_pvn|NULLOK const HEK* hek|NULLOK const char* str|I32 len|U32 hash +sR |HEK* |share_hek_flags|NN const char *str|I32 len|U32 hash|int flags +rs |void |hv_notallowed |int flags|NN const char *key|I32 klen|NN const char *msg +sn |struct xpvhv_aux*|hv_auxinit|NN HV *hv +sM |SV* |hv_delete_common|NULLOK HV *hv|NULLOK SV *keysv \ + |NULLOK const char *key|STRLEN klen|int k_flags|I32 d_flags \ + |U32 hash +sM |void |clear_placeholders |NN HV *hv|U32 items +sM |SV * |refcounted_he_value |NN const struct refcounted_he *he +#endif + +#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) +s |void |save_magic |I32 mgs_ix|NN SV *sv +s |int |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN const char *meth +s |int |magic_methcall |NN SV *sv|NN const MAGIC *mg|NN const char *meth|I32 f \ + |int n|NULLOK SV *val +s |void |restore_magic |NULLOK const void *p +s |void |unwind_handler_stack|NN const void *p + +#endif + +#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) +pR |OP* |ck_anoncode |NN OP *o +pR |OP* |ck_bitop |NN OP *o +pR |OP* |ck_concat |NN OP *o +pR |OP* |ck_defined |NN OP *o +pR |OP* |ck_delete |NN OP *o +pR |OP* |ck_die |NN OP *o +pR |OP* |ck_eof |NN OP *o +pR |OP* |ck_eval |NN OP *o +pR |OP* |ck_exec |NN OP *o +pR |OP* |ck_exists |NN OP *o +pR |OP* |ck_exit |NN OP *o +pR |OP* |ck_ftst |NN OP *o +pR |OP* |ck_fun |NN OP *o +pR |OP* |ck_glob |NN OP *o +pR |OP* |ck_grep |NN OP *o +pR |OP* |ck_index |NN OP *o +pR |OP* |ck_join |NN OP *o +pR |OP* |ck_lfun |NN OP *o +pR |OP* |ck_listiob |NN OP *o +pR |OP* |ck_match |NN OP *o +pR |OP* |ck_method |NN OP *o +pR |OP* |ck_null |NN OP *o +pR |OP* |ck_open |NN OP *o +pR |OP* |ck_readline |NN OP *o +pR |OP* |ck_repeat |NN OP *o +pR |OP* |ck_require |NN OP *o +pR |OP* |ck_return |NN OP *o +pR |OP* |ck_rfun |NN OP *o +pR |OP* |ck_rvconst |NN OP *o +pR |OP* |ck_sassign |NN OP *o +pR |OP* |ck_select |NN OP *o +pR |OP* |ck_shift |NN OP *o +pR |OP* |ck_sort |NN OP *o +pR |OP* |ck_spair |NN OP *o +pR |OP* |ck_split |NN OP *o +pR |OP* |ck_subr |NN OP *o +pR |OP* |ck_substr |NN OP *o +pR |OP* |ck_svconst |NN OP *o +pR |OP* |ck_trunc |NN OP *o +pR |OP* |ck_unpack |NN OP *o +pR |OP* |ck_each |NN OP *o +sRn |bool |is_handle_constructor|NN const OP *o|I32 numargs +sR |I32 |is_list_assignment|NULLOK const OP *o +# ifdef USE_ITHREADS +so |void |forget_pmop |NN PMOP *const o|U32 flags +# else +so |void |forget_pmop |NN PMOP *const o +# endif +s |void |find_and_forget_pmops |NN OP *o +s |void |cop_free |NN COP *cop +s |OP* |modkids |NULLOK OP *o|I32 type +s |OP* |scalarboolean |NN OP *o +sR |OP* |newDEFSVOP +sR |OP* |new_logop |I32 type|I32 flags|NN OP **firstp|NN OP **otherp +s |void |simplify_sort |NN OP *o +s |const char* |gv_ename |NN GV *gv +sRn |bool |scalar_mod_type|NN const OP *o|I32 type +s |OP * |my_kid |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp +s |OP * |dup_attrlist |NN OP *o +s |void |apply_attrs |NN HV *stash|NN SV *target|NULLOK OP *attrs|bool for_my +s |void |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp +s |void |bad_type |I32 n|NN const char *t|NN const char *name|NN const OP *kid +s |void |no_bareword_allowed|NN const OP *o +sR |OP* |no_fh_allowed|NN OP *o +sR |OP* |too_few_arguments|NN OP *o|NN const char* name +sR |OP* |too_many_arguments|NN OP *o|NN const char* name +s |bool |looks_like_bool|NN const OP* o +s |OP* |newGIVWHENOP |NULLOK OP* cond|NN OP *block \ + |I32 enter_opcode|I32 leave_opcode \ + |PADOFFSET entertarg +s |OP* |ref_array_or_hash|NULLOK OP* cond +s |void |process_special_blocks |NN const char *const fullname\ + |NN GV *const gv|NN CV *const cv +#endif +#if defined(PL_OP_SLAB_ALLOC) +Apa |void* |Slab_Alloc |size_t sz +Ap |void |Slab_Free |NN void *op +# if defined(PERL_DEBUG_READONLY_OPS) +poxM |void |pending_Slabs_to_ro +poxM |OP * |op_refcnt_inc |NULLOK OP *o +poxM |PADOFFSET |op_refcnt_dec |NN OP *o +# if defined(PERL_IN_OP_C) +s |void |Slab_to_rw |NN void *op +# endif +# endif +#endif + +#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) +s |void |find_beginning |NN SV* linestr_sv|NN PerlIO *rsfp +s |void |forbid_setid |const char flag|const bool suidscript +s |void |incpush |NULLOK const char *dir|bool addsubdirs|bool addoldvers|bool usesep|bool canrelocate +s |void |init_interp +s |void |init_ids +s |void |init_main_stash +s |void |init_perllib +s |void |init_postdump_symbols|int argc|NN char **argv|NULLOK char **env +s |void |init_predump_symbols +rs |void |my_exit_jump +s |void |nuke_stacks +s |int |open_script |NN const char *scriptname|bool dosearch \ + |NN bool *suidscript|NN PerlIO **rsfpp +s |void |usage |NN const char *name +#ifdef DOSUID +# ifdef IAMSUID +so |void |validate_suid |NN const char *validarg \ + |int fdscript \ + |bool suidscript|NN SV* linestr_sv \ + |NN PerlIO *rsfp +# else +so |void |validate_suid |NN const char *validarg \ + |NN const char *scriptname|int fdscript \ + |NN SV* linestr_sv \ + |NN PerlIO *rsfp +# endif +#else +# ifndef SETUID_SCRIPTS_ARE_SECURE_NOW +so |void |validate_suid |NN PerlIO *rsfp +# endif +#endif + +# if defined(IAMSUID) +s |int |fd_on_nosuid_fs|int fd +# endif +s |void* |parse_body |NULLOK char **env|XSINIT_t xsinit +rs |void |run_body |I32 oldscope +s |SV * |incpush_if_exists|NN SV *dir +#endif + +#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) +sR |SV* |refto |NN SV* sv +#endif +#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) +pRxo |GV* |softref2xv |NN SV *const sv|NN const char *const what \ + |const svtype type|NN SV ***spp +#endif + +#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT) +s |I32 |unpack_rec |NN struct tempsym* symptr|NN const char *s \ + |NN const char *strbeg|NN const char *strend|NULLOK const char **new_s +s |SV ** |pack_rec |NN SV *cat|NN struct tempsym* symptr|NN SV **beglist|NN SV **endlist +s |SV* |mul128 |NN SV *sv|U8 m +s |I32 |measure_struct |NN struct tempsym* symptr +s |bool |next_symbol |NN struct tempsym* symptr +sR |SV* |is_an_int |NN const char *s|STRLEN l +s |int |div128 |NN SV *pnum|NN bool *done +s |const char *|group_end |NN const char *patptr|NN const char *patend \ + |char ender +sR |const char *|get_num |NN const char *patptr|NN I32 *lenptr +ns |bool |need_utf8 |NN const char *pat|NN const char *patend +ns |char |first_symbol |NN const char *pat|NN const char *patend +sR |char * |sv_exp_grow |NN SV *sv|STRLEN needed +snR |char * |bytes_to_uni |NN const U8 *start|STRLEN len|NN char *dest +#endif + +#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) +sR |OP* |docatch |NULLOK OP *o +sR |OP* |dofindlabel |NN OP *o|NN const char *label|NN OP **opstack|NN OP **oplimit +sR |OP* |doparseform |NN SV *sv +snR |bool |num_overflow |NV value|I32 fldsize|I32 frcsize +sR |I32 |dopoptoeval |I32 startingblock +sR |I32 |dopoptogiven |I32 startingblock +sR |I32 |dopoptolabel |NN const char *label +sR |I32 |dopoptoloop |I32 startingblock +sR |I32 |dopoptosub_at |NN const PERL_CONTEXT* cxstk|I32 startingblock +sR |I32 |dopoptowhen |I32 startingblock +s |void |save_lines |NULLOK AV *array|NN SV *sv +s |bool |doeval |int gimme|NULLOK OP** startop|NULLOK CV* outside|U32 seq +sR |PerlIO *|check_type_and_open|NN const char *name +#ifndef PERL_DISABLE_PMC +sR |PerlIO *|doopen_pm |NN const char *name|const STRLEN namelen +#endif +sRn |bool |path_is_absolute|NN const char *name +sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen +sR |PMOP* |make_matcher |NN REGEXP* re +sR |bool |matcher_matches_sv|NN PMOP* matcher|NN SV* sv +s |void |destroy_matcher|NN PMOP* matcher +s |OP* |do_smartmatch |NULLOK HV* seen_this|NULLOK HV* seen_other +#endif + +#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) +s |void |do_oddball |NN HV *hash|NN SV **relem|NN SV **firstrelem +sR |SV* |method_common |NN SV* meth|NULLOK U32* hashp +#endif + +#if defined(PERL_IN_PP_SORT_C) || defined(PERL_DECL_PROT) +s |I32 |sv_ncmp |NN SV *const a|NN SV *const b +s |I32 |sv_i_ncmp |NN SV *const a|NN SV *const b +s |I32 |amagic_ncmp |NN SV *const a|NN SV *const b +s |I32 |amagic_i_ncmp |NN SV *const a|NN SV *const b +s |I32 |amagic_cmp |NN SV *const str1|NN SV *const str2 +s |I32 |amagic_cmp_locale|NN SV *const str1|NN SV *const str2 +s |I32 |sortcv |NN SV *const a|NN SV *const b +s |I32 |sortcv_xsub |NN SV *const a|NN SV *const b +s |I32 |sortcv_stacked |NN SV *const a|NN SV *const b +s |void |qsortsvu |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t compare +#endif + +#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT) +s |OP* |doform |NN CV *cv|NN GV *gv|NN OP *retop +# if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) +sR |int |dooneliner |NN const char *cmd|NN const char *filename +# endif +s |SV * |space_join_names_mortal|NN char *const *array +#endif + +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT) +Es |regnode*|reg |NN struct RExC_state_t *pRExC_state \ + |I32 paren|NN I32 *flagp|U32 depth +Es |regnode*|reganode |NN struct RExC_state_t *pRExC_state|U8 op \ + |U32 arg +Es |regnode*|regatom |NN struct RExC_state_t *pRExC_state \ + |NN I32 *flagp|U32 depth +Es |regnode*|regbranch |NN struct RExC_state_t *pRExC_state \ + |NN I32 *flagp|I32 first|U32 depth +Es |STRLEN |reguni |NN const struct RExC_state_t *pRExC_state \ + |UV uv|NN char *s +Es |regnode*|regclass |NN struct RExC_state_t *pRExC_state|U32 depth +ERsn |I32 |regcurly |NN const char *s +Es |regnode*|reg_node |NN struct RExC_state_t *pRExC_state|U8 op +Es |UV |reg_recode |const char value|NN SV **encp +Es |regnode*|regpiece |NN struct RExC_state_t *pRExC_state \ + |NN I32 *flagp|U32 depth +Es |regnode*|reg_namedseq |NN struct RExC_state_t *pRExC_state \ + |NULLOK UV *valuep +Es |void |reginsert |NN struct RExC_state_t *pRExC_state \ + |U8 op|NN regnode *opnd|U32 depth +Es |void |regtail |NN struct RExC_state_t *pRExC_state \ + |NN regnode *p|NN const regnode *val|U32 depth +Es |SV * |reg_scan_name |NN struct RExC_state_t *pRExC_state \ + |U32 flags +Es |U32 |join_exact |NN struct RExC_state_t *pRExC_state \ + |NN regnode *scan|NN I32 *min|U32 flags|NULLOK regnode *val|U32 depth +EsRn |char * |regwhite |NN struct RExC_state_t *pRExC_state \ + |NN char *p +Es |char * |nextchar |NN struct RExC_state_t *pRExC_state +Es |bool |reg_skipcomment|NN struct RExC_state_t *pRExC_state +Es |void |scan_commit |NN const struct RExC_state_t *pRExC_state \ + |NN struct scan_data_t *data|NN I32 *minlenp \ + |int is_inf +Esn |void |cl_anything |NN const struct RExC_state_t *pRExC_state \ + |NN struct regnode_charclass_class *cl +EsRn |int |cl_is_anything |NN const struct regnode_charclass_class *cl +Esn |void |cl_init |NN const struct RExC_state_t *pRExC_state \ + |NN struct regnode_charclass_class *cl +Esn |void |cl_init_zero |NN const struct RExC_state_t *pRExC_state \ + |NN struct regnode_charclass_class *cl +Esn |void |cl_and |NN struct regnode_charclass_class *cl \ + |NN const struct regnode_charclass_class *and_with +Esn |void |cl_or |NN const struct RExC_state_t *pRExC_state \ + |NN struct regnode_charclass_class *cl \ + |NN const struct regnode_charclass_class *or_with +Es |I32 |study_chunk |NN struct RExC_state_t *pRExC_state \ + |NN regnode **scanp|NN I32 *minlenp \ + |NN I32 *deltap|NN regnode *last \ + |NULLOK struct scan_data_t *data \ + |I32 stopparen|NULLOK U8* recursed \ + |NULLOK struct regnode_charclass_class *and_withp \ + |U32 flags|U32 depth +EsRn |U32 |add_data |NN struct RExC_state_t *pRExC_state|U32 n \ + |NN const char *s +rs |void |re_croak2 |NN const char* pat1|NN const char* pat2|... +Es |I32 |regpposixcc |NN struct RExC_state_t *pRExC_state|I32 value +Es |void |checkposixcc |NN struct RExC_state_t *pRExC_state +Es |I32 |make_trie |NN struct RExC_state_t *pRExC_state \ + |NN regnode *startbranch|NN regnode *first \ + |NN regnode *last|NN regnode *tail \ + |U32 word_count|U32 flags|U32 depth +Es |void |make_trie_failtable |NN struct RExC_state_t *pRExC_state \ + |NN regnode *source|NN regnode *stclass \ + |U32 depth +# ifdef DEBUGGING +Es |void |regdump_extflags|NULLOK const char *lead| const U32 flags +Es |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \ + |NN const regnode *node \ + |NULLOK const regnode *last \ + |NULLOK const regnode *plast \ + |NN SV* sv|I32 indent|U32 depth +Es |void |put_byte |NN SV* sv|int c +Es |void |dump_trie |NN const struct _reg_trie_data *trie\ + |NULLOK HV* widecharmap|NN AV *revcharmap\ + |U32 depth +Es |void |dump_trie_interim_list|NN const struct _reg_trie_data *trie\ + |NULLOK HV* widecharmap|NN AV *revcharmap\ + |U32 next_alloc|U32 depth +Es |void |dump_trie_interim_table|NN const struct _reg_trie_data *trie\ + |NULLOK HV* widecharmap|NN AV *revcharmap\ + |U32 next_alloc|U32 depth +Es |U8 |regtail_study |NN struct RExC_state_t *pRExC_state \ + |NN regnode *p|NN const regnode *val|U32 depth +# endif +#endif + +#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT) +ERs |I32 |regmatch |NN regmatch_info *reginfo|NN regnode *prog +ERs |I32 |regrepeat |NN const regexp *prog|NN const regnode *p|I32 max|int depth +ERs |I32 |regtry |NN regmatch_info *reginfo|NN char **startpos +ERs |bool |reginclass |NULLOK const regexp *prog|NN const regnode *n|NN const U8 *p|NULLOK STRLEN *lenp\ + |bool do_utf8sv_is_utf8 +Es |CHECKPOINT|regcppush |I32 parenfloor +Es |char* |regcppop |NN const regexp *rex +ERsn |U8* |reghop3 |NN U8 *s|I32 off|NN const U8 *lim +#ifdef XXX_dmq +ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN const U8 *llim \ + |NN const U8 *rlim +#endif +ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim +ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo +Es |void |swap_match_buff|NN regexp * prog +Es |void |to_utf8_substr |NN regexp * prog +Es |void |to_byte_substr |NN regexp * prog +ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \ + |NN const regnode *scan +# ifdef DEBUGGING +Es |void |dump_exec_pos |NN const char *locinput|NN const regnode *scan|NN const char *loc_regeol\ + |NN const char *loc_bostr|NN const char *loc_reg_starttry|const bool do_utf8 +Es |void |debug_start_match|NN const REGEXP *prog|const bool do_utf8\ + |NN const char *start|NN const char *end\ + |NN const char *blurb +# endif +#endif + +#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) +s |CV* |deb_curcv |const I32 ix +s |void |debprof |NN const OP *o +s |void |sequence |NULLOK const OP *o +s |void |sequence_tail |NULLOK const OP *o +s |UV |sequence_num |NULLOK const OP *o +s |SV* |pm_description |NN const PMOP *pm +#endif + +#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) +s |SV* |save_scalar_at |NN SV **sptr +#endif + +#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) +po |void |sv_add_backref |NN SV *const tsv|NN SV *const sv +#endif + +#if defined(PERL_IN_HV_C) || defined(PERL_IN_MG_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) +poM |int |sv_kill_backrefs |NN SV *const sv|NN AV *const av +#endif + +#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) +nsR |char * |uiv_2buf |NN char *const buf|const IV iv|UV uv|const int is_uv|NN char **const peob +s |void |sv_unglob |NN SV *const sv +s |void |not_a_number |NN SV *const sv +s |I32 |visit |NN SVFUNC_t f|const U32 flags|const U32 mask +s |void |sv_del_backref |NN SV *const tsv|NN SV *const sv +sR |SV * |varname |NULLOK GV *gv|const char gvtype|PADOFFSET targ \ + |NULLOK SV *keyname|I32 aindex|int subscript_type +# ifdef DEBUGGING +s |void |del_sv |NN SV *p +# endif +# if !defined(NV_PRESERVES_UV) +# ifdef DEBUGGING +s |int |sv_2iuv_non_preserve |NN SV *const sv|I32 numtype +# else +s |int |sv_2iuv_non_preserve |NN SV *const sv +# endif +# endif +sR |I32 |expect_number |NN char **const pattern +# +sn |STRLEN |sv_pos_u2b_forwards|NN const U8 *const start \ + |NN const U8 *const send|STRLEN uoffset +sn |STRLEN |sv_pos_u2b_midway|NN const U8 *const start \ + |NN const U8 *send|const STRLEN uoffset|const STRLEN uend +s |STRLEN |sv_pos_u2b_cached|NN SV *const sv|NN MAGIC **const mgp \ + |NN const U8 *const start|NN const U8 *const send \ + |const STRLEN uoffset|STRLEN uoffset0|STRLEN boffset0 +s |void |utf8_mg_pos_cache_update|NN SV *const sv|NN MAGIC **const mgp \ + |const STRLEN byte|const STRLEN utf8|const STRLEN blen +s |STRLEN |sv_pos_b2u_midway|NN const U8 *const s|NN const U8 *const target \ + |NN const U8 *end|STRLEN endu +sn |char * |F0convert |NV nv|NN char *const endbuf|NN STRLEN *const len +# if defined(PERL_OLD_COPY_ON_WRITE) +sM |void |sv_release_COW |NN SV *sv|NN const char *pvx|NN SV *after +# endif +s |SV * |more_sv +s |void * |more_bodies |const svtype sv_type +s |bool |sv_2iuv_common |NN SV *const sv +s |void |glob_assign_glob|NN SV *const dstr|NN SV *const sstr \ + |const int dtype +s |void |glob_assign_ref|NN SV *const dstr|NN SV *const sstr +sRn |PTR_TBL_ENT_t *|ptr_table_find|NN PTR_TBL_t *const tbl|NULLOK const void *const sv +#endif + +#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +s |void |check_uni +s |void |force_next |I32 type +s |char* |force_version |NN char *s|int guessing +s |char* |force_word |NN char *start|int token|int check_keyword \ + |int allow_pack|int allow_tick +s |SV* |tokeq |NN SV *sv +s |void |readpipe_override| +sR |char* |scan_const |NN char *start +sR |char* |scan_formline |NN char *s +sR |char* |scan_heredoc |NN char *s +s |char* |scan_ident |NN char *s|NN const char *send|NN char *dest \ + |STRLEN destlen|I32 ck_uni +sR |char* |scan_inputsymbol|NN char *start +sR |char* |scan_pat |NN char *start|I32 type +sR |char* |scan_str |NN char *start|int keep_quoted|int keep_delims +sR |char* |scan_subst |NN char *start +sR |char* |scan_trans |NN char *start +s |char* |scan_word |NN char *s|NN char *dest|STRLEN destlen \ + |int allow_package|NN STRLEN *slp +s |void |update_debugger_info|NULLOK SV *orig_sv \ + |NULLOK const char *const buf|STRLEN len +sR |char* |skipspace |NN char *s +sR |char* |swallow_bom |NN U8 *s +s |void |checkcomma |NN const char *s|NN const char *name \ + |NN const char *what +s |bool |feature_is_enabled|NN const char *const name|STRLEN namelen +s |void |force_ident |NN const char *s|int kind +s |void |incline |NN const char *s +s |int |intuit_method |NN char *s|NULLOK GV *gv|NULLOK CV *cv +s |int |intuit_more |NN char *s +s |I32 |lop |I32 f|int x|NN char *s +rs |void |missingterm |NULLOK char *s +s |void |no_op |NN const char *const what|NULLOK char *s +sR |I32 |sublex_done +sR |I32 |sublex_push +sR |I32 |sublex_start +sR |char * |filter_gets |NN SV *sv|NN PerlIO *fp|STRLEN append +sR |HV * |find_in_my_stash|NN const char *pkgname|STRLEN len +sR |char * |tokenize_use |int is_use|NN char *s +so |SV* |new_constant |NULLOK const char *s|STRLEN len \ + |NN const char *key|STRLEN keylen|NN SV *sv \ + |NULLOK SV *pv|NULLOK const char *type \ + |STRLEN typelen +s |int |ao |int toketype +# if defined(PERL_CR_FILTER) +s |I32 |cr_textfilter |int idx|NULLOK SV *sv|int maxlen +s |void |strip_return |NN SV *sv +# endif +# if defined(DEBUGGING) +s |int |tokereport |I32 rv|NN const YYSTYPE* lvalp +s |void |printbuf |NN const char *const fmt|NN const char *const s +# endif +#endif + +#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) +s |bool|isa_lookup |NULLOK HV *stash|NN const char * const name|NULLOK const HV * const name_stash +#endif + +#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT) +#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE) +s |char* |stdize_locale |NN char* locs +#endif +#endif + +#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +s |const COP*|closest_cop |NN const COP *cop|NULLOK const OP *o +s |SV* |mess_alloc +s |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args \ + |NULLOK STRLEN *msglen|NULLOK I32* utf8 +s |bool |vdie_common |NULLOK const char *message|STRLEN msglen\ + |I32 utf8|bool warn +sr |char * |write_no_mem +#endif + +#if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT) +sn |NV|mulexp10 |NV value|I32 exponent +#endif + +#if defined(PERL_IN_UTF8_C) || defined(PERL_DECL_PROT) +sRn |STRLEN |is_utf8_char_slow|NN const U8 *s|const STRLEN len +sR |bool |is_utf8_common |NN const U8 *const p|NN SV **swash|NN const char * const swashname +sR |SV* |swash_get |NN SV* swash|UV start|UV span +#endif + +START_EXTERN_C + +Apd |void |sv_setsv_flags |NN SV *dstr|NULLOK SV *sstr|const I32 flags +Apd |void |sv_catpvn_flags|NN SV *const dstr|NN const char *sstr|const STRLEN len \ + |const I32 flags +Apd |void |sv_catsv_flags |NN SV *const dsv|NULLOK SV *const ssv|const I32 flags +Apd |STRLEN |sv_utf8_upgrade_flags|NN SV *const sv|const I32 flags +Apd |char* |sv_pvn_force_flags|NN SV *const sv|NULLOK STRLEN *const lp|const I32 flags +Apd |void |sv_copypv |NN SV *const dsv|NN SV *const ssv +Ap |char* |my_atof2 |NN const char *s|NN NV* value +Apn |int |my_socketpair |int family|int type|int protocol|int fd[2] +Ap |int |my_dirfd |NULLOK DIR* dir +#ifdef PERL_OLD_COPY_ON_WRITE +pMXE |SV* |sv_setsv_cow |NN SV* dstr|NN SV* sstr +#endif + +Aop |const char *|PerlIO_context_layers|NULLOK const char *mode + +#if defined(USE_PERLIO) && !defined(USE_SFIO) +Ap |int |PerlIO_close |NULLOK PerlIO *f +Ap |int |PerlIO_fill |NULLOK PerlIO *f +Ap |int |PerlIO_fileno |NULLOK PerlIO *f +Ap |int |PerlIO_eof |NULLOK PerlIO *f +Ap |int |PerlIO_error |NULLOK PerlIO *f +Ap |int |PerlIO_flush |NULLOK PerlIO *f +Ap |void |PerlIO_clearerr |NULLOK PerlIO *f +Ap |void |PerlIO_set_cnt |NULLOK PerlIO *f|int cnt +Ap |void |PerlIO_set_ptrcnt |NULLOK PerlIO *f|NULLOK STDCHAR *ptr \ + |int cnt +Ap |void |PerlIO_setlinebuf |NULLOK PerlIO *f +Ap |SSize_t|PerlIO_read |NULLOK PerlIO *f|NN void *vbuf \ + |Size_t count +Ap |SSize_t|PerlIO_write |NULLOK PerlIO *f|NN const void *vbuf \ + |Size_t count +Ap |SSize_t|PerlIO_unread |NULLOK PerlIO *f|NN const void *vbuf \ + |Size_t count +Ap |Off_t |PerlIO_tell |NULLOK PerlIO *f +Ap |int |PerlIO_seek |NULLOK PerlIO *f|Off_t offset|int whence + +Ap |STDCHAR *|PerlIO_get_base |NULLOK PerlIO *f +Ap |STDCHAR *|PerlIO_get_ptr |NULLOK PerlIO *f +ApR |int |PerlIO_get_bufsiz |NULLOK PerlIO *f +ApR |int |PerlIO_get_cnt |NULLOK PerlIO *f + +ApR |PerlIO *|PerlIO_stdin +ApR |PerlIO *|PerlIO_stdout +ApR |PerlIO *|PerlIO_stderr +#endif /* PERLIO_LAYERS */ + +p |void |deb_stack_all +#ifdef PERL_IN_DEB_C +s |void |deb_stack_n |NN SV** stack_base|I32 stack_min \ + |I32 stack_max|I32 mark_min|I32 mark_max +#endif + +pda |PADLIST*|pad_new |int flags +pd |void |pad_undef |NN CV* cv +pd |PADOFFSET|pad_add_name |NN const char *name\ + |NULLOK HV* typestash|NULLOK HV* ourstash|bool clone|bool state +pd |PADOFFSET|pad_add_anon |NN SV* sv|OPCODE op_type +pd |void |pad_check_dup |NN const char* name|bool is_our|NN const HV* ourstash +#ifdef DEBUGGING +pd |void |pad_setsv |PADOFFSET po|NN SV* sv +#endif +pd |void |pad_block_start|int full +pd |void |pad_tidy |padtidy_type type +pd |void |do_dump_pad |I32 level|NN PerlIO *file|NULLOK PADLIST *padlist|int full +pd |void |pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv + +pdX |void |pad_push |NN PADLIST *padlist|int depth +pR |HV* |pad_compname_type|const PADOFFSET po + +#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) +sd |PADOFFSET|pad_findlex |NN const char *name|NN const CV* cv|U32 seq|int warn \ + |NULLOK SV** out_capture|NN SV** out_name_sv \ + |NN int *out_flags +# if defined(DEBUGGING) +sd |void |cv_dump |NN const CV *cv|NN const char *title +# endif +#endif +ApdR |CV* |find_runcv |NULLOK U32 *db_seqp +p |void |free_tied_hv_pool +#if defined(DEBUGGING) +pR |int |get_debug_opts |NN const char **s|bool givehelp +#endif +Ap |void |save_set_svflags|NN SV *sv|U32 mask|U32 val +Apod |void |hv_assert |NN HV *hv + +ApdR |SV* |hv_scalar |NN HV *hv +ApoR |I32* |hv_riter_p |NN HV *hv +ApoR |HE** |hv_eiter_p |NN HV *hv +Apo |void |hv_riter_set |NN HV *hv|I32 riter +Apo |void |hv_eiter_set |NN HV *hv|NULLOK HE *eiter +Ap |void |hv_name_set |NN HV *hv|NULLOK const char *name|U32 len|U32 flags +poM |AV** |hv_backreferences_p |NN HV *hv +#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) +poM |void |hv_kill_backrefs |NN HV *hv +#endif +Apd |void |hv_clear_placeholders |NN HV *hv +ApoR |I32* |hv_placeholders_p |NN HV *hv +ApoR |I32 |hv_placeholders_get |NN HV *hv +Apo |void |hv_placeholders_set |NN HV *hv|I32 ph + +p |SV* |magic_scalarpack|NN HV *hv|NN MAGIC *mg + +#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) +s |SV * |find_hash_subscript|NULLOK HV *hv|NN SV *val +s |I32 |find_array_subscript|NULLOK AV *av|NN SV *val +sMd |SV* |find_uninit_var|NULLOK OP* obase|NULLOK SV* uninit_sv|bool top +#endif + +#ifdef PERL_NEED_MY_HTOLE16 +np |U16 |my_htole16 |U16 n +#endif +#ifdef PERL_NEED_MY_LETOH16 +np |U16 |my_letoh16 |U16 n +#endif +#ifdef PERL_NEED_MY_HTOBE16 +np |U16 |my_htobe16 |U16 n +#endif +#ifdef PERL_NEED_MY_BETOH16 +np |U16 |my_betoh16 |U16 n +#endif +#ifdef PERL_NEED_MY_HTOLE32 +np |U32 |my_htole32 |U32 n +#endif +#ifdef PERL_NEED_MY_LETOH32 +np |U32 |my_letoh32 |U32 n +#endif +#ifdef PERL_NEED_MY_HTOBE32 +np |U32 |my_htobe32 |U32 n +#endif +#ifdef PERL_NEED_MY_BETOH32 +np |U32 |my_betoh32 |U32 n +#endif +#ifdef PERL_NEED_MY_HTOLE64 +np |U64 |my_htole64 |U64 n +#endif +#ifdef PERL_NEED_MY_LETOH64 +np |U64 |my_letoh64 |U64 n +#endif +#ifdef PERL_NEED_MY_HTOBE64 +np |U64 |my_htobe64 |U64 n +#endif +#ifdef PERL_NEED_MY_BETOH64 +np |U64 |my_betoh64 |U64 n +#endif + +#ifdef PERL_NEED_MY_HTOLES +np |short |my_htoles |short n +#endif +#ifdef PERL_NEED_MY_LETOHS +np |short |my_letohs |short n +#endif +#ifdef PERL_NEED_MY_HTOBES +np |short |my_htobes |short n +#endif +#ifdef PERL_NEED_MY_BETOHS +np |short |my_betohs |short n +#endif +#ifdef PERL_NEED_MY_HTOLEI +np |int |my_htolei |int n +#endif +#ifdef PERL_NEED_MY_LETOHI +np |int |my_letohi |int n +#endif +#ifdef PERL_NEED_MY_HTOBEI +np |int |my_htobei |int n +#endif +#ifdef PERL_NEED_MY_BETOHI +np |int |my_betohi |int n +#endif +#ifdef PERL_NEED_MY_HTOLEL +np |long |my_htolel |long n +#endif +#ifdef PERL_NEED_MY_LETOHL +np |long |my_letohl |long n +#endif +#ifdef PERL_NEED_MY_HTOBEL +np |long |my_htobel |long n +#endif +#ifdef PERL_NEED_MY_BETOHL +np |long |my_betohl |long n +#endif + +np |void |my_swabn |NN void* ptr|int n + +Ap |GV* |gv_fetchpvn_flags|NN const char* name|STRLEN len|I32 flags|const svtype sv_type +Ap |GV* |gv_fetchsv|NN SV *name|I32 flags|const svtype sv_type +dpR |bool |is_gv_magical_sv|NN SV *name|U32 flags + +ApR |bool |stashpv_hvname_match|NN const COP *c|NN const HV *hv + +#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP +p |void |dump_sv_child |NN SV *sv +#endif + +#ifdef PERL_DONT_CREATE_GVSV +Ap |GV* |gv_SVadd |NN GV* gv +#endif +Apo |bool |ckwarn |U32 w +Apo |bool |ckwarn_d |U32 w +XEopMa |STRLEN *|new_warnings_bitfield|NULLOK STRLEN *buffer \ + |NN const char *const bits|STRLEN size + +p |void |offer_nice_chunk |NN void *const chunk|const U32 chunk_size + +#ifndef SPRINTF_RETURNS_STRLEN +Apnod |int |my_sprintf |NN char *buffer|NN const char *pat|... +#endif + +Apnodf |int |my_snprintf |NN char *buffer|const Size_t len|NN const char *format|... +Apnod |int |my_vsnprintf |NN char *buffer|const Size_t len|NN const char *format|va_list ap + +px |void |my_clearenv + +#ifdef PERL_IMPLICIT_CONTEXT +#ifdef PERL_GLOBAL_STRUCT_PRIVATE +Apo |void* |my_cxt_init |NN const char *my_cxt_key|size_t size +Apo |int |my_cxt_index |NN const char *my_cxt_key +#else +Apo |void* |my_cxt_init |NN int *index|size_t size +#endif +#endif + +#ifndef HAS_STRLCAT +Apno |Size_t |my_strlcat |NULLOK char *dst|NULLOK const char *src|Size_t size +#endif + +#ifndef HAS_STRLCPY +Apno |Size_t |my_strlcpy |NULLOK char *dst|NULLOK const char *src|Size_t size +#endif + +#ifdef PERL_MAD +Mnp |void |pad_peg |NN const char* s +#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) +sf |void |xmldump_attr |I32 level|NN PerlIO *file|NN const char* pat \ + |... +#endif +Mfp |void |xmldump_indent |I32 level|NN PerlIO *file|NN const char* pat \ + |... +Mp |void |xmldump_vindent|I32 level|NN PerlIO *file|NN const char* pat \ + |NULLOK va_list *args +Mp |void |xmldump_all +Mp |void |xmldump_packsubs |NN const HV* stash +Mp |void |xmldump_sub |NN const GV* gv +Mp |void |xmldump_form |NN const GV* gv +Mp |void |xmldump_eval +Mp |char* |sv_catxmlsv |NN SV *dsv|NN SV *ssv +Mp |char* |sv_catxmlpvn |NN SV *dsv|NN const char *pv|STRLEN len|int utf8 +Mp |char* |sv_xmlpeek |NN SV* sv +Mp |void |do_pmop_xmldump|I32 level|NN PerlIO *file \ + |NULLOK const PMOP *pm +Mp |void |pmop_xmldump |NULLOK const PMOP* pm +Mp |void |do_op_xmldump |I32 level|NN PerlIO *file|NULLOK const OP *o +Mp |void |op_xmldump |NN const OP *o + +Mp |TOKEN* |newTOKEN |I32 optype|YYSTYPE lval \ + |NULLOK MADPROP* madprop +Mp |void |token_free |NN TOKEN *tk +Mp |void |token_getmad |NN TOKEN *tk|NULLOK OP *o|char slot +Mp |void |op_getmad_weak |NULLOK OP* from|NULLOK OP* o|char slot +Mp |void |op_getmad |NULLOK OP* from|NULLOK OP* o|char slot +Mp |void |prepend_madprops|NULLOK MADPROP* mp|NULLOK OP* o|char slot +Mp |void |append_madprops|NULLOK MADPROP* tm|NULLOK OP* o|char slot +Mp |void |addmad |NULLOK MADPROP* tm|NULLOK MADPROP** root \ + |char slot +Mp |MADPROP*|newMADsv |char key|NN SV* sv +Mp |MADPROP*|newMADPROP |char key|char type|NULLOK const void* val \ + |I32 vlen +Mp |void |mad_free |NULLOK MADPROP* mp + +# if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +s |char* |skipspace0 |NN char *s +s |char* |skipspace1 |NN char *s +s |char* |skipspace2 |NN char *s|NULLOK SV **sv +s |void |start_force |int where +s |void |curmad |char slot|NULLOK SV *sv +# endif +Mp |int |madlex +Mp |int |madparse +#endif +#if !defined(HAS_SIGNBIT) +AMdnoP |int |Perl_signbit |NV f +#endif + +XEMop |void |emulate_cop_io |NN const COP *const c|NN SV *const sv +XEMop |REGEXP *|get_re_arg|NULLOK SV *sv + +p |struct mro_meta* |mro_meta_init |NN HV* stash +#if defined(USE_ITHREADS) +p |struct mro_meta* |mro_meta_dup |NN struct mro_meta* smeta|NN CLONE_PARAMS* param +#endif +Apd |AV* |mro_get_linear_isa|NN HV* stash +#if defined(PERL_IN_MRO_C) || defined(PERL_DECL_PROT) +sd |AV* |mro_get_linear_isa_c3|NN HV* stash|I32 level +sd |AV* |mro_get_linear_isa_dfs|NN HV* stash|I32 level +#endif +pd |void |mro_isa_changed_in|NN HV* stash +Apd |void |mro_method_changed_in |NN HV* stash +p |void |boot_core_mro +Apon |void |sys_init |NN int* argc|NN char*** argv +Apon |void |sys_init3 |NN int* argc|NN char*** argv|NN char*** env +Apon |void |sys_term +ApoM |const char *|fetch_cop_label|NULLOK struct refcounted_he *const chain \ + |NULLOK STRLEN *len|NULLOK U32 *flags +xpoM |struct refcounted_he *|store_cop_label \ + |NULLOK struct refcounted_he *const chain|NN const char *label + +END_EXTERN_C +/* + * ex: set ts=8 sts=4 sw=4 noet: + */ diff --git a/ext/Devel-PPPort/parts/inc/MY_CXT b/ext/Devel-PPPort/parts/inc/MY_CXT new file mode 100644 index 0000000000..d67af01377 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/MY_CXT @@ -0,0 +1,192 @@ +################################################################################ +## +## $Revision: 16 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +START_MY_CXT +dMY_CXT_SV +dMY_CXT +MY_CXT_INIT +MY_CXT_CLONE +MY_CXT +pMY_CXT +pMY_CXT_ +_pMY_CXT +aMY_CXT +aMY_CXT_ +_aMY_CXT + +=implementation + +/* + * Boilerplate macros for initializing and accessing interpreter-local + * data from C. All statics in extensions should be reworked to use + * this, if you want to make the extension thread-safe. See ext/re/re.xs + * for an example of the use of these macros. + * + * Code that uses these macros is responsible for the following: + * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" + * 2. Declare a typedef named my_cxt_t that is a structure that contains + * all the data that needs to be interpreter-local. + * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. + * 4. Use the MY_CXT_INIT macro such that it is called exactly once + * (typically put in the BOOT: section). + * 5. Use the members of the my_cxt_t structure everywhere as + * MY_CXT.member. + * 6. Use the dMY_CXT macro (a declaration) in all the functions that + * access MY_CXT. + */ + +#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ + defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) + +#ifndef START_MY_CXT + +/* This must appear in all extensions that define a my_cxt_t structure, + * right after the definition (i.e. at file scope). The non-threads + * case below uses it to declare the data as static. */ +#define START_MY_CXT + +#if { VERSION < 5.004_68 } +/* Fetches the SV that keeps the per-interpreter data. */ +#define dMY_CXT_SV \ + SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) +#else /* >= perl5.004_68 */ +#define dMY_CXT_SV \ + SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ + sizeof(MY_CXT_KEY)-1, TRUE) +#endif /* < perl5.004_68 */ + +/* This declaration should be used within all functions that use the + * interpreter-local data. */ +#define dMY_CXT \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) + +/* Creates and zeroes the per-interpreter data. + * (We allocate my_cxtp in a Perl SV so that it will be released when + * the interpreter goes away.) */ +#define MY_CXT_INIT \ + dMY_CXT_SV; \ + /* newSV() allocates one more than needed */ \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Zero(my_cxtp, 1, my_cxt_t); \ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + +/* This macro must be used to access members of the my_cxt_t structure. + * e.g. MYCXT.some_data */ +#define MY_CXT (*my_cxtp) + +/* Judicious use of these macros can reduce the number of times dMY_CXT + * is used. Use is similar to pTHX, aTHX etc. */ +#define pMY_CXT my_cxt_t *my_cxtp +#define pMY_CXT_ pMY_CXT, +#define _pMY_CXT ,pMY_CXT +#define aMY_CXT my_cxtp +#define aMY_CXT_ aMY_CXT, +#define _aMY_CXT ,aMY_CXT + +#endif /* START_MY_CXT */ + +#ifndef MY_CXT_CLONE +/* Clones the per-interpreter data. */ +#define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +#endif + +#else /* single interpreter */ + +#ifndef START_MY_CXT + +#define START_MY_CXT static my_cxt_t my_cxt; +#define dMY_CXT_SV dNOOP +#define dMY_CXT dNOOP +#define MY_CXT_INIT NOOP +#define MY_CXT my_cxt + +#define pMY_CXT void +#define pMY_CXT_ +#define _pMY_CXT +#define aMY_CXT +#define aMY_CXT_ +#define _aMY_CXT + +#endif /* START_MY_CXT */ + +#ifndef MY_CXT_CLONE +#define MY_CXT_CLONE NOOP +#endif + +#endif + +=xsmisc + +#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION + +typedef struct { + /* Put Global Data in here */ + int dummy; +} my_cxt_t; + +START_MY_CXT + +=xsboot + +{ + MY_CXT_INIT; + /* If any of the fields in the my_cxt_t struct need + * to be initialised, do it here. + */ + MY_CXT.dummy = 42; +} + +=xsubs + +int +MY_CXT_1() + CODE: + dMY_CXT; + RETVAL = MY_CXT.dummy == 42; + ++MY_CXT.dummy; + OUTPUT: + RETVAL + +int +MY_CXT_2() + CODE: + dMY_CXT; + RETVAL = MY_CXT.dummy == 43; + OUTPUT: + RETVAL + +int +MY_CXT_CLONE() + CODE: + MY_CXT_CLONE; + RETVAL = 42; + OUTPUT: + RETVAL + +=tests plan => 3 + +ok(&Devel::PPPort::MY_CXT_1()); +ok(&Devel::PPPort::MY_CXT_2()); +ok(&Devel::PPPort::MY_CXT_CLONE()); + diff --git a/ext/Devel-PPPort/parts/inc/SvPV b/ext/Devel-PPPort/parts/inc/SvPV new file mode 100644 index 0000000000..e81fb684c1 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/SvPV @@ -0,0 +1,524 @@ +################################################################################ +## +## $Revision: 22 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ +SvPVbyte +sv_2pvbyte +sv_2pv_flags +sv_pvn_force_flags + +=dontwarn + +NEED_sv_2pv_flags +NEED_sv_2pv_flags_GLOBAL +DPPP_SVPV_NOLEN_LP_ARG + +=implementation + +/* Backwards compatibility stuff... :-( */ +#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen) +# define NEED_sv_2pv_flags +#endif +#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL) +# define NEED_sv_2pv_flags_GLOBAL +#endif + +/* Hint: sv_2pv_nolen + * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen(). + */ + +__UNDEFINED__ sv_2pv_nolen(sv) SvPV_nolen(sv) + +#ifdef SvPVbyte + +/* Hint: SvPVbyte + * Does not work in perl-5.6.1, ppport.h implements a version + * borrowed from perl-5.7.3. + */ + +#if { VERSION < 5.7.0 } + +#if { NEED sv_2pvbyte } + +char * +sv_2pvbyte(pTHX_ SV *sv, STRLEN *lp) +{ + sv_utf8_downgrade(sv,0); + return SvPV(sv,*lp); +} + +#endif + +/* Hint: sv_2pvbyte + * Use the SvPVbyte() macro instead of sv_2pvbyte(). + */ + +#undef SvPVbyte + +#define SvPVbyte(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) + +#endif + +#else + +# define SvPVbyte SvPV +# define sv_2pvbyte sv_2pv + +#endif + +__UNDEFINED__ sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv) + +/* Hint: sv_pvn + * Always use the SvPV() macro instead of sv_pvn(). + */ + +/* Hint: sv_pvn_force + * Always use the SvPV_force() macro instead of sv_pvn_force(). + */ + +/* If these are undefined, they're not handled by the core anyway */ +__UNDEFINED__ SV_IMMEDIATE_UNREF 0 +__UNDEFINED__ SV_GMAGIC 0 +__UNDEFINED__ SV_COW_DROP_PV 0 +__UNDEFINED__ SV_UTF8_NO_ENCODING 0 +__UNDEFINED__ SV_NOSTEAL 0 +__UNDEFINED__ SV_CONST_RETURN 0 +__UNDEFINED__ SV_MUTABLE_RETURN 0 +__UNDEFINED__ SV_SMAGIC 0 +__UNDEFINED__ SV_HAS_TRAILING_NUL 0 +__UNDEFINED__ SV_COW_SHARED_HASH_KEYS 0 + +#if { VERSION < 5.7.2 } + +#if { NEED sv_2pv_flags } + +char * +sv_2pv_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) +{ + STRLEN n_a = (STRLEN) flags; + return sv_2pv(sv, lp ? lp : &n_a); +} + +#endif + +#if { NEED sv_pvn_force_flags } + +char * +sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) +{ + STRLEN n_a = (STRLEN) flags; + return sv_pvn_force(sv, lp ? lp : &n_a); +} + +#endif + +#endif + +#if { VERSION < 5.8.8 } || ( { VERSION >= 5.9.0 } && { VERSION < 5.9.3 } ) +# define DPPP_SVPV_NOLEN_LP_ARG &PL_na +#else +# define DPPP_SVPV_NOLEN_LP_ARG 0 +#endif + +__UNDEFINED__ SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) +__UNDEFINED__ SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC) + +__UNDEFINED__ SvPV_flags(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) + +__UNDEFINED__ SvPV_flags_const(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ + (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN)) + +__UNDEFINED__ SvPV_flags_const_nolen(sv, flags) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX_const(sv) : \ + (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN)) + +__UNDEFINED__ SvPV_flags_mutable(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ + sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) + +__UNDEFINED__ SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC) +__UNDEFINED__ SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC) +__UNDEFINED__ SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC) +__UNDEFINED__ SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0) +__UNDEFINED__ SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) + +__UNDEFINED__ SvPV_force_flags(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) + +__UNDEFINED__ SvPV_force_flags_nolen(sv, flags) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ + ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags)) + +__UNDEFINED__ SvPV_force_flags_mutable(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ + : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) + +__UNDEFINED__ SvPV_nolen(sv) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC)) + +__UNDEFINED__ SvPV_nolen_const(sv) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN)) + +__UNDEFINED__ SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) +__UNDEFINED__ SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0) +__UNDEFINED__ SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0) + +__UNDEFINED__ SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \ + SvPV_set((sv), (char *) saferealloc( \ + (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \ + } STMT_END + +=xsinit + +#define NEED_sv_2pv_flags +#define NEED_sv_pvn_force_flags +#define NEED_sv_2pvbyte + +=xsubs + +IV +SvPVbyte(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPVbyte(sv, len); + RETVAL = strEQ(str, "mhx") ? (IV) len : (IV) -1; + OUTPUT: + RETVAL + +IV +SvPV_nolen(sv) + SV *sv + PREINIT: + char *str; + CODE: + str = SvPV_nolen(sv); + RETVAL = strEQ(str, "mhx") ? 42 : 0; + OUTPUT: + RETVAL + +IV +SvPV_const(sv) + SV *sv + PREINIT: + const char *str; + STRLEN len; + CODE: + str = SvPV_const(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 40 : 0); + OUTPUT: + RETVAL + +IV +SvPV_mutable(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_mutable(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 41 : 0); + OUTPUT: + RETVAL + +IV +SvPV_flags(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_flags(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 42 : 0); + OUTPUT: + RETVAL + +IV +SvPV_flags_const(sv) + SV *sv + PREINIT: + const char *str; + STRLEN len; + CODE: + str = SvPV_flags_const(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 43 : 0); + OUTPUT: + RETVAL + +IV +SvPV_flags_const_nolen(sv) + SV *sv + PREINIT: + const char *str; + CODE: + str = SvPV_flags_const_nolen(sv, SV_GMAGIC); + RETVAL = strEQ(str, "mhx") ? 47 : 0; + OUTPUT: + RETVAL + +IV +SvPV_flags_mutable(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_flags_mutable(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 45 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 46 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force_nolen(sv) + SV *sv + PREINIT: + char *str; + CODE: + str = SvPV_force_nolen(sv); + RETVAL = strEQ(str, "mhx") ? 50 : 0; + OUTPUT: + RETVAL + +IV +SvPV_force_mutable(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force_mutable(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 48 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force_nomg(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force_nomg(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 49 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force_nomg_nolen(sv) + SV *sv + PREINIT: + char *str; + CODE: + str = SvPV_force_nomg_nolen(sv); + RETVAL = strEQ(str, "mhx") ? 53 : 0; + OUTPUT: + RETVAL + +IV +SvPV_force_flags(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force_flags(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 51 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force_flags_nolen(sv) + SV *sv + PREINIT: + char *str; + CODE: + str = SvPV_force_flags_nolen(sv, SV_GMAGIC); + RETVAL = strEQ(str, "mhx") ? 55 : 0; + OUTPUT: + RETVAL + +IV +SvPV_force_flags_mutable(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force_flags_mutable(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 53 : 0); + OUTPUT: + RETVAL + +IV +SvPV_nolen_const(sv) + SV *sv + PREINIT: + const char *str; + CODE: + str = SvPV_nolen_const(sv); + RETVAL = strEQ(str, "mhx") ? 57 : 0; + OUTPUT: + RETVAL + +IV +SvPV_nomg(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_nomg(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 55 : 0); + OUTPUT: + RETVAL + +IV +SvPV_nomg_const(sv) + SV *sv + PREINIT: + const char *str; + STRLEN len; + CODE: + str = SvPV_nomg_const(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 56 : 0); + OUTPUT: + RETVAL + +IV +SvPV_nomg_const_nolen(sv) + SV *sv + PREINIT: + const char *str; + CODE: + str = SvPV_nomg_const_nolen(sv); + RETVAL = strEQ(str, "mhx") ? 60 : 0; + OUTPUT: + RETVAL + +void +SvPV_renew(sv, nlen, insv) + SV *sv + IV nlen + SV *insv + PREINIT: + STRLEN slen; + const char *str; + PPCODE: + str = SvPV_const(insv, slen); + XPUSHs(sv); + mXPUSHi(SvLEN(sv)); + SvPV_renew(sv, nlen); + Copy(str, SvPVX(sv), slen + 1, char); + SvCUR_set(sv, slen); + mXPUSHi(SvLEN(sv)); + + +=tests plan => 47 + +my $mhx = "mhx"; + +ok(&Devel::PPPort::SvPVbyte($mhx), 3); + +my $i = 42; + +ok(&Devel::PPPort::SvPV_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++); + +ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_force($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0); + +my $str = ""; +my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80); +ok($str, "x"x80); +ok($s2, "x"x80); +ok($before < 81); +ok($after, 81); + +$str = "x"x400; +($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40); +ok($str, "x"x40); +ok($s2, "x"x40); +ok($before > 41); +ok($after, 41); diff --git a/ext/Devel-PPPort/parts/inc/SvREFCNT b/ext/Devel-PPPort/parts/inc/SvREFCNT new file mode 100644 index 0000000000..46c5deb356 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/SvREFCNT @@ -0,0 +1,130 @@ +################################################################################ +## +## $Revision: 5 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +SvREFCNT_inc +SvREFCNT_inc_simple +SvREFCNT_inc_NN +SvREFCNT_inc_void +__UNDEFINED__ + +=implementation + +#ifndef SvREFCNT_inc +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + if (_sv) \ + (SvREFCNT(_sv))++; \ + _sv; \ + }) +# else +# define SvREFCNT_inc(sv) \ + ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL) +# endif +#endif + +#ifndef SvREFCNT_inc_simple +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_simple(sv) \ + ({ \ + if (sv) \ + (SvREFCNT(sv))++; \ + (SV *)(sv); \ + }) +# else +# define SvREFCNT_inc_simple(sv) \ + ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL) +# endif +#endif + +#ifndef SvREFCNT_inc_NN +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_NN(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + SvREFCNT(_sv)++; \ + _sv; \ + }) +# else +# define SvREFCNT_inc_NN(sv) \ + (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv) +# endif +#endif + +#ifndef SvREFCNT_inc_void +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_void(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + if (_sv) \ + (void)(SvREFCNT(_sv)++); \ + }) +# else +# define SvREFCNT_inc_void(sv) \ + (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0) +# endif +#endif + +__UNDEFINED__ SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END +__UNDEFINED__ SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv)) +__UNDEFINED__ SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) +__UNDEFINED__ SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) + +=xsubs + +void +SvREFCNT() + PREINIT: + SV *sv, *svr; + PPCODE: + sv = newSV(0); + mXPUSHi(SvREFCNT(sv) == 1); + svr = SvREFCNT_inc(sv); + mXPUSHi(sv == svr); + mXPUSHi(SvREFCNT(sv) == 2); + svr = SvREFCNT_inc_simple(sv); + mXPUSHi(sv == svr); + mXPUSHi(SvREFCNT(sv) == 3); + svr = SvREFCNT_inc_NN(sv); + mXPUSHi(sv == svr); + mXPUSHi(SvREFCNT(sv) == 4); + svr = SvREFCNT_inc_simple_NN(sv); + mXPUSHi(sv == svr); + mXPUSHi(SvREFCNT(sv) == 5); + SvREFCNT_inc_void(sv); + mXPUSHi(SvREFCNT(sv) == 6); + SvREFCNT_inc_simple_void(sv); + mXPUSHi(SvREFCNT(sv) == 7); + SvREFCNT_inc_void_NN(sv); + mXPUSHi(SvREFCNT(sv) == 8); + SvREFCNT_inc_simple_void_NN(sv); + mXPUSHi(SvREFCNT(sv) == 9); + while (SvREFCNT(sv) > 1) + SvREFCNT_dec(sv); + mXPUSHi(SvREFCNT(sv) == 1); + SvREFCNT_dec(sv); + XSRETURN(14); + +=tests plan => 14 + +for (Devel::PPPort::SvREFCNT()) { + ok(defined $_ and $_); +} + diff --git a/ext/Devel-PPPort/parts/inc/Sv_set b/ext/Devel-PPPort/parts/inc/Sv_set new file mode 100644 index 0000000000..95cf2d672e --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/Sv_set @@ -0,0 +1,124 @@ +################################################################################ +## +## $Revision: 7 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +__UNDEFINED__ SvMAGIC_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ + (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END + +#if { VERSION < 5.9.3 } + +__UNDEFINED__ SvPVX_const(sv) ((const char*) (0 + SvPVX(sv))) +__UNDEFINED__ SvPVX_mutable(sv) (0 + SvPVX(sv)) + +__UNDEFINED__ SvRV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ + (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END + +#else + +__UNDEFINED__ SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) +__UNDEFINED__ SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) + +__UNDEFINED__ SvRV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ + ((sv)->sv_u.svu_rv = (val)); } STMT_END + +#endif + +__UNDEFINED__ SvSTASH_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ + (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END + +#if { VERSION < 5.004 } + +__UNDEFINED__ SvUV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ + (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END + +#else + +__UNDEFINED__ SvUV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ + (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END + +#endif + +=xsubs + +IV +TestSvUV_set(sv, val) + SV *sv + UV val + CODE: + SvUV_set(sv, val); + RETVAL = SvUVX(sv) == val ? 42 : -1; + OUTPUT: + RETVAL + +IV +TestSvPVX_const(sv) + SV *sv + CODE: + RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1; + OUTPUT: + RETVAL + +IV +TestSvPVX_mutable(sv) + SV *sv + CODE: + RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1; + OUTPUT: + RETVAL + +void +TestSvSTASH_set(sv, name) + SV *sv + char *name + CODE: + sv = SvRV(sv); + SvREFCNT_dec(SvSTASH(sv)); + SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0))); + +=tests plan => 5 + +my $foo = 5; +ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42); +ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43); +ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44); + +my $bar = []; + +bless $bar, 'foo'; +ok($bar->x(), 'foobar'); + +Devel::PPPort::TestSvSTASH_set($bar, 'bar'); +ok($bar->x(), 'hacker'); + +package foo; + +sub x { 'foobar' } + +package bar; + +sub x { 'hacker' } diff --git a/ext/Devel-PPPort/parts/inc/call b/ext/Devel-PPPort/parts/inc/call new file mode 100644 index 0000000000..85159e22a8 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/call @@ -0,0 +1,367 @@ +################################################################################ +## +## $Revision: 19 $ +## $Author: mhx $ +## $Date: 2009/01/23 18:27:48 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +eval_pv +eval_sv +call_sv +call_pv +call_argv +call_method +load_module +vload_module +G_METHOD + +=implementation + +/* Replace: 1 */ +__UNDEFINED__ call_sv perl_call_sv +__UNDEFINED__ call_pv perl_call_pv +__UNDEFINED__ call_argv perl_call_argv +__UNDEFINED__ call_method perl_call_method + +__UNDEFINED__ eval_sv perl_eval_sv +/* Replace: 0 */ + +__UNDEFINED__ PERL_LOADMOD_DENY 0x1 +__UNDEFINED__ PERL_LOADMOD_NOIMPORT 0x2 +__UNDEFINED__ PERL_LOADMOD_IMPORT_OPS 0x4 + +#ifndef G_METHOD +# define G_METHOD 64 +# ifdef call_sv +# undef call_sv +# endif +# if { VERSION < 5.6.0 } +# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \ + (flags) & ~G_METHOD) : perl_call_sv(sv, flags)) +# else +# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \ + (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags)) +# endif +#endif + +/* Replace perl_eval_pv with eval_pv */ + +#ifndef eval_pv +#if { NEED eval_pv } + +SV* +eval_pv(char *p, I32 croak_on_error) +{ + dSP; + SV* sv = newSVpv(p, 0); + + PUSHMARK(sp); + eval_sv(sv, G_SCALAR); + SvREFCNT_dec(sv); + + SPAGAIN; + sv = POPs; + PUTBACK; + + if (croak_on_error && SvTRUE(GvSV(errgv))) + croak(SvPVx(GvSV(errgv), na)); + + return sv; +} + +#endif +#endif + +#ifndef vload_module +#if { NEED vload_module } + +void +vload_module(U32 flags, SV *name, SV *ver, va_list *args) +{ + dTHR; + dVAR; + OP *veop, *imop; + + OP * const modname = newSVOP(OP_CONST, 0, name); + /* 5.005 has a somewhat hacky force_normal that doesn't croak on + SvREADONLY() if PL_compling is true. Current perls take care in + ck_require() to correctly turn off SvREADONLY before calling + force_normal_flags(). This seems a better fix than fudging PL_compling + */ + SvREADONLY_off(((SVOP*)modname)->op_sv); + modname->op_private |= OPpCONST_BARE; + if (ver) { + veop = newSVOP(OP_CONST, 0, ver); + } + else + veop = NULL; + if (flags & PERL_LOADMOD_NOIMPORT) { + imop = sawparens(newNULLLIST()); + } + else if (flags & PERL_LOADMOD_IMPORT_OPS) { + imop = va_arg(*args, OP*); + } + else { + SV *sv; + imop = NULL; + sv = va_arg(*args, SV*); + while (sv) { + imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv)); + sv = va_arg(*args, SV*); + } + } + { + const line_t ocopline = PL_copline; + COP * const ocurcop = PL_curcop; + const int oexpect = PL_expect; + +#if { VERSION >= 5.004 } + utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), + veop, modname, imop); +#else + utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), + modname, imop); +#endif + PL_expect = oexpect; + PL_copline = ocopline; + PL_curcop = ocurcop; + } +} + +#endif +#endif + +#ifndef load_module +#if { NEED load_module } + +void +load_module(U32 flags, SV *name, SV *ver, ...) +{ + va_list args; + va_start(args, ver); + vload_module(flags, name, ver, &args); + va_end(args); +} + +#endif +#endif + +=xsinit + +#define NEED_eval_pv +#define NEED_load_module +#define NEED_vload_module + +=xsubs + +I32 +G_SCALAR() + CODE: + RETVAL = G_SCALAR; + OUTPUT: + RETVAL + +I32 +G_ARRAY() + CODE: + RETVAL = G_ARRAY; + OUTPUT: + RETVAL + +I32 +G_DISCARD() + CODE: + RETVAL = G_DISCARD; + OUTPUT: + RETVAL + +void +eval_sv(sv, flags) + SV* sv + I32 flags + PREINIT: + I32 i; + PPCODE: + PUTBACK; + i = eval_sv(sv, flags); + SPAGAIN; + EXTEND(SP, 1); + mPUSHi(i); + +void +eval_pv(p, croak_on_error) + char* p + I32 croak_on_error + PPCODE: + PUTBACK; + EXTEND(SP, 1); + PUSHs(eval_pv(p, croak_on_error)); + +void +call_sv(sv, flags, ...) + SV* sv + I32 flags + PREINIT: + I32 i; + PPCODE: + for (i=0; i 8) /* play safe */ + XSRETURN_UNDEF; + for (i=2; i 52 + +sub eq_array +{ + my($a, $b) = @_; + join(':', @$a) eq join(':', @$b); +} + +sub f +{ + shift; + unshift @_, 'b'; + pop @_; + @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; +} + +my $obj = bless [], 'Foo'; + +sub Foo::meth +{ + return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo'; + shift; + shift; + unshift @_, 'b'; + pop @_; + @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; +} + +my $test; + +for $test ( + # flags args expected description + [ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ], + [ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ], + [ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ], + [ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ], + [ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ], + [ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ], +) +{ + my ($flags, $args, $expected, $description) = @$test; + print "# --- $description ---\n"; + ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected)); +}; + +ok(&Devel::PPPort::eval_pv('f()', 0), 'y'); +ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y'); + +ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet"); +Devel::PPPort::load_module(0, "less", undef); +ok(defined $::{'less::'}, 1, "Have now loaded less"); diff --git a/ext/Devel-PPPort/parts/inc/cop b/ext/Devel-PPPort/parts/inc/cop new file mode 100644 index 0000000000..7c8674112d --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/cop @@ -0,0 +1,84 @@ +################################################################################ +## +## $Revision: 8 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +#ifdef USE_ITHREADS + +__UNDEFINED__ CopFILE(c) ((c)->cop_file) +__UNDEFINED__ CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) +__UNDEFINED__ CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) +__UNDEFINED__ CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) +__UNDEFINED__ CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) +__UNDEFINED__ CopSTASHPV(c) ((c)->cop_stashpv) +__UNDEFINED__ CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) +__UNDEFINED__ CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) +__UNDEFINED__ CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) +__UNDEFINED__ CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \ + || (CopSTASHPV(c) && HvNAME(hv) \ + && strEQ(CopSTASHPV(c), HvNAME(hv))))) + +#else + +__UNDEFINED__ CopFILEGV(c) ((c)->cop_filegv) +__UNDEFINED__ CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) +__UNDEFINED__ CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) +__UNDEFINED__ CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) +__UNDEFINED__ CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) +__UNDEFINED__ CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) +__UNDEFINED__ CopSTASH(c) ((c)->cop_stash) +__UNDEFINED__ CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) +__UNDEFINED__ CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) +__UNDEFINED__ CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) +__UNDEFINED__ CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) + +#endif /* USE_ITHREADS */ + +=xsubs + +char * +CopSTASHPV() + CODE: + RETVAL = CopSTASHPV(PL_curcop); + OUTPUT: + RETVAL + +char * +CopFILE() + CODE: + RETVAL = CopFILE(PL_curcop); + OUTPUT: + RETVAL + +=tests plan => 2 + +my $package; +{ + package MyPackage; + $package = &Devel::PPPort::CopSTASHPV(); +} +print "# $package\n"; +ok($package, "MyPackage"); + +my $file = &Devel::PPPort::CopFILE(); +print "# $file\n"; +ok($file =~ /cop/i); + diff --git a/ext/Devel-PPPort/parts/inc/exception b/ext/Devel-PPPort/parts/inc/exception new file mode 100644 index 0000000000..122277bbb1 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/exception @@ -0,0 +1,74 @@ +################################################################################ +## +## $Revision: 7 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +dXCPT +XCPT_TRY_START +XCPT_TRY_END +XCPT_CATCH +XCPT_RETHROW + +=implementation + +#ifdef NO_XSLOCKS +# ifdef dJMPENV +# define dXCPT dJMPENV; int rEtV = 0 +# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) +# define XCPT_TRY_END JMPENV_POP; +# define XCPT_CATCH if (rEtV != 0) +# define XCPT_RETHROW JMPENV_JUMP(rEtV) +# else +# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0 +# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0) +# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf); +# define XCPT_CATCH if (rEtV != 0) +# define XCPT_RETHROW Siglongjmp(top_env, rEtV) +# endif +#endif + +=xsmisc + +/* defined in module3.c */ +int exception(int throw_e); + +=xsubs + +int +exception(throw_e) + int throw_e + OUTPUT: + RETVAL + +=tests plan => 7 + +my $rv; + +$Devel::PPPort::exception_caught = undef; + +$rv = eval { &Devel::PPPort::exception(0) }; +ok($@, ''); +ok(defined $rv); +ok($rv, 42); +ok($Devel::PPPort::exception_caught, 0); + +$Devel::PPPort::exception_caught = undef; + +$rv = eval { &Devel::PPPort::exception(1) }; +ok($@, "boo\n"); +ok(not defined $rv); +ok($Devel::PPPort::exception_caught, 1); diff --git a/ext/Devel-PPPort/parts/inc/format b/ext/Devel-PPPort/parts/inc/format new file mode 100644 index 0000000000..d39670416c --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/format @@ -0,0 +1,70 @@ +################################################################################ +## +## $Revision: 9 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +/^#\s*define\s+(\w+)/ + +=implementation + +#ifndef IVdf +# if IVSIZE == LONGSIZE +# define IVdf "ld" +# define UVuf "lu" +# define UVof "lo" +# define UVxf "lx" +# define UVXf "lX" +# else +# if IVSIZE == INTSIZE +# define IVdf "d" +# define UVuf "u" +# define UVof "o" +# define UVxf "x" +# define UVXf "X" +# endif +# endif +#endif + +#ifndef NVef +# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ + defined(PERL_PRIfldbl) && { VERSION != 5.6.0 } + /* Not very likely, but let's try anyway. */ +# define NVef PERL_PRIeldbl +# define NVff PERL_PRIfldbl +# define NVgf PERL_PRIgldbl +# else +# define NVef "e" +# define NVff "f" +# define NVgf "g" +# endif +#endif + +=xsubs + +void +croak_NVgf(num) + NV num + PPCODE: + Perl_croak(aTHX_ "%.20" NVgf "\n", num); + +=tests plan => 1 + +my $num = 1.12345678901234567890; + +eval { Devel::PPPort::croak_NVgf($num) }; +ok($@ =~ /^1.1234567890/); + diff --git a/ext/Devel-PPPort/parts/inc/grok b/ext/Devel-PPPort/parts/inc/grok new file mode 100644 index 0000000000..5e32f8e990 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/grok @@ -0,0 +1,677 @@ +################################################################################ +## +## $Revision: 16 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +grok_hex +grok_oct +grok_bin +grok_numeric_radix +grok_number +__UNDEFINED__ + +=implementation + +__UNDEFINED__ IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) +__UNDEFINED__ IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) +__UNDEFINED__ IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) +__UNDEFINED__ IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) + +__UNDEFINED__ IS_NUMBER_IN_UV 0x01 +__UNDEFINED__ IS_NUMBER_GREATER_THAN_UV_MAX 0x02 +__UNDEFINED__ IS_NUMBER_NOT_INT 0x04 +__UNDEFINED__ IS_NUMBER_NEG 0x08 +__UNDEFINED__ IS_NUMBER_INFINITY 0x10 +__UNDEFINED__ IS_NUMBER_NAN 0x20 + +__UNDEFINED__ GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) + +__UNDEFINED__ PERL_SCAN_GREATER_THAN_UV_MAX 0x02 +__UNDEFINED__ PERL_SCAN_SILENT_ILLDIGIT 0x04 +__UNDEFINED__ PERL_SCAN_ALLOW_UNDERSCORES 0x01 +__UNDEFINED__ PERL_SCAN_DISALLOW_PREFIX 0x02 + +#ifndef grok_numeric_radix +#if { NEED grok_numeric_radix } +bool +grok_numeric_radix(pTHX_ const char **sp, const char *send) +{ +#ifdef USE_LOCALE_NUMERIC +#ifdef PL_numeric_radix_sv + if (PL_numeric_radix_sv && IN_LOCALE) { + STRLEN len; + char* radix = SvPV(PL_numeric_radix_sv, len); + if (*sp + len <= send && memEQ(*sp, radix, len)) { + *sp += len; + return TRUE; + } + } +#else + /* older perls don't have PL_numeric_radix_sv so the radix + * must manually be requested from locale.h + */ +#include + dTHR; /* needed for older threaded perls */ + struct lconv *lc = localeconv(); + char *radix = lc->decimal_point; + if (radix && IN_LOCALE) { + STRLEN len = strlen(radix); + if (*sp + len <= send && memEQ(*sp, radix, len)) { + *sp += len; + return TRUE; + } + } +#endif +#endif /* USE_LOCALE_NUMERIC */ + /* always try "." if numeric radix didn't match because + * we may have data from different locales mixed */ + if (*sp < send && **sp == '.') { + ++*sp; + return TRUE; + } + return FALSE; +} +#endif +#endif + +#ifndef grok_number +#if { NEED grok_number } +int +grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) +{ + const char *s = pv; + const char *send = pv + len; + const UV max_div_10 = UV_MAX / 10; + const char max_mod_10 = UV_MAX % 10; + int numtype = 0; + int sawinf = 0; + int sawnan = 0; + + while (s < send && isSPACE(*s)) + s++; + if (s == send) { + return 0; + } else if (*s == '-') { + s++; + numtype = IS_NUMBER_NEG; + } + else if (*s == '+') + s++; + + if (s == send) + return 0; + + /* next must be digit or the radix separator or beginning of infinity */ + if (isDIGIT(*s)) { + /* UVs are at least 32 bits, so the first 9 decimal digits cannot + overflow. */ + UV value = *s - '0'; + /* This construction seems to be more optimiser friendly. + (without it gcc does the isDIGIT test and the *s - '0' separately) + With it gcc on arm is managing 6 instructions (6 cycles) per digit. + In theory the optimiser could deduce how far to unroll the loop + before checking for overflow. */ + if (++s < send) { + int digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + /* Now got 9 digits, so need to check + each time for overflow. */ + digit = *s - '0'; + while (digit >= 0 && digit <= 9 + && (value < max_div_10 + || (value == max_div_10 + && digit <= max_mod_10))) { + value = value * 10 + digit; + if (++s < send) + digit = *s - '0'; + else + break; + } + if (digit >= 0 && digit <= 9 + && (s < send)) { + /* value overflowed. + skip the remaining digits, don't + worry about setting *valuep. */ + do { + s++; + } while (s < send && isDIGIT(*s)); + numtype |= + IS_NUMBER_GREATER_THAN_UV_MAX; + goto skip_value; + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + numtype |= IS_NUMBER_IN_UV; + if (valuep) + *valuep = value; + + skip_value: + if (GROK_NUMERIC_RADIX(&s, send)) { + numtype |= IS_NUMBER_NOT_INT; + while (s < send && isDIGIT(*s)) /* optional digits after the radix */ + s++; + } + } + else if (GROK_NUMERIC_RADIX(&s, send)) { + numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ + /* no digits before the radix means we need digits after it */ + if (s < send && isDIGIT(*s)) { + do { + s++; + } while (s < send && isDIGIT(*s)); + if (valuep) { + /* integer approximation is valid - it's 0. */ + *valuep = 0; + } + } + else + return 0; + } else if (*s == 'I' || *s == 'i') { + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; + s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; + s++; if (s < send && (*s == 'I' || *s == 'i')) { + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; + s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; + s++; if (s == send || (*s != 'T' && *s != 't')) return 0; + s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; + s++; + } + sawinf = 1; + } else if (*s == 'N' || *s == 'n') { + /* XXX TODO: There are signaling NaNs and quiet NaNs. */ + s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; + s++; + sawnan = 1; + } else + return 0; + + if (sawinf) { + numtype &= IS_NUMBER_NEG; /* Keep track of sign */ + numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; + } else if (sawnan) { + numtype &= IS_NUMBER_NEG; /* Keep track of sign */ + numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; + } else if (s < send) { + /* we can have an optional exponent part */ + if (*s == 'e' || *s == 'E') { + /* The only flag we keep is sign. Blow away any "it's UV" */ + numtype &= IS_NUMBER_NEG; + numtype |= IS_NUMBER_NOT_INT; + s++; + if (s < send && (*s == '-' || *s == '+')) + s++; + if (s < send && isDIGIT(*s)) { + do { + s++; + } while (s < send && isDIGIT(*s)); + } + else + return 0; + } + } + while (s < send && isSPACE(*s)) + s++; + if (s >= send) + return numtype; + if (len == 10 && memEQ(pv, "0 but true", 10)) { + if (valuep) + *valuep = 0; + return IS_NUMBER_IN_UV; + } + return 0; +} +#endif +#endif + +/* + * The grok_* routines have been modified to use warn() instead of + * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, + * which is why the stack variable has been renamed to 'xdigit'. + */ + +#ifndef grok_bin +#if { NEED grok_bin } +UV +grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_2 = UV_MAX / 2; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { + /* strip off leading b or 0b. + for compatibility silently suffer "b" and "0b" as valid binary + numbers. */ + if (len >= 1) { + if (s[0] == 'b') { + s++; + len--; + } + else if (len >= 2 && s[0] == '0' && s[1] == 'b') { + s+=2; + len-=2; + } + } + } + + for (; len-- && *s; s++) { + char bit = *s; + if (bit == '0' || bit == '1') { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + With gcc seems to be much straighter code than old scan_bin. */ + redo: + if (!overflowed) { + if (value <= max_div_2) { + value = (value << 1) | (bit - '0'); + continue; + } + /* Bah. We're just overflowed. */ + warn("Integer overflow in binary number"); + overflowed = TRUE; + value_nv = (NV) value; + } + value_nv *= 2.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount. */ + value_nv += (NV)(bit - '0'); + continue; + } + if (bit == '_' && len && allow_underscores && (bit = s[1]) + && (bit == '0' || bit == '1')) + { + --len; + ++s; + goto redo; + } + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal binary digit '%c' ignored", *s); + break; + } + + if ( ( overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff ) +#endif + ) { + warn("Binary number > 0b11111111111111111111111111111111 non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} +#endif +#endif + +#ifndef grok_hex +#if { NEED grok_hex } +UV +grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_16 = UV_MAX / 16; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + const char *xdigit; + + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { + /* strip off leading x or 0x. + for compatibility silently suffer "x" and "0x" as valid hex numbers. + */ + if (len >= 1) { + if (s[0] == 'x') { + s++; + len--; + } + else if (len >= 2 && s[0] == '0' && s[1] == 'x') { + s+=2; + len-=2; + } + } + } + + for (; len-- && *s; s++) { + xdigit = strchr((char *) PL_hexdigit, *s); + if (xdigit) { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + With gcc seems to be much straighter code than old scan_hex. */ + redo: + if (!overflowed) { + if (value <= max_div_16) { + value = (value << 4) | ((xdigit - PL_hexdigit) & 15); + continue; + } + warn("Integer overflow in hexadecimal number"); + overflowed = TRUE; + value_nv = (NV) value; + } + value_nv *= 16.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount of 16-tuples. */ + value_nv += (NV)((xdigit - PL_hexdigit) & 15); + continue; + } + if (*s == '_' && len && allow_underscores && s[1] + && (xdigit = strchr((char *) PL_hexdigit, s[1]))) + { + --len; + ++s; + goto redo; + } + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal hexadecimal digit '%c' ignored", *s); + break; + } + + if ( ( overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff ) +#endif + ) { + warn("Hexadecimal number > 0xffffffff non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} +#endif +#endif + +#ifndef grok_oct +#if { NEED grok_oct } +UV +grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_8 = UV_MAX / 8; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + + for (; len-- && *s; s++) { + /* gcc 2.95 optimiser not smart enough to figure that this subtraction + out front allows slicker code. */ + int digit = *s - '0'; + if (digit >= 0 && digit <= 7) { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + */ + redo: + if (!overflowed) { + if (value <= max_div_8) { + value = (value << 3) | digit; + continue; + } + /* Bah. We're just overflowed. */ + warn("Integer overflow in octal number"); + overflowed = TRUE; + value_nv = (NV) value; + } + value_nv *= 8.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount of 8-tuples. */ + value_nv += (NV)digit; + continue; + } + if (digit == ('_' - '0') && len && allow_underscores + && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) + { + --len; + ++s; + goto redo; + } + /* Allow \octal to work the DWIM way (that is, stop scanning + * as soon as non-octal characters are seen, complain only iff + * someone seems to want to use the digits eight and nine). */ + if (digit == 8 || digit == 9) { + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal octal digit '%c' ignored", *s); + } + break; + } + + if ( ( overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff ) +#endif + ) { + warn("Octal number > 037777777777 non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} +#endif +#endif + +=xsinit + +#define NEED_grok_number +#define NEED_grok_numeric_radix +#define NEED_grok_bin +#define NEED_grok_hex +#define NEED_grok_oct + +=xsubs + +UV +grok_number(string) + SV *string + PREINIT: + const char *pv; + STRLEN len; + CODE: + pv = SvPV(string, len); + if (!grok_number(pv, len, &RETVAL)) + XSRETURN_UNDEF; + OUTPUT: + RETVAL + +UV +grok_bin(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = grok_bin(pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +grok_hex(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = grok_hex(pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +grok_oct(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = grok_oct(pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +Perl_grok_number(string) + SV *string + PREINIT: + const char *pv; + STRLEN len; + CODE: + pv = SvPV(string, len); + if (!Perl_grok_number(aTHX_ pv, len, &RETVAL)) + XSRETURN_UNDEF; + OUTPUT: + RETVAL + +UV +Perl_grok_bin(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +Perl_grok_hex(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +Perl_grok_oct(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +=tests plan => 10 + +ok(&Devel::PPPort::grok_number("42"), 42); +ok(!defined(&Devel::PPPort::grok_number("A"))); +ok(&Devel::PPPort::grok_bin("10000001"), 129); +ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef); +ok(&Devel::PPPort::grok_oct("377"), 255); + +ok(&Devel::PPPort::Perl_grok_number("42"), 42); +ok(!defined(&Devel::PPPort::Perl_grok_number("A"))); +ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129); +ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef); +ok(&Devel::PPPort::Perl_grok_oct("377"), 255); + diff --git a/ext/Devel-PPPort/parts/inc/limits b/ext/Devel-PPPort/parts/inc/limits new file mode 100644 index 0000000000..25b3940179 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/limits @@ -0,0 +1,331 @@ +################################################################################ +## +## $Revision: 7 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +PERL_UCHAR_MIN +PERL_UCHAR_MAX +PERL_USHORT_MIN +PERL_USHORT_MAX +PERL_SHORT_MAX +PERL_SHORT_MIN +PERL_UINT_MAX +PERL_UINT_MIN +PERL_INT_MAX +PERL_INT_MIN +PERL_ULONG_MAX +PERL_ULONG_MIN +PERL_LONG_MAX +PERL_LONG_MIN +PERL_UQUAD_MAX +PERL_UQUAD_MIN +PERL_QUAD_MAX +PERL_QUAD_MIN +IVSIZE +UVSIZE +IVTYPE +UVTYPE + +=implementation + +#ifdef I_LIMITS +# include +#endif + +#ifndef PERL_UCHAR_MIN +# define PERL_UCHAR_MIN ((unsigned char)0) +#endif + +#ifndef PERL_UCHAR_MAX +# ifdef UCHAR_MAX +# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) +# else +# ifdef MAXUCHAR +# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) +# else +# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) +# endif +# endif +#endif + +#ifndef PERL_USHORT_MIN +# define PERL_USHORT_MIN ((unsigned short)0) +#endif + +#ifndef PERL_USHORT_MAX +# ifdef USHORT_MAX +# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) +# else +# ifdef MAXUSHORT +# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) +# else +# ifdef USHRT_MAX +# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) +# else +# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) +# endif +# endif +# endif +#endif + +#ifndef PERL_SHORT_MAX +# ifdef SHORT_MAX +# define PERL_SHORT_MAX ((short)SHORT_MAX) +# else +# ifdef MAXSHORT /* Often used in */ +# define PERL_SHORT_MAX ((short)MAXSHORT) +# else +# ifdef SHRT_MAX +# define PERL_SHORT_MAX ((short)SHRT_MAX) +# else +# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) +# endif +# endif +# endif +#endif + +#ifndef PERL_SHORT_MIN +# ifdef SHORT_MIN +# define PERL_SHORT_MIN ((short)SHORT_MIN) +# else +# ifdef MINSHORT +# define PERL_SHORT_MIN ((short)MINSHORT) +# else +# ifdef SHRT_MIN +# define PERL_SHORT_MIN ((short)SHRT_MIN) +# else +# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) +# endif +# endif +# endif +#endif + +#ifndef PERL_UINT_MAX +# ifdef UINT_MAX +# define PERL_UINT_MAX ((unsigned int)UINT_MAX) +# else +# ifdef MAXUINT +# define PERL_UINT_MAX ((unsigned int)MAXUINT) +# else +# define PERL_UINT_MAX (~(unsigned int)0) +# endif +# endif +#endif + +#ifndef PERL_UINT_MIN +# define PERL_UINT_MIN ((unsigned int)0) +#endif + +#ifndef PERL_INT_MAX +# ifdef INT_MAX +# define PERL_INT_MAX ((int)INT_MAX) +# else +# ifdef MAXINT /* Often used in */ +# define PERL_INT_MAX ((int)MAXINT) +# else +# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) +# endif +# endif +#endif + +#ifndef PERL_INT_MIN +# ifdef INT_MIN +# define PERL_INT_MIN ((int)INT_MIN) +# else +# ifdef MININT +# define PERL_INT_MIN ((int)MININT) +# else +# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) +# endif +# endif +#endif + +#ifndef PERL_ULONG_MAX +# ifdef ULONG_MAX +# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) +# else +# ifdef MAXULONG +# define PERL_ULONG_MAX ((unsigned long)MAXULONG) +# else +# define PERL_ULONG_MAX (~(unsigned long)0) +# endif +# endif +#endif + +#ifndef PERL_ULONG_MIN +# define PERL_ULONG_MIN ((unsigned long)0L) +#endif + +#ifndef PERL_LONG_MAX +# ifdef LONG_MAX +# define PERL_LONG_MAX ((long)LONG_MAX) +# else +# ifdef MAXLONG +# define PERL_LONG_MAX ((long)MAXLONG) +# else +# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) +# endif +# endif +#endif + +#ifndef PERL_LONG_MIN +# ifdef LONG_MIN +# define PERL_LONG_MIN ((long)LONG_MIN) +# else +# ifdef MINLONG +# define PERL_LONG_MIN ((long)MINLONG) +# else +# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) +# endif +# endif +#endif + +#if defined(HAS_QUAD) && (defined(convex) || defined(uts)) +# ifndef PERL_UQUAD_MAX +# ifdef ULONGLONG_MAX +# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) +# else +# ifdef MAXULONGLONG +# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) +# else +# define PERL_UQUAD_MAX (~(unsigned long long)0) +# endif +# endif +# endif + +# ifndef PERL_UQUAD_MIN +# define PERL_UQUAD_MIN ((unsigned long long)0L) +# endif + +# ifndef PERL_QUAD_MAX +# ifdef LONGLONG_MAX +# define PERL_QUAD_MAX ((long long)LONGLONG_MAX) +# else +# ifdef MAXLONGLONG +# define PERL_QUAD_MAX ((long long)MAXLONGLONG) +# else +# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1)) +# endif +# endif +# endif + +# ifndef PERL_QUAD_MIN +# ifdef LONGLONG_MIN +# define PERL_QUAD_MIN ((long long)LONGLONG_MIN) +# else +# ifdef MINLONGLONG +# define PERL_QUAD_MIN ((long long)MINLONGLONG) +# else +# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) +# endif +# endif +# endif +#endif + +/* This is based on code from 5.003 perl.h */ +#ifdef HAS_QUAD +# ifdef cray + __UNDEFINED__ IVTYPE int + __UNDEFINED__ IV_MIN PERL_INT_MIN + __UNDEFINED__ IV_MAX PERL_INT_MAX + __UNDEFINED__ UV_MIN PERL_UINT_MIN + __UNDEFINED__ UV_MAX PERL_UINT_MAX +# ifdef INTSIZE + __UNDEFINED__ IVSIZE INTSIZE +# endif +# else +# if defined(convex) || defined(uts) + __UNDEFINED__ IVTYPE long long + __UNDEFINED__ IV_MIN PERL_QUAD_MIN + __UNDEFINED__ IV_MAX PERL_QUAD_MAX + __UNDEFINED__ UV_MIN PERL_UQUAD_MIN + __UNDEFINED__ UV_MAX PERL_UQUAD_MAX +# ifdef LONGLONGSIZE + __UNDEFINED__ IVSIZE LONGLONGSIZE +# endif +# else + __UNDEFINED__ IVTYPE long + __UNDEFINED__ IV_MIN PERL_LONG_MIN + __UNDEFINED__ IV_MAX PERL_LONG_MAX + __UNDEFINED__ UV_MIN PERL_ULONG_MIN + __UNDEFINED__ UV_MAX PERL_ULONG_MAX +# ifdef LONGSIZE + __UNDEFINED__ IVSIZE LONGSIZE +# endif +# endif +# endif + __UNDEFINED__ IVSIZE 8 + __UNDEFINED__ PERL_QUAD_MIN IV_MIN + __UNDEFINED__ PERL_QUAD_MAX IV_MAX + __UNDEFINED__ PERL_UQUAD_MIN UV_MIN + __UNDEFINED__ PERL_UQUAD_MAX UV_MAX +#else + __UNDEFINED__ IVTYPE long + __UNDEFINED__ IV_MIN PERL_LONG_MIN + __UNDEFINED__ IV_MAX PERL_LONG_MAX + __UNDEFINED__ UV_MIN PERL_ULONG_MIN + __UNDEFINED__ UV_MAX PERL_ULONG_MAX +#endif + +#ifndef IVSIZE +# ifdef LONGSIZE +# define IVSIZE LONGSIZE +# else +# define IVSIZE 4 /* A bold guess, but the best we can make. */ +# endif +#endif + +__UNDEFINED__ UVTYPE unsigned IVTYPE +__UNDEFINED__ UVSIZE IVSIZE + +=xsubs + +IV +iv_size() + CODE: + RETVAL = IVSIZE == sizeof(IV); + OUTPUT: + RETVAL + +IV +uv_size() + CODE: + RETVAL = UVSIZE == sizeof(UV); + OUTPUT: + RETVAL + +IV +iv_type() + CODE: + RETVAL = sizeof(IVTYPE) == sizeof(IV); + OUTPUT: + RETVAL + +IV +uv_type() + CODE: + RETVAL = sizeof(UVTYPE) == sizeof(UV); + OUTPUT: + RETVAL + +=tests plan => 4 + +ok(&Devel::PPPort::iv_size()); +ok(&Devel::PPPort::uv_size()); +ok(&Devel::PPPort::iv_type()); +ok(&Devel::PPPort::uv_type()); + diff --git a/ext/Devel-PPPort/parts/inc/mPUSH b/ext/Devel-PPPort/parts/inc/mPUSH new file mode 100644 index 0000000000..3613058837 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/mPUSH @@ -0,0 +1,138 @@ +################################################################################ +## +## $Revision: 11 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +__UNDEFINED__ mPUSHs(s) PUSHs(sv_2mortal(s)) +__UNDEFINED__ PUSHmortal PUSHs(sv_newmortal()) +__UNDEFINED__ mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l)) +__UNDEFINED__ mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n)) +__UNDEFINED__ mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i)) +__UNDEFINED__ mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u)) + +__UNDEFINED__ mXPUSHs(s) XPUSHs(sv_2mortal(s)) +__UNDEFINED__ XPUSHmortal XPUSHs(sv_newmortal()) +__UNDEFINED__ mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END +__UNDEFINED__ mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END +__UNDEFINED__ mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END +__UNDEFINED__ mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END + +=xsubs + +void +mPUSHs() + PPCODE: + EXTEND(SP, 3); + mPUSHs(newSVpv("foo", 0)); + mPUSHs(newSVpv("bar13", 3)); + mPUSHs(newSViv(42)); + XSRETURN(3); + +void +mPUSHp() + PPCODE: + EXTEND(SP, 3); + mPUSHp("one", 3); + mPUSHp("two", 3); + mPUSHp("three", 5); + XSRETURN(3); + +void +mPUSHn() + PPCODE: + EXTEND(SP, 3); + mPUSHn(0.5); + mPUSHn(-0.25); + mPUSHn(0.125); + XSRETURN(3); + +void +mPUSHi() + PPCODE: + EXTEND(SP, 3); + mPUSHi(-1); + mPUSHi(2); + mPUSHi(-3); + XSRETURN(3); + +void +mPUSHu() + PPCODE: + EXTEND(SP, 3); + mPUSHu(1); + mPUSHu(2); + mPUSHu(3); + XSRETURN(3); + +void +mXPUSHs() + PPCODE: + mXPUSHs(newSVpv("foo", 0)); + mXPUSHs(newSVpv("bar13", 3)); + mXPUSHs(newSViv(42)); + XSRETURN(3); + +void +mXPUSHp() + PPCODE: + mXPUSHp("one", 3); + mXPUSHp("two", 3); + mXPUSHp("three", 5); + XSRETURN(3); + +void +mXPUSHn() + PPCODE: + mXPUSHn(0.5); + mXPUSHn(-0.25); + mXPUSHn(0.125); + XSRETURN(3); + +void +mXPUSHi() + PPCODE: + mXPUSHi(-1); + mXPUSHi(2); + mXPUSHi(-3); + XSRETURN(3); + +void +mXPUSHu() + PPCODE: + mXPUSHu(1); + mXPUSHu(2); + mXPUSHu(3); + XSRETURN(3); + +=tests plan => 10 + +ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42"); +ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three"); +ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125"); +ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3"); +ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3"); + +ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42"); +ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three"); +ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125"); +ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3"); +ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3"); + diff --git a/ext/Devel-PPPort/parts/inc/magic b/ext/Devel-PPPort/parts/inc/magic new file mode 100644 index 0000000000..31721715ea --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/magic @@ -0,0 +1,369 @@ +################################################################################ +## +## $Revision: 17 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ +/sv_\w+_mg/ +sv_magic_portable + +=implementation + +__UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END + +__UNDEFINED__ PERL_MAGIC_sv '\0' +__UNDEFINED__ PERL_MAGIC_overload 'A' +__UNDEFINED__ PERL_MAGIC_overload_elem 'a' +__UNDEFINED__ PERL_MAGIC_overload_table 'c' +__UNDEFINED__ PERL_MAGIC_bm 'B' +__UNDEFINED__ PERL_MAGIC_regdata 'D' +__UNDEFINED__ PERL_MAGIC_regdatum 'd' +__UNDEFINED__ PERL_MAGIC_env 'E' +__UNDEFINED__ PERL_MAGIC_envelem 'e' +__UNDEFINED__ PERL_MAGIC_fm 'f' +__UNDEFINED__ PERL_MAGIC_regex_global 'g' +__UNDEFINED__ PERL_MAGIC_isa 'I' +__UNDEFINED__ PERL_MAGIC_isaelem 'i' +__UNDEFINED__ PERL_MAGIC_nkeys 'k' +__UNDEFINED__ PERL_MAGIC_dbfile 'L' +__UNDEFINED__ PERL_MAGIC_dbline 'l' +__UNDEFINED__ PERL_MAGIC_mutex 'm' +__UNDEFINED__ PERL_MAGIC_shared 'N' +__UNDEFINED__ PERL_MAGIC_shared_scalar 'n' +__UNDEFINED__ PERL_MAGIC_collxfrm 'o' +__UNDEFINED__ PERL_MAGIC_tied 'P' +__UNDEFINED__ PERL_MAGIC_tiedelem 'p' +__UNDEFINED__ PERL_MAGIC_tiedscalar 'q' +__UNDEFINED__ PERL_MAGIC_qr 'r' +__UNDEFINED__ PERL_MAGIC_sig 'S' +__UNDEFINED__ PERL_MAGIC_sigelem 's' +__UNDEFINED__ PERL_MAGIC_taint 't' +__UNDEFINED__ PERL_MAGIC_uvar 'U' +__UNDEFINED__ PERL_MAGIC_uvar_elem 'u' +__UNDEFINED__ PERL_MAGIC_vstring 'V' +__UNDEFINED__ PERL_MAGIC_vec 'v' +__UNDEFINED__ PERL_MAGIC_utf8 'w' +__UNDEFINED__ PERL_MAGIC_substr 'x' +__UNDEFINED__ PERL_MAGIC_defelem 'y' +__UNDEFINED__ PERL_MAGIC_glob '*' +__UNDEFINED__ PERL_MAGIC_arylen '#' +__UNDEFINED__ PERL_MAGIC_pos '.' +__UNDEFINED__ PERL_MAGIC_backref '<' +__UNDEFINED__ PERL_MAGIC_ext '~' + +/* That's the best we can do... */ +__UNDEFINED__ sv_catpvn_nomg sv_catpvn +__UNDEFINED__ sv_catsv_nomg sv_catsv +__UNDEFINED__ sv_setsv_nomg sv_setsv +__UNDEFINED__ sv_pvn_nomg sv_pvn +__UNDEFINED__ SvIV_nomg SvIV +__UNDEFINED__ SvUV_nomg SvUV + +#ifndef sv_catpv_mg +# define sv_catpv_mg(sv, ptr) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_catpv(TeMpSv,ptr); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_catpvn_mg +# define sv_catpvn_mg(sv, ptr, len) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_catpvn(TeMpSv,ptr,len); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_catsv_mg +# define sv_catsv_mg(dsv, ssv) \ + STMT_START { \ + SV *TeMpSv = dsv; \ + sv_catsv(TeMpSv,ssv); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setiv_mg +# define sv_setiv_mg(sv, i) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setiv(TeMpSv,i); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setnv_mg +# define sv_setnv_mg(sv, num) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setnv(TeMpSv,num); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setpv_mg +# define sv_setpv_mg(sv, ptr) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setpv(TeMpSv,ptr); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setpvn_mg +# define sv_setpvn_mg(sv, ptr, len) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setpvn(TeMpSv,ptr,len); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setsv_mg +# define sv_setsv_mg(dsv, ssv) \ + STMT_START { \ + SV *TeMpSv = dsv; \ + sv_setsv(TeMpSv,ssv); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setuv_mg +# define sv_setuv_mg(sv, i) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setuv(TeMpSv,i); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_usepvn_mg +# define sv_usepvn_mg(sv, ptr, len) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_usepvn(TeMpSv,ptr,len); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +__UNDEFINED__ SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL) + +/* Hint: sv_magic_portable + * This is a compatibility function that is only available with + * Devel::PPPort. It is NOT in the perl core. + * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when + * it is being passed a name pointer with namlen == 0. In that + * case, perl 5.8.0 and later store the pointer, not a copy of it. + * The compatibility can be provided back to perl 5.004. With + * earlier versions, the code will not compile. + */ + +#if { VERSION < 5.004 } + + /* code that uses sv_magic_portable will not compile */ + +#elif { VERSION < 5.8.0 } + +# define sv_magic_portable(sv, obj, how, name, namlen) \ + STMT_START { \ + SV *SvMp_sv = (sv); \ + char *SvMp_name = (char *) (name); \ + I32 SvMp_namlen = (namlen); \ + if (SvMp_name && SvMp_namlen == 0) \ + { \ + MAGIC *mg; \ + sv_magic(SvMp_sv, obj, how, 0, 0); \ + mg = SvMAGIC(SvMp_sv); \ + mg->mg_len = -42; /* XXX: this is the tricky part */ \ + mg->mg_ptr = SvMp_name; \ + } \ + else \ + { \ + sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \ + } \ + } STMT_END + +#else + +# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e) + +#endif + +=xsubs + +void +sv_catpv_mg(sv, string) + SV *sv; + char *string; + CODE: + sv_catpv_mg(sv, string); + +void +sv_catpvn_mg(sv, sv2) + SV *sv; + SV *sv2; + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV(sv2, len); + sv_catpvn_mg(sv, str, len); + +void +sv_catsv_mg(sv, sv2) + SV *sv; + SV *sv2; + CODE: + sv_catsv_mg(sv, sv2); + +void +sv_setiv_mg(sv, iv) + SV *sv; + IV iv; + CODE: + sv_setiv_mg(sv, iv); + +void +sv_setnv_mg(sv, nv) + SV *sv; + NV nv; + CODE: + sv_setnv_mg(sv, nv); + +void +sv_setpv_mg(sv, pv) + SV *sv; + char *pv; + CODE: + sv_setpv_mg(sv, pv); + +void +sv_setpvn_mg(sv, sv2) + SV *sv; + SV *sv2; + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV(sv2, len); + sv_setpvn_mg(sv, str, len); + +void +sv_setsv_mg(sv, sv2) + SV *sv; + SV *sv2; + CODE: + sv_setsv_mg(sv, sv2); + +void +sv_setuv_mg(sv, uv) + SV *sv; + UV uv; + CODE: + sv_setuv_mg(sv, uv); + +void +sv_usepvn_mg(sv, sv2) + SV *sv; + SV *sv2; + PREINIT: + char *str, *copy; + STRLEN len; + CODE: + str = SvPV(sv2, len); + New(42, copy, len+1, char); + Copy(str, copy, len+1, char); + sv_usepvn_mg(sv, copy, len); + +int +SvVSTRING_mg(sv) + SV *sv; + CODE: + RETVAL = SvVSTRING_mg(sv) != NULL; + OUTPUT: + RETVAL + +int +sv_magic_portable(sv) + SV *sv + PREINIT: + MAGIC *mg; + const char *foo = "foo"; + CODE: +#if { VERSION >= 5.004 } + sv_magic_portable(sv, 0, '~', foo, 0); + mg = mg_find(sv, '~'); + RETVAL = mg->mg_ptr == foo; +#else + sv_magic(sv, 0, '~', (char *) foo, strlen(foo)); + mg = mg_find(sv, '~'); + RETVAL = strEQ(mg->mg_ptr, foo); +#endif + sv_unmagic(sv, '~'); + OUTPUT: + RETVAL + +=tests plan => 15 + +use Tie::Hash; +my %h; +tie %h, 'Tie::StdHash'; +$h{foo} = 'foo'; +$h{bar} = ''; + +&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); +ok($h{foo}, 'foobar'); + +&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); +ok($h{bar}, 'baz'); + +&Devel::PPPort::sv_catsv_mg($h{foo}, '42'); +ok($h{foo}, 'foobar42'); + +&Devel::PPPort::sv_setiv_mg($h{bar}, 42); +ok($h{bar}, 42); + +&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); +ok(abs($h{PI} - 3.14159) < 0.01); + +&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); +ok($h{mhx}, 'mhx'); + +&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); +ok($h{mhx}, 'Marcus'); + +&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); +ok($h{sv}, 'SV'); + +&Devel::PPPort::sv_setuv_mg($h{sv}, 4711); +ok($h{sv}, 4711); + +&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); +ok($h{sv}, 'Perl'); + +my $ver = eval qq[qv("v1.2.0")]; +ok($[ < 5.009 || $@ eq ''); +ok($@ || Devel::PPPort::SvVSTRING_mg($ver)); +ok(!Devel::PPPort::SvVSTRING_mg(4711)); + +my $foo = 'bar'; +ok(Devel::PPPort::sv_magic_portable($foo)); +ok($foo eq 'bar'); + diff --git a/ext/Devel-PPPort/parts/inc/memory b/ext/Devel-PPPort/parts/inc/memory new file mode 100644 index 0000000000..761d80c959 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/memory @@ -0,0 +1,84 @@ +################################################################################ +## +## $Revision: 5 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +#ifdef HAS_MEMCMP +__UNDEFINED__ memNE(s1,s2,l) (memcmp(s1,s2,l)) +__UNDEFINED__ memEQ(s1,s2,l) (!memcmp(s1,s2,l)) +#else +__UNDEFINED__ memNE(s1,s2,l) (bcmp(s1,s2,l)) +__UNDEFINED__ memEQ(s1,s2,l) (!bcmp(s1,s2,l)) +#endif + +__UNDEFINED__ MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) +__UNDEFINED__ CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) +#ifdef HAS_MEMSET +__UNDEFINED__ ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) +#else +__UNDEFINED__ ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) +#endif + +__UNDEFINED__ PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) +__UNDEFINED__ PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) +__UNDEFINED__ PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) +__UNDEFINED__ Poison(d,n,t) PoisonFree(d,n,t) + +__UNDEFINED__ Newx(v,n,t) New(0,v,n,t) +__UNDEFINED__ Newxc(v,n,t,c) Newc(0,v,n,t,c) +__UNDEFINED__ Newxz(v,n,t) Newz(0,v,n,t) + +=xsubs + +int +checkmem() + PREINIT: + char *p; + + CODE: + RETVAL = 0; + Newx(p, 6, char); + CopyD("Hello", p, 6, char); + if (memEQ(p, "Hello", 6)) + RETVAL++; + ZeroD(p, 6, char); + if (memEQ(p, "\0\0\0\0\0\0", 6)) + RETVAL++; + Poison(p, 6, char); + if (memNE(p, "\0\0\0\0\0\0", 6)) + RETVAL++; + Safefree(p); + + Newxz(p, 6, char); + if (memEQ(p, "\0\0\0\0\0\0", 6)) + RETVAL++; + Safefree(p); + + Newxc(p, 3, short, char); + Safefree(p); + + OUTPUT: + RETVAL + +=tests plan => 1 + +ok(Devel::PPPort::checkmem(), 4); + diff --git a/ext/Devel-PPPort/parts/inc/misc b/ext/Devel-PPPort/parts/inc/misc new file mode 100644 index 0000000000..8044df92a1 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/misc @@ -0,0 +1,536 @@ +################################################################################ +## +## $Revision: 51 $ +## $Author: mhx $ +## $Date: 2009/01/23 18:28:31 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ +PERL_UNUSED_DECL +PERL_UNUSED_ARG +PERL_UNUSED_VAR +PERL_UNUSED_CONTEXT +PERL_GCC_BRACE_GROUPS_FORBIDDEN +PERL_USE_GCC_BRACE_GROUPS +PERLIO_FUNCS_DECL +PERLIO_FUNCS_CAST +NVTYPE +INT2PTR +PTRV +NUM2PTR +PERL_HASH +PTR2IV +PTR2UV +PTR2NV +PTR2ul +START_EXTERN_C +END_EXTERN_C +EXTERN_C +STMT_START +STMT_END +UTF8_MAXBYTES +XSRETURN + +=implementation + +#ifndef PERL_UNUSED_DECL +# ifdef HASATTRIBUTE +# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) +# define PERL_UNUSED_DECL +# else +# define PERL_UNUSED_DECL __attribute__((unused)) +# endif +# else +# define PERL_UNUSED_DECL +# endif +#endif + +#ifndef PERL_UNUSED_ARG +# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ +# include +# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) +# else +# define PERL_UNUSED_ARG(x) ((void)x) +# endif +#endif + +#ifndef PERL_UNUSED_VAR +# define PERL_UNUSED_VAR(x) ((void)x) +#endif + +#ifndef PERL_UNUSED_CONTEXT +# ifdef USE_ITHREADS +# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) +# else +# define PERL_UNUSED_CONTEXT +# endif +#endif + +__UNDEFINED__ NOOP /*EMPTY*/(void)0 +__UNDEFINED__ dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL + +#ifndef NVTYPE +# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) +# define NVTYPE long double +# else +# define NVTYPE double +# endif +typedef NVTYPE NV; +#endif + +#ifndef INT2PTR + +# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) +# define PTRV UV +# define INT2PTR(any,d) (any)(d) +# else +# if PTRSIZE == LONGSIZE +# define PTRV unsigned long +# else +# define PTRV unsigned +# endif +# define INT2PTR(any,d) (any)(PTRV)(d) +# endif + +# define NUM2PTR(any,d) (any)(PTRV)(d) +# define PTR2IV(p) INT2PTR(IV,p) +# define PTR2UV(p) INT2PTR(UV,p) +# define PTR2NV(p) NUM2PTR(NV,p) + +# if PTRSIZE == LONGSIZE +# define PTR2ul(p) (unsigned long)(p) +# else +# define PTR2ul(p) INT2PTR(unsigned long,p) +# endif + +#endif /* !INT2PTR */ + +#undef START_EXTERN_C +#undef END_EXTERN_C +#undef EXTERN_C +#ifdef __cplusplus +# define START_EXTERN_C extern "C" { +# define END_EXTERN_C } +# define EXTERN_C extern "C" +#else +# define START_EXTERN_C +# define END_EXTERN_C +# define EXTERN_C extern +#endif + +#if defined(PERL_GCC_PEDANTIC) +# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN +# define PERL_GCC_BRACE_GROUPS_FORBIDDEN +# endif +#endif + +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) +# ifndef PERL_USE_GCC_BRACE_GROUPS +# define PERL_USE_GCC_BRACE_GROUPS +# endif +#endif + +#undef STMT_START +#undef STMT_END +#ifdef PERL_USE_GCC_BRACE_GROUPS +# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ +# define STMT_END ) +#else +# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) +# define STMT_START if (1) +# define STMT_END else (void)0 +# else +# define STMT_START do +# define STMT_END while (0) +# endif +#endif + +__UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) + +/* DEFSV appears first in 5.004_56 */ +__UNDEFINED__ DEFSV GvSV(PL_defgv) +__UNDEFINED__ SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) +__UNDEFINED__ DEFSV_set(sv) (DEFSV = (sv)) + +/* Older perls (<=5.003) lack AvFILLp */ +__UNDEFINED__ AvFILLp AvFILL + +__UNDEFINED__ ERRSV get_sv("@",FALSE) + +/* Hint: gv_stashpvn + * This function's backport doesn't support the length parameter, but + * rather ignores it. Portability can only be ensured if the length + * parameter is used for speed reasons, but the length can always be + * correctly computed from the string argument. + */ + +__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create) + +/* Replace: 1 */ +__UNDEFINED__ get_cv perl_get_cv +__UNDEFINED__ get_sv perl_get_sv +__UNDEFINED__ get_av perl_get_av +__UNDEFINED__ get_hv perl_get_hv +/* Replace: 0 */ + +__UNDEFINED__ dUNDERBAR dNOOP +__UNDEFINED__ UNDERBAR DEFSV + +__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1 +__UNDEFINED__ dITEMS I32 items = SP - MARK + +__UNDEFINED__ dXSTARG SV * targ = sv_newmortal() + +__UNDEFINED__ dAXMARK I32 ax = POPMARK; \ + register SV ** const mark = PL_stack_base + ax++ + + +__UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1) + +#if { VERSION < 5.005 } +# undef XSRETURN +# define XSRETURN(off) \ + STMT_START { \ + PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ + return; \ + } STMT_END +#endif + +__UNDEFINED__ PERL_ABS(x) ((x) < 0 ? -(x) : (x)) + +__UNDEFINED__ dVAR dNOOP + +__UNDEFINED__ SVf "_" + +__UNDEFINED__ UTF8_MAXBYTES UTF8_MAXLEN + +__UNDEFINED__ CPERLscope(x) x + +__UNDEFINED__ PERL_HASH(hash,str,len) \ + STMT_START { \ + const char *s_PeRlHaSh = str; \ + I32 i_PeRlHaSh = len; \ + U32 hash_PeRlHaSh = 0; \ + while (i_PeRlHaSh--) \ + hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \ + (hash) = hash_PeRlHaSh; \ + } STMT_END + +#ifndef PERLIO_FUNCS_DECL +# ifdef PERLIO_FUNCS_CONST +# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs +# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs) +# else +# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs +# define PERLIO_FUNCS_CAST(funcs) (funcs) +# endif +#endif + +/* provide these typedefs for older perls */ +#if { VERSION < 5.9.3 } + +# ifdef ARGSproto +typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto); +# else +typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); +# endif + +typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); + +#endif + +__UNDEFINED__ isPSXSPC(c) (isSPACE(c) || (c) == '\v') +__UNDEFINED__ isBLANK(c) ((c) == ' ' || (c) == '\t') +#ifdef EBCDIC +__UNDEFINED__ isALNUMC(c) isalnum(c) +__UNDEFINED__ isASCII(c) isascii(c) +__UNDEFINED__ isCNTRL(c) iscntrl(c) +__UNDEFINED__ isGRAPH(c) isgraph(c) +__UNDEFINED__ isPRINT(c) isprint(c) +__UNDEFINED__ isPUNCT(c) ispunct(c) +__UNDEFINED__ isXDIGIT(c) isxdigit(c) +#else +# if { VERSION < 5.10.0 } +/* Hint: isPRINT + * The implementation in older perl versions includes all of the + * isSPACE() characters, which is wrong. The version provided by + * Devel::PPPort always overrides a present buggy version. + */ +# undef isPRINT +# endif +__UNDEFINED__ isALNUMC(c) (isALPHA(c) || isDIGIT(c)) +__UNDEFINED__ isASCII(c) ((c) <= 127) +__UNDEFINED__ isCNTRL(c) ((c) < ' ' || (c) == 127) +__UNDEFINED__ isGRAPH(c) (isALNUM(c) || isPUNCT(c)) +__UNDEFINED__ isPRINT(c) (((c) >= 32 && (c) < 127)) +__UNDEFINED__ isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126)) +__UNDEFINED__ isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F')) +#endif + +=xsmisc + +XS(XS_Devel__PPPort_dXSTARG); /* prototype */ +XS(XS_Devel__PPPort_dXSTARG) +{ + dXSARGS; + dXSTARG; + IV iv; + SP -= items; + iv = SvIV(ST(0)) + 1; + PUSHi(iv); + XSRETURN(1); +} + +XS(XS_Devel__PPPort_dAXMARK); /* prototype */ +XS(XS_Devel__PPPort_dAXMARK) +{ + dSP; + dAXMARK; + dITEMS; + IV iv; + SP -= items; + iv = SvIV(ST(0)) - 1; + mPUSHi(iv); + XSRETURN(1); +} + +=xsboot + +newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file); +newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file); + +=xsubs + +int +gv_stashpvn(name, create) + char *name + I32 create + CODE: + RETVAL = gv_stashpvn(name, strlen(name), create) != NULL; + OUTPUT: + RETVAL + +int +get_sv(name, create) + char *name + I32 create + CODE: + RETVAL = get_sv(name, create) != NULL; + OUTPUT: + RETVAL + +int +get_av(name, create) + char *name + I32 create + CODE: + RETVAL = get_av(name, create) != NULL; + OUTPUT: + RETVAL + +int +get_hv(name, create) + char *name + I32 create + CODE: + RETVAL = get_hv(name, create) != NULL; + OUTPUT: + RETVAL + +int +get_cv(name, create) + char *name + I32 create + CODE: + RETVAL = get_cv(name, create) != NULL; + OUTPUT: + RETVAL + +void +xsreturn(two) + int two + PPCODE: + mXPUSHp("test1", 5); + if (two) + mXPUSHp("test2", 5); + if (two) + XSRETURN(2); + else + XSRETURN(1); + +SV* +boolSV(value) + int value + CODE: + RETVAL = newSVsv(boolSV(value)); + OUTPUT: + RETVAL + +SV* +DEFSV() + CODE: + RETVAL = newSVsv(DEFSV); + OUTPUT: + RETVAL + +void +DEFSV_modify() + PPCODE: + XPUSHs(sv_mortalcopy(DEFSV)); + ENTER; + SAVE_DEFSV; + DEFSV_set(newSVpvs("DEFSV")); + XPUSHs(sv_mortalcopy(DEFSV)); + /* Yes, this leaks the above scalar; 5.005 with threads for some reason */ + /* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */ + /* sv_2mortal(DEFSV); */ + LEAVE; + XPUSHs(sv_mortalcopy(DEFSV)); + XSRETURN(3); + +int +ERRSV() + CODE: + RETVAL = SvTRUE(ERRSV); + OUTPUT: + RETVAL + +SV* +UNDERBAR() + CODE: + { + dUNDERBAR; + RETVAL = newSVsv(UNDERBAR); + } + OUTPUT: + RETVAL + +void +prepush() + CODE: + { + dXSTARG; + XSprePUSH; + PUSHi(42); + XSRETURN(1); + } + +int +PERL_ABS(a) + int a + +void +SVf(x) + SV *x + PPCODE: +#if { VERSION >= 5.004 } + x = sv_2mortal(newSVpvf("[%"SVf"]", x)); +#endif + XPUSHs(x); + XSRETURN(1); + +void +Perl_ppaddr_t(string) + char *string + PREINIT: + Perl_ppaddr_t lower; + PPCODE: + lower = PL_ppaddr[OP_LC]; + PUSHMARK(SP); + mXPUSHs(newSVpv(string, 0)); + PUTBACK; + ENTER; + (void)*(lower)(aTHXR); + SPAGAIN; + LEAVE; + XSRETURN(1); + +=tests plan => 38 + +use vars qw($my_sv @my_av %my_hv); + +ok(&Devel::PPPort::boolSV(1)); +ok(!&Devel::PPPort::boolSV(0)); + +$_ = "Fred"; +ok(&Devel::PPPort::DEFSV(), "Fred"); +ok(&Devel::PPPort::UNDERBAR(), "Fred"); + +if ($] >= 5.009002) { + eval q{ + my $_ = "Tony"; + ok(&Devel::PPPort::DEFSV(), "Fred"); + ok(&Devel::PPPort::UNDERBAR(), "Tony"); + }; +} +else { + ok(1); + ok(1); +} + +my @r = &Devel::PPPort::DEFSV_modify(); + +ok(@r == 3); +ok($r[0], 'Fred'); +ok($r[1], 'DEFSV'); +ok($r[2], 'Fred'); + +ok(&Devel::PPPort::DEFSV(), "Fred"); + +eval { 1 }; +ok(!&Devel::PPPort::ERRSV()); +eval { cannot_call_this_one() }; +ok(&Devel::PPPort::ERRSV()); + +ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0)); +ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0)); +ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1)); + +$my_sv = 1; +ok(&Devel::PPPort::get_sv('my_sv', 0)); +ok(!&Devel::PPPort::get_sv('not_my_sv', 0)); +ok(&Devel::PPPort::get_sv('not_my_sv', 1)); + +@my_av = (1); +ok(&Devel::PPPort::get_av('my_av', 0)); +ok(!&Devel::PPPort::get_av('not_my_av', 0)); +ok(&Devel::PPPort::get_av('not_my_av', 1)); + +%my_hv = (a=>1); +ok(&Devel::PPPort::get_hv('my_hv', 0)); +ok(!&Devel::PPPort::get_hv('not_my_hv', 0)); +ok(&Devel::PPPort::get_hv('not_my_hv', 1)); + +sub my_cv { 1 }; +ok(&Devel::PPPort::get_cv('my_cv', 0)); +ok(!&Devel::PPPort::get_cv('not_my_cv', 0)); +ok(&Devel::PPPort::get_cv('not_my_cv', 1)); + +ok(Devel::PPPort::dXSTARG(42), 43); +ok(Devel::PPPort::dAXMARK(4711), 4710); + +ok(Devel::PPPort::prepush(), 42); + +ok(join(':', Devel::PPPort::xsreturn(0)), 'test1'); +ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); + +ok(Devel::PPPort::PERL_ABS(42), 42); +ok(Devel::PPPort::PERL_ABS(-13), 13); + +ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42'); +ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc'); + +ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo"); + diff --git a/ext/Devel-PPPort/parts/inc/newCONSTSUB b/ext/Devel-PPPort/parts/inc/newCONSTSUB new file mode 100644 index 0000000000..4b266d7990 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/newCONSTSUB @@ -0,0 +1,111 @@ +################################################################################ +## +## $Revision: 15 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +newCONSTSUB + +=implementation + +/* Hint: newCONSTSUB + * Returns a CV* as of perl-5.7.1. This return value is not supported + * by Devel::PPPort. + */ + +/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ +#if { VERSION < 5.004_63 } && { VERSION != 5.004_05 } +#if { NEED newCONSTSUB } + +/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */ +/* (There's no PL_parser in perl < 5.005, so this is completely safe) */ +#define D_PPP_PL_copline PL_copline + +void +newCONSTSUB(HV *stash, const char *name, SV *sv) +{ + U32 oldhints = PL_hints; + HV *old_cop_stash = PL_curcop->cop_stash; + HV *old_curstash = PL_curstash; + line_t oldline = PL_curcop->cop_line; + PL_curcop->cop_line = D_PPP_PL_copline; + + PL_hints &= ~HINT_BLOCK_SCOPE; + if (stash) + PL_curstash = PL_curcop->cop_stash = stash; + + newSUB( + +#if { VERSION < 5.003_22 } + start_subparse(), +#elif { VERSION == 5.003_22 } + start_subparse(0), +#else /* 5.003_23 onwards */ + start_subparse(FALSE, 0), +#endif + + newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)), + newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ + newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) + ); + + PL_hints = oldhints; + PL_curcop->cop_stash = old_cop_stash; + PL_curstash = old_curstash; + PL_curcop->cop_line = oldline; +} +#endif +#endif + +=xsinit + +#define NEED_newCONSTSUB + +=xsmisc + +void call_newCONSTSUB_1(void) +{ +#ifdef PERL_NO_GET_CONTEXT + dTHX; +#endif + newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1)); +} + +extern void call_newCONSTSUB_2(void); +extern void call_newCONSTSUB_3(void); + +=xsubs + +void +call_newCONSTSUB_1() + +void +call_newCONSTSUB_2() + +void +call_newCONSTSUB_3() + +=tests plan => 3 + +&Devel::PPPort::call_newCONSTSUB_1(); +ok(&Devel::PPPort::test_value_1(), 1); + +&Devel::PPPort::call_newCONSTSUB_2(); +ok(&Devel::PPPort::test_value_2(), 2); + +&Devel::PPPort::call_newCONSTSUB_3(); +ok(&Devel::PPPort::test_value_3(), 3); + diff --git a/ext/Devel-PPPort/parts/inc/newRV b/ext/Devel-PPPort/parts/inc/newRV new file mode 100644 index 0000000000..1467d1ae9d --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/newRV @@ -0,0 +1,74 @@ +################################################################################ +## +## $Revision: 9 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +newRV_inc +newRV_noinc + +=implementation + +__UNDEFINED__ newRV_inc(sv) newRV(sv) /* Replace */ + +#ifndef newRV_noinc +#if { NEED newRV_noinc } +SV * +newRV_noinc(SV *sv) +{ + SV *rv = (SV *)newRV(sv); + SvREFCNT_dec(sv); + return rv; +} +#endif +#endif + +=xsinit + +#define NEED_newRV_noinc + +=xsubs + +U32 +newRV_inc_REFCNT() + PREINIT: + SV *sv, *rv; + CODE: + sv = newSViv(42); + rv = newRV_inc(sv); + SvREFCNT_dec(sv); + RETVAL = SvREFCNT(sv); + sv_2mortal(rv); + OUTPUT: + RETVAL + +U32 +newRV_noinc_REFCNT() + PREINIT: + SV *sv, *rv; + CODE: + sv = newSViv(42); + rv = newRV_noinc(sv); + RETVAL = SvREFCNT(sv); + sv_2mortal(rv); + OUTPUT: + RETVAL + +=tests plan => 2 + +ok(&Devel::PPPort::newRV_inc_REFCNT, 1); +ok(&Devel::PPPort::newRV_noinc_REFCNT, 1); + diff --git a/ext/Devel-PPPort/parts/inc/newSVpv b/ext/Devel-PPPort/parts/inc/newSVpv new file mode 100644 index 0000000000..3a38549f98 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/newSVpv @@ -0,0 +1,115 @@ +################################################################################ +## +## $Revision: 6 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:51 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ +newSVpvn_flags + +=implementation + +#if { VERSION < 5.6.0 } +# define D_PPP_CONSTPV_ARG(x) ((char *) (x)) +#else +# define D_PPP_CONSTPV_ARG(x) (x) +#endif + +__UNDEFINED__ newSVpvn(data,len) ((data) \ + ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \ + : newSV(0)) + +__UNDEFINED__ newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) + +__UNDEFINED__ SVf_UTF8 0 + +#ifndef newSVpvn_flags + +#if { NEED newSVpvn_flags } + +SV * +newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags) +{ + SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len); + SvFLAGS(sv) |= (flags & SVf_UTF8); + return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv; +} + +#endif + +#endif + +=xsinit + +#define NEED_newSVpvn_flags + +=xsubs + +void +newSVpvn() + PPCODE: + mXPUSHs(newSVpvn("test", 4)); + mXPUSHs(newSVpvn("test", 2)); + mXPUSHs(newSVpvn("test", 0)); + mXPUSHs(newSVpvn(NULL, 2)); + mXPUSHs(newSVpvn(NULL, 0)); + XSRETURN(5); + +void +newSVpvn_flags() + PPCODE: + XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP)); + XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP)); + XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP)); + XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP)); + XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP)); + XSRETURN(5); + +void +newSVpvn_utf8() + PPCODE: + XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8)); + XSRETURN(1); + +=tests plan => 15 + +my @s = &Devel::PPPort::newSVpvn(); +ok(@s == 5); +ok($s[0], "test"); +ok($s[1], "te"); +ok($s[2], ""); +ok(!defined($s[3])); +ok(!defined($s[4])); + +@s = &Devel::PPPort::newSVpvn_flags(); +ok(@s == 5); +ok($s[0], "test"); +ok($s[1], "te"); +ok($s[2], ""); +ok(!defined($s[3])); +ok(!defined($s[4])); + +@s = &Devel::PPPort::newSVpvn_utf8(); +ok(@s == 1); +ok($s[0], "test"); + +if ($] >= 5.008001) { + require utf8; + ok(utf8::is_utf8($s[0])); +} +else { + skip("skip: no is_utf8()", 0); +} diff --git a/ext/Devel-PPPort/parts/inc/podtest b/ext/Devel-PPPort/parts/inc/podtest new file mode 100644 index 0000000000..ceea0cf7a2 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/podtest @@ -0,0 +1,52 @@ +################################################################################ +## +## $Revision: 9 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=tests plan => 0 + +my @pods = qw( HACKERS PPPort.pm ppport.h soak devel/regenerate devel/buildperl.pl ); + +my $reason = ''; + +if ($ENV{'SKIP_SLOW_TESTS'}) { + $reason = 'SKIP_SLOW_TESTS'; +} +else { + # Try loading Test::Pod + eval q{ + use Test::Pod; + $Test::Pod::VERSION >= 0.95 + or die "Test::Pod version only $Test::Pod::VERSION"; + import Test::Pod tests => scalar @pods; + }; + $reason = 'Test::Pod >= 0.95 required' if $@; +} + +if ($reason) { + load(); + plan(tests => scalar @pods); +} + +for (@pods) { + print "# checking $_\n"; + if ($reason) { + skip("skip: $reason", 0); + } + else { + pod_file_ok($_); + } +} + diff --git a/ext/Devel-PPPort/parts/inc/ppphbin b/ext/Devel-PPPort/parts/inc/ppphbin new file mode 100644 index 0000000000..583f266a77 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/ppphbin @@ -0,0 +1,828 @@ +################################################################################ +## +## $Revision: 50 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +=implementation + +use strict; + +# Disable broken TRIE-optimization +BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 } + +my $VERSION = __VERSION__; + +my %opt = ( + quiet => 0, + diag => 1, + hints => 1, + changes => 1, + cplusplus => 0, + filter => 1, + strip => 0, + version => 0, +); + +my($ppport) = $0 =~ /([\w.]+)$/; +my $LF = '(?:\r\n|[\r\n])'; # line feed +my $HS = "[ \t]"; # horizontal whitespace + +# Never use C comments in this file! +my $ccs = '/'.'*'; +my $cce = '*'.'/'; +my $rccs = quotemeta $ccs; +my $rcce = quotemeta $cce; + +eval { + require Getopt::Long; + Getopt::Long::GetOptions(\%opt, qw( + help quiet diag! filter! hints! changes! cplusplus strip version + patch=s copy=s diff=s compat-version=s + list-provided list-unsupported api-info=s + )) or usage(); +}; + +if ($@ and grep /^-/, @ARGV) { + usage() if "@ARGV" =~ /^--?h(?:elp)?$/; + die "Getopt::Long not found. Please don't use any options.\n"; +} + +if ($opt{version}) { + print "This is $0 $VERSION.\n"; + exit 0; +} + +usage() if $opt{help}; +strip() if $opt{strip}; + +if (exists $opt{'compat-version'}) { + my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; + if ($@) { + die "Invalid version number format: '$opt{'compat-version'}'\n"; + } + die "Only Perl 5 is supported\n" if $r != 5; + die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000; + $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; +} +else { + $opt{'compat-version'} = 5; +} + +my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ + ? ( $1 => { + ($2 ? ( base => $2 ) : ()), + ($3 ? ( todo => $3 ) : ()), + (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), + (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), + (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), + } ) + : die "invalid spec: $_" } qw( +__PERL_API__ +); + +if (exists $opt{'list-unsupported'}) { + my $f; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $API{$f}{todo}; + print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; + } + exit 0; +} + +# Scan for possible replacement candidates + +my(%replace, %need, %hints, %warnings, %depends); +my $replace = 0; +my($hint, $define, $function); + +sub find_api +{ + my $code = shift; + $code =~ s{ + / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) + | "[^"\\]*(?:\\.[^"\\]*)*" + | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx; + grep { exists $API{$_} } $code =~ /(\w+)/mg; +} + +while () { + if ($hint) { + my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings; + if (m{^\s*\*\s(.*?)\s*$}) { + for (@{$hint->[1]}) { + $h->{$_} ||= ''; # suppress warning with older perls + $h->{$_} .= "$1\n"; + } + } + else { undef $hint } + } + + $hint = [$1, [split /,?\s+/, $2]] + if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$}; + + if ($define) { + if ($define->[1] =~ /\\$/) { + $define->[1] .= $_; + } + else { + if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) { + my @n = find_api($define->[1]); + push @{$depends{$define->[0]}}, @n if @n + } + undef $define; + } + } + + $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)}; + + if ($function) { + if (/^}/) { + if (exists $API{$function->[0]}) { + my @n = find_api($function->[1]); + push @{$depends{$function->[0]}}, @n if @n + } + undef $function; + } + else { + $function->[1] .= $_; + } + } + + $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)}; + + $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; + $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; + $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; + $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; + + if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { + my @deps = map { s/\s+//g; $_ } split /,/, $3; + my $d; + for $d (map { s/\s+//g; $_ } split /,/, $1) { + push @{$depends{$d}}, @deps; + } + } + + $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; +} + +for (values %depends) { + my %s; + $_ = [sort grep !$s{$_}++, @$_]; +} + +if (exists $opt{'api-info'}) { + my $f; + my $count = 0; + my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $f =~ /$match/; + print "\n=== $f ===\n\n"; + my $info = 0; + if ($API{$f}{base} || $API{$f}{todo}) { + my $base = format_version($API{$f}{base} || $API{$f}{todo}); + print "Supported at least starting from perl-$base.\n"; + $info++; + } + if ($API{$f}{provided}) { + my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "__MIN_PERL__"; + print "Support by $ppport provided back to perl-$todo.\n"; + print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f}; + print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; + print "\n$hints{$f}" if exists $hints{$f}; + print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f}; + $info++; + } + print "No portability information available.\n" unless $info; + $count++; + } + $count or print "Found no API matching '$opt{'api-info'}'."; + print "\n"; + exit 0; +} + +if (exists $opt{'list-provided'}) { + my $f; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $API{$f}{provided}; + my @flags; + push @flags, 'explicit' if exists $need{$f}; + push @flags, 'depend' if exists $depends{$f}; + push @flags, 'hint' if exists $hints{$f}; + push @flags, 'warning' if exists $warnings{$f}; + my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; + print "$f$flags\n"; + } + exit 0; +} + +my @files; +my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc ); +my $srcext = join '|', map { quotemeta $_ } @srcext; + +if (@ARGV) { + my %seen; + for (@ARGV) { + if (-e) { + if (-f) { + push @files, $_ unless $seen{$_}++; + } + else { warn "'$_' is not a file.\n" } + } + else { + my @new = grep { -f } glob $_ + or warn "'$_' does not exist.\n"; + push @files, grep { !$seen{$_}++ } @new; + } + } +} +else { + eval { + require File::Find; + File::Find::find(sub { + $File::Find::name =~ /($srcext)$/i + and push @files, $File::Find::name; + }, '.'); + }; + if ($@) { + @files = map { glob "*$_" } @srcext; + } +} + +if (!@ARGV || $opt{filter}) { + my(@in, @out); + my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files; + for (@files) { + my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i; + push @{ $out ? \@out : \@in }, $_; + } + if (@ARGV && @out) { + warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out); + } + @files = @in; +} + +die "No input files given!\n" unless @files; + +my(%files, %global, %revreplace); +%revreplace = reverse %replace; +my $filename; +my $patch_opened = 0; + +for $filename (@files) { + unless (open IN, "<$filename") { + warn "Unable to read from $filename: $!\n"; + next; + } + + info("Scanning $filename ..."); + + my $c = do { local $/; }; + close IN; + + my %file = (orig => $c, changes => 0); + + # Temporarily remove C/XS comments and strings from the code + my @ccom; + + $c =~ s{ + ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]* + | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* ) + | ( ^$HS*\#[^\r\n]* + | "[^"\\]*(?:\\.[^"\\]*)*" + | '[^'\\]*(?:\\.[^'\\]*)*' + | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) ) + }{ defined $2 and push @ccom, $2; + defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex; + + $file{ccom} = \@ccom; + $file{code} = $c; + $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m; + + my $func; + + for $func (keys %API) { + my $match = $func; + $match .= "|$revreplace{$func}" if exists $revreplace{$func}; + if ($c =~ /\b(?:Perl_)?($match)\b/) { + $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; + $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; + if (exists $API{$func}{provided}) { + $file{uses_provided}{$func}++; + if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { + $file{uses}{$func}++; + my @deps = rec_depend($func); + if (@deps) { + $file{uses_deps}{$func} = \@deps; + for (@deps) { + $file{uses}{$_} = 0 unless exists $file{uses}{$_}; + } + } + for ($func, @deps) { + $file{needs}{$_} = 'static' if exists $need{$_}; + } + } + } + if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { + if ($c =~ /\b$func\b/) { + $file{uses_todo}{$func}++; + } + } + } + } + + while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { + if (exists $need{$2}) { + $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; + } + else { warning("Possibly wrong #define $1 in $filename") } + } + + for (qw(uses needs uses_todo needed_global needed_static)) { + for $func (keys %{$file{$_}}) { + push @{$global{$_}{$func}}, $filename; + } + } + + $files{$filename} = \%file; +} + +# Globally resolve NEED_'s +my $need; +for $need (keys %{$global{needs}}) { + if (@{$global{needs}{$need}} > 1) { + my @targets = @{$global{needs}{$need}}; + my @t = grep $files{$_}{needed_global}{$need}, @targets; + @targets = @t if @t; + @t = grep /\.xs$/i, @targets; + @targets = @t if @t; + my $target = shift @targets; + $files{$target}{needs}{$need} = 'global'; + for (@{$global{needs}{$need}}) { + $files{$_}{needs}{$need} = 'extern' if $_ ne $target; + } + } +} + +for $filename (@files) { + exists $files{$filename} or next; + + info("=== Analyzing $filename ==="); + + my %file = %{$files{$filename}}; + my $func; + my $c = $file{code}; + my $warnings = 0; + + for $func (sort keys %{$file{uses_Perl}}) { + if ($API{$func}{varargs}) { + unless ($API{$func}{nothxarg}) { + my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} + { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); + if ($changes) { + warning("Doesn't pass interpreter argument aTHX to Perl_$func"); + $file{changes} += $changes; + } + } + } + else { + warning("Uses Perl_$func instead of $func"); + $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} + {$func$1(}g); + } + } + + for $func (sort keys %{$file{uses_replace}}) { + warning("Uses $func instead of $replace{$func}"); + $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); + } + + for $func (sort keys %{$file{uses_provided}}) { + if ($file{uses}{$func}) { + if (exists $file{uses_deps}{$func}) { + diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); + } + else { + diag("Uses $func"); + } + } + $warnings += hint($func); + } + + unless ($opt{quiet}) { + for $func (sort keys %{$file{uses_todo}}) { + print "*** WARNING: Uses $func, which may not be portable below perl ", + format_version($API{$func}{todo}), ", even with '$ppport'\n"; + $warnings++; + } + } + + for $func (sort keys %{$file{needed_static}}) { + my $message = ''; + if (not exists $file{uses}{$func}) { + $message = "No need to define NEED_$func if $func is never used"; + } + elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { + $message = "No need to define NEED_$func when already needed globally"; + } + if ($message) { + diag($message); + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); + } + } + + for $func (sort keys %{$file{needed_global}}) { + my $message = ''; + if (not exists $global{uses}{$func}) { + $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; + } + elsif (exists $file{needs}{$func}) { + if ($file{needs}{$func} eq 'extern') { + $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; + } + elsif ($file{needs}{$func} eq 'static') { + $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; + } + } + if ($message) { + diag($message); + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); + } + } + + $file{needs_inc_ppport} = keys %{$file{uses}}; + + if ($file{needs_inc_ppport}) { + my $pp = ''; + + for $func (sort keys %{$file{needs}}) { + my $type = $file{needs}{$func}; + next if $type eq 'extern'; + my $suffix = $type eq 'global' ? '_GLOBAL' : ''; + unless (exists $file{"needed_$type"}{$func}) { + if ($type eq 'global') { + diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); + } + else { + diag("File needs $func, adding static request"); + } + $pp .= "#define NEED_$func$suffix\n"; + } + } + + if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { + $pp = ''; + $file{changes}++; + } + + unless ($file{has_inc_ppport}) { + diag("Needs to include '$ppport'"); + $pp .= qq(#include "$ppport"\n) + } + + if ($pp) { + $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) + || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) + || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) + || ($c =~ s/^/$pp/); + } + } + else { + if ($file{has_inc_ppport}) { + diag("No need to include '$ppport'"); + $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); + } + } + + # put back in our C comments + my $ix; + my $cppc = 0; + my @ccom = @{$file{ccom}}; + for $ix (0 .. $#ccom) { + if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { + $cppc++; + $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; + } + else { + $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; + } + } + + if ($cppc) { + my $s = $cppc != 1 ? 's' : ''; + warning("Uses $cppc C++ style comment$s, which is not portable"); + } + + my $s = $warnings != 1 ? 's' : ''; + my $warn = $warnings ? " ($warnings warning$s)" : ''; + info("Analysis completed$warn"); + + if ($file{changes}) { + if (exists $opt{copy}) { + my $newfile = "$filename$opt{copy}"; + if (-e $newfile) { + error("'$newfile' already exists, refusing to write copy of '$filename'"); + } + else { + local *F; + if (open F, ">$newfile") { + info("Writing copy of '$filename' with changes to '$newfile'"); + print F $c; + close F; + } + else { + error("Cannot open '$newfile' for writing: $!"); + } + } + } + elsif (exists $opt{patch} || $opt{changes}) { + if (exists $opt{patch}) { + unless ($patch_opened) { + if (open PATCH, ">$opt{patch}") { + $patch_opened = 1; + } + else { + error("Cannot open '$opt{patch}' for writing: $!"); + delete $opt{patch}; + $opt{changes} = 1; + goto fallback; + } + } + mydiff(\*PATCH, $filename, $c); + } + else { +fallback: + info("Suggested changes:"); + mydiff(\*STDOUT, $filename, $c); + } + } + else { + my $s = $file{changes} == 1 ? '' : 's'; + info("$file{changes} potentially required change$s detected"); + } + } + else { + info("Looks good"); + } +} + +close PATCH if $patch_opened; + +exit 0; + +####################################################################### + +sub try_use { eval "use @_;"; return $@ eq '' } + +sub mydiff +{ + local *F = shift; + my($file, $str) = @_; + my $diff; + + if (exists $opt{diff}) { + $diff = run_diff($opt{diff}, $file, $str); + } + + if (!defined $diff and try_use('Text::Diff')) { + $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); + $diff = <
$tmp") { + print F $str; + close F; + + if (open F, "$prog $file $tmp |") { + while () { + s/\Q$tmp\E/$file.patched/; + $diff .= $_; + } + close F; + unlink $tmp; + return $diff; + } + + unlink $tmp; + } + else { + error("Cannot open '$tmp' for writing: $!"); + } + + return undef; +} + +sub rec_depend +{ + my($func, $seen) = @_; + return () unless exists $depends{$func}; + $seen = {%{$seen||{}}}; + return () if $seen->{$func}++; + my %s; + grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}}; +} + +sub parse_version +{ + my $ver = shift; + + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { + return ($1, $2, $3); + } + elsif ($ver !~ /^\d+\.[\d_]+$/) { + die "cannot parse version '$ver'\n"; + } + + $ver =~ s/_//g; + $ver =~ s/$/000000/; + + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "cannot parse version '$ver'\n"; + } + } + + return ($r, $v, $s); +} + +sub format_version +{ + my $ver = shift; + + $ver =~ s/$/000000/; + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "invalid version '$ver'\n"; + } + $s /= 10; + + $ver = sprintf "%d.%03d", $r, $v; + $s > 0 and $ver .= sprintf "_%02d", $s; + + return $ver; + } + + return sprintf "%d.%d.%d", $r, $v, $s; +} + +sub info +{ + $opt{quiet} and return; + print @_, "\n"; +} + +sub diag +{ + $opt{quiet} and return; + $opt{diag} and print @_, "\n"; +} + +sub warning +{ + $opt{quiet} and return; + print "*** ", @_, "\n"; +} + +sub error +{ + print "*** ERROR: ", @_, "\n"; +} + +my %given_hints; +my %given_warnings; +sub hint +{ + $opt{quiet} and return; + my $func = shift; + my $rv = 0; + if (exists $warnings{$func} && !$given_warnings{$func}++) { + my $warn = $warnings{$func}; + $warn =~ s!^!*** !mg; + print "*** WARNING: $func\n", $warn; + $rv++; + } + if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) { + my $hint = $hints{$func}; + $hint =~ s/^/ /mg; + print " --- hint for $func ---\n", $hint; + } + $rv; +} + +sub usage +{ + my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; + my %M = ( 'I' => '*' ); + $usage =~ s/^\s*perl\s+\S+/$^X $0/; + $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; + + print < }; + my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms; + $copy =~ s/^(?=\S+)/ /gms; + $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms; + $self =~ s/^SKIP.*(?=^__DATA__)/SKIP +if (\@ARGV && \$ARGV[0] eq '--unstrip') { + eval { require Devel::PPPort }; + \$@ and die "Cannot require Devel::PPPort, please install.\\n"; + if (eval \$Devel::PPPort::VERSION < $VERSION) { + die "$0 was originally generated with Devel::PPPort $VERSION.\\n" + . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n" + . "Please install a newer version, or --unstrip will not work.\\n"; + } + Devel::PPPort::WriteFile(\$0); + exit 0; +} +print <$0" or die "cannot strip $0: $!\n"; + print OUT "$pl$c\n"; + + exit 0; +} diff --git a/ext/Devel-PPPort/parts/inc/ppphdoc b/ext/Devel-PPPort/parts/inc/ppphdoc new file mode 100644 index 0000000000..62d484106f --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/ppphdoc @@ -0,0 +1,353 @@ +################################################################################ +## +## $Revision: 32 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +=dontwarn + +NEED_function +NEED_function_GLOBAL +NEED_variable +NEED_variable_GLOBAL +DPPP_NAMESPACE + +=implementation + +=pod + +=head1 NAME + +ppport.h - Perl/Pollution/Portability version __VERSION__ + +=head1 SYNOPSIS + + perl ppport.h [options] [source files] + + Searches current directory for files if no [source files] are given + + --help show short help + + --version show version + + --patch=file write one patch file with changes + --copy=suffix write changed copies with suffix + --diff=program use diff program and options + + --compat-version=version provide compatibility with Perl version + --cplusplus accept C++ comments + + --quiet don't output anything except fatal errors + --nodiag don't show diagnostics + --nohints don't show hints + --nochanges don't suggest changes + --nofilter don't filter input files + + --strip strip all script and doc functionality from + ppport.h + + --list-provided list provided API + --list-unsupported list unsupported API + --api-info=name show Perl API portability information + +=head1 COMPATIBILITY + +This version of F is designed to support operation with Perl +installations back to __MIN_PERL__, and has been tested up to __MAX_PERL__. + +=head1 OPTIONS + +=head2 --help + +Display a brief usage summary. + +=head2 --version + +Display the version of F. + +=head2 --patch=I + +If this option is given, a single patch file will be created if +any changes are suggested. This requires a working diff program +to be installed on your system. + +=head2 --copy=I + +If this option is given, a copy of each file will be saved with +the given suffix that contains the suggested changes. This does +not require any external programs. Note that this does not +automagially add a dot between the original filename and the +suffix. If you want the dot, you have to include it in the option +argument. + +If neither C<--patch> or C<--copy> are given, the default is to +simply print the diffs for each file. This requires either +C or a C program to be installed. + +=head2 --diff=I + +Manually set the diff program and options to use. The default +is to use C, when installed, and output unified +context diffs. + +=head2 --compat-version=I + +Tell F to check for compatibility with the given +Perl version. The default is to check for compatibility with Perl +version __MIN_PERL__. You can use this option to reduce the output +of F if you intend to be backward compatible only +down to a certain Perl version. + +=head2 --cplusplus + +Usually, F will detect C++ style comments and +replace them with C style comments for portability reasons. +Using this option instructs F to leave C++ +comments untouched. + +=head2 --quiet + +Be quiet. Don't print anything except fatal errors. + +=head2 --nodiag + +Don't output any diagnostic messages. Only portability +alerts will be printed. + +=head2 --nohints + +Don't output any hints. Hints often contain useful portability +notes. Warnings will still be displayed. + +=head2 --nochanges + +Don't suggest any changes. Only give diagnostic output and hints +unless these are also deactivated. + +=head2 --nofilter + +Don't filter the list of input files. By default, files not looking +like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped. + +=head2 --strip + +Strip all script and documentation functionality from F. +This reduces the size of F dramatically and may be useful +if you want to include F in smaller modules without +increasing their distribution size too much. + +The stripped F will have a C<--unstrip> option that allows +you to undo the stripping, but only if an appropriate C +module is installed. + +=head2 --list-provided + +Lists the API elements for which compatibility is provided by +F. Also lists if it must be explicitly requested, +if it has dependencies, and if there are hints or warnings for it. + +=head2 --list-unsupported + +Lists the API elements that are known not to be supported by +F and below which version of Perl they probably +won't be available or work. + +=head2 --api-info=I + +Show portability information for API elements matching I. +If I is surrounded by slashes, it is interpreted as a regular +expression. + +=head1 DESCRIPTION + +In order for a Perl extension (XS) module to be as portable as possible +across differing versions of Perl itself, certain steps need to be taken. + +=over 4 + +=item * + +Including this header is the first major one. This alone will give you +access to a large part of the Perl API that hasn't been available in +earlier Perl releases. Use + + perl ppport.h --list-provided + +to see which API elements are provided by ppport.h. + +=item * + +You should avoid using deprecated parts of the API. For example, using +global Perl variables without the C prefix is deprecated. Also, +some API functions used to have a C prefix. Using this form is +also deprecated. You can safely use the supported API, as F +will provide wrappers for older Perl versions. + +=item * + +If you use one of a few functions or variables that were not present in +earlier versions of Perl, and that can't be provided using a macro, you +have to explicitly request support for these functions by adding one or +more C<#define>s in your source code before the inclusion of F. + +These functions or variables will be marked C in the list shown +by C<--list-provided>. + +Depending on whether you module has a single or multiple files that +use such functions or variables, you want either C or global +variants. + +For a C function or variable (used only in a single source +file), use: + + #define NEED_function + #define NEED_variable + +For a global function or variable (used in multiple source files), +use: + + #define NEED_function_GLOBAL + #define NEED_variable_GLOBAL + +Note that you mustn't have more than one global request for the +same function or variable in your project. + + __EXPLICIT_API__ + +To avoid namespace conflicts, you can change the namespace of the +explicitly exported functions / variables using the C +macro. Just C<#define> the macro before including C: + + #define DPPP_NAMESPACE MyOwnNamespace_ + #include "ppport.h" + +The default namespace is C. + +=back + +The good thing is that most of the above can be checked by running +F on your source code. See the next section for +details. + +=head1 EXAMPLES + +To verify whether F is needed for your module, whether you +should make any changes to your code, and whether any special defines +should be used, F can be run as a Perl script to check your +source code. Simply say: + + perl ppport.h + +The result will usually be a list of patches suggesting changes +that should at least be acceptable, if not necessarily the most +efficient solution, or a fix for all possible problems. + +If you know that your XS module uses features only available in +newer Perl releases, if you're aware that it uses C++ comments, +and if you want all suggestions as a single patch file, you could +use something like this: + + perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff + +If you only want your code to be scanned without any suggestions +for changes, use: + + perl ppport.h --nochanges + +You can specify a different C program or options, using +the C<--diff> option: + + perl ppport.h --diff='diff -C 10' + +This would output context diffs with 10 lines of context. + +If you want to create patched copies of your files instead, use: + + perl ppport.h --copy=.new + +To display portability information for the C function, +use: + + perl ppport.h --api-info=newSVpvn + +Since the argument to C<--api-info> can be a regular expression, +you can use + + perl ppport.h --api-info=/_nomg$/ + +to display portability information for all C<_nomg> functions or + + perl ppport.h --api-info=/./ + +to display information for all known API elements. + +=head1 BUGS + +If this version of F is causing failure during +the compilation of this module, please check if newer versions +of either this module or C are available on CPAN +before sending a bug report. + +If F was generated using the latest version of +C and is causing failure of this module, please +file a bug report using the CPAN Request Tracker at L. + +Please include the following information: + +=over 4 + +=item 1. + +The complete output from running "perl -V" + +=item 2. + +This file. + +=item 3. + +The name and version of the module you were trying to build. + +=item 4. + +A full log of the build that failed. + +=item 5. + +Any other information that you think could be relevant. + +=back + +For the latest version of this code, please get the C +module from CPAN. + +=head1 COPYRIGHT + +Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz. + +Version 2.x, Copyright (C) 2001, Paul Marquess. + +Version 1.x, Copyright (C) 1999, Kenneth Albanowski. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +See L. + +=cut + diff --git a/ext/Devel-PPPort/parts/inc/ppphtest b/ext/Devel-PPPort/parts/inc/ppphtest new file mode 100644 index 0000000000..f94cc7de2d --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/ppphtest @@ -0,0 +1,901 @@ +################################################################################ +## +## $Revision: 46 $ +## $Author: mhx $ +## $Date: 2009/01/23 18:28:00 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=tests plan => 235 + +BEGIN { + if ($ENV{'SKIP_SLOW_TESTS'}) { + for (1 .. 235) { + skip("skip: SKIP_SLOW_TESTS", 0); + } + exit 0; + } +} + +use File::Path qw/rmtree mkpath/; +use Config; + +my $tmp = 'ppptmp'; +my $inc = ''; +my $isVMS = $^O eq 'VMS'; +my $isMAC = $^O eq 'MacOS'; +my $perl = find_perl(); + +rmtree($tmp) if -d $tmp; +mkpath($tmp) or die "mkpath $tmp: $!\n"; +chdir($tmp) or die "chdir $tmp: $!\n"; + +if ($ENV{'PERL_CORE'}) { + if (-d '../../lib') { + if ($isVMS) { + $inc = '"-I../../lib"'; + } + elsif ($isMAC) { + $inc = '-I:::lib'; + } + else { + $inc = '-I../../lib'; + } + unshift @INC, '../../lib'; + } +} +if ($perl =~ m!^\./!) { + $perl = ".$perl"; +} + +END { + chdir('..') if !-d $tmp && -d "../$tmp"; + rmtree($tmp) if -d $tmp; +} + +ok(&Devel::PPPort::WriteFile("ppport.h")); + +sub comment +{ + my $c = shift; + $c =~ s/^/# | /mg; + $c .= "\n" unless $c =~ /[\r\n]$/; + print $c; +} + +sub ppport +{ + my @args = ('ppport.h', @_); + unshift @args, $inc if $inc; + my $run = $perl =~ m/\s/ ? qq("$perl") : $perl; + $run .= ' -MMac::err=unix' if $isMAC; + for (@args) { + $_ = qq("$_") if $isVMS && /^[^"]/; + $run .= " $_"; + } + print "# *** running $run ***\n"; + $run .= ' 2>&1' unless $isMAC; + my @out = `$run`; + my $out = join '', @out; + comment($out); + return wantarray ? @out : $out; +} + +sub matches +{ + my($str, $re, $mod) = @_; + my @n; + eval "\@n = \$str =~ /$re/g$mod;"; + if ($@) { + my $err = $@; + $err =~ s/^/# *** /mg; + print "# *** ERROR ***\n$err\n"; + } + return $@ ? -42 : scalar @n; +} + +sub eq_files +{ + my($f1, $f2) = @_; + return 0 unless -e $f1 && -e $f2; + local *F; + for ($f1, $f2) { + print "# File: $_\n"; + unless (open F, $_) { + print "# couldn't open $_: $!\n"; + return 0; + } + $_ = do { local $/; }; + close F; + comment($_); + } + return $f1 eq $f2; +} + +my @tests; + +for (split /\s*={70,}\s*/, do { local $/; }) { + s/^\s+//; s/\s+$//; + my($c, %f); + ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/; + push @tests, { code => $c, files => \%f }; +} + +my $t; +for $t (@tests) { + print "#\n", ('# ', '-'x70, "\n")x3, "#\n"; + my $f; + for $f (keys %{$t->{files}}) { + my @f = split /\//, $f; + if (@f > 1) { + pop @f; + my $path = join '/', @f; + mkpath($path) or die "mkpath('$path'): $!\n"; + } + my $txt = $t->{files}{$f}; + local *F; + open F, ">$f" or die "open $f: $!\n"; + print F "$txt\n"; + close F; + $txt =~ s/^/# | /mg; + print "# *** writing $f ***\n$txt\n"; + } + + my $code = $t->{code}; + $code =~ s/^/# | /mg; + + print "# *** evaluating test code ***\n$code\n"; + + eval $t->{code}; + if ($@) { + my $err = $@; + $err =~ s/^/# *** /mg; + print "# *** ERROR ***\n$err\n"; + } + ok($@, ''); + + for (keys %{$t->{files}}) { + unlink $_ or die "unlink('$_'): $!\n"; + } +} + +sub find_perl +{ + my $perl = $^X; + + return $perl if $isVMS; + + my $exe = $Config{'_exe'} || ''; + + if ($perl =~ /^perl\Q$exe\E$/i) { + $perl = "perl$exe"; + eval "require File::Spec"; + if ($@) { + $perl = "./$perl"; + } else { + $perl = File::Spec->catfile(File::Spec->curdir(), $perl); + } + } + + if ($perl !~ /\Q$exe\E$/i) { + $perl .= $exe; + } + + warn "find_perl: cannot find $perl from $^X" unless -f $perl; + + return $perl; +} + +__DATA__ + +my $o = ppport(qw(--help)); +ok($o =~ /^Usage:.*ppport\.h/m); +ok($o =~ /--help/m); + +$o = ppport(qw(--version)); +ok($o =~ /^This is.*ppport.*\d+\.\d+(?:_?\d+)?\.$/); + +$o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*test\.xs/mi); +ok($o =~ /Analyzing.*test\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); +ok($o =~ /Uses Perl_newSViv instead of newSViv/); + +$o = ppport(qw(--quiet --nochanges)); +ok($o =~ /^\s*$/); + +---------------------------- test.xs ------------------------------------------ + +Perl_newSViv(); + +=============================================================================== + +# check if C and C++ comments are filtered correctly + +my $o = ppport(qw(--copy=a)); +ok($o =~ /^Scanning.*MyExt\.xs/mi); +ok($o =~ /Analyzing.*MyExt\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Uses grok_bin/m); +ok($o !~ /^Uses newSVpv/m); +ok($o =~ /Uses 1 C\+\+ style comment/m); +ok(eq_files('MyExt.xsa', 'MyExt.ra')); + +# check if C++ are left untouched with --cplusplus + +$o = ppport(qw(--copy=b --cplusplus)); +ok($o =~ /^Scanning.*MyExt\.xs/mi); +ok($o =~ /Analyzing.*MyExt\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Uses grok_bin/m); +ok($o !~ /^Uses newSVpv/m); +ok($o !~ /Uses \d+ C\+\+ style comment/m); +ok(eq_files('MyExt.xsb', 'MyExt.rb')); + +unlink qw(MyExt.xsa MyExt.xsb); + +---------------------------- MyExt.xs ----------------------------------------- + +newSVuv(); + // newSVpv(); + XPUSHs(foo); +/* grok_bin(); */ + +---------------------------- MyExt.ra ----------------------------------------- + +#include "ppport.h" +newSVuv(); + /* newSVpv(); */ + XPUSHs(foo); +/* grok_bin(); */ + +---------------------------- MyExt.rb ----------------------------------------- + +#include "ppport.h" +newSVuv(); + // newSVpv(); + XPUSHs(foo); +/* grok_bin(); */ + +=============================================================================== + +my $o = ppport(qw(--nochanges file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o =~ /^Uses newCONSTSUB/m); +ok($o =~ /^Uses PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o =~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --nohints file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o =~ /^Uses newCONSTSUB/m); +ok($o =~ /^Uses PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --nohints --nodiag file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o !~ /^Uses newCONSTSUB/m); +ok($o !~ /^Uses PL_expect/m); +ok($o !~ /^Uses SvPV_nolen/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --quiet file1.xs)); +ok($o =~ /^\s*$/); + +$o = ppport(qw(--nochanges file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o =~ /^Uses mXPUSHp/m); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --nohints file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o =~ /^Uses mXPUSHp/m); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --nohints --nodiag file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o !~ /^Uses mXPUSHp/m); +ok($o !~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --quiet file2.xs)); +ok($o =~ /^\s*$/); + +---------------------------- file1.xs ----------------------------------------- + +#define NEED_newCONSTSUB +#define NEED_sv_2pv_flags +#define NEED_PL_parser +#include "ppport.h" + +newCONSTSUB(); +SvPV_nolen(); +PL_expect = 0; + +---------------------------- file2.xs ----------------------------------------- + +mXPUSHp(foo); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*FooBar\.xs/mi); +ok($o =~ /Analyzing.*FooBar\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o !~ /^Looks good/m); +ok($o =~ /^Uses grok_bin/m); + +---------------------------- FooBar.xs ---------------------------------------- + +newSViv(); +XPUSHs(foo); +grok_bin(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*First\.xs/mi); +ok($o =~ /Analyzing.*First\.xs/mi); +ok($o =~ /^Scanning.*second\.h/mi); +ok($o =~ /Analyzing.*second\.h/mi); +ok($o =~ /^Scanning.*sub.*third\.c/mi); +ok($o =~ /Analyzing.*sub.*third\.c/mi); +ok($o !~ /^Scanning.*foobar/mi); +ok(matches($o, '^Scanning', 'm'), 3); + +---------------------------- First.xs ----------------------------------------- + +one + +---------------------------- foobar.xyz --------------------------------------- + +two + +---------------------------- second.h ----------------------------------------- + +three + +---------------------------- sub/third.c -------------------------------------- + +four + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i); + +---------------------------- test.xs ------------------------------------------ + +#define NEED_foobar + +=============================================================================== + +# And now some complex "real-world" example + +my $o = ppport(qw(--copy=f)); +for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) { + ok($o =~ /^Scanning.*\Q$_\E/mi); + ok($o =~ /Analyzing.*\Q$_\E/i); +} +ok(matches($o, '^Scanning', 'm'), 6); + +ok(matches($o, '^Writing copy of', 'm'), 5); +ok(!-e "mod5.cf"); + +for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- main.xs ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_newCONSTSUB +#define NEED_grok_hex_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_hex(); +Perl_grok_bin(aTHX_ foo, bar); + +/* some comment */ + +perl_eval_pv(); +grok_bin(); +Perl_grok_bin(bar, sv_no); + +---------------------------- mod1.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_grok_bin_GLOBAL +#define NEED_newCONSTSUB +#include "ppport.h" + +newCONSTSUB(); +grok_bin(); +{ + Perl_croak ("foo"); + Perl_sv_catpvf(); /* I know it's wrong ;-) */ +} + +---------------------------- mod2.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_eval_pv +#include "ppport.h" + +newSViv(); + +/* + eval_pv(); +*/ + +---------------------------- mod3.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +grok_oct(); +eval_pv(); + +---------------------------- mod4.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +START_MY_CXT; + +---------------------------- mod5.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "ppport.h" +call_pv(); + +---------------------------- main.xsr ----------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_eval_pv_GLOBAL +#define NEED_grok_hex +#define NEED_newCONSTSUB_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_hex(); +grok_bin(foo, bar); + +/* some comment */ + +eval_pv(); +grok_bin(); +grok_bin(bar, PL_sv_no); + +---------------------------- mod1.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_grok_bin_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_bin(); +{ + Perl_croak (aTHX_ "foo"); + Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */ +} + +---------------------------- mod2.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + + +newSViv(); + +/* + eval_pv(); +*/ + +---------------------------- mod3.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#define NEED_grok_oct +#include "ppport.h" + +grok_oct(); +eval_pv(); + +---------------------------- mod4.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "ppport.h" + +START_MY_CXT; + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Uses grok_hex/m); +ok($o !~ /Looks good/m); + +$o = ppport(qw(--nochanges --compat-version=5.8.0)); +ok($o !~ /Uses grok_hex/m); +ok($o =~ /Looks good/m); + +---------------------------- FooBar.xs ---------------------------------------- + +grok_hex(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.5.3)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.005_03)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.6.0)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=5.006)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=5.999.999)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=6.0.0)); +ok($o =~ /Only Perl 5 is supported/m); + +$o = ppport(qw(--nochanges --compat-version=5.1000.999)); +ok($o =~ /Invalid version number: 5.1000.999/m); + +$o = ppport(qw(--nochanges --compat-version=5.999.1000)); +ok($o =~ /Invalid version number: 5.999.1000/m); + +---------------------------- FooBar.xs ---------------------------------------- + +SvPVutf8_force(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o !~ /potentially required change/); +ok(matches($o, '^Looks good', 'm'), 2); + +---------------------------- FooBar.xs ---------------------------------------- + +#define NEED_grok_numeric_radix +#define NEED_grok_number +#include "ppport.h" + +GROK_NUMERIC_RADIX(); +grok_number(); + +---------------------------- foo.c -------------------------------------------- + +#include "ppport.h" + +call_pv(); + +=============================================================================== + +# check --api-info option + +my $o = ppport(qw(--api-info=INT2PTR)); +my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 1); +ok(exists $found{INT2PTR}); +ok(matches($o, '^Supported at least starting from perl-5\.6\.0\.', 'm'), 1); +ok(matches($o, '^Support by .*ppport.* provided back to perl-5\.003\.', 'm'), 1); + +$o = ppport(qw(--api-info=Zero)); +%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 1); +ok(exists $found{Zero}); +ok(matches($o, '^No portability information available\.', 'm'), 1); + +$o = ppport(qw(--api-info=/Zero/)); +%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 2); +ok(exists $found{Zero}); +ok(exists $found{ZeroD}); + +=============================================================================== + +# check --list-provided option + +my @o = ppport(qw(--list-provided)); +my %p; +my $fail = 0; +for (@o) { + my($name, $flags) = /^(\w+)(?:\s+\[(\w+(?:,\s+\w+)*)\])?$/ or $fail++; + exists $p{$name} and $fail++; + $p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : ''; +} +ok(@o > 100); +ok($fail, 0); + +ok(exists $p{call_pv}); +ok(not ref $p{call_pv}); + +ok(exists $p{grok_bin}); +ok(ref $p{grok_bin}, 'HASH'); +ok(scalar keys %{$p{grok_bin}}, 2); +ok($p{grok_bin}{explicit}); +ok($p{grok_bin}{depend}); + +ok(exists $p{gv_stashpvn}); +ok(ref $p{gv_stashpvn}, 'HASH'); +ok(scalar keys %{$p{gv_stashpvn}}, 2); +ok($p{gv_stashpvn}{depend}); +ok($p{gv_stashpvn}{hint}); + +ok(exists $p{sv_catpvf_mg}); +ok(ref $p{sv_catpvf_mg}, 'HASH'); +ok(scalar keys %{$p{sv_catpvf_mg}}, 2); +ok($p{sv_catpvf_mg}{explicit}); +ok($p{sv_catpvf_mg}{depend}); + +ok(exists $p{PL_signals}); +ok(ref $p{PL_signals}, 'HASH'); +ok(scalar keys %{$p{PL_signals}}, 1); +ok($p{PL_signals}{explicit}); + +=============================================================================== + +# check --list-unsupported option + +my @o = ppport(qw(--list-unsupported)); +my %p; +my $fail = 0; +for (@o) { + my($name, $ver) = /^(\w+)\s*\.+\s*([\d._]+)$/ or $fail++; + exists $p{$name} and $fail++; + $p{$name} = $ver; +} +ok(@o > 100); +ok($fail, 0); + +ok(exists $p{utf8_distance}); +ok($p{utf8_distance}, '5.6.0'); + +ok(exists $p{save_generic_svref}); +ok($p{save_generic_svref}, '5.005_03'); + +=============================================================================== + +# check --nofilter option + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); + +$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL)); +ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m); +ok(matches($o, '^\|\s+foo\.o', 'mi'), 1); +ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); + +$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL)); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok($o =~ /^Scanning.*foo\.o/mi); +ok($o =~ /Analyzing.*foo\.o/mi); +ok($o =~ /^Scanning.*Makefile/mi); +ok($o =~ /Analyzing.*Makefile/mi); +ok(matches($o, '^Scanning', 'm'), 3); +ok(matches($o, 'Analyzing', 'm'), 3); + +---------------------------- foo.cpp ------------------------------------------ + +newSViv(); + +---------------------------- foo.o -------------------------------------------- + +newSViv(); + +---------------------------- Makefile.PL -------------------------------------- + +newSViv(); + +=============================================================================== + +# check if explicit variables are handled propery + +my $o = ppport(qw(--copy=a)); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o =~ /^Uses PL_signals/m); +ok($o =~ /^File needs PL_signals, adding static request/m); +ok(eq_files('MyExt.xsa', 'MyExt.ra')); + +unlink qw(MyExt.xsa); + +---------------------------- MyExt.xs ----------------------------------------- + +PL_signals = 123; +if (PL_signals == 42) + foo(); + +---------------------------- MyExt.ra ----------------------------------------- + +#define NEED_PL_signals +#include "ppport.h" +PL_signals = 123; +if (PL_signals == 42) + foo(); + +=============================================================================== + +my $o = ppport(qw(--nochanges file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o =~ /^Uses SvUOK/m); +ok($o =~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(2 warnings\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --compat-version=5.8.0 file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o !~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +---------------------------- file.xs ----------------------------------------- + +#define NEED_PL_parser +#include "ppport.h" +SvUOK +PL_copline + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE defgv + \ + sv_undef + +---------------------------- file.xsr ----------------------------------------- + +#include "ppport.h" +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING PL_defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE PL_defgv + \ + PL_sv_undef + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak("bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner("foo"); +warner_nocontext("foo"); +warner("foo"); + +---------------------------- file.xsr ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak(aTHX_ "bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner(aTHX_ "foo"); +warner_nocontext("foo"); +warner("foo"); + diff --git a/ext/Devel-PPPort/parts/inc/pv_tools b/ext/Devel-PPPort/parts/inc/pv_tools new file mode 100644 index 0000000000..c7e4c1e907 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/pv_tools @@ -0,0 +1,281 @@ +################################################################################ +## +## $Revision: 5 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:51 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ +pv_escape +pv_pretty +pv_display + +=implementation + +__UNDEFINED__ PERL_PV_ESCAPE_QUOTE 0x0001 +__UNDEFINED__ PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE +__UNDEFINED__ PERL_PV_PRETTY_ELLIPSES 0x0002 +__UNDEFINED__ PERL_PV_PRETTY_LTGT 0x0004 +__UNDEFINED__ PERL_PV_ESCAPE_FIRSTCHAR 0x0008 +__UNDEFINED__ PERL_PV_ESCAPE_UNI 0x0100 +__UNDEFINED__ PERL_PV_ESCAPE_UNI_DETECT 0x0200 +__UNDEFINED__ PERL_PV_ESCAPE_ALL 0x1000 +__UNDEFINED__ PERL_PV_ESCAPE_NOBACKSLASH 0x2000 +__UNDEFINED__ PERL_PV_ESCAPE_NOCLEAR 0x4000 +__UNDEFINED__ PERL_PV_ESCAPE_RE 0x8000 +__UNDEFINED__ PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR + +__UNDEFINED__ PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE +__UNDEFINED__ PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE + +/* Hint: pv_escape + * Note that unicode functionality is only backported to + * those perl versions that support it. For older perl + * versions, the implementation will fall back to bytes. + */ + +#ifndef pv_escape +#if { NEED pv_escape } + +char * +pv_escape(pTHX_ SV *dsv, char const * const str, + const STRLEN count, const STRLEN max, + STRLEN * const escaped, const U32 flags) +{ + const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\'; + const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc; + char octbuf[32] = "%123456789ABCDF"; + STRLEN wrote = 0; + STRLEN chsize = 0; + STRLEN readsize = 1; +#if defined(is_utf8_string) && defined(utf8_to_uvchr) + bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0; +#endif + const char *pv = str; + const char * const end = pv + count; + octbuf[0] = esc; + + if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) + sv_setpvs(dsv, ""); + +#if defined(is_utf8_string) && defined(utf8_to_uvchr) + if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count)) + isuni = 1; +#endif + + for (; pv < end && (!max || wrote < max) ; pv += readsize) { + const UV u = +#if defined(is_utf8_string) && defined(utf8_to_uvchr) + isuni ? utf8_to_uvchr((U8*)pv, &readsize) : +#endif + (U8)*pv; + const U8 c = (U8)u & 0xFF; + + if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) { + if (flags & PERL_PV_ESCAPE_FIRSTCHAR) + chsize = my_snprintf(octbuf, sizeof octbuf, + "%"UVxf, u); + else + chsize = my_snprintf(octbuf, sizeof octbuf, + "%cx{%"UVxf"}", esc, u); + } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) { + chsize = 1; + } else { + if (c == dq || c == esc || !isPRINT(c)) { + chsize = 2; + switch (c) { + case '\\' : /* fallthrough */ + case '%' : if (c == esc) + octbuf[1] = esc; + else + chsize = 1; + break; + case '\v' : octbuf[1] = 'v'; break; + case '\t' : octbuf[1] = 't'; break; + case '\r' : octbuf[1] = 'r'; break; + case '\n' : octbuf[1] = 'n'; break; + case '\f' : octbuf[1] = 'f'; break; + case '"' : if (dq == '"') + octbuf[1] = '"'; + else + chsize = 1; + break; + default: chsize = my_snprintf(octbuf, sizeof octbuf, + pv < end && isDIGIT((U8)*(pv+readsize)) + ? "%c%03o" : "%c%o", esc, c); + } + } else { + chsize = 1; + } + } + if (max && wrote + chsize > max) { + break; + } else if (chsize > 1) { + sv_catpvn(dsv, octbuf, chsize); + wrote += chsize; + } else { + char tmp[2]; + my_snprintf(tmp, sizeof tmp, "%c", c); + sv_catpvn(dsv, tmp, 1); + wrote++; + } + if (flags & PERL_PV_ESCAPE_FIRSTCHAR) + break; + } + if (escaped != NULL) + *escaped= pv - str; + return SvPVX(dsv); +} + +#endif +#endif + +#ifndef pv_pretty +#if { NEED pv_pretty } + +char * +pv_pretty(pTHX_ SV *dsv, char const * const str, const STRLEN count, + const STRLEN max, char const * const start_color, char const * const end_color, + const U32 flags) +{ + const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%'; + STRLEN escaped; + + if (!(flags & PERL_PV_PRETTY_NOCLEAR)) + sv_setpvs(dsv, ""); + + if (dq == '"') + sv_catpvs(dsv, "\""); + else if (flags & PERL_PV_PRETTY_LTGT) + sv_catpvs(dsv, "<"); + + if (start_color != NULL) + sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color)); + + pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR); + + if (end_color != NULL) + sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color)); + + if (dq == '"') + sv_catpvs(dsv, "\""); + else if (flags & PERL_PV_PRETTY_LTGT) + sv_catpvs(dsv, ">"); + + if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count) + sv_catpvs(dsv, "..."); + + return SvPVX(dsv); +} + +#endif +#endif + +#ifndef pv_display +#if { NEED pv_display } + +char * +pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) +{ + pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP); + if (len > cur && pv[cur] == '\0') + sv_catpvs(dsv, "\\0"); + return SvPVX(dsv); +} + +#endif +#endif + +=xsinit + +#define NEED_pv_escape +#define NEED_pv_pretty +#define NEED_pv_display + +=xsubs + +void +pv_escape_can_unicode() + PPCODE: +#if defined(is_utf8_string) && defined(utf8_to_uvchr) + XSRETURN_YES; +#else + XSRETURN_NO; +#endif + +void +pv_pretty() + PREINIT: + char *rv; + PPCODE: + EXTEND(SP, 8); + ST(0) = sv_newmortal(); + rv = pv_pretty(ST(0), "foobarbaz", + 9, 40, NULL, NULL, 0); + ST(1) = sv_2mortal(newSVpv(rv, 0)); + ST(2) = sv_newmortal(); + rv = pv_pretty(ST(2), "pv_p\retty\n", + 10, 40, "left", "right", PERL_PV_PRETTY_LTGT); + ST(3) = sv_2mortal(newSVpv(rv, 0)); + ST(4) = sv_newmortal(); + rv = pv_pretty(ST(4), "N\303\275 Batter\303\255", + 12, 20, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT); + ST(5) = sv_2mortal(newSVpv(rv, 0)); + ST(6) = sv_newmortal(); + rv = pv_pretty(ST(6), "\303\201g\303\246tis Byrjun", + 15, 18, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT|PERL_PV_PRETTY_ELLIPSES); + ST(7) = sv_2mortal(newSVpv(rv, 0)); + XSRETURN(8); + +void +pv_display() + PREINIT: + char *rv; + PPCODE: + EXTEND(SP, 4); + ST(0) = sv_newmortal(); + rv = pv_display(ST(0), "foob\0rbaz", 9, 10, 20); + ST(1) = sv_2mortal(newSVpv(rv, 0)); + ST(2) = sv_newmortal(); + rv = pv_display(ST(2), "pv_display", 10, 11, 5); + ST(3) = sv_2mortal(newSVpv(rv, 0)); + XSRETURN(4); + +=tests plan => 13 + +my $uni = &Devel::PPPort::pv_escape_can_unicode(); + +# sanity check +ok($uni ? $] >= 5.006 : $] < 5.008); + +my @r; + +@r = &Devel::PPPort::pv_pretty(); +ok($r[0], $r[1]); +ok($r[0], "foobarbaz"); +ok($r[2], $r[3]); +ok($r[2], ''); +ok($r[4], $r[5]); +ok($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303'); +ok($r[6], $r[7]); +ok($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...'); + +@r = &Devel::PPPort::pv_display(); +ok($r[0], $r[1]); +ok($r[0], '"foob\0rbaz"\0'); +ok($r[2], $r[3]); +ok($r[2] eq '"pv_di"...\0' || + $r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :( + diff --git a/ext/Devel-PPPort/parts/inc/pvs b/ext/Devel-PPPort/parts/inc/pvs new file mode 100644 index 0000000000..73bc9fb57a --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/pvs @@ -0,0 +1,99 @@ +################################################################################ +## +## $Revision: 9 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +/* concatenating with "" ensures that only literal strings are accepted as argument + * note that STR_WITH_LEN() can't be used as argument to macros or functions that + * under some configurations might be macros + */ + +__UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1) + +__UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) +__UNDEFINED__ newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags) +__UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) +__UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) +__UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) +__UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) + +=xsubs + +void +newSVpvs() + PPCODE: + mXPUSHs(newSVpvs("newSVpvs")); + XSRETURN(1); + +void +newSVpvs_flags() + PPCODE: + XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP)); + XSRETURN(1); + +void +sv_catpvs(sv) + SV *sv + PPCODE: + sv_catpvs(sv, "sv_catpvs"); + +void +sv_setpvs(sv) + SV *sv + PPCODE: + sv_setpvs(sv, "sv_setpvs"); + +void +hv_fetchs(hv) + SV *hv + PREINIT: + SV **s; + PPCODE: + s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0); + XPUSHs(sv_mortalcopy(*s)); + XSRETURN(1); + +void +hv_stores(hv, sv) + SV *hv + SV *sv + PPCODE: + (void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv)); + +=tests plan => 8 + +my $x = 'foo'; + +ok(Devel::PPPort::newSVpvs(), "newSVpvs"); +ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); + +Devel::PPPort::sv_catpvs($x); +ok($x, "foosv_catpvs"); + +Devel::PPPort::sv_setpvs($x); +ok($x, "sv_setpvs"); + +my %h = ('hv_fetchs' => 42); +Devel::PPPort::hv_stores(\%h, 4711); +ok(scalar keys %h, 2); +ok(exists $h{'hv_stores'}); +ok($h{'hv_stores'}, 4711); +ok(Devel::PPPort::hv_fetchs(\%h), 42); diff --git a/ext/Devel-PPPort/parts/inc/shared_pv b/ext/Devel-PPPort/parts/inc/shared_pv new file mode 100644 index 0000000000..db779be835 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/shared_pv @@ -0,0 +1,91 @@ +################################################################################ +## +## $Revision: 5 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +newSVpvn_share +__UNDEFINED__ + +=implementation + +#ifndef newSVpvn_share + +#if { NEED newSVpvn_share } + +SV * +newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash) +{ + SV *sv; + if (len < 0) + len = -len; + if (!hash) + PERL_HASH(hash, (char*) src, len); + sv = newSVpvn((char *) src, len); + sv_upgrade(sv, SVt_PVIV); + SvIVX(sv) = hash; + SvREADONLY_on(sv); + SvPOK_on(sv); + return sv; +} + +#endif + +#endif + +__UNDEFINED__ SvSHARED_HASH(sv) (0 + SvUVX(sv)) + +=xsinit + +#define NEED_newSVpvn_share + +=xsubs + +int +newSVpvn_share() + PREINIT: + const char *s; + SV *sv; + STRLEN len; + U32 hash; + CODE: + RETVAL = 0; + s = "mhx"; + len = 3; + PERL_HASH(hash, (char *) s, len); + sv = newSVpvn_share(s, len, 0); + s = 0; + RETVAL += strEQ(SvPV_nolen_const(sv), "mhx"); + RETVAL += SvCUR(sv) == len; + RETVAL += SvSHARED_HASH(sv) == hash; + SvREFCNT_dec(sv); + s = "foobar"; + len = 6; + PERL_HASH(hash, (char *) s, len); + sv = newSVpvn_share(s, -(I32) len, hash); + s = 0; + RETVAL += strEQ(SvPV_nolen_const(sv), "foobar"); + RETVAL += SvCUR(sv) == len; + RETVAL += SvSHARED_HASH(sv) == hash; + SvREFCNT_dec(sv); + OUTPUT: + RETVAL + + +=tests plan => 1 + +ok(&Devel::PPPort::newSVpvn_share(), 6); + diff --git a/ext/Devel-PPPort/parts/inc/snprintf b/ext/Devel-PPPort/parts/inc/snprintf new file mode 100644 index 0000000000..310bfbaa10 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/snprintf @@ -0,0 +1,70 @@ +################################################################################ +## +## $Revision: 6 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +my_snprintf + +=implementation + +#if !defined(my_snprintf) +#if { NEED my_snprintf } + +int +my_snprintf(char *buffer, const Size_t len, const char *format, ...) +{ + dTHX; + int retval; + va_list ap; + va_start(ap, format); +#ifdef HAS_VSNPRINTF + retval = vsnprintf(buffer, len, format, ap); +#else + retval = vsprintf(buffer, format, ap); +#endif + va_end(ap); + if (retval < 0 || (len > 0 && (Size_t)retval >= len)) + Perl_croak(aTHX_ "panic: my_snprintf buffer overflow"); + return retval; +} + +#endif +#endif + +=xsinit + +#define NEED_my_snprintf + +=xsubs + +void +my_snprintf() + PREINIT: + char buf[128]; + int len; + PPCODE: + len = my_snprintf(buf, sizeof buf, "foo%s%d", "bar", 42); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + XSRETURN(2); + +=tests plan => 2 + +my($l, $s) = Devel::PPPort::my_snprintf(); +ok($l, 8); +ok($s, "foobar42"); + diff --git a/ext/Devel-PPPort/parts/inc/sprintf b/ext/Devel-PPPort/parts/inc/sprintf new file mode 100644 index 0000000000..6756f9abc9 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/sprintf @@ -0,0 +1,62 @@ +################################################################################ +## +## $Revision: 2 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:51 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +my_sprintf + +=implementation + +#if !defined(my_sprintf) +#if { NEED my_sprintf } + +int +my_sprintf(char *buffer, const char* pat, ...) +{ + va_list args; + va_start(args, pat); + vsprintf(buffer, pat, args); + va_end(args); + return strlen(buffer); +} + +#endif +#endif + +=xsinit + +#define NEED_my_sprintf + +=xsubs + +void +my_sprintf() + PREINIT: + char buf[128]; + int len; + PPCODE: + len = my_sprintf(buf, "foo%s%d", "bar", 42); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + XSRETURN(2); + +=tests plan => 2 + +my($l, $s) = Devel::PPPort::my_sprintf(); +ok($l, 8); +ok($s, "foobar42"); + diff --git a/ext/Devel-PPPort/parts/inc/strlfuncs b/ext/Devel-PPPort/parts/inc/strlfuncs new file mode 100644 index 0000000000..d351703e19 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/strlfuncs @@ -0,0 +1,114 @@ +################################################################################ +## +## $Revision: 6 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +my_strlcat +my_strlcpy + +=implementation + +#if !defined(my_strlcat) +#if { NEED my_strlcat } + +Size_t +my_strlcat(char *dst, const char *src, Size_t size) +{ + Size_t used, length, copy; + + used = strlen(dst); + length = strlen(src); + if (size > 0 && used < size - 1) { + copy = (length >= size - used) ? size - used - 1 : length; + memcpy(dst + used, src, copy); + dst[used + copy] = '\0'; + } + return used + length; +} +#endif +#endif + +#if !defined(my_strlcpy) +#if { NEED my_strlcpy } + +Size_t +my_strlcpy(char *dst, const char *src, Size_t size) +{ + Size_t length, copy; + + length = strlen(src); + if (size > 0) { + copy = (length >= size) ? size - 1 : length; + memcpy(dst, src, copy); + dst[copy] = '\0'; + } + return length; +} + +#endif +#endif + +=xsinit + +#define NEED_my_strlcat +#define NEED_my_strlcpy + +=xsubs + +void +my_strlfunc() + PREINIT: + char buf[8]; + int len; + PPCODE: + len = my_strlcpy(buf, "foo", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcat(buf, "bar", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcat(buf, "baz", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcpy(buf, "1234567890", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcpy(buf, "1234", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcat(buf, "567890123456", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + XSRETURN(12); + +=tests plan => 13 + +my @e = (3, 'foo', + 6, 'foobar', + 9, 'foobarb', + 10, '1234567', + 4, '1234', + 16, '1234567', + ); +my @r = Devel::PPPort::my_strlfunc(); + +ok(@e == @r); + +for (0 .. $#e) { + ok($r[$_], $e[$_]); +} + diff --git a/ext/Devel-PPPort/parts/inc/sv_xpvf b/ext/Devel-PPPort/parts/inc/sv_xpvf new file mode 100644 index 0000000000..3c990c6e93 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/sv_xpvf @@ -0,0 +1,321 @@ +################################################################################ +## +## $Revision: 10 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +vnewSVpvf +sv_vcatpvf +sv_vsetpvf + +sv_catpvf_mg +sv_catpvf_mg_nocontext +sv_vcatpvf_mg + +sv_setpvf_mg +sv_setpvf_mg_nocontext +sv_vsetpvf_mg + +=implementation + +#if { VERSION >= 5.004 } && !defined(vnewSVpvf) +#if { NEED vnewSVpvf } + +SV * +vnewSVpvf(pTHX_ const char *pat, va_list *args) +{ + register SV *sv = newSV(0); + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); + return sv; +} + +#endif +#endif + +#if { VERSION >= 5.004 } && !defined(sv_vcatpvf) +# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) +#endif + +#if { VERSION >= 5.004 } && !defined(sv_vsetpvf) +# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) +#endif + +#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg) +#if { NEED sv_catpvf_mg } + +void +sv_catpvf_mg(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif + +#ifdef PERL_IMPLICIT_CONTEXT +#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg_nocontext) +#if { NEED sv_catpvf_mg_nocontext } + +void +sv_catpvf_mg_nocontext(SV *sv, const char *pat, ...) +{ + dTHX; + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif +#endif + +/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */ +#ifndef sv_catpvf_mg +# ifdef PERL_IMPLICIT_CONTEXT +# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext +# else +# define sv_catpvf_mg Perl_sv_catpvf_mg +# endif +#endif + +#if { VERSION >= 5.004 } && !defined(sv_vcatpvf_mg) +# define sv_vcatpvf_mg(sv, pat, args) \ + STMT_START { \ + sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ + SvSETMAGIC(sv); \ + } STMT_END +#endif + +#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg) +#if { NEED sv_setpvf_mg } + +void +sv_setpvf_mg(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif + +#ifdef PERL_IMPLICIT_CONTEXT +#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg_nocontext) +#if { NEED sv_setpvf_mg_nocontext } + +void +sv_setpvf_mg_nocontext(SV *sv, const char *pat, ...) +{ + dTHX; + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif +#endif + +/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */ +#ifndef sv_setpvf_mg +# ifdef PERL_IMPLICIT_CONTEXT +# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext +# else +# define sv_setpvf_mg Perl_sv_setpvf_mg +# endif +#endif + +#if { VERSION >= 5.004 } && !defined(sv_vsetpvf_mg) +# define sv_vsetpvf_mg(sv, pat, args) \ + STMT_START { \ + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ + SvSETMAGIC(sv); \ + } STMT_END +#endif + +=xsinit + +#define NEED_vnewSVpvf +#define NEED_sv_catpvf_mg +#define NEED_sv_catpvf_mg_nocontext +#define NEED_sv_setpvf_mg +#define NEED_sv_setpvf_mg_nocontext + +=xsmisc + +static SV * test_vnewSVpvf(pTHX_ const char *pat, ...) +{ + SV *sv; + va_list args; + va_start(args, pat); +#if { VERSION >= 5.004 } + sv = vnewSVpvf(pat, &args); +#else + sv = newSVpv((char *) pat, 0); +#endif + va_end(args); + return sv; +} + +static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); +#if { VERSION >= 5.004 } + sv_vcatpvf(sv, pat, &args); +#else + sv_catpv(sv, (char *) pat); +#endif + va_end(args); +} + +static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); +#if { VERSION >= 5.004 } + sv_vsetpvf(sv, pat, &args); +#else + sv_setpv(sv, (char *) pat); +#endif + va_end(args); +} + +=xsubs + +SV * +vnewSVpvf() + CODE: + RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42); + OUTPUT: + RETVAL + +SV * +sv_vcatpvf(sv) + SV *sv + CODE: + RETVAL = newSVsv(sv); + test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42); + OUTPUT: + RETVAL + +SV * +sv_vsetpvf(sv) + SV *sv + CODE: + RETVAL = newSVsv(sv); + test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42); + OUTPUT: + RETVAL + +void +sv_catpvf_mg(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } + sv_catpvf_mg(sv, "%s-%d", "Perl", 42); +#endif + +void +Perl_sv_catpvf_mg(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } + Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43); +#endif + +void +sv_catpvf_mg_nocontext(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } +#ifdef PERL_IMPLICIT_CONTEXT + sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44); +#else + sv_catpvf_mg(sv, "%s-%d", "-Perl", 44); +#endif +#endif + +void +sv_setpvf_mg(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } + sv_setpvf_mg(sv, "%s-%d", "mhx", 42); +#endif + +void +Perl_sv_setpvf_mg(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } + Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43); +#endif + +void +sv_setpvf_mg_nocontext(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } +#ifdef PERL_IMPLICIT_CONTEXT + sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44); +#else + sv_setpvf_mg(sv, "%s-%d", "bar", 44); +#endif +#endif + +=tests plan => 9 + +use Tie::Hash; +my %h; +tie %h, 'Tie::StdHash'; +$h{foo} = 'foo-'; +$h{bar} = ''; + +ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d'); +ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d'); +ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d'); + +&Devel::PPPort::sv_catpvf_mg($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-'); + +&Devel::PPPort::Perl_sv_catpvf_mg($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-'); + +&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-'); + +&Devel::PPPort::sv_setpvf_mg($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'mhx-42' : ''); + +&Devel::PPPort::Perl_sv_setpvf_mg($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'foo-43' : ''); + +&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'bar-44' : ''); + + diff --git a/ext/Devel-PPPort/parts/inc/threads b/ext/Devel-PPPort/parts/inc/threads new file mode 100644 index 0000000000..518bdf1fcb --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/threads @@ -0,0 +1,75 @@ +################################################################################ +## +## $Revision: 11 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ +aTHXR +aTHXR_ +dTHXR + +=implementation + +__UNDEFINED__ dTHR dNOOP + +__UNDEFINED__ dTHX dNOOP +__UNDEFINED__ dTHXa(x) dNOOP + +__UNDEFINED__ pTHX void +__UNDEFINED__ pTHX_ +__UNDEFINED__ aTHX +__UNDEFINED__ aTHX_ + +#if { VERSION < 5.6.0 } +# ifdef USE_THREADS +# define aTHXR thr +# define aTHXR_ thr, +# else +# define aTHXR +# define aTHXR_ +# endif +# define dTHXR dTHR +#else +# define aTHXR aTHX +# define aTHXR_ aTHX_ +# define dTHXR dTHX +#endif + +__UNDEFINED__ dTHXoa(x) dTHXa(x) + +=xsubs + +IV +no_THX_arg(sv) + SV *sv + CODE: + RETVAL = 1 + sv_2iv(sv); + OUTPUT: + RETVAL + +void +with_THX_arg(error) + char *error + PPCODE: + Perl_croak(aTHX_ "%s", error); + +=tests plan => 2 + +ok(&Devel::PPPort::no_THX_arg("42"), 43); +eval { &Devel::PPPort::with_THX_arg("yes\n"); }; +ok($@ =~ /^yes/); + diff --git a/ext/Devel-PPPort/parts/inc/uv b/ext/Devel-PPPort/parts/inc/uv new file mode 100644 index 0000000000..5fdec7afa0 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/uv @@ -0,0 +1,129 @@ +################################################################################ +## +## $Revision: 17 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ +SvUOK + +=implementation + +__UNDEFINED__ sv_setuv(sv, uv) \ + STMT_START { \ + UV TeMpUv = uv; \ + if (TeMpUv <= IV_MAX) \ + sv_setiv(sv, TeMpUv); \ + else \ + sv_setnv(sv, (double)TeMpUv); \ + } STMT_END + +__UNDEFINED__ newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) + +__UNDEFINED__ sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) +__UNDEFINED__ SvUVX(sv) ((UV)SvIVX(sv)) +__UNDEFINED__ SvUVXx(sv) SvUVX(sv) +__UNDEFINED__ SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) +__UNDEFINED__ SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) + +/* Hint: sv_uv + * Always use the SvUVx() macro instead of sv_uv(). + */ +__UNDEFINED__ sv_uv(sv) SvUVx(sv) + +#if !defined(SvUOK) && defined(SvIOK_UV) +# define SvUOK(sv) SvIOK_UV(sv) +#endif + +__UNDEFINED__ XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) +__UNDEFINED__ XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END + +__UNDEFINED__ PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END +__UNDEFINED__ XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END + +=xsubs + +SV * +sv_setuv(uv) + UV uv + CODE: + RETVAL = newSViv(1); + sv_setuv(RETVAL, uv); + OUTPUT: + RETVAL + +SV * +newSVuv(uv) + UV uv + CODE: + RETVAL = newSVuv(uv); + OUTPUT: + RETVAL + +UV +sv_2uv(sv) + SV *sv + CODE: + RETVAL = sv_2uv(sv); + OUTPUT: + RETVAL + +UV +SvUVx(sv) + SV *sv + CODE: + sv--; + RETVAL = SvUVx(++sv); + OUTPUT: + RETVAL + +void +XSRETURN_UV() + PPCODE: + XSRETURN_UV(42); + +void +PUSHu() + PREINIT: + dTARG; + PPCODE: + TARG = sv_newmortal(); + EXTEND(SP, 1); + PUSHu(42); + XSRETURN(1); + +void +XPUSHu() + PREINIT: + dTARG; + PPCODE: + TARG = sv_newmortal(); + XPUSHu(43); + XSRETURN(1); + +=tests plan => 10 + +ok(&Devel::PPPort::sv_setuv(42), 42); +ok(&Devel::PPPort::newSVuv(123), 123); +ok(&Devel::PPPort::sv_2uv("4711"), 4711); +ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559); +ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559); +ok(&Devel::PPPort::SvUVx(1735928559), 1735928559); +ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef); +ok(&Devel::PPPort::XSRETURN_UV(), 42); +ok(&Devel::PPPort::PUSHu(), 42); +ok(&Devel::PPPort::XPUSHu(), 43); + diff --git a/ext/Devel-PPPort/parts/inc/variables b/ext/Devel-PPPort/parts/inc/variables new file mode 100644 index 0000000000..3058412507 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/variables @@ -0,0 +1,449 @@ +################################################################################ +## +## $Revision: 19 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +PL_ppaddr +PL_no_modify +PL_DBsignal +PL_DBsingle +PL_DBsub +PL_DBtrace +PL_Sv +PL_bufend +PL_bufptr +PL_compiling +PL_copline +PL_curcop +PL_curstash +PL_debstash +PL_defgv +PL_diehook +PL_dirty +PL_dowarn +PL_errgv +PL_expect +PL_hexdigit +PL_hints +PL_laststatval +PL_lex_state +PL_lex_stuff +PL_linestr +PL_na +PL_parser +PL_perl_destruct_level +PL_perldb +PL_rsfp_filters +PL_rsfp +PL_stack_base +PL_stack_sp +PL_statcache +PL_stdingv +PL_sv_arenaroot +PL_sv_no +PL_sv_undef +PL_sv_yes +PL_tainted +PL_tainting +PL_tokenbuf +PL_signals +PERL_SIGNALS_UNSAFE_FLAG + +=implementation + +#ifndef PERL_SIGNALS_UNSAFE_FLAG + +#define PERL_SIGNALS_UNSAFE_FLAG 0x0001 + +#if { VERSION < 5.8.0 } +# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG +#else +# define D_PPP_PERL_SIGNALS_INIT 0 +#endif + +__NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT; + +#endif + +/* Hint: PL_ppaddr + * Calling an op via PL_ppaddr requires passing a context argument + * for threaded builds. Since the context argument is different for + * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will + * automatically be defined as the correct argument. + */ + +#if { VERSION <= 5.005_05 } +/* Replace: 1 */ +# define PL_ppaddr ppaddr +# define PL_no_modify no_modify +/* Replace: 0 */ +#endif + +#if { VERSION <= 5.004_05 } +/* Replace: 1 */ +# define PL_DBsignal DBsignal +# define PL_DBsingle DBsingle +# define PL_DBsub DBsub +# define PL_DBtrace DBtrace +# define PL_Sv Sv +# define PL_bufend bufend +# define PL_bufptr bufptr +# define PL_compiling compiling +# define PL_copline copline +# define PL_curcop curcop +# define PL_curstash curstash +# define PL_debstash debstash +# define PL_defgv defgv +# define PL_diehook diehook +# define PL_dirty dirty +# define PL_dowarn dowarn +# define PL_errgv errgv +# define PL_expect expect +# define PL_hexdigit hexdigit +# define PL_hints hints +# define PL_laststatval laststatval +# define PL_lex_state lex_state +# define PL_lex_stuff lex_stuff +# define PL_linestr linestr +# define PL_na na +# define PL_perl_destruct_level perl_destruct_level +# define PL_perldb perldb +# define PL_rsfp_filters rsfp_filters +# define PL_rsfp rsfp +# define PL_stack_base stack_base +# define PL_stack_sp stack_sp +# define PL_statcache statcache +# define PL_stdingv stdingv +# define PL_sv_arenaroot sv_arenaroot +# define PL_sv_no sv_no +# define PL_sv_undef sv_undef +# define PL_sv_yes sv_yes +# define PL_tainted tainted +# define PL_tainting tainting +# define PL_tokenbuf tokenbuf +/* Replace: 0 */ +#endif + +/* Warning: PL_parser + * For perl versions earlier than 5.9.5, this is an always + * non-NULL dummy. Also, it cannot be dereferenced. Don't + * use it if you can avoid is and unless you absolutely know + * what you're doing. + * If you always check that PL_parser is non-NULL, you can + * define DPPP_PL_parser_NO_DUMMY to avoid the creation of + * a dummy parser structure. + */ + +#if { VERSION >= 5.9.5 } +# ifdef DPPP_PL_parser_NO_DUMMY +# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ + (croak("panic: PL_parser == NULL in %s:%d", \ + __FILE__, __LINE__), (yy_parser *) NULL))->var) +# else +# ifdef DPPP_PL_parser_NO_DUMMY_WARNING +# define D_PPP_parser_dummy_warning(var) +# else +# define D_PPP_parser_dummy_warning(var) \ + warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__), +# endif +# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ + (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var) +__NEED_DUMMY_VAR__ yy_parser PL_parser; +# endif + +/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */ +/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf + * Do not use this variable unless you know exactly what you're + * doint. It is internal to the perl parser and may change or even + * be removed in the future. As of perl 5.9.5, you have to check + * for (PL_parser != NULL) for this variable to have any effect. + * An always non-NULL PL_parser dummy is provided for earlier + * perl versions. + * If PL_parser is NULL when you try to access this variable, a + * dummy is being accessed instead and a warning is issued unless + * you define DPPP_PL_parser_NO_DUMMY_WARNING. + * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access + * this variable will croak with a panic message. + */ + +# define PL_expect D_PPP_my_PL_parser_var(expect) +# define PL_copline D_PPP_my_PL_parser_var(copline) +# define PL_rsfp D_PPP_my_PL_parser_var(rsfp) +# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters) +# define PL_linestr D_PPP_my_PL_parser_var(linestr) +# define PL_bufptr D_PPP_my_PL_parser_var(bufptr) +# define PL_bufend D_PPP_my_PL_parser_var(bufend) +# define PL_lex_state D_PPP_my_PL_parser_var(lex_state) +# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff) +# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf) + +#else + +/* ensure that PL_parser != NULL and cannot be dereferenced */ +# define PL_parser ((void *) 1) + +#endif + +=xsinit + +#define NEED_PL_signals +#define NEED_PL_parser +#define DPPP_PL_parser_NO_DUMMY_WARNING + +=xsmisc + +U32 get_PL_signals_1(void) +{ + return PL_signals; +} + +extern U32 get_PL_signals_2(void); +extern U32 get_PL_signals_3(void); +int no_dummy_parser_vars(int); +int dummy_parser_warning(void); + +#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END + +#define ppp_PARSERVAR(type, var) STMT_START { \ + type volatile my_ ## var; \ + type volatile *my_p_ ## var; \ + my_ ## var = var; \ + my_p_ ## var = &var; \ + var = my_ ## var; \ + var = *my_p_ ## var; \ + mXPUSHi(&var != NULL); \ + count++; \ + } STMT_END + +#if { VERSION < 5.004 } +# define ppp_rsfp_t FILE * +#else +# define ppp_rsfp_t PerlIO * +#endif + +#if { VERSION < 5.6.0 } +# define ppp_expect_t expectation +#elif { VERSION < 5.9.5 } +# define ppp_expect_t int +#else +# define ppp_expect_t U8 +#endif + +#if { VERSION < 5.9.5 } +# define ppp_lex_state_t U32 +#else +# define ppp_lex_state_t U8 +#endif + +=xsubs + +int +compare_PL_signals() + CODE: + { + U32 ref = get_PL_signals_1(); + RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3(); + } + OUTPUT: + RETVAL + +SV * +PL_sv_undef() + CODE: + RETVAL = newSVsv(&PL_sv_undef); + OUTPUT: + RETVAL + +SV * +PL_sv_yes() + CODE: + RETVAL = newSVsv(&PL_sv_yes); + OUTPUT: + RETVAL + +SV * +PL_sv_no() + CODE: + RETVAL = newSVsv(&PL_sv_no); + OUTPUT: + RETVAL + +int +PL_na(string) + char *string + CODE: + PL_na = strlen(string); + RETVAL = PL_na; + OUTPUT: + RETVAL + +SV * +PL_Sv() + CODE: + PL_Sv = newSVpv("mhx", 0); + RETVAL = PL_Sv; + OUTPUT: + RETVAL + +SV * +PL_tokenbuf() + CODE: + RETVAL = newSViv(PL_tokenbuf[0]); + OUTPUT: + RETVAL + +SV * +PL_parser() + CODE: + RETVAL = newSViv(PL_parser != NULL); + OUTPUT: + RETVAL + +SV * +PL_hexdigit() + CODE: + RETVAL = newSVpv((char *) PL_hexdigit, 0); + OUTPUT: + RETVAL + +SV * +PL_hints() + CODE: + RETVAL = newSViv((IV) PL_hints); + OUTPUT: + RETVAL + +void +PL_ppaddr(string) + char *string + PPCODE: + PUSHMARK(SP); + mXPUSHs(newSVpv(string, 0)); + PUTBACK; + ENTER; + (void)*(PL_ppaddr[OP_UC])(aTHXR); + SPAGAIN; + LEAVE; + XSRETURN(1); + +void +other_variables() + PREINIT: + int count = 0; + PPCODE: + ppp_TESTVAR(PL_DBsignal); + ppp_TESTVAR(PL_DBsingle); + ppp_TESTVAR(PL_DBsub); + ppp_TESTVAR(PL_DBtrace); + ppp_TESTVAR(PL_compiling); + ppp_TESTVAR(PL_curcop); + ppp_TESTVAR(PL_curstash); + ppp_TESTVAR(PL_debstash); + ppp_TESTVAR(PL_defgv); + ppp_TESTVAR(PL_diehook); + ppp_TESTVAR(PL_dirty); + ppp_TESTVAR(PL_dowarn); + ppp_TESTVAR(PL_errgv); + ppp_TESTVAR(PL_laststatval); + ppp_TESTVAR(PL_no_modify); + ppp_TESTVAR(PL_perl_destruct_level); + ppp_TESTVAR(PL_perldb); + ppp_TESTVAR(PL_stack_base); + ppp_TESTVAR(PL_stack_sp); + ppp_TESTVAR(PL_statcache); + ppp_TESTVAR(PL_stdingv); + ppp_TESTVAR(PL_sv_arenaroot); + ppp_TESTVAR(PL_tainted); + ppp_TESTVAR(PL_tainting); + + ppp_PARSERVAR(ppp_expect_t, PL_expect); + ppp_PARSERVAR(line_t, PL_copline); + ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp); + ppp_PARSERVAR(AV *, PL_rsfp_filters); + ppp_PARSERVAR(SV *, PL_linestr); + ppp_PARSERVAR(char *, PL_bufptr); + ppp_PARSERVAR(char *, PL_bufend); + ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state); + ppp_PARSERVAR(SV *, PL_lex_stuff); + + XSRETURN(count); + +int +no_dummy_parser_vars(check) + int check + +int +dummy_parser_warning() + +=tests plan => 49 + +ok(Devel::PPPort::compare_PL_signals()); + +ok(!defined(&Devel::PPPort::PL_sv_undef())); +ok(&Devel::PPPort::PL_sv_yes()); +ok(!&Devel::PPPort::PL_sv_no()); +ok(&Devel::PPPort::PL_na("abcd"), 4); +ok(&Devel::PPPort::PL_Sv(), "mhx"); +ok(defined &Devel::PPPort::PL_tokenbuf()); +ok($] >= 5.009005 || &Devel::PPPort::PL_parser()); +ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/); +ok(defined &Devel::PPPort::PL_hints()); +ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX"); + +for (&Devel::PPPort::other_variables()) { + ok($_ != 0); +} + +{ + my @w; + my $fail = 0; + { + local $SIG{'__WARN__'} = sub { push @w, @_ }; + ok(&Devel::PPPort::dummy_parser_warning()); + } + if ($] >= 5.009005) { + ok(@w >= 0); + for (@w) { + print "# $_"; + unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) { + warn $_; + $fail++; + } + } + } + else { + ok(@w == 0); + } + ok($fail, 0); +} + +ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0)); + +eval { &Devel::PPPort::no_dummy_parser_vars(0) }; + +if ($] < 5.009005) { + ok($@, ''); +} +else { + if ($@) { + print "# $@"; + ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i); + } + else { + ok(1); + } +} diff --git a/ext/Devel-PPPort/parts/inc/version b/ext/Devel-PPPort/parts/inc/version new file mode 100644 index 0000000000..ca8d8a6e35 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/version @@ -0,0 +1,58 @@ +################################################################################ +## +## $Revision: 10 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +PERL_REVISION +PERL_VERSION +PERL_SUBVERSION +PERL_BCDVERSION + +=dontwarn + +PERL_PATCHLEVEL_H_IMPLICIT +_dpppDEC2BCD + +=implementation + +#ifndef PERL_REVISION +# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) +# define PERL_PATCHLEVEL_H_IMPLICIT +# include +# endif +# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) +# include +# endif +# ifndef PERL_REVISION +# define PERL_REVISION (5) + /* Replace: 1 */ +# define PERL_VERSION PATCHLEVEL +# define PERL_SUBVERSION SUBVERSION + /* Replace PERL_PATCHLEVEL with PERL_VERSION */ + /* Replace: 0 */ +# endif +#endif + +#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10)) +#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION)) + +/* It is very unlikely that anyone will try to use this with Perl 6 + (or greater), but who knows. + */ +#if PERL_REVISION != 5 +# error ppport.h only works with Perl version 5 +#endif /* PERL_REVISION != 5 */ diff --git a/ext/Devel-PPPort/parts/inc/warn b/ext/Devel-PPPort/parts/inc/warn new file mode 100644 index 0000000000..76bd881e97 --- /dev/null +++ b/ext/Devel-PPPort/parts/inc/warn @@ -0,0 +1,175 @@ +################################################################################ +## +## $Revision: 7 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +## Version 2.x, Copyright (C) 2001, Paul Marquess. +## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +## +## This program is free software; you can redistribute it and/or +## modify it under the same terms as Perl itself. +## +################################################################################ + +=provides + +__UNDEFINED__ +ckWARN +warner +Perl_warner +Perl_warner_nocontext + +=implementation + +__UNDEFINED__ WARN_ALL 0 +__UNDEFINED__ WARN_CLOSURE 1 +__UNDEFINED__ WARN_DEPRECATED 2 +__UNDEFINED__ WARN_EXITING 3 +__UNDEFINED__ WARN_GLOB 4 +__UNDEFINED__ WARN_IO 5 +__UNDEFINED__ WARN_CLOSED 6 +__UNDEFINED__ WARN_EXEC 7 +__UNDEFINED__ WARN_LAYER 8 +__UNDEFINED__ WARN_NEWLINE 9 +__UNDEFINED__ WARN_PIPE 10 +__UNDEFINED__ WARN_UNOPENED 11 +__UNDEFINED__ WARN_MISC 12 +__UNDEFINED__ WARN_NUMERIC 13 +__UNDEFINED__ WARN_ONCE 14 +__UNDEFINED__ WARN_OVERFLOW 15 +__UNDEFINED__ WARN_PACK 16 +__UNDEFINED__ WARN_PORTABLE 17 +__UNDEFINED__ WARN_RECURSION 18 +__UNDEFINED__ WARN_REDEFINE 19 +__UNDEFINED__ WARN_REGEXP 20 +__UNDEFINED__ WARN_SEVERE 21 +__UNDEFINED__ WARN_DEBUGGING 22 +__UNDEFINED__ WARN_INPLACE 23 +__UNDEFINED__ WARN_INTERNAL 24 +__UNDEFINED__ WARN_MALLOC 25 +__UNDEFINED__ WARN_SIGNAL 26 +__UNDEFINED__ WARN_SUBSTR 27 +__UNDEFINED__ WARN_SYNTAX 28 +__UNDEFINED__ WARN_AMBIGUOUS 29 +__UNDEFINED__ WARN_BAREWORD 30 +__UNDEFINED__ WARN_DIGIT 31 +__UNDEFINED__ WARN_PARENTHESIS 32 +__UNDEFINED__ WARN_PRECEDENCE 33 +__UNDEFINED__ WARN_PRINTF 34 +__UNDEFINED__ WARN_PROTOTYPE 35 +__UNDEFINED__ WARN_QW 36 +__UNDEFINED__ WARN_RESERVED 37 +__UNDEFINED__ WARN_SEMICOLON 38 +__UNDEFINED__ WARN_TAINT 39 +__UNDEFINED__ WARN_THREADS 40 +__UNDEFINED__ WARN_UNINITIALIZED 41 +__UNDEFINED__ WARN_UNPACK 42 +__UNDEFINED__ WARN_UNTIE 43 +__UNDEFINED__ WARN_UTF8 44 +__UNDEFINED__ WARN_VOID 45 +__UNDEFINED__ WARN_ASSERTIONS 46 + +__UNDEFINED__ packWARN(a) (a) + +#ifndef ckWARN +# ifdef G_WARN_ON +# define ckWARN(a) (PL_dowarn & G_WARN_ON) +# else +# define ckWARN(a) PL_dowarn +# endif +#endif + +#if { VERSION >= 5.004 } && !defined(warner) +#if { NEED warner } + +void +warner(U32 err, const char *pat, ...) +{ + SV *sv; + va_list args; + + PERL_UNUSED_ARG(err); + + va_start(args, pat); + sv = vnewSVpvf(pat, &args); + va_end(args); + sv_2mortal(sv); + warn("%s", SvPV_nolen(sv)); +} + +#define warner Perl_warner + +#define Perl_warner_nocontext Perl_warner + +#endif +#endif + +=xsinit + +#define NEED_warner + +=xsubs + +void +warner() + CODE: +#if { VERSION >= 5.004 } + warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42); +#endif + +void +Perl_warner() + CODE: +#if { VERSION >= 5.004 } + Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42); +#endif + +void +Perl_warner_nocontext() + CODE: +#if { VERSION >= 5.004 } + Perl_warner_nocontext(packWARN(WARN_MISC), "Perl_warner_nocontext %s:%d", "bar", 42); +#endif + +void +ckWARN() + CODE: +#if { VERSION >= 5.004 } + if (ckWARN(WARN_MISC)) + Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42); +#endif + +=tests plan => 5 + +$^W = 0; + +my $warning; + +$SIG{'__WARN__'} = sub { $warning = $_[0] }; + +$warning = ''; +Devel::PPPort::warner(); +ok($] >= 5.004 ? $warning =~ /^warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner_nocontext(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($warning, ''); + +$^W = 1; + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($] >= 5.004 ? $warning =~ /^ckWARN bar:42/ : $warning eq ''); + diff --git a/ext/Devel-PPPort/parts/ppport.fnc b/ext/Devel-PPPort/parts/ppport.fnc new file mode 100644 index 0000000000..567955e3bc --- /dev/null +++ b/ext/Devel-PPPort/parts/ppport.fnc @@ -0,0 +1,29 @@ +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: Perl/Pollution/Portability +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: $Revision: 3 $ +: $Author: mhx $ +: $Date: 2009/01/18 14:10:51 +0100 $ +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +: Version 2.x, Copyright (C) 2001, Paul Marquess. +: Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +: +: This program is free software; you can redistribute it and/or +: modify it under the same terms as Perl itself. +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +: +: This file lists all API functions/macros that are provided purely +: by Devel::PPPort. It is in the same format as the F that +: ships with the Perl source code. +: + +Am |void |sv_magic_portable|NN SV* sv|NULLOK SV* obj|int how|NULLOK const char* name \ + |I32 namlen diff --git a/ext/Devel-PPPort/parts/ppptools.pl b/ext/Devel-PPPort/parts/ppptools.pl new file mode 100644 index 0000000000..36830eb186 --- /dev/null +++ b/ext/Devel-PPPort/parts/ppptools.pl @@ -0,0 +1,400 @@ +################################################################################ +# +# ppptools.pl -- various utility functions +# +################################################################################ +# +# $Revision: 27 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:51 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +sub cat_file +{ + eval { require File::Spec }; + return $@ ? join('/', @_) : File::Spec->catfile(@_); +} + +sub all_files_in_dir +{ + my $dir = shift; + local *DIR; + + opendir DIR, $dir or die "cannot open directory $dir: $!\n"; + my @files = grep { !-d && !/^\./ } readdir DIR; # no dirs or hidden files + closedir DIR; + + return map { cat_file($dir, $_) } @files; +} + +sub parse_todo +{ + my $dir = shift || 'parts/todo'; + local *TODO; + my %todo; + my $todo; + + for $todo (all_files_in_dir($dir)) { + open TODO, $todo or die "cannot open $todo: $!\n"; + my $perl = ; + chomp $perl; + while () { + chomp; + s/#.*//; + s/^\s+//; s/\s+$//; + /^\s*$/ and next; + /^\w+$/ or die "invalid identifier: $_\n"; + exists $todo{$_} and die "duplicate identifier: $_ ($todo{$_} <=> $perl)\n"; + $todo{$_} = $perl; + } + close TODO; + } + + return \%todo; +} + +sub expand_version +{ + my($op, $ver) = @_; + my($r, $v, $s) = parse_version($ver); + $r == 5 or die "only Perl revision 5 is supported\n"; + my $bcdver = sprintf "0x%d%03d%03d", $r, $v, $s; + return "(PERL_BCDVERSION $op $bcdver)"; +} + +sub parse_partspec +{ + my $file = shift; + my $section = 'implementation'; + my $vsec = join '|', qw( provides dontwarn implementation + xsubs xsinit xsmisc xshead xsboot tests ); + my(%data, %options); + local *F; + + open F, $file or die "$file: $!\n"; + while () { + /[ \t]+$/ and warn "$file:$.: warning: trailing whitespace\n"; + if ($section eq 'implementation') { + m!//! && !m!(?:=~|s/).*//! && !m!(?:ht|f)tp://! + and warn "$file:$.: warning: potential C++ comment\n"; + } + /^##/ and next; + if (/^=($vsec)(?:\s+(.*))?/) { + $section = $1; + if (defined $2) { + my $opt = $2; + $options{$section} = eval "{ $opt }"; + $@ and die "$file:$.: invalid options ($opt) in section $section: $@\n"; + } + next; + } + push @{$data{$section}}, $_; + } + close F; + + for (keys %data) { + my @v = @{$data{$_}}; + shift @v while @v && $v[0] =~ /^\s*$/; + pop @v while @v && $v[-1] =~ /^\s*$/; + $data{$_} = join '', @v; + } + + unless (exists $data{provides}) { + $data{provides} = ($file =~ /(\w+)\.?$/)[0]; + } + $data{provides} = [$data{provides} =~ /(\S+)/g]; + + if (exists $data{dontwarn}) { + $data{dontwarn} = [$data{dontwarn} =~ /(\S+)/g]; + } + + my @prov; + my %proto; + + if (exists $data{tests} && (!exists $data{implementation} || $data{implementation} !~ /\S/)) { + $data{implementation} = ''; + } + else { + $data{implementation} =~ /\S/ or die "Empty implementation in $file\n"; + + my $p; + + for $p (@{$data{provides}}) { + if ($p =~ m#^/.*/\w*$#) { + my @tmp = eval "\$data{implementation} =~ ${p}gm"; + $@ and die "invalid regex $p in $file\n"; + @tmp or warn "no matches for regex $p in $file\n"; + push @prov, do { my %h; grep !$h{$_}++, @tmp }; + } + elsif ($p eq '__UNDEFINED__') { + my @tmp = $data{implementation} =~ /^\s*__UNDEFINED__[^\r\n\S]+(\w+)/gm; + @tmp or warn "no __UNDEFINED__ macros in $file\n"; + push @prov, @tmp; + } + else { + push @prov, $p; + } + } + + for (@prov) { + if ($data{implementation} !~ /\b\Q$_\E\b/) { + warn "$file claims to provide $_, but doesn't seem to do so\n"; + next; + } + + # scan for prototypes + my($proto) = $data{implementation} =~ / + ( ^ (?:[\w*]|[^\S\r\n])+ + [\r\n]*? + ^ \b$_\b \s* + \( [^{]* \) + ) + \s* \{ + /xm or next; + + $proto =~ s/^\s+//; + $proto =~ s/\s+$//; + $proto =~ s/\s+/ /g; + + exists $proto{$_} and warn "$file: duplicate prototype for $_\n"; + $proto{$_} = $proto; + } + } + + for $section (qw( implementation xsubs xsinit xsmisc xshead xsboot )) { + if (exists $data{$section}) { + $data{$section} =~ s/\{\s*version\s*(<|>|==|!=|>=|<=)\s*([\d._]+)\s*\}/expand_version($1, $2)/gei; + } + } + + $data{provides} = \@prov; + $data{prototypes} = \%proto; + $data{OPTIONS} = \%options; + + my %prov = map { ($_ => 1) } @prov; + my %dontwarn = exists $data{dontwarn} ? map { ($_ => 1) } @{$data{dontwarn}} : (); + my @maybeprov = do { my %h; + grep { + my($nop) = /^Perl_(.*)/; + not exists $prov{$_} || + exists $dontwarn{$_} || + /^D_PPP_/ || + (defined $nop && exists $prov{$nop} ) || + (defined $nop && exists $dontwarn{$nop}) || + $h{$_}++; + } + $data{implementation} =~ /^\s*#\s*define\s+(\w+)/gm }; + + if (@maybeprov) { + warn "$file seems to provide these macros, but doesn't list them:\n " + . join("\n ", @maybeprov) . "\n"; + } + + return \%data; +} + +sub compare_prototypes +{ + my($p1, $p2) = @_; + for ($p1, $p2) { + s/^\s+//; + s/\s+$//; + s/\s+/ /g; + s/(\w)\s(\W)/$1$2/g; + s/(\W)\s(\w)/$1$2/g; + } + return $p1 cmp $p2; +} + +sub ppcond +{ + my $s = shift; + my @c; + my $p; + + for $p (@$s) { + push @c, map "!($_)", @{$p->{pre}}; + defined $p->{cur} and push @c, "($p->{cur})"; + } + + join " && ", @c; +} + +sub trim_arg +{ + my $in = shift; + my $remove = join '|', qw( NN NULLOK VOL ); + + $in eq '...' and return ($in); + + local $_ = $in; + my $id; + + s/[*()]/ /g; + s/\[[^\]]*\]/ /g; + s/\b(?:auto|const|extern|inline|register|static|volatile|restrict)\b//g; + s/\b(?:$remove)\b//; + s/^\s*//; s/\s*$//; + + if( /^\b(?:struct|union|enum)\s+\w+(?:\s+(\w+))?$/ ) { + defined $1 and $id = $1; + } + else { + if( s/\b(?:char|double|float|int|long|short|signed|unsigned|void)\b//g ) { + /^\s*(\w+)\s*$/ and $id = $1; + } + else { + /^\s*\w+\s+(\w+)\s*$/ and $id = $1; + } + } + + $_ = $in; + + defined $id and s/\b$id\b//; + + # these don't matter at all + s/\b(?:auto|extern|inline|register|static|volatile|restrict)\b//g; + s/\b(?:$remove)\b//; + + s/(?=<\*)\s+(?=\*)//g; + s/\s*(\*+)\s*/ $1 /g; + s/^\s*//; s/\s*$//; + s/\s+/ /g; + + return ($_, $id); +} + +sub parse_embed +{ + my @files = @_; + my @func; + my @pps; + my $file; + local *FILE; + + for $file (@files) { + open FILE, $file or die "$file: $!\n"; + my($line, $l); + + while (defined($line = )) { + while ($line =~ /\\$/ && defined($l = )) { + $line =~ s/\\\s*//; + $line .= $l; + } + next if $line =~ /^\s*:/; + $line =~ s/^\s+|\s+$//gs; + my($dir, $args) = ($line =~ /^\s*#\s*(\w+)(?:\s*(.*?)\s*)?$/); + if (defined $dir and defined $args) { + for ($dir) { + /^ifdef$/ and do { push @pps, { pre => [], cur => "defined($args)" } ; last }; + /^ifndef$/ and do { push @pps, { pre => [], cur => "!defined($args)" } ; last }; + /^if$/ and do { push @pps, { pre => [], cur => $args } ; last }; + /^elif$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = $args; last }; + /^else$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = undef; last }; + /^endif$/ and do { pop @pps ; last }; + /^include$/ and last; + /^define$/ and last; + /^undef$/ and last; + warn "unhandled preprocessor directive: $dir\n"; + } + } + else { + my @e = split /\s*\|\s*/, $line; + if( @e >= 3 ) { + my($flags, $ret, $name, @args) = @e; + for (@args) { + $_ = [trim_arg($_)]; + } + ($ret) = trim_arg($ret); + push @func, { + name => $name, + flags => { map { $_, 1 } $flags =~ /./g }, + ret => $ret, + args => \@args, + cond => ppcond(\@pps), + }; + } + } + } + + close FILE; + } + + return @func; +} + +sub make_prototype +{ + my $f = shift; + my @args = map { "@$_" } @{$f->{args}}; + my $proto; + my $pTHX_ = exists $f->{flags}{n} ? "" : "pTHX_ "; + $proto = "$f->{ret} $f->{name}" . "($pTHX_" . join(', ', @args) . ')'; + return $proto; +} + +sub format_version +{ + my $ver = shift; + + $ver =~ s/$/000000/; + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "invalid version '$ver'\n"; + } + $s /= 10; + + $ver = sprintf "%d.%03d", $r, $v; + $s > 0 and $ver .= sprintf "_%02d", $s; + + return $ver; + } + + return sprintf "%d.%d.%d", $r, $v, $s; +} + +sub parse_version +{ + my $ver = shift; + + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { + return ($1, $2, $3); + } + elsif ($ver !~ /^\d+\.[\d_]+$/) { + die "cannot parse version '$ver'\n"; + } + + $ver =~ s/_//g; + $ver =~ s/$/000000/; + + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "cannot parse version '$ver'\n"; + } + $s /= 10; + } + + return ($r, $v, $s); +} + +1; diff --git a/ext/Devel-PPPort/parts/todo/5004000 b/ext/Devel-PPPort/parts/todo/5004000 new file mode 100644 index 0000000000..1382ea7648 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5004000 @@ -0,0 +1,68 @@ +5.004000 +GIMME_V # E +G_VOID # E +HEf_SVKEY # E +HeHASH # U +HeKEY # U +HeKLEN # U +HePV # U +HeSVKEY # U +HeSVKEY_force # U +HeSVKEY_set # U +HeVAL # U +SvSetMagicSV # U +SvSetMagicSV_nosteal # U +SvSetSV_nosteal # U +SvTAINTED # U +SvTAINTED_off # U +SvTAINTED_on # U +block_gimme # U +call_list # U +cv_const_sv # U +delimcpy # U +do_open # E (Perl_do_open) +form # U +gv_autoload4 # U +gv_efullname3 # U +gv_fetchmethod_autoload # U +gv_fullname3 # U +hv_delayfree_ent # U +hv_delete_ent # U +hv_exists_ent # U +hv_fetch_ent # U +hv_free_ent # U +hv_iterkeysv # U +hv_ksplit # U +hv_store_ent # U +ibcmp_locale # U +my_failure_exit # U +my_memcmp # U +my_pclose # E (Perl_my_pclose) +my_popen # E (Perl_my_popen) +newSVpvf # U +rsignal # E +rsignal_state # E +save_I16 # U +save_gp # U +share_hek # E +start_subparse # E (Perl_start_subparse) +sv_catpvf # U +sv_catpvf_mg # U +sv_cmp_locale # U +sv_derived_from # U +sv_gets # E (Perl_sv_gets) +sv_magic_portable # U +sv_setpvf # U +sv_setpvf_mg # U +sv_taint # U +sv_tainted # U +sv_untaint # U +sv_vcatpvf # U +sv_vcatpvf_mg # U +sv_vcatpvfn # U +sv_vsetpvf # U +sv_vsetpvf_mg # U +sv_vsetpvfn # U +unsharepvn # U +vnewSVpvf # U +warner # U diff --git a/ext/Devel-PPPort/parts/todo/5004010 b/ext/Devel-PPPort/parts/todo/5004010 new file mode 100644 index 0000000000..8c29866603 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5004010 @@ -0,0 +1 @@ +5.004010 diff --git a/ext/Devel-PPPort/parts/todo/5004020 b/ext/Devel-PPPort/parts/todo/5004020 new file mode 100644 index 0000000000..4b43fdf8e4 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5004020 @@ -0,0 +1 @@ +5.004020 diff --git a/ext/Devel-PPPort/parts/todo/5004030 b/ext/Devel-PPPort/parts/todo/5004030 new file mode 100644 index 0000000000..e45facbb1f --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5004030 @@ -0,0 +1 @@ +5.004030 diff --git a/ext/Devel-PPPort/parts/todo/5004040 b/ext/Devel-PPPort/parts/todo/5004040 new file mode 100644 index 0000000000..69ccd5d62c --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5004040 @@ -0,0 +1 @@ +5.004040 diff --git a/ext/Devel-PPPort/parts/todo/5004050 b/ext/Devel-PPPort/parts/todo/5004050 new file mode 100644 index 0000000000..f1c9f8942a --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5004050 @@ -0,0 +1,4 @@ +5.004050 +do_binmode # U +save_aelem # U +save_helem # U diff --git a/ext/Devel-PPPort/parts/todo/5005000 b/ext/Devel-PPPort/parts/todo/5005000 new file mode 100644 index 0000000000..b99f61e20e --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5005000 @@ -0,0 +1,27 @@ +5.005000 +PL_modglobal # E +cx_dump # U +debop # U +debprofdump # U +fbm_compile # E (Perl_fbm_compile) +fbm_instr # E (Perl_fbm_instr) +get_op_descs # U +get_op_names # U +init_stacks # U +mg_length # U +mg_size # U +newHVhv # U +new_stackinfo # E +regdump # U +regexec_flags # U +regnext # E (Perl_regnext) +runops_debug # U +runops_standard # U +save_iv # U (save_iv) +screaminstr # E (Perl_screaminstr) +sv_iv # U +sv_nv # U +sv_peek # U +sv_pvn # U +sv_pvn_nomg # U +sv_true # U diff --git a/ext/Devel-PPPort/parts/todo/5005010 b/ext/Devel-PPPort/parts/todo/5005010 new file mode 100644 index 0000000000..deebff5bf8 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5005010 @@ -0,0 +1 @@ +5.005010 diff --git a/ext/Devel-PPPort/parts/todo/5005020 b/ext/Devel-PPPort/parts/todo/5005020 new file mode 100644 index 0000000000..d19ff2ae09 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5005020 @@ -0,0 +1 @@ +5.005020 diff --git a/ext/Devel-PPPort/parts/todo/5005030 b/ext/Devel-PPPort/parts/todo/5005030 new file mode 100644 index 0000000000..885afa0d23 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5005030 @@ -0,0 +1,4 @@ +5.005030 +POPpx # E +get_vtbl # U +save_generic_svref # U diff --git a/ext/Devel-PPPort/parts/todo/5005040 b/ext/Devel-PPPort/parts/todo/5005040 new file mode 100644 index 0000000000..8a165c2033 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5005040 @@ -0,0 +1 @@ +5.005040 diff --git a/ext/Devel-PPPort/parts/todo/5006000 b/ext/Devel-PPPort/parts/todo/5006000 new file mode 100644 index 0000000000..86f24e2b02 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5006000 @@ -0,0 +1,150 @@ +5.006000 +SvIOK_UV # U +SvIOK_notUV # U +SvIOK_only_UV # U +SvPOK_only_UTF8 # U +SvPVbyte_nolen # U +SvPVbytex # U +SvPVbytex_force # U +SvPVutf8 # U +SvPVutf8_force # U +SvPVutf8_nolen # U +SvPVutf8x # U +SvPVutf8x_force # U +SvUOK # U +SvUTF8 # U +SvUTF8_off # U +SvUTF8_on # U +av_delete # U +av_exists # U +call_atexit # E +cast_i32 # U (cast_i32) +cast_iv # U (cast_iv) +cast_ulong # U +cast_uv # U (cast_uv) +do_gv_dump # U +do_gvgv_dump # U +do_hv_dump # U +do_magic_dump # U +do_op_dump # U +do_open9 # U +do_pmop_dump # U +do_sv_dump # U +dump_all # U +dump_eval # U +dump_form # U +dump_indent # U +dump_packsubs # U +dump_sub # U +dump_vindent # U +get_context # U +get_ppaddr # E +gv_dump # U +init_i18nl10n # U (perl_init_i18nl10n) +init_i18nl14n # U (perl_init_i18nl14n) +is_uni_alnum # U +is_uni_alnum_lc # U +is_uni_alnumc # U +is_uni_alnumc_lc # U +is_uni_alpha # U +is_uni_alpha_lc # U +is_uni_ascii # U +is_uni_ascii_lc # U +is_uni_cntrl # U +is_uni_cntrl_lc # U +is_uni_digit # U +is_uni_digit_lc # U +is_uni_graph # U +is_uni_graph_lc # U +is_uni_idfirst # U +is_uni_idfirst_lc # U +is_uni_lower # U +is_uni_lower_lc # U +is_uni_print # U +is_uni_print_lc # U +is_uni_punct # U +is_uni_punct_lc # U +is_uni_space # U +is_uni_space_lc # U +is_uni_upper # U +is_uni_upper_lc # U +is_uni_xdigit # U +is_uni_xdigit_lc # U +is_utf8_alnum # U +is_utf8_alnumc # U +is_utf8_alpha # U +is_utf8_ascii # U +is_utf8_char # U +is_utf8_cntrl # U +is_utf8_digit # U +is_utf8_graph # U +is_utf8_idfirst # U +is_utf8_lower # U +is_utf8_mark # U +is_utf8_print # U +is_utf8_punct # U +is_utf8_space # U +is_utf8_upper # U +is_utf8_xdigit # U +magic_dump # U +mess # E (Perl_mess) +my_atof # U +my_fflush_all # U +newANONATTRSUB # U +newATTRSUB # U +newXS # E (Perl_newXS) +newXSproto # E +new_collate # U (perl_new_collate) +new_ctype # U (perl_new_ctype) +new_numeric # U (perl_new_numeric) +op_dump # U +perl_parse # E (perl_parse) +pmop_dump # U +re_intuit_string # U +reginitcolors # U +require_pv # U (perl_require_pv) +safesyscalloc # U +safesysfree # U +safesysmalloc # U +safesysrealloc # U +save_I8 # U +save_alloc # U +save_destructor # E (Perl_save_destructor) +save_destructor_x # E +save_re_context # U +save_vptr # U +scan_bin # U +set_context # U +set_numeric_local # U (perl_set_numeric_local) +set_numeric_radix # U +set_numeric_standard # U (perl_set_numeric_standard) +str_to_version # U +sv_2pvutf8 # U +sv_2pvutf8_nolen # U +sv_force_normal # U +sv_len_utf8 # U +sv_pos_b2u # U +sv_pos_u2b # U +sv_pv # U +sv_pvbyte # U +sv_pvbyten # U +sv_pvbyten_force # U +sv_pvutf8 # U +sv_pvutf8n # U +sv_pvutf8n_force # U +sv_rvweaken # U +sv_utf8_decode # U +sv_utf8_downgrade # U +sv_utf8_encode # U +swash_init # U +tmps_grow # U +to_uni_lower_lc # U +to_uni_title_lc # U +to_uni_upper_lc # U +utf8_distance # U +utf8_hop # U +vcroak # U +vform # U +vmess # U +vwarn # U +vwarner # U diff --git a/ext/Devel-PPPort/parts/todo/5006001 b/ext/Devel-PPPort/parts/todo/5006001 new file mode 100644 index 0000000000..3f4ea792ff --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5006001 @@ -0,0 +1,11 @@ +5.006001 +SvGAMAGIC # U +apply_attrs_string # U +bytes_to_utf8 # U +gv_efullname4 # U +gv_fullname4 # U +is_utf8_string # U +save_generic_pvref # U +utf16_to_utf8 # E (Perl_utf16_to_utf8) +utf16_to_utf8_reversed # E (Perl_utf16_to_utf8_reversed) +utf8_to_bytes # U diff --git a/ext/Devel-PPPort/parts/todo/5006002 b/ext/Devel-PPPort/parts/todo/5006002 new file mode 100644 index 0000000000..dfe09ce2c5 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5006002 @@ -0,0 +1 @@ +5.006002 diff --git a/ext/Devel-PPPort/parts/todo/5007000 b/ext/Devel-PPPort/parts/todo/5007000 new file mode 100644 index 0000000000..49d08465db --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5007000 @@ -0,0 +1 @@ +5.007000 diff --git a/ext/Devel-PPPort/parts/todo/5007001 b/ext/Devel-PPPort/parts/todo/5007001 new file mode 100644 index 0000000000..f8f9664f8e --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5007001 @@ -0,0 +1,19 @@ +5.007001 +POPpbytex # E +bytes_from_utf8 # U +despatch_signals # U +do_openn # U +gv_handler # U +is_lvalue_sub # U +my_popen_list # U +save_mortalizesv # U +scan_num # E (Perl_scan_num) +sv_force_normal_flags # U +sv_setref_uv # U +sv_unref_flags # U +sv_utf8_upgrade # E (Perl_sv_utf8_upgrade) +utf8_length # U +utf8_to_uvchr # U +utf8_to_uvuni # U +utf8n_to_uvuni # U +uvuni_to_utf8 # U diff --git a/ext/Devel-PPPort/parts/todo/5007002 b/ext/Devel-PPPort/parts/todo/5007002 new file mode 100644 index 0000000000..2fba735a96 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5007002 @@ -0,0 +1,16 @@ +5.007002 +calloc # U +getcwd_sv # U +init_tm # U +malloc # U +mfree # U +mini_mktime # U +my_atof2 # U +my_strftime # U +op_null # U +realloc # U +sv_catpvn_flags # U +sv_catsv_flags # U +sv_setsv_flags # U +sv_utf8_upgrade_flags # U +swash_fetch # E (Perl_swash_fetch) diff --git a/ext/Devel-PPPort/parts/todo/5007003 b/ext/Devel-PPPort/parts/todo/5007003 new file mode 100644 index 0000000000..2271d2bcd9 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5007003 @@ -0,0 +1,62 @@ +5.007003 +PerlIO_clearerr # U (PerlIO_clearerr) +PerlIO_close # U (PerlIO_close) +PerlIO_eof # U (PerlIO_eof) +PerlIO_error # U (PerlIO_error) +PerlIO_fileno # U (PerlIO_fileno) +PerlIO_fill # U (PerlIO_fill) +PerlIO_flush # U (PerlIO_flush) +PerlIO_get_base # U (PerlIO_get_base) +PerlIO_get_bufsiz # U (PerlIO_get_bufsiz) +PerlIO_get_cnt # U (PerlIO_get_cnt) +PerlIO_get_ptr # U (PerlIO_get_ptr) +PerlIO_read # U (PerlIO_read) +PerlIO_seek # U (PerlIO_seek) +PerlIO_set_cnt # U (PerlIO_set_cnt) +PerlIO_set_ptrcnt # U (PerlIO_set_ptrcnt) +PerlIO_setlinebuf # U (PerlIO_setlinebuf) +PerlIO_stderr # U (PerlIO_stderr) +PerlIO_stdin # U (PerlIO_stdin) +PerlIO_stdout # U (PerlIO_stdout) +PerlIO_tell # U (PerlIO_tell) +PerlIO_unread # U (PerlIO_unread) +PerlIO_write # U (PerlIO_write) +SvLOCK # U +SvSHARE # U +SvUNLOCK # U +atfork_lock # U +atfork_unlock # U +custom_op_desc # U +custom_op_name # U +deb # U +debstack # U +debstackptrs # U +gv_fetchmeth_autoload # U +ibcmp_utf8 # U +my_fork # U +my_socketpair # U +pack_cat # U +perl_destruct # E (perl_destruct) +pv_uni_display # U +save_shared_pvref # U +savesharedpv # U +sortsv # U +sv_copypv # U +sv_magicext # U +sv_nolocking # U +sv_nosharing # U +sv_recode_to_utf8 # U +sv_uni_display # U +to_uni_fold # U +to_uni_lower # E (Perl_to_uni_lower) +to_uni_title # E (Perl_to_uni_title) +to_uni_upper # E (Perl_to_uni_upper) +to_utf8_case # U +to_utf8_fold # U +to_utf8_lower # E (Perl_to_utf8_lower) +to_utf8_title # E (Perl_to_utf8_title) +to_utf8_upper # E (Perl_to_utf8_upper) +unpack_str # U +uvchr_to_utf8_flags # U +uvuni_to_utf8_flags # U +vdeb # U diff --git a/ext/Devel-PPPort/parts/todo/5008000 b/ext/Devel-PPPort/parts/todo/5008000 new file mode 100644 index 0000000000..a22b04eb81 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5008000 @@ -0,0 +1,5 @@ +5.008000 +hv_iternext_flags # U +hv_store_flags # U +is_utf8_idcont # U +nothreadhook # U diff --git a/ext/Devel-PPPort/parts/todo/5008001 b/ext/Devel-PPPort/parts/todo/5008001 new file mode 100644 index 0000000000..ddc9d09c43 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5008001 @@ -0,0 +1,14 @@ +5.008001 +SvVOK # U +doing_taint # U +find_runcv # U +is_utf8_string_loc # U +packlist # U +save_bool # U +savestack_grow_cnt # U +seed # U +sv_cat_decode # U +sv_compile_2op # E (Perl_sv_compile_2op) +sv_setpviv # U +sv_setpviv_mg # U +unpackstring # U diff --git a/ext/Devel-PPPort/parts/todo/5008002 b/ext/Devel-PPPort/parts/todo/5008002 new file mode 100644 index 0000000000..63aac525fe --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5008002 @@ -0,0 +1 @@ +5.008002 diff --git a/ext/Devel-PPPort/parts/todo/5008003 b/ext/Devel-PPPort/parts/todo/5008003 new file mode 100644 index 0000000000..50c6ce1aa1 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5008003 @@ -0,0 +1,3 @@ +5.008003 +SvIsCOW # U +SvIsCOW_shared_hash # U diff --git a/ext/Devel-PPPort/parts/todo/5008004 b/ext/Devel-PPPort/parts/todo/5008004 new file mode 100644 index 0000000000..bb7bcdf66a --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5008004 @@ -0,0 +1 @@ +5.008004 diff --git a/ext/Devel-PPPort/parts/todo/5008005 b/ext/Devel-PPPort/parts/todo/5008005 new file mode 100644 index 0000000000..7bd2029f4b --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5008005 @@ -0,0 +1 @@ +5.008005 diff --git a/ext/Devel-PPPort/parts/todo/5008006 b/ext/Devel-PPPort/parts/todo/5008006 new file mode 100644 index 0000000000..ba5cad07ed --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5008006 @@ -0,0 +1 @@ +5.008006 diff --git a/ext/Devel-PPPort/parts/todo/5008007 b/ext/Devel-PPPort/parts/todo/5008007 new file mode 100644 index 0000000000..7d656f0b9e --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5008007 @@ -0,0 +1 @@ +5.008007 diff --git a/ext/Devel-PPPort/parts/todo/5008008 b/ext/Devel-PPPort/parts/todo/5008008 new file mode 100644 index 0000000000..f17b19ff4b --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5008008 @@ -0,0 +1 @@ +5.008008 diff --git a/ext/Devel-PPPort/parts/todo/5009000 b/ext/Devel-PPPort/parts/todo/5009000 new file mode 100644 index 0000000000..28bc85958e --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5009000 @@ -0,0 +1,6 @@ +5.009000 +new_version # U +save_set_svflags # U +vcmp # U +vnumify # U +vstringify # U diff --git a/ext/Devel-PPPort/parts/todo/5009001 b/ext/Devel-PPPort/parts/todo/5009001 new file mode 100644 index 0000000000..26d2c4c548 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5009001 @@ -0,0 +1,6 @@ +5.009001 +hv_clear_placeholders # U +hv_scalar # U +scan_version # E (Perl_scan_version) +sv_2iv_flags # U +sv_2uv_flags # U diff --git a/ext/Devel-PPPort/parts/todo/5009002 b/ext/Devel-PPPort/parts/todo/5009002 new file mode 100644 index 0000000000..c6d8a1e183 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5009002 @@ -0,0 +1,9 @@ +5.009002 +SvPVbyte_force # U +find_rundefsvoffset # U +gv_fetchpvn_flags # U +gv_fetchsv # U +op_refcnt_lock # U +op_refcnt_unlock # U +savesvpv # U +vnormal # U diff --git a/ext/Devel-PPPort/parts/todo/5009003 b/ext/Devel-PPPort/parts/todo/5009003 new file mode 100644 index 0000000000..7be9e0749e --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5009003 @@ -0,0 +1,26 @@ +5.009003 +av_arylen_p # U +ckwarn # U +ckwarn_d # U +csighandler # E (Perl_csighandler) +dMULTICALL # E +doref # U +gv_const_sv # U +gv_stashpvs # U +hv_eiter_p # U +hv_eiter_set # U +hv_name_set # U +hv_placeholders_get # U +hv_placeholders_p # U +hv_placeholders_set # U +hv_riter_p # U +hv_riter_set # U +is_utf8_string_loclen # U +newGIVENOP # U +newSVhek # U +newSVpvs_share # U +newWHENOP # U +newWHILEOP # E (Perl_newWHILEOP) +savepvs # U +sortsv_flags # U +vverify # U diff --git a/ext/Devel-PPPort/parts/todo/5009004 b/ext/Devel-PPPort/parts/todo/5009004 new file mode 100644 index 0000000000..0d6b7d5051 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5009004 @@ -0,0 +1,8 @@ +5.009004 +PerlIO_context_layers # U +gv_name_set # U +my_vsnprintf # U +newXS_flags # U +regclass_swash # E (Perl_regclass_swash) +sv_does # U +sv_usepvn_flags # U diff --git a/ext/Devel-PPPort/parts/todo/5009005 b/ext/Devel-PPPort/parts/todo/5009005 new file mode 100644 index 0000000000..cf90cd8f80 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5009005 @@ -0,0 +1,31 @@ +5.009005 +Perl_signbit # U +SvRX # U +SvRXOK # U +av_create_and_push # U +av_create_and_unshift_one # U +get_cvn_flags # U +gv_fetchfile_flags # U +mro_get_linear_isa # U +mro_method_changed_in # U +my_dirfd # U +newSV_type # U +pregcomp # E (Perl_pregcomp) +ptr_table_clear # U +ptr_table_fetch # U +ptr_table_free # U +ptr_table_new # U +ptr_table_split # U +ptr_table_store # U +re_compile # U +re_intuit_start # E (Perl_re_intuit_start) +reg_named_buff_all # U +reg_named_buff_exists # U +reg_named_buff_fetch # U +reg_named_buff_firstkey # U +reg_named_buff_nextkey # U +reg_named_buff_scalar # U +regfree_internal # U +savesharedpvn # U +scan_vstring # E (Perl_scan_vstring) +upg_version # E (Perl_upg_version) diff --git a/ext/Devel-PPPort/parts/todo/5010000 b/ext/Devel-PPPort/parts/todo/5010000 new file mode 100644 index 0000000000..737f374ef0 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5010000 @@ -0,0 +1,7 @@ +5.010000 +hv_common # U +hv_common_key_len # U +sv_destroyable # U +sys_init # U +sys_init3 # U +sys_term # U diff --git a/ext/Devel-PPPort/parts/todo/5011000 b/ext/Devel-PPPort/parts/todo/5011000 new file mode 100644 index 0000000000..857f62f439 --- /dev/null +++ b/ext/Devel-PPPort/parts/todo/5011000 @@ -0,0 +1,17 @@ +5.011000 +HeUTF8 # U +MULTICALL # E +POP_MULTICALL # E +PUSH_MULTICALL # E +SvOOK_offset # U +av_iter_p # U +croak_xs_usage # U +fetch_cop_label # U +gv_fetchmethod_flags # U +hv_assert # U +pad_sv # U +pregfree2 # U +ref # U (Perl_ref) +save_padsv_and_mortalize # U +stashpv_hvname_match # U +sv_insert_flags # U diff --git a/ext/Devel-PPPort/ppport_h.PL b/ext/Devel-PPPort/ppport_h.PL new file mode 100644 index 0000000000..e652c352d9 --- /dev/null +++ b/ext/Devel-PPPort/ppport_h.PL @@ -0,0 +1,25 @@ +################################################################################ +# +# ppport_h.PL -- generate ppport.h +# +################################################################################ +# +# $Revision: 7 $ +# $Author: mhx $ +# $Date: 2006/06/25 03:41:08 +0200 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +package Devel::PPPort; +require "PPPort.pm"; +rename 'ppport.h', 'ppport.old' if -f 'ppport.h'; +unlink "ppport.old" if WriteFile("ppport.h") && -f 'ppport.h'; diff --git a/ext/Devel-PPPort/soak b/ext/Devel-PPPort/soak new file mode 100644 index 0000000000..9a67665b9a --- /dev/null +++ b/ext/Devel-PPPort/soak @@ -0,0 +1,606 @@ +#!/usr/bin/perl -w +################################################################################ +# +# soak -- Test Perl modules with multiple Perl releases. +# +# Original Author: Paul Marquess +# +################################################################################ +# +# $Revision: 19 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +require 5.006001; + +use strict; +use warnings; +use ExtUtils::MakeMaker; +use Getopt::Long; +use Pod::Usage; +use File::Find; +use List::Util qw(max); +use Config; + +my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.16 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; + +$| = 1; +my %OPT = ( + verbose => 0, + make => $Config{make} || 'make', + min => '5.000', + color => 1, +); + +GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@ color!)) or pod2usage(2); + +$OPT{mmargs} = [''] unless exists $OPT{mmargs}; +$OPT{min} = parse_version($OPT{min}) - 1e-10; + +sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) } + +my @GoodPerls = map { $_->[0] } + sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] } + grep { $_->[1] >= $OPT{min} } + map { [$_ => perl_version($_)] } + @ARGV ? SearchPerls(@ARGV) : FindPerls(); + +unless (@GoodPerls) { + print "Sorry, got no Perl binaries for testing.\n\n"; + exit 0; +} + +my $maxlen = max(map length, @GoodPerls) + 3; +my $mmalen = max(map length, @{$OPT{mmargs}}); +$maxlen += $mmalen+3 if $mmalen > 0; + +my $rep = Soak::Reporter->new( verbose => $OPT{verbose} + , color => $OPT{color} + , width => $maxlen + ); + +$SIG{__WARN__} = sub { $rep->warn(@_) }; +$SIG{__DIE__} = sub { $rep->die(@_) }; + +# prime the pump, so the first "make realclean" will work. +runit("$^X Makefile.PL") && runit("$OPT{make} realclean") + or $rep->die("Cannot run $^X Makefile.PL && $OPT{make} realclean\n"); + +my $tot = @GoodPerls*@{$OPT{mmargs}}; + +$rep->set(tests => $tot); + +$rep->status(sprintf("Testing %d version%s / %d configuration%s (%d combination%s)...\n", + cs(@GoodPerls), cs(@{$OPT{mmargs}}), cs($tot))); + +for my $perl (@GoodPerls) { + for my $mm (@{$OPT{mmargs}}) { + $rep->set(perl => $perl, config => $mm); + + $rep->test; + + my @warn_mfpl; + my @warn_make; + my @warn_test; + + my $ok = runit("$perl Makefile.PL $mm", \@warn_mfpl) && + runit("$OPT{make}", \@warn_make) && + runit("$OPT{make} test", \@warn_test); + + $rep->warnings(['Makefile.PL' => \@warn_mfpl], + ['make' => \@warn_make], + ['make test' => \@warn_test]); + + if ($ok) { + $rep->passed; + } + else { + $rep->failed; + } + + runit("$OPT{make} realclean"); + } +} + +exit $rep->finish; + +sub runit +{ + # TODO -- portability alert!! + + my($cmd, $warn) = @_; + $rep->vsay("\n Running [$cmd]"); + my $output = `$cmd 2>&1`; + $output = "\n" unless defined $output; + $output =~ s/^/ > /gm; + $rep->say("\n Output:\n$output") if $OPT{verbose} || $?; + if ($?) { + $rep->warn(" Running '$cmd' failed: $?\n"); + return 0; + } + push @$warn, $output =~ /(warning: .*)/ig; + return 1; +} + +sub FindPerls +{ + # TODO -- need to decide how far back we go. + # TODO -- get list of user releases prior to 5.004 + # TODO -- does not work on Windows (at least) + + # find versions of Perl that are available + my @PerlBinaries = qw( + 5.000 + 5.001 + 5.002 + 5.003 + 5.004 5.00401 5.00402 5.00403 5.00404 5.00405 + 5.005 5.00501 5.00502 5.00503 5.00504 + 5.6.0 5.6.1 5.6.2 + 5.7.0 5.7.1 5.7.2 5.7.3 + 5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6 5.8.7 5.8.8 + 5.9.0 5.9.1 5.9.2 5.9.3 + ); + + print "Searching for Perl binaries...\n"; + + # find_perl will send a warning to STDOUT if it can't find + # the requested perl, so need to temporarily silence STDOUT. + tie *STDOUT, 'NoSTDOUT'; + + my $mm = MM->new( { NAME => 'dummy' }); + my @path = $mm->path; + my @GoodPerls; + + for my $perl (@PerlBinaries) { + if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) { + push @GoodPerls, $abs; + } + } + + untie *STDOUT; + + print "\nFound:\n", (map " $_\n", @GoodPerls), "\n"; + + return @GoodPerls; +} + +sub SearchPerls +{ + my @args = @_; + my @perls; + + for my $arg (@args) { + if (-d $arg) { + my @found; + print "Searching for Perl binaries in '$arg'...\n"; + find({ wanted => sub { + $File::Find::name =~ m!perl5[\w._]+$! + and -f $File::Find::name + and -x $File::Find::name + and perl_version($File::Find::name) + and push @found, $File::Find::name; + }, follow => 1 }, $arg); + printf "Found %d Perl binar%s in '%s'.\n\n", cs(@found, 'y', 'ies'), $arg; + push @perls, @found; + } + else { + push @perls, $arg; + } + } + + return @perls; +} + +sub perl_version +{ + my $perl = shift; + my $ver = `$perl -e 'print \$]' 2>&1`; + return $? == 0 && $ver =~ /^\d+\.\d+/ && $ver >= 5 ? $ver : 0; +} + +sub parse_version +{ + my $ver = shift; + + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { + return $1 + 1e-3*$2 + 1e-6*$3; + } + elsif ($ver =~ /^\d+\.[\d_]+$/) { + $ver =~ s/_//g; + return $ver; + } + + die "cannot parse version '$ver'\n"; +} + +package NoSTDOUT; + +use Tie::Handle; +our @ISA = qw(Tie::Handle); + +sub TIEHANDLE { bless \(my $s = ''), shift } +sub PRINT {} +sub WRITE {} + +package Soak::Reporter; + +use strict; + +sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) } + +sub new +{ + my $class = shift; + bless { + tests => undef, + color => 1, + verbose => 0, + @_, + _cur => 0, + _atbol => 1, + _total => 0, + _good => [], + _bad => [], + }, $class; +} + +sub colored +{ + my $self = shift; + + if ($self->{color}) { + my $c = eval { + require Term::ANSIColor; + Term::ANSIColor::colored(@_); + }; + + if ($@) { + $self->{color} = 0; + } + else { + return $c; + } + } + + return $_[0]; +} + +sub _config +{ + my $self = shift; + return $self->{config} =~ /\S+/ ? " ($self->{config})" : ''; +} + +sub _progress +{ + my $self = shift; + return '' unless defined $self->{tests}; + my $tlen = length $self->{tests}; + my $text = sprintf "[%${tlen}d/%${tlen}d] ", $self->{_cur}, $self->{tests}; + return $self->colored($text, 'bold'); +} + +sub _test +{ + my $self = shift; + return $self->_progress . "Testing " + . $self->colored($self->{perl}, 'blue') + . $self->colored($self->_config, 'green'); +} + +sub _testlen +{ + my $self = shift; + return length("Testing " . $self->{perl} . $self->_config); +} + +sub _dots +{ + my $self = shift; + return '.' x $self->_dotslen; +} + +sub _dotslen +{ + my $self = shift; + return $self->{width} - length($self->{perl} . $self->_config); +} + +sub _sep +{ + my $self = shift; + my $width = shift; + $self->print($self->colored('-'x$width, 'bold'), "\n"); +} + +sub _vsep +{ + goto &_sep if $_[0]->{verbose}; +} + +sub set +{ + my $self = shift; + while (@_) { + my($k, $v) = splice @_, 0, 2; + $self->{$k} = $v; + } +} + +sub test +{ + my $self = shift; + $self->{_cur}++; + $self->_vsep($self->_testlen); + $self->print($self->_test, $self->{verbose} ? "\n" : ' ' . $self->_dots . ' '); + $self->_vsep($self->_testlen); +} + +sub _warnings +{ + my($self, $mode) = @_; + + my $warnings = 0; + my $differ = 0; + + for my $w (@{$self->{_warnings}}) { + if (@{$w->[1]}) { + $warnings += @{$w->[1]}; + $differ++; + } + } + + my $rv = ''; + + if ($warnings) { + if ($mode eq 'summary') { + $rv .= sprintf " (%d warning%s", cs($warnings); + } + else { + $rv .= "\n"; + } + + for my $w (@{$self->{_warnings}}) { + if (@{$w->[1]}) { + if ($mode eq 'detail') { + $rv .= " Warnings during '$w->[0]':\n"; + my $cnt = 1; + for my $msg (@{$w->[1]}) { + $rv .= sprintf " [%d] %s", $cnt++, $msg; + } + $rv .= "\n"; + } + else { + unless ($self->{verbose}) { + $rv .= $differ == 1 ? " during " . $w->[0] + : sprintf(", %d during %s", scalar @{$w->[1]}, $w->[0]); + } + } + } + } + + if ($mode eq 'summary') { + $rv .= ')'; + } + } + + return $rv; +} + +sub _result +{ + my($self, $text, $color) = @_; + my $sum = $self->_warnings('summary'); + my $len = $self->_testlen + $self->_dotslen + length($text) + length($sum) + 2; + + $self->_vsep($len); + $self->print($self->_test, ' ', $self->_dots, ' ') if $self->{verbose} || $self->{_atbol}; + $self->print($self->colored($text, $color)); + $self->print($self->colored($sum, 'red')); + $self->print("\n"); + $self->_vsep($len); + $self->print($self->_warnings('detail')) if $self->{verbose}; + $self->{_total}++; +} + +sub passed +{ + my $self = shift; + $self->_result(@_, 'ok', 'bold green'); + push @{$self->{_good}}, [$self->{perl}, $self->{config}]; +} + +sub failed +{ + my $self = shift; + $self->_result(@_, 'not ok', 'bold red'); + push @{$self->{_bad}}, [$self->{perl}, $self->{config}]; +} + +sub warnings +{ + my $self = shift; + $self->{_warnings} = \@_; +} + +sub _tobol +{ + my $self = shift; + print "\n" unless $self->{_atbol}; + $self->{_atbol} = 1; +} + +sub print +{ + my $self = shift; + my $text = join '', @_; + print $text; + $self->{_atbol} = $text =~ /[\r\n]$/; +} + +sub say +{ + my $self = shift; + $self->_tobol; + $self->print(@_, "\n"); +} + +sub vsay +{ + goto &say if $_[0]->{verbose}; +} + +sub warn +{ + my $self = shift; + $self->say($self->colored(join('', @_), 'red')); +} + +sub die +{ + my $self = shift; + $self->say($self->colored(join('', 'FATAL: ', @_), 'bold red')); + exit -1; +} + +sub status +{ + my($self, $text) = @_; + $self->_tobol; + $self->print($self->colored($text, 'bold'), "\n"); +} + +sub finish +{ + my $self = shift; + + if (@{$self->{_bad}}) { + $self->status("\nFailed with:"); + for my $fail (@{$self->{_bad}}) { + my($perl, $cfg) = @$fail; + $self->set(config => $cfg); + $self->say(" ", $self->colored($perl, 'blue'), $self->colored($self->_config, 'green')); + } + } + + $self->status(sprintf("\nPassed with %d of %d combination%s.\n", + scalar @{$self->{_good}}, cs($self->{_total}))); + + return scalar @{$self->{_bad}}; +} + +__END__ + +=head1 NAME + +soak - Test Perl modules with multiple Perl releases + +=head1 SYNOPSIS + + soak [options] [perl ...] + + --make=program override name of make program ($Config{make}) + --min=version use at least this version of perl + --mmargs=options pass options to Makefile.PL (multiple --mmargs possible) + --verbose be verbose + --nocolor don't use colored output + +=head1 DESCRIPTION + +The F utility can be used to test Perl modules with +multiple Perl releases or build options. It automates the +task of running F and the modules test suite. + +It is not primarily intended for cross-platform checking, +so don't expect it to work on all platforms. + +=head1 EXAMPLES + +To test your favourite module, just change to its root +directory (where the F is located) and run: + + soak + +This will automatically look for Perl binaries installed +on your system. + +Alternatively, you can explicitly pass F a list of +Perl binaries: + + soak perl5.8.6 perl5.9.2 + +Last but not least, you can pass it a list of directories +to recursively search for Perl binaries, for example: + + soak /tmp/perl/install /usr/bin + +All of the above examples will run + + perl Makefile.PL + make + make test + +for your module and report success or failure. + +If your F can take arguments, you may also +want to test different configurations for your module. +You can do so with the I<--mmargs> option: + + soak --mmargs=' ' --mmargs='CCFLAGS=-Wextra' --mmargs='enable-debug' + +This will run + + perl Makefile.PL + make + make test + perl Makefile.PL CCFLAGS=-Wextra + make + make test + perl Makefile.PL enable-debug + make + make test + +for each Perl binary. + +If you have a directory full of different Perl binaries, +but your module isn't expected to work with ancient perls, +you can use the I<--min> option to specify the minimum +version a Perl binary must have to be chosen for testing: + + soak --min=5.8.1 + +Usually, the output of F is rather terse, to give +you a good overview. If you'd like to see more of what's +going on, use the I<--verbose> option: + + soak --verbose + +=head1 COPYRIGHT + +Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz. + +Version 2.x, Copyright (C) 2001, Paul Marquess. + +Version 1.x, Copyright (C) 1999, Kenneth Albanowski. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +See L. + +=cut + diff --git a/ext/Devel-PPPort/t/MY_CXT.t b/ext/Devel-PPPort/t/MY_CXT.t new file mode 100644 index 0000000000..a94bd386c4 --- /dev/null +++ b/ext/Devel-PPPort/t/MY_CXT.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/MY_CXT instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (3) { + load(); + plan(tests => 3); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::MY_CXT_1()); +ok(&Devel::PPPort::MY_CXT_2()); +ok(&Devel::PPPort::MY_CXT_CLONE()); + diff --git a/ext/Devel-PPPort/t/SvPV.t b/ext/Devel-PPPort/t/SvPV.t new file mode 100644 index 0000000000..63c7d72c43 --- /dev/null +++ b/ext/Devel-PPPort/t/SvPV.t @@ -0,0 +1,116 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/SvPV instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (47) { + load(); + plan(tests => 47); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $mhx = "mhx"; + +ok(&Devel::PPPort::SvPVbyte($mhx), 3); + +my $i = 42; + +ok(&Devel::PPPort::SvPV_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++); + +ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_force($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0); + +my $str = ""; +my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80); +ok($str, "x"x80); +ok($s2, "x"x80); +ok($before < 81); +ok($after, 81); + +$str = "x"x400; +($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40); +ok($str, "x"x40); +ok($s2, "x"x40); +ok($before > 41); +ok($after, 41); + diff --git a/ext/Devel-PPPort/t/SvREFCNT.t b/ext/Devel-PPPort/t/SvREFCNT.t new file mode 100644 index 0000000000..0b46a51793 --- /dev/null +++ b/ext/Devel-PPPort/t/SvREFCNT.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/SvREFCNT instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (14) { + load(); + plan(tests => 14); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +for (Devel::PPPort::SvREFCNT()) { + ok(defined $_ and $_); +} + diff --git a/ext/Devel-PPPort/t/Sv_set.t b/ext/Devel-PPPort/t/Sv_set.t new file mode 100644 index 0000000000..77a7a860db --- /dev/null +++ b/ext/Devel-PPPort/t/Sv_set.t @@ -0,0 +1,71 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/Sv_set instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (5) { + load(); + plan(tests => 5); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $foo = 5; +ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42); +ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43); +ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44); + +my $bar = []; + +bless $bar, 'foo'; +ok($bar->x(), 'foobar'); + +Devel::PPPort::TestSvSTASH_set($bar, 'bar'); +ok($bar->x(), 'hacker'); + +package foo; + +sub x { 'foobar' } + +package bar; + +sub x { 'hacker' } + diff --git a/ext/Devel-PPPort/t/call.t b/ext/Devel-PPPort/t/call.t new file mode 100644 index 0000000000..4d3e80e4c8 --- /dev/null +++ b/ext/Devel-PPPort/t/call.t @@ -0,0 +1,107 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/call instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (52) { + load(); + plan(tests => 52); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +sub eq_array +{ + my($a, $b) = @_; + join(':', @$a) eq join(':', @$b); +} + +sub f +{ + shift; + unshift @_, 'b'; + pop @_; + @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; +} + +my $obj = bless [], 'Foo'; + +sub Foo::meth +{ + return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo'; + shift; + shift; + unshift @_, 'b'; + pop @_; + @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; +} + +my $test; + +for $test ( + # flags args expected description + [ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ], + [ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ], + [ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ], + [ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ], + [ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ], + [ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ], +) +{ + my ($flags, $args, $expected, $description) = @$test; + print "# --- $description ---\n"; + ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected)); +}; + +ok(&Devel::PPPort::eval_pv('f()', 0), 'y'); +ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y'); + +ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet"); +Devel::PPPort::load_module(0, "less", undef); +ok(defined $::{'less::'}, 1, "Have now loaded less"); + diff --git a/ext/Devel-PPPort/t/cop.t b/ext/Devel-PPPort/t/cop.t new file mode 100644 index 0000000000..1162a5ed50 --- /dev/null +++ b/ext/Devel-PPPort/t/cop.t @@ -0,0 +1,62 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/cop instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $package; +{ + package MyPackage; + $package = &Devel::PPPort::CopSTASHPV(); +} +print "# $package\n"; +ok($package, "MyPackage"); + +my $file = &Devel::PPPort::CopFILE(); +print "# $file\n"; +ok($file =~ /cop/i); + diff --git a/ext/Devel-PPPort/t/exception.t b/ext/Devel-PPPort/t/exception.t new file mode 100644 index 0000000000..c432df6e69 --- /dev/null +++ b/ext/Devel-PPPort/t/exception.t @@ -0,0 +1,67 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/exception instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (7) { + load(); + plan(tests => 7); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $rv; + +$Devel::PPPort::exception_caught = undef; + +$rv = eval { &Devel::PPPort::exception(0) }; +ok($@, ''); +ok(defined $rv); +ok($rv, 42); +ok($Devel::PPPort::exception_caught, 0); + +$Devel::PPPort::exception_caught = undef; + +$rv = eval { &Devel::PPPort::exception(1) }; +ok($@, "boo\n"); +ok(not defined $rv); +ok($Devel::PPPort::exception_caught, 1); + diff --git a/ext/Devel-PPPort/t/format.t b/ext/Devel-PPPort/t/format.t new file mode 100644 index 0000000000..a25ede533f --- /dev/null +++ b/ext/Devel-PPPort/t/format.t @@ -0,0 +1,55 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/format instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $num = 1.12345678901234567890; + +eval { Devel::PPPort::croak_NVgf($num) }; +ok($@ =~ /^1.1234567890/); + diff --git a/ext/Devel-PPPort/t/grok.t b/ext/Devel-PPPort/t/grok.t new file mode 100644 index 0000000000..b807ce8ccd --- /dev/null +++ b/ext/Devel-PPPort/t/grok.t @@ -0,0 +1,62 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/grok instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (10) { + load(); + plan(tests => 10); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::grok_number("42"), 42); +ok(!defined(&Devel::PPPort::grok_number("A"))); +ok(&Devel::PPPort::grok_bin("10000001"), 129); +ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef); +ok(&Devel::PPPort::grok_oct("377"), 255); + +ok(&Devel::PPPort::Perl_grok_number("42"), 42); +ok(!defined(&Devel::PPPort::Perl_grok_number("A"))); +ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129); +ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef); +ok(&Devel::PPPort::Perl_grok_oct("377"), 255); + diff --git a/ext/Devel-PPPort/t/limits.t b/ext/Devel-PPPort/t/limits.t new file mode 100644 index 0000000000..ed1cb2e3ac --- /dev/null +++ b/ext/Devel-PPPort/t/limits.t @@ -0,0 +1,55 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/limits instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (4) { + load(); + plan(tests => 4); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::iv_size()); +ok(&Devel::PPPort::uv_size()); +ok(&Devel::PPPort::iv_type()); +ok(&Devel::PPPort::uv_type()); + diff --git a/ext/Devel-PPPort/t/mPUSH.t b/ext/Devel-PPPort/t/mPUSH.t new file mode 100644 index 0000000000..2f38276828 --- /dev/null +++ b/ext/Devel-PPPort/t/mPUSH.t @@ -0,0 +1,62 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/mPUSH instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (10) { + load(); + plan(tests => 10); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42"); +ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three"); +ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125"); +ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3"); +ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3"); + +ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42"); +ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three"); +ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125"); +ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3"); +ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3"); + diff --git a/ext/Devel-PPPort/t/magic.t b/ext/Devel-PPPort/t/magic.t new file mode 100644 index 0000000000..23b19ed438 --- /dev/null +++ b/ext/Devel-PPPort/t/magic.t @@ -0,0 +1,95 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/magic instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (15) { + load(); + plan(tests => 15); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +use Tie::Hash; +my %h; +tie %h, 'Tie::StdHash'; +$h{foo} = 'foo'; +$h{bar} = ''; + +&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); +ok($h{foo}, 'foobar'); + +&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); +ok($h{bar}, 'baz'); + +&Devel::PPPort::sv_catsv_mg($h{foo}, '42'); +ok($h{foo}, 'foobar42'); + +&Devel::PPPort::sv_setiv_mg($h{bar}, 42); +ok($h{bar}, 42); + +&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); +ok(abs($h{PI} - 3.14159) < 0.01); + +&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); +ok($h{mhx}, 'mhx'); + +&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); +ok($h{mhx}, 'Marcus'); + +&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); +ok($h{sv}, 'SV'); + +&Devel::PPPort::sv_setuv_mg($h{sv}, 4711); +ok($h{sv}, 4711); + +&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); +ok($h{sv}, 'Perl'); + +my $ver = eval qq[qv("v1.2.0")]; +ok($[ < 5.009 || $@ eq ''); +ok($@ || Devel::PPPort::SvVSTRING_mg($ver)); +ok(!Devel::PPPort::SvVSTRING_mg(4711)); + +my $foo = 'bar'; +ok(Devel::PPPort::sv_magic_portable($foo)); +ok($foo eq 'bar'); + diff --git a/ext/Devel-PPPort/t/memory.t b/ext/Devel-PPPort/t/memory.t new file mode 100644 index 0000000000..501b819864 --- /dev/null +++ b/ext/Devel-PPPort/t/memory.t @@ -0,0 +1,52 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/memory instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::checkmem(), 4); + diff --git a/ext/Devel-PPPort/t/misc.t b/ext/Devel-PPPort/t/misc.t new file mode 100644 index 0000000000..d7ab504848 --- /dev/null +++ b/ext/Devel-PPPort/t/misc.t @@ -0,0 +1,125 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/misc instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (38) { + load(); + plan(tests => 38); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +use vars qw($my_sv @my_av %my_hv); + +ok(&Devel::PPPort::boolSV(1)); +ok(!&Devel::PPPort::boolSV(0)); + +$_ = "Fred"; +ok(&Devel::PPPort::DEFSV(), "Fred"); +ok(&Devel::PPPort::UNDERBAR(), "Fred"); + +if ($] >= 5.009002) { + eval q{ + my $_ = "Tony"; + ok(&Devel::PPPort::DEFSV(), "Fred"); + ok(&Devel::PPPort::UNDERBAR(), "Tony"); + }; +} +else { + ok(1); + ok(1); +} + +my @r = &Devel::PPPort::DEFSV_modify(); + +ok(@r == 3); +ok($r[0], 'Fred'); +ok($r[1], 'DEFSV'); +ok($r[2], 'Fred'); + +ok(&Devel::PPPort::DEFSV(), "Fred"); + +eval { 1 }; +ok(!&Devel::PPPort::ERRSV()); +eval { cannot_call_this_one() }; +ok(&Devel::PPPort::ERRSV()); + +ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0)); +ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0)); +ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1)); + +$my_sv = 1; +ok(&Devel::PPPort::get_sv('my_sv', 0)); +ok(!&Devel::PPPort::get_sv('not_my_sv', 0)); +ok(&Devel::PPPort::get_sv('not_my_sv', 1)); + +@my_av = (1); +ok(&Devel::PPPort::get_av('my_av', 0)); +ok(!&Devel::PPPort::get_av('not_my_av', 0)); +ok(&Devel::PPPort::get_av('not_my_av', 1)); + +%my_hv = (a=>1); +ok(&Devel::PPPort::get_hv('my_hv', 0)); +ok(!&Devel::PPPort::get_hv('not_my_hv', 0)); +ok(&Devel::PPPort::get_hv('not_my_hv', 1)); + +sub my_cv { 1 }; +ok(&Devel::PPPort::get_cv('my_cv', 0)); +ok(!&Devel::PPPort::get_cv('not_my_cv', 0)); +ok(&Devel::PPPort::get_cv('not_my_cv', 1)); + +ok(Devel::PPPort::dXSTARG(42), 43); +ok(Devel::PPPort::dAXMARK(4711), 4710); + +ok(Devel::PPPort::prepush(), 42); + +ok(join(':', Devel::PPPort::xsreturn(0)), 'test1'); +ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); + +ok(Devel::PPPort::PERL_ABS(42), 42); +ok(Devel::PPPort::PERL_ABS(-13), 13); + +ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42'); +ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc'); + +ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo"); + diff --git a/ext/Devel-PPPort/t/newCONSTSUB.t b/ext/Devel-PPPort/t/newCONSTSUB.t new file mode 100644 index 0000000000..cb207a4587 --- /dev/null +++ b/ext/Devel-PPPort/t/newCONSTSUB.t @@ -0,0 +1,59 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newCONSTSUB instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (3) { + load(); + plan(tests => 3); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +&Devel::PPPort::call_newCONSTSUB_1(); +ok(&Devel::PPPort::test_value_1(), 1); + +&Devel::PPPort::call_newCONSTSUB_2(); +ok(&Devel::PPPort::test_value_2(), 2); + +&Devel::PPPort::call_newCONSTSUB_3(); +ok(&Devel::PPPort::test_value_3(), 3); + diff --git a/ext/Devel-PPPort/t/newRV.t b/ext/Devel-PPPort/t/newRV.t new file mode 100644 index 0000000000..731a62b1f6 --- /dev/null +++ b/ext/Devel-PPPort/t/newRV.t @@ -0,0 +1,53 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newRV instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::newRV_inc_REFCNT, 1); +ok(&Devel::PPPort::newRV_noinc_REFCNT, 1); + diff --git a/ext/Devel-PPPort/t/newSVpv.t b/ext/Devel-PPPort/t/newSVpv.t new file mode 100644 index 0000000000..d14a53fbe8 --- /dev/null +++ b/ext/Devel-PPPort/t/newSVpv.t @@ -0,0 +1,78 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newSVpv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (15) { + load(); + plan(tests => 15); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my @s = &Devel::PPPort::newSVpvn(); +ok(@s == 5); +ok($s[0], "test"); +ok($s[1], "te"); +ok($s[2], ""); +ok(!defined($s[3])); +ok(!defined($s[4])); + +@s = &Devel::PPPort::newSVpvn_flags(); +ok(@s == 5); +ok($s[0], "test"); +ok($s[1], "te"); +ok($s[2], ""); +ok(!defined($s[3])); +ok(!defined($s[4])); + +@s = &Devel::PPPort::newSVpvn_utf8(); +ok(@s == 1); +ok($s[0], "test"); + +if ($] >= 5.008001) { + require utf8; + ok(utf8::is_utf8($s[0])); +} +else { + skip("skip: no is_utf8()", 0); +} + diff --git a/ext/Devel-PPPort/t/podtest.t b/ext/Devel-PPPort/t/podtest.t new file mode 100644 index 0000000000..c1a35b20a0 --- /dev/null +++ b/ext/Devel-PPPort/t/podtest.t @@ -0,0 +1,83 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/podtest instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (0) { + load(); + plan(tests => 0); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my @pods = qw( HACKERS PPPort.pm ppport.h soak devel/regenerate devel/buildperl.pl ); + +my $reason = ''; + +if ($ENV{'SKIP_SLOW_TESTS'}) { + $reason = 'SKIP_SLOW_TESTS'; +} +else { + # Try loading Test::Pod + eval q{ + use Test::Pod; + $Test::Pod::VERSION >= 0.95 + or die "Test::Pod version only $Test::Pod::VERSION"; + import Test::Pod tests => scalar @pods; + }; + $reason = 'Test::Pod >= 0.95 required' if $@; +} + +if ($reason) { + load(); + plan(tests => scalar @pods); +} + +for (@pods) { + print "# checking $_\n"; + if ($reason) { + skip("skip: $reason", 0); + } + else { + pod_file_ok($_); + } +} + diff --git a/ext/Devel-PPPort/t/ppphtest.t b/ext/Devel-PPPort/t/ppphtest.t new file mode 100644 index 0000000000..fe4ade08e7 --- /dev/null +++ b/ext/Devel-PPPort/t/ppphtest.t @@ -0,0 +1,932 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/ppphtest instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (235) { + load(); + plan(tests => 235); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +BEGIN { + if ($ENV{'SKIP_SLOW_TESTS'}) { + for (1 .. 235) { + skip("skip: SKIP_SLOW_TESTS", 0); + } + exit 0; + } +} + +use File::Path qw/rmtree mkpath/; +use Config; + +my $tmp = 'ppptmp'; +my $inc = ''; +my $isVMS = $^O eq 'VMS'; +my $isMAC = $^O eq 'MacOS'; +my $perl = find_perl(); + +rmtree($tmp) if -d $tmp; +mkpath($tmp) or die "mkpath $tmp: $!\n"; +chdir($tmp) or die "chdir $tmp: $!\n"; + +if ($ENV{'PERL_CORE'}) { + if (-d '../../lib') { + if ($isVMS) { + $inc = '"-I../../lib"'; + } + elsif ($isMAC) { + $inc = '-I:::lib'; + } + else { + $inc = '-I../../lib'; + } + unshift @INC, '../../lib'; + } +} +if ($perl =~ m!^\./!) { + $perl = ".$perl"; +} + +END { + chdir('..') if !-d $tmp && -d "../$tmp"; + rmtree($tmp) if -d $tmp; +} + +ok(&Devel::PPPort::WriteFile("ppport.h")); + +sub comment +{ + my $c = shift; + $c =~ s/^/# | /mg; + $c .= "\n" unless $c =~ /[\r\n]$/; + print $c; +} + +sub ppport +{ + my @args = ('ppport.h', @_); + unshift @args, $inc if $inc; + my $run = $perl =~ m/\s/ ? qq("$perl") : $perl; + $run .= ' -MMac::err=unix' if $isMAC; + for (@args) { + $_ = qq("$_") if $isVMS && /^[^"]/; + $run .= " $_"; + } + print "# *** running $run ***\n"; + $run .= ' 2>&1' unless $isMAC; + my @out = `$run`; + my $out = join '', @out; + comment($out); + return wantarray ? @out : $out; +} + +sub matches +{ + my($str, $re, $mod) = @_; + my @n; + eval "\@n = \$str =~ /$re/g$mod;"; + if ($@) { + my $err = $@; + $err =~ s/^/# *** /mg; + print "# *** ERROR ***\n$err\n"; + } + return $@ ? -42 : scalar @n; +} + +sub eq_files +{ + my($f1, $f2) = @_; + return 0 unless -e $f1 && -e $f2; + local *F; + for ($f1, $f2) { + print "# File: $_\n"; + unless (open F, $_) { + print "# couldn't open $_: $!\n"; + return 0; + } + $_ = do { local $/; }; + close F; + comment($_); + } + return $f1 eq $f2; +} + +my @tests; + +for (split /\s*={70,}\s*/, do { local $/; }) { + s/^\s+//; s/\s+$//; + my($c, %f); + ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/; + push @tests, { code => $c, files => \%f }; +} + +my $t; +for $t (@tests) { + print "#\n", ('# ', '-'x70, "\n")x3, "#\n"; + my $f; + for $f (keys %{$t->{files}}) { + my @f = split /\//, $f; + if (@f > 1) { + pop @f; + my $path = join '/', @f; + mkpath($path) or die "mkpath('$path'): $!\n"; + } + my $txt = $t->{files}{$f}; + local *F; + open F, ">$f" or die "open $f: $!\n"; + print F "$txt\n"; + close F; + $txt =~ s/^/# | /mg; + print "# *** writing $f ***\n$txt\n"; + } + + my $code = $t->{code}; + $code =~ s/^/# | /mg; + + print "# *** evaluating test code ***\n$code\n"; + + eval $t->{code}; + if ($@) { + my $err = $@; + $err =~ s/^/# *** /mg; + print "# *** ERROR ***\n$err\n"; + } + ok($@, ''); + + for (keys %{$t->{files}}) { + unlink $_ or die "unlink('$_'): $!\n"; + } +} + +sub find_perl +{ + my $perl = $^X; + + return $perl if $isVMS; + + my $exe = $Config{'_exe'} || ''; + + if ($perl =~ /^perl\Q$exe\E$/i) { + $perl = "perl$exe"; + eval "require File::Spec"; + if ($@) { + $perl = "./$perl"; + } else { + $perl = File::Spec->catfile(File::Spec->curdir(), $perl); + } + } + + if ($perl !~ /\Q$exe\E$/i) { + $perl .= $exe; + } + + warn "find_perl: cannot find $perl from $^X" unless -f $perl; + + return $perl; +} + +__DATA__ + +my $o = ppport(qw(--help)); +ok($o =~ /^Usage:.*ppport\.h/m); +ok($o =~ /--help/m); + +$o = ppport(qw(--version)); +ok($o =~ /^This is.*ppport.*\d+\.\d+(?:_?\d+)?\.$/); + +$o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*test\.xs/mi); +ok($o =~ /Analyzing.*test\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); +ok($o =~ /Uses Perl_newSViv instead of newSViv/); + +$o = ppport(qw(--quiet --nochanges)); +ok($o =~ /^\s*$/); + +---------------------------- test.xs ------------------------------------------ + +Perl_newSViv(); + +=============================================================================== + +# check if C and C++ comments are filtered correctly + +my $o = ppport(qw(--copy=a)); +ok($o =~ /^Scanning.*MyExt\.xs/mi); +ok($o =~ /Analyzing.*MyExt\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Uses grok_bin/m); +ok($o !~ /^Uses newSVpv/m); +ok($o =~ /Uses 1 C\+\+ style comment/m); +ok(eq_files('MyExt.xsa', 'MyExt.ra')); + +# check if C++ are left untouched with --cplusplus + +$o = ppport(qw(--copy=b --cplusplus)); +ok($o =~ /^Scanning.*MyExt\.xs/mi); +ok($o =~ /Analyzing.*MyExt\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Uses grok_bin/m); +ok($o !~ /^Uses newSVpv/m); +ok($o !~ /Uses \d+ C\+\+ style comment/m); +ok(eq_files('MyExt.xsb', 'MyExt.rb')); + +unlink qw(MyExt.xsa MyExt.xsb); + +---------------------------- MyExt.xs ----------------------------------------- + +newSVuv(); + // newSVpv(); + XPUSHs(foo); +/* grok_bin(); */ + +---------------------------- MyExt.ra ----------------------------------------- + +#include "ppport.h" +newSVuv(); + /* newSVpv(); */ + XPUSHs(foo); +/* grok_bin(); */ + +---------------------------- MyExt.rb ----------------------------------------- + +#include "ppport.h" +newSVuv(); + // newSVpv(); + XPUSHs(foo); +/* grok_bin(); */ + +=============================================================================== + +my $o = ppport(qw(--nochanges file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o =~ /^Uses newCONSTSUB/m); +ok($o =~ /^Uses PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o =~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --nohints file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o =~ /^Uses newCONSTSUB/m); +ok($o =~ /^Uses PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --nohints --nodiag file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o !~ /^Uses newCONSTSUB/m); +ok($o !~ /^Uses PL_expect/m); +ok($o !~ /^Uses SvPV_nolen/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --quiet file1.xs)); +ok($o =~ /^\s*$/); + +$o = ppport(qw(--nochanges file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o =~ /^Uses mXPUSHp/m); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --nohints file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o =~ /^Uses mXPUSHp/m); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --nohints --nodiag file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o !~ /^Uses mXPUSHp/m); +ok($o !~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --quiet file2.xs)); +ok($o =~ /^\s*$/); + +---------------------------- file1.xs ----------------------------------------- + +#define NEED_newCONSTSUB +#define NEED_sv_2pv_flags +#define NEED_PL_parser +#include "ppport.h" + +newCONSTSUB(); +SvPV_nolen(); +PL_expect = 0; + +---------------------------- file2.xs ----------------------------------------- + +mXPUSHp(foo); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*FooBar\.xs/mi); +ok($o =~ /Analyzing.*FooBar\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o !~ /^Looks good/m); +ok($o =~ /^Uses grok_bin/m); + +---------------------------- FooBar.xs ---------------------------------------- + +newSViv(); +XPUSHs(foo); +grok_bin(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*First\.xs/mi); +ok($o =~ /Analyzing.*First\.xs/mi); +ok($o =~ /^Scanning.*second\.h/mi); +ok($o =~ /Analyzing.*second\.h/mi); +ok($o =~ /^Scanning.*sub.*third\.c/mi); +ok($o =~ /Analyzing.*sub.*third\.c/mi); +ok($o !~ /^Scanning.*foobar/mi); +ok(matches($o, '^Scanning', 'm'), 3); + +---------------------------- First.xs ----------------------------------------- + +one + +---------------------------- foobar.xyz --------------------------------------- + +two + +---------------------------- second.h ----------------------------------------- + +three + +---------------------------- sub/third.c -------------------------------------- + +four + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i); + +---------------------------- test.xs ------------------------------------------ + +#define NEED_foobar + +=============================================================================== + +# And now some complex "real-world" example + +my $o = ppport(qw(--copy=f)); +for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) { + ok($o =~ /^Scanning.*\Q$_\E/mi); + ok($o =~ /Analyzing.*\Q$_\E/i); +} +ok(matches($o, '^Scanning', 'm'), 6); + +ok(matches($o, '^Writing copy of', 'm'), 5); +ok(!-e "mod5.cf"); + +for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- main.xs ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_newCONSTSUB +#define NEED_grok_hex_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_hex(); +Perl_grok_bin(aTHX_ foo, bar); + +/* some comment */ + +perl_eval_pv(); +grok_bin(); +Perl_grok_bin(bar, sv_no); + +---------------------------- mod1.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_grok_bin_GLOBAL +#define NEED_newCONSTSUB +#include "ppport.h" + +newCONSTSUB(); +grok_bin(); +{ + Perl_croak ("foo"); + Perl_sv_catpvf(); /* I know it's wrong ;-) */ +} + +---------------------------- mod2.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_eval_pv +#include "ppport.h" + +newSViv(); + +/* + eval_pv(); +*/ + +---------------------------- mod3.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +grok_oct(); +eval_pv(); + +---------------------------- mod4.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +START_MY_CXT; + +---------------------------- mod5.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "ppport.h" +call_pv(); + +---------------------------- main.xsr ----------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_eval_pv_GLOBAL +#define NEED_grok_hex +#define NEED_newCONSTSUB_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_hex(); +grok_bin(foo, bar); + +/* some comment */ + +eval_pv(); +grok_bin(); +grok_bin(bar, PL_sv_no); + +---------------------------- mod1.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_grok_bin_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_bin(); +{ + Perl_croak (aTHX_ "foo"); + Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */ +} + +---------------------------- mod2.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + + +newSViv(); + +/* + eval_pv(); +*/ + +---------------------------- mod3.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#define NEED_grok_oct +#include "ppport.h" + +grok_oct(); +eval_pv(); + +---------------------------- mod4.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "ppport.h" + +START_MY_CXT; + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Uses grok_hex/m); +ok($o !~ /Looks good/m); + +$o = ppport(qw(--nochanges --compat-version=5.8.0)); +ok($o !~ /Uses grok_hex/m); +ok($o =~ /Looks good/m); + +---------------------------- FooBar.xs ---------------------------------------- + +grok_hex(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.5.3)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.005_03)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.6.0)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=5.006)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=5.999.999)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=6.0.0)); +ok($o =~ /Only Perl 5 is supported/m); + +$o = ppport(qw(--nochanges --compat-version=5.1000.999)); +ok($o =~ /Invalid version number: 5.1000.999/m); + +$o = ppport(qw(--nochanges --compat-version=5.999.1000)); +ok($o =~ /Invalid version number: 5.999.1000/m); + +---------------------------- FooBar.xs ---------------------------------------- + +SvPVutf8_force(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o !~ /potentially required change/); +ok(matches($o, '^Looks good', 'm'), 2); + +---------------------------- FooBar.xs ---------------------------------------- + +#define NEED_grok_numeric_radix +#define NEED_grok_number +#include "ppport.h" + +GROK_NUMERIC_RADIX(); +grok_number(); + +---------------------------- foo.c -------------------------------------------- + +#include "ppport.h" + +call_pv(); + +=============================================================================== + +# check --api-info option + +my $o = ppport(qw(--api-info=INT2PTR)); +my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 1); +ok(exists $found{INT2PTR}); +ok(matches($o, '^Supported at least starting from perl-5\.6\.0\.', 'm'), 1); +ok(matches($o, '^Support by .*ppport.* provided back to perl-5\.003\.', 'm'), 1); + +$o = ppport(qw(--api-info=Zero)); +%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 1); +ok(exists $found{Zero}); +ok(matches($o, '^No portability information available\.', 'm'), 1); + +$o = ppport(qw(--api-info=/Zero/)); +%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 2); +ok(exists $found{Zero}); +ok(exists $found{ZeroD}); + +=============================================================================== + +# check --list-provided option + +my @o = ppport(qw(--list-provided)); +my %p; +my $fail = 0; +for (@o) { + my($name, $flags) = /^(\w+)(?:\s+\[(\w+(?:,\s+\w+)*)\])?$/ or $fail++; + exists $p{$name} and $fail++; + $p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : ''; +} +ok(@o > 100); +ok($fail, 0); + +ok(exists $p{call_pv}); +ok(not ref $p{call_pv}); + +ok(exists $p{grok_bin}); +ok(ref $p{grok_bin}, 'HASH'); +ok(scalar keys %{$p{grok_bin}}, 2); +ok($p{grok_bin}{explicit}); +ok($p{grok_bin}{depend}); + +ok(exists $p{gv_stashpvn}); +ok(ref $p{gv_stashpvn}, 'HASH'); +ok(scalar keys %{$p{gv_stashpvn}}, 2); +ok($p{gv_stashpvn}{depend}); +ok($p{gv_stashpvn}{hint}); + +ok(exists $p{sv_catpvf_mg}); +ok(ref $p{sv_catpvf_mg}, 'HASH'); +ok(scalar keys %{$p{sv_catpvf_mg}}, 2); +ok($p{sv_catpvf_mg}{explicit}); +ok($p{sv_catpvf_mg}{depend}); + +ok(exists $p{PL_signals}); +ok(ref $p{PL_signals}, 'HASH'); +ok(scalar keys %{$p{PL_signals}}, 1); +ok($p{PL_signals}{explicit}); + +=============================================================================== + +# check --list-unsupported option + +my @o = ppport(qw(--list-unsupported)); +my %p; +my $fail = 0; +for (@o) { + my($name, $ver) = /^(\w+)\s*\.+\s*([\d._]+)$/ or $fail++; + exists $p{$name} and $fail++; + $p{$name} = $ver; +} +ok(@o > 100); +ok($fail, 0); + +ok(exists $p{utf8_distance}); +ok($p{utf8_distance}, '5.6.0'); + +ok(exists $p{save_generic_svref}); +ok($p{save_generic_svref}, '5.005_03'); + +=============================================================================== + +# check --nofilter option + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); + +$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL)); +ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m); +ok(matches($o, '^\|\s+foo\.o', 'mi'), 1); +ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); + +$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL)); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok($o =~ /^Scanning.*foo\.o/mi); +ok($o =~ /Analyzing.*foo\.o/mi); +ok($o =~ /^Scanning.*Makefile/mi); +ok($o =~ /Analyzing.*Makefile/mi); +ok(matches($o, '^Scanning', 'm'), 3); +ok(matches($o, 'Analyzing', 'm'), 3); + +---------------------------- foo.cpp ------------------------------------------ + +newSViv(); + +---------------------------- foo.o -------------------------------------------- + +newSViv(); + +---------------------------- Makefile.PL -------------------------------------- + +newSViv(); + +=============================================================================== + +# check if explicit variables are handled propery + +my $o = ppport(qw(--copy=a)); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o =~ /^Uses PL_signals/m); +ok($o =~ /^File needs PL_signals, adding static request/m); +ok(eq_files('MyExt.xsa', 'MyExt.ra')); + +unlink qw(MyExt.xsa); + +---------------------------- MyExt.xs ----------------------------------------- + +PL_signals = 123; +if (PL_signals == 42) + foo(); + +---------------------------- MyExt.ra ----------------------------------------- + +#define NEED_PL_signals +#include "ppport.h" +PL_signals = 123; +if (PL_signals == 42) + foo(); + +=============================================================================== + +my $o = ppport(qw(--nochanges file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o =~ /^Uses SvUOK/m); +ok($o =~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(2 warnings\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --compat-version=5.8.0 file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o !~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +---------------------------- file.xs ----------------------------------------- + +#define NEED_PL_parser +#include "ppport.h" +SvUOK +PL_copline + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE defgv + \ + sv_undef + +---------------------------- file.xsr ----------------------------------------- + +#include "ppport.h" +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING PL_defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE PL_defgv + \ + PL_sv_undef + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak("bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner("foo"); +warner_nocontext("foo"); +warner("foo"); + +---------------------------- file.xsr ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak(aTHX_ "bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner(aTHX_ "foo"); +warner_nocontext("foo"); +warner("foo"); + diff --git a/ext/Devel-PPPort/t/pv_tools.t b/ext/Devel-PPPort/t/pv_tools.t new file mode 100644 index 0000000000..e53beed0a0 --- /dev/null +++ b/ext/Devel-PPPort/t/pv_tools.t @@ -0,0 +1,74 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/pv_tools instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (13) { + load(); + plan(tests => 13); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $uni = &Devel::PPPort::pv_escape_can_unicode(); + +# sanity check +ok($uni ? $] >= 5.006 : $] < 5.008); + +my @r; + +@r = &Devel::PPPort::pv_pretty(); +ok($r[0], $r[1]); +ok($r[0], "foobarbaz"); +ok($r[2], $r[3]); +ok($r[2], ''); +ok($r[4], $r[5]); +ok($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303'); +ok($r[6], $r[7]); +ok($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...'); + +@r = &Devel::PPPort::pv_display(); +ok($r[0], $r[1]); +ok($r[0], '"foob\0rbaz"\0'); +ok($r[2], $r[3]); +ok($r[2] eq '"pv_di"...\0' || + $r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :( + diff --git a/ext/Devel-PPPort/t/pvs.t b/ext/Devel-PPPort/t/pvs.t new file mode 100644 index 0000000000..4a85e49b13 --- /dev/null +++ b/ext/Devel-PPPort/t/pvs.t @@ -0,0 +1,68 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/pvs instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (8) { + load(); + plan(tests => 8); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $x = 'foo'; + +ok(Devel::PPPort::newSVpvs(), "newSVpvs"); +ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); + +Devel::PPPort::sv_catpvs($x); +ok($x, "foosv_catpvs"); + +Devel::PPPort::sv_setpvs($x); +ok($x, "sv_setpvs"); + +my %h = ('hv_fetchs' => 42); +Devel::PPPort::hv_stores(\%h, 4711); +ok(scalar keys %h, 2); +ok(exists $h{'hv_stores'}); +ok($h{'hv_stores'}, 4711); +ok(Devel::PPPort::hv_fetchs(\%h), 42); + diff --git a/ext/Devel-PPPort/t/shared_pv.t b/ext/Devel-PPPort/t/shared_pv.t new file mode 100644 index 0000000000..eac79c6ca8 --- /dev/null +++ b/ext/Devel-PPPort/t/shared_pv.t @@ -0,0 +1,52 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/shared_pv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::newSVpvn_share(), 6); + diff --git a/ext/Devel-PPPort/t/snprintf.t b/ext/Devel-PPPort/t/snprintf.t new file mode 100644 index 0000000000..0b90004d9e --- /dev/null +++ b/ext/Devel-PPPort/t/snprintf.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/snprintf instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my($l, $s) = Devel::PPPort::my_snprintf(); +ok($l, 8); +ok($s, "foobar42"); + diff --git a/ext/Devel-PPPort/t/sprintf.t b/ext/Devel-PPPort/t/sprintf.t new file mode 100644 index 0000000000..8b0d51fc91 --- /dev/null +++ b/ext/Devel-PPPort/t/sprintf.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/sprintf instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my($l, $s) = Devel::PPPort::my_sprintf(); +ok($l, 8); +ok($s, "foobar42"); + diff --git a/ext/Devel-PPPort/t/strlfuncs.t b/ext/Devel-PPPort/t/strlfuncs.t new file mode 100644 index 0000000000..c8175472de --- /dev/null +++ b/ext/Devel-PPPort/t/strlfuncs.t @@ -0,0 +1,65 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/strlfuncs instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (13) { + load(); + plan(tests => 13); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my @e = (3, 'foo', + 6, 'foobar', + 9, 'foobarb', + 10, '1234567', + 4, '1234', + 16, '1234567', + ); +my @r = Devel::PPPort::my_strlfunc(); + +ok(@e == @r); + +for (0 .. $#e) { + ok($r[$_], $e[$_]); +} + diff --git a/ext/Devel-PPPort/t/sv_xpvf.t b/ext/Devel-PPPort/t/sv_xpvf.t new file mode 100644 index 0000000000..15074317df --- /dev/null +++ b/ext/Devel-PPPort/t/sv_xpvf.t @@ -0,0 +1,78 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/sv_xpvf instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (9) { + load(); + plan(tests => 9); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +use Tie::Hash; +my %h; +tie %h, 'Tie::StdHash'; +$h{foo} = 'foo-'; +$h{bar} = ''; + +ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d'); +ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d'); +ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d'); + +&Devel::PPPort::sv_catpvf_mg($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-'); + +&Devel::PPPort::Perl_sv_catpvf_mg($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-'); + +&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-'); + +&Devel::PPPort::sv_setpvf_mg($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'mhx-42' : ''); + +&Devel::PPPort::Perl_sv_setpvf_mg($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'foo-43' : ''); + +&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'bar-44' : ''); + diff --git a/ext/Devel-PPPort/t/testutil.pl b/ext/Devel-PPPort/t/testutil.pl new file mode 100644 index 0000000000..4fc7d667a6 --- /dev/null +++ b/ext/Devel-PPPort/t/testutil.pl @@ -0,0 +1,48 @@ +{ + my $__ntest; + my $__total; + + sub plan { + @_ == 2 or die "usage: plan(tests => count)"; + my $what = shift; + $what eq 'tests' or die "cannot plan anything but tests"; + $__total = shift; + defined $__total && $__total > 0 or die "need a positive number of tests"; + print "1..$__total\n"; + } + + sub skip { + my $reason = shift; + ++$__ntest; + print "ok $__ntest # skip: $reason\n" + } + + sub ok ($;$$) { + local($\,$,); + my $ok = 0; + my $result = shift; + if (@_ == 0) { + $ok = $result; + } else { + $expected = shift; + if (!defined $expected) { + $ok = !defined $result; + } elsif (!defined $result) { + $ok = 0; + } elsif (ref($expected) eq 'Regexp') { + die "using regular expression objects is not backwards compatible"; + } else { + $ok = $result eq $expected; + } + } + ++$__ntest; + if ($ok) { + print "ok $__ntest\n" + } + else { + print "not ok $__ntest\n" + } + } +} + +1; diff --git a/ext/Devel-PPPort/t/threads.t b/ext/Devel-PPPort/t/threads.t new file mode 100644 index 0000000000..a1c8caa5c8 --- /dev/null +++ b/ext/Devel-PPPort/t/threads.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/threads instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::no_THX_arg("42"), 43); +eval { &Devel::PPPort::with_THX_arg("yes\n"); }; +ok($@ =~ /^yes/); + diff --git a/ext/Devel-PPPort/t/uv.t b/ext/Devel-PPPort/t/uv.t new file mode 100644 index 0000000000..bc123c6bbf --- /dev/null +++ b/ext/Devel-PPPort/t/uv.t @@ -0,0 +1,61 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/uv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (10) { + load(); + plan(tests => 10); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::sv_setuv(42), 42); +ok(&Devel::PPPort::newSVuv(123), 123); +ok(&Devel::PPPort::sv_2uv("4711"), 4711); +ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559); +ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559); +ok(&Devel::PPPort::SvUVx(1735928559), 1735928559); +ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef); +ok(&Devel::PPPort::XSRETURN_UV(), 42); +ok(&Devel::PPPort::PUSHu(), 42); +ok(&Devel::PPPort::XPUSHu(), 43); + diff --git a/ext/Devel-PPPort/t/variables.t b/ext/Devel-PPPort/t/variables.t new file mode 100644 index 0000000000..da7b99d6cb --- /dev/null +++ b/ext/Devel-PPPort/t/variables.t @@ -0,0 +1,107 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/variables instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (49) { + load(); + plan(tests => 49); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::compare_PL_signals()); + +ok(!defined(&Devel::PPPort::PL_sv_undef())); +ok(&Devel::PPPort::PL_sv_yes()); +ok(!&Devel::PPPort::PL_sv_no()); +ok(&Devel::PPPort::PL_na("abcd"), 4); +ok(&Devel::PPPort::PL_Sv(), "mhx"); +ok(defined &Devel::PPPort::PL_tokenbuf()); +ok($] >= 5.009005 || &Devel::PPPort::PL_parser()); +ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/); +ok(defined &Devel::PPPort::PL_hints()); +ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX"); + +for (&Devel::PPPort::other_variables()) { + ok($_ != 0); +} + +{ + my @w; + my $fail = 0; + { + local $SIG{'__WARN__'} = sub { push @w, @_ }; + ok(&Devel::PPPort::dummy_parser_warning()); + } + if ($] >= 5.009005) { + ok(@w >= 0); + for (@w) { + print "# $_"; + unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) { + warn $_; + $fail++; + } + } + } + else { + ok(@w == 0); + } + ok($fail, 0); +} + +ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0)); + +eval { &Devel::PPPort::no_dummy_parser_vars(0) }; + +if ($] < 5.009005) { + ok($@, ''); +} +else { + if ($@) { + print "# $@"; + ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i); + } + else { + ok(1); + } +} + diff --git a/ext/Devel-PPPort/t/warn.t b/ext/Devel-PPPort/t/warn.t new file mode 100644 index 0000000000..d538055a65 --- /dev/null +++ b/ext/Devel-PPPort/t/warn.t @@ -0,0 +1,78 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/warn instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F file that came with this distribution. +# +################################################################################ + +BEGIN { + if ($ENV{'PERL_CORE'}) { + chdir 't' if -d 't'; + @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; + require Config; import Config; + use vars '%Config'; + if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { + print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; + exit 0; + } + } + else { + unshift @INC, 't'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (5) { + load(); + plan(tests => 5); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +$^W = 0; + +my $warning; + +$SIG{'__WARN__'} = sub { $warning = $_[0] }; + +$warning = ''; +Devel::PPPort::warner(); +ok($] >= 5.004 ? $warning =~ /^warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner_nocontext(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($warning, ''); + +$^W = 1; + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($] >= 5.004 ? $warning =~ /^ckWARN bar:42/ : $warning eq ''); + diff --git a/ext/Devel-PPPort/typemap b/ext/Devel-PPPort/typemap new file mode 100644 index 0000000000..f2118a8166 --- /dev/null +++ b/ext/Devel-PPPort/typemap @@ -0,0 +1,35 @@ +################################################################################ +# +# typemap -- XS type mappings not present in early perls +# +################################################################################ +# +# $Revision: 8 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:48 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +UV T_UV +NV T_NV + +INPUT +T_UV + $var = ($type)SvUV($arg) +T_NV + $var = ($type)SvNV($arg) + +OUTPUT +T_UV + sv_setuv($arg, (UV)$var); +T_NV + sv_setnv($arg, (NV)$var); diff --git a/ext/Devel/.gitignore b/ext/Devel/.gitignore deleted file mode 100644 index e9f3854bb5..0000000000 --- a/ext/Devel/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -!/PPPort/module2.c -!/PPPort/module3.c diff --git a/ext/Devel/PPPort/.gitignore b/ext/Devel/PPPort/.gitignore deleted file mode 100644 index 032b772d08..0000000000 --- a/ext/Devel/PPPort/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -/PPPort.pm -#ignored in /ext -#/ppport.h -/module*.c -/RealPPPort.xs diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes deleted file mode 100644 index 86d85d1120..0000000000 --- a/ext/Devel/PPPort/Changes +++ /dev/null @@ -1,717 +0,0 @@ -3.16 - 2009-01-23 - - * fix DEFSV_set() for threaded 5.005 perls - * add G_METHOD support to call_sv() - -3.15 - 2009-01-18 - - * added support for the following API - DEFSV_set - * fix --unstrip for development versions - -3.14_05 - 2008-10-31 - - * fix stupid bugs in pv_pretty tests (only the - tests were broken, ppport.h was find) - -3.14_04 - 2008-10-30 - - * added support for the following API - isALNUMC [depend] - isASCII - isBLANK - isCNTRL - isGRAPH - isPRINT - isPSXSPC - isPUNCT - isXDIGIT - PERL_PV_ESCAPE_ALL - PERL_PV_ESCAPE_FIRSTCHAR - PERL_PV_ESCAPE_NOBACKSLASH - PERL_PV_ESCAPE_NOCLEAR - PERL_PV_ESCAPE_QUOTE - PERL_PV_ESCAPE_RE - PERL_PV_ESCAPE_UNI - PERL_PV_ESCAPE_UNI_DETECT - PERL_PV_PRETTY_DUMP - PERL_PV_PRETTY_ELLIPSES - PERL_PV_PRETTY_LTGT - PERL_PV_PRETTY_NOCLEAR - PERL_PV_PRETTY_QUOTE - PERL_PV_PRETTY_REGPROP - pv_display - pv_escape - pv_pretty - -3.14_03 - 2008-10-21 - - * fix C++ compilation issue with last release - (spotted by Nicholas Clark) - * added support for the following API - Perl_ppaddr_t - Perl_check_t - CPERLscope - (fixes CPAN #40078) - -3.14_02 - 2008-10-12 - - * added support for the following API - my_sprintf - PL_linestr - PL_bufptr - PL_bufend - PL_lex_state - PL_lex_stuff - PL_tokenbuf - SvPV_renew - (fixes CPAN #39809 and CPAN #39808) - * add read/write support for - PL_expect - PL_copline - PL_rsfp - PL_rsfp_filters - (fixes CPAN #39802) - * sync my_snprintf implementation with bleadperl - -3.14_01 - 2008-07-11 - - * resolve CPAN #37451: add PERLIO_FUNCS_DECL and - PERLIO_FUNCS_CAST - * update API info - -3.14 - 2008-06-01 - - * fix CPAN #36197: filename nit in parse_partspec - (thanks to Craig A. Berry for providing a patch) - -3.13_03 - 2008-05-13 - - * fix CPAN #35835: SvPV_flags_const_nolen segfaults prior - to perl 5.8.8 - -3.13_02 - 2008-04-13 - - * fix NV[efg]f format string macros for perl-5.6.0 built - using -Duselongdouble (thanks to Zefram for figuring this - out and to Jarkko Hietaniemi for keeping me in sync) - * add --patch and --oneshot options to devel/buildperl.pl - -3.13_01 - 2008-01-04 - - * fix dependency detection algorithm for functions - * fix some potential memory leaks in the test suite - * no need to use *_mg functions for mX?PUSH macros - * added support for the following API - mPUSHs - mXPUSHs - newSVpvn_flags - newSVpvn_utf8 - newSVpvs_flags - SVf_UTF8 - * make sure soak works with cromfs - -3.13 - 2007-10-04 - - * fix cpan #29748: ppport.h problems with perl5.005_05 - (spotted by Slaven Rezić) - * fix a compiler warning - -3.12 - 2007-09-22 - - [released without changes] - -3.11_06 - 2007-09-11 - - * fix cpan #29302: Perl_croak_nocontext doesn't need aTHX_ - (spotted by Jerry D. Hedden) - * fix a Win32 VC++ compiler warning (thanks to Steve Hay for - providing a patch) - * don't generate redundant specs for provided Perl_ functions - * fun with const and casts to avoid compiler warnings - * bump max supported version to 5.10.0 - -3.11_05 - 2007-08-20 - - * fix: PERL_HASH() was emitting a warning when passed in a - const char pointer - * fix: sv_magic_portable() was emitting a warning when - passed in a const char pointer - * fix: make sure arguments to sv_magic_portable() are only - evaluated once - -3.11_04 - 2007-08-20 - - * fix: ignore strings and XS comments when scanning and - patching files - * added support for the following API - newSVpvn_share - PERL_HASH - SvSHARED_HASH - * use PERL_BCDREVISION for version checking to save some - bytes in ppport.h - * improve the --strip option - - strip all C comments - - strip most superfluous whitespace - with these changes, the stripped ppport.h is now almost - 30% smaller: - 3.11_03 3.11_04 delta - ------------------------------------------ - uncompressed 87988 62573 -28.9% - gzip'd 17985 12725 -29.2% - -3.11_03 - 2007-08-14 - - * fix an infinite recursion in ppport.h that could be - triggered by circular dependencies - * fix PERL_BCDREVISION, which wasn't BCD but simply - shifted decimal (just in time for 5.10) - * fix detection of macros that are not listed in the - implementation/dontwarn sections - -3.11_02 - 2007-08-13 - - * fix cpan #25372: special case sv_magic(sv, obj, how, name, 0) - * fix cpan #27906: [PATCH] add UTF8_MAXBYTES - (thanks to Steve Peters for providing a patch) - * added support for the following API - sv_2pv_flags - sv_2pvbyte_nolen - SV_CONST_RETURN - SV_COW_DROP_PV - SV_COW_SHARED_HASH_KEYS - SV_GMAGIC - SV_HAS_TRAILING_NUL - SV_IMMEDIATE_UNREF - sv_magic_portable - SV_MUTABLE_RETURN - SV_NOSTEAL - sv_pvn_force_flags - SV_SMAGIC - SV_UTF8_NO_ENCODING - SvPV_const - SvPV_flags - SvPV_flags_const - SvPV_flags_const_nolen - SvPV_flags_mutable - SvPV_force - SvPV_force_flags - SvPV_force_flags_mutable - SvPV_force_flags_nolen - SvPV_force_mutable - SvPV_force_nolen - SvPV_force_nomg_nolen - SvPV_mutable - SvPV_nolen_const - SvPV_nomg_const - SvPV_nomg_const_nolen - SvUOK - UTF8_MAXBYTES - * provide compatibility macros for vanished variables - PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters - * add warnings support to ppport.h - * update ppport.h file searching logic - * add -c.inc and -xs.inc to the list of supported extensions - * document that --copy doesn't include the dot - * improve soak script and devel/buildperl.pl - -3.11_01 - 2007-03-23 - - * added support for the following API - PL_expect - load_module - vload_module - (thanks to Nicholas Clark for providing a patch) - -3.11 - 2007-02-14 - - * happy new year! - -3.10_02 - 2006-12-02 - - * add two missing files - -3.10_01 - 2006-12-02 - - * fix cpan #21239: Signals safe in Perl 5.8.0 - * fix PL_ppaddr and PL_no_modify support 5.005 perls - * added dTHXR, aTHXR and aTHXR_ for API that need - the context argument in pre-5.6.0 perls - * added support for the following API - PL_DBsignal - PL_DBtrace - PL_laststatval - PL_statcache - * added tests for all PL_* variables - * added progress indicator to soak script - * added --test-archives option to buildperl.pl script - * added comments to all autogenerated files that - clearly indicate their purpose and origin - -3.10 - 2006-08-14 - - * remove timestamp from generated ppport.h - -3.09_02 - 2006-07-25 - - * added support for the following API - my_strlcat - my_strlcpy - (thanks to Steve Peters for providing a patch) - -3.09_01 - 2006-07-21 - - * avoid using 'glob' when running under miniperl - -3.09 - 2006-07-08 - - * fix Makefile.PL's c_o override - * update API info - * improve soak script - - now counts warnings emitted during testing - - output is colored (can be turned off) - * add a section on integrating this module into - the core to the HACKERS file - -3.08_07 - 2006-07-03 - - * fix cpan #20179: Licensing information for PPPort is - unclear - * only --unstrip a stripped ppport.h if an appropriate - version of Devel::PPPort is installed - * add a --version option to ppport.h - -3.08_06 - 2006-06-25 - - * fix breakage on MSWin32, where generating XS files on - the fly doesn't seem to work the same way as under Linux - (thanks to Sadahiro Tomoyuki for providing a patch) - * load the shared files only when testing the module - * remove PPPort.xs from CPAN distribution - -3.08_05 - 2006-06-23 - - * when in the core, generate PPPort.pm and PPPort.xs - automatically - * PPPort.pm can now be loaded by miniperl - -3.08_04 - 2006-05-29 - - * update API info - * fix a bug in the automated API info generator that - caused slightly wrong output - * improve the speed of the automated API info generator; - we're now down from several hours to a few minutes - -3.08_03 - 2006-05-25 - - * update API info - * add devel/regenerate script to regenerate API info - * improve and speed up the development tools - -3.08_02 - 2006-05-22 - - * fix a POD error - * added POD test - * changed hv_stores() to omit the hash parameter - * improve soak script - - can now search directories for perl executables - - can use only perl binaries of at least a certain - revision using the --min option - - sorts tests by perl version - - shows a summary of failed versions - * added support for the following API - PERL_USE_GCC_BRACE_GROUPS - PoisonFree - PoisonNew - PoisonWith - SvREFCNT_inc - SvREFCNT_inc_NN - SvREFCNT_inc_simple - SvREFCNT_inc_simple_NN - SvREFCNT_inc_simple_void - SvREFCNT_inc_simple_void_NN - SvREFCNT_inc_void - SvREFCNT_inc_void_NN - -3.08_01 - 2006-05-20 - - * update NOOP and dNOOP to include lint directives - * update API info (for 5.8.8 and 5.9.3) - * added support for the following API - ckWARN - dVAR - hv_fetchs - hv_stores - my_snprintf - newSVpvs - packWARN - PERL_ABS - PERL_UNUSED_ARG - PERL_UNUSED_CONTEXT - PERL_UNUSED_VAR - STR_WITH_LEN - sv_catpvs - sv_setpvs - SVf - SvVSTRING_mg - warner - -3.08 - 2006-01-19 - - * thanks to Craig Berry for fixing my broken ppphtest - * add AUTHOR and ABSTRACT_FROM to Makefile.PL - -3.07 - 2006-01-16 - - * improve internals documentation in HACKERS - * minor internal cleanups - * thanks to Steve Peters for adding support for - the following API - SvMAGIC_set - SvPVX_const - SvPVX_mutable - SvRV_set - SvSTASH_set - SvUV_set - -3.06_04 - 2005-10-30 - - * add --strip / --unstrip options - * added support for the following API - Newx - Newxc - Newxz - XSRETURN - -3.06_03 - 2005-10-18 - - * fix extra ')' in PPPort_pm.PL - * fix compiler warnings - * fix test for PL_signals - * fix API listing - * more tests - -3.06_02 - 2005-10-18 - - * improve devel/buildperl.pl utility - * added support for the following API - dAXMARK - PL_signals - PERL_SIGNALS_UNSAFE_FLAG - XSprePUSH - -3.06_01 - 2005-06-25 - - * fix --compat-version argument checking - * filter files passed on the command line by default - to make sure 'perl ppport.h *' does something useful - * add --nofilter option to override the filtering - * testsuite now hopefully supports MacOS Classic - * check definedness of PERL_UNUSED_DECL - * update API info - -3.06 - 2005-02-02 - - * fix cpan #11327: make fails with syntax error - * fix XCPT_* macros - -3.05 - 2005-01-31 - - * fix a test for SvPV_nolen - * add more examples to tht documentation - * improve wording baseline information - * added support for the following API - dXCPT - dXSTARG - XCPT_CATCH - XCPT_RETHROW - XCPT_TRY_END - XCPT_TRY_START - -3.04 - 2004-12-29 - - * fix a hint for sv_pvn_force - * fix VMS problem with unquoted command line arguments - not preserving case (perl change #23367) - * add --api-info switch for ppport.h - -3.03 - 2004-09-08 - - * MY_CXT_CLONE was broken - -3.02 - 2004-09-08 - - * added support for the following API: - END_EXTERN_C - EXTERN_C - MY_CXT_CLONE - PERL_GCC_BRACE_GROUPS_FORBIDDEN - START_EXTERN_C - STMT_END - STMT_START - -3.01 - 2004-08-23 - - * patchlevel.h tweak - -3.00_03 - 2004-08-20 - - * make sure the @INC path is kept up-to-date when changing - directories while running in the core test suite - -3.00_02 - 2004-08-19 - - * remove PPPort.pm and PPPort.xs dependencies from Makefile.PL, - as they can be rebuilt with a "make regen" when neccessary - -3.00_01 - 2004-08-17 - - * fixed problems with $^X in t/ppphtest.t when building in - the core on OpenBSD - * fixed a "duplicate dependencies" bug that could lead to - global NEED_'s where static NEED_'s are sufficient - * added support for the following API: - PL_DBsingle - PL_DBsub - PL_debstash - PL_diehook - PL_errgv - PL_no_modify - PL_perl_destruct_level - PL_ppaddr - PL_stack_sp - PL_sv_arenaroot - PL_tainted - PL_tainting - PUSHu - sv_catpvf_mg - sv_catpvf_mg_nocontext - sv_setpvf_mg - sv_setpvf_mg_nocontext - sv_vcatpvf - sv_vcatpvf_mg - sv_vsetpvf - sv_vsetpvf_mg - vnewSVpvf - XPUSHu - -3.00 - 2004-08-16 - - * added support for dAX and dITEMS, which got lost while - working on the 3.00 internals - -2.99_07 - 2004-08-13 - - * improve/check documentation - * add tests for CopFILE and CopSTASHPV - * add file headers - * some code cleanups - -2.99_06 - 2004-08-11 - - * --compat-version now considers all macros/functions - provided by Devel::PPPort, not only the documented API - * fixed: PL_rsfp was PL_rsfpv - * turn __PPPORT_NAME__ back to ppport.h, because the former - looks ugly on search.cpan.org - -2.99_05 - 2004-08-10 - - * --compat-version now also hides compatibility warnings for - unsupported API calls - -2.99_04 - 2004-08-10 - - * added code to check for correct INSTALLDIRS - * added --compat-version option to ppport.h script to only - check for compatibility with at least the given Perl version - * some small adjustments - -2.99_03 - 2004-08-09 - - * remove useless dependency from Makefile.PL (spotted by - Craig A. Berry) - * added checking for and replacement of C++ comments as - well as --cplusplus option to suppress it to ppport.h - script - * added more diagnostic output to ppport.h script - * added a hint for gv_stashpvn - * fixed the thread tests (spotted by Craig A. Berry) - * added more tests - * renamed and documented DPPP_NAMESPACE - * renamed some files - -2.99_02 - 2004-08-08 - - * second beta - * feature complete for 3.00 - * implemented missing functionality for ppport.h script: - - can now perform global (i.e. multi-file) NEED_ checks - - checks source for missing aTHX arguments - - checks source for unsupported API calls - - can now lists provided and unsupported API - - can use Text::Diff on platforms without diff utility - - can use custom diff utility / options - - can write one patch against the module - - can write single copies with changes applied - * updated the documentation for Devel::PPPort and ppport.h - * added lots of tests for the ppport.h script - * merged tests for call_* eval_* from XS::APItest - * added HACKERS file to document internals - * now includes PPPort.pm, so you can read the full docs - using search.cpan.org - -2.99_01 - 2004-08-07 - - * first beta towards 3.00 - * complete rework of internals - * autogenerated API-checks - * autogenerated .pm, .xs and .t files - * ppport.h changes: - - no static/global functions without explicit NEED_ - - can now be run without -x - - now shows hints and dependencies - - now has POD documentation, so perldoc ppport.h works - - now has options - - now uses File::Find when available - * tested with multi-threaded (ithreads and 5.005-threads) perls - from 5.005 and single-threaded perls from 5.003 up to 5.9.x - * added support for the following API: - CopFILE - CopFILEAV - CopFILEGV - CopFILEGV_set - CopFILE_set - CopFILESV - CopSTASH - CopSTASH_eq - CopSTASHPV - CopSTASHPV_set - CopSTASH_set - CopyD - dUNDERBAR - IN_PERL_COMPILETIME - IV_MAX - IV_MIN - IVTYPE - memEQ - memNE - MoveD - mPUSHi - mPUSHn - mPUSHp - mPUSHu - mXPUSHi - mXPUSHn - mXPUSHp - mXPUSHu - newCONSTSUB - newSVuv - PERL_INT_MAX - PERL_INT_MIN - PERL_LONG_MAX - PERL_LONG_MIN - PERL_QUAD_MAX - PERL_QUAD_MIN - PERL_SHORT_MAX - PERL_SHORT_MIN - PERL_UCHAR_MAX - PERL_UCHAR_MIN - PERL_UINT_MAX - PERL_UINT_MIN - PERL_ULONG_MAX - PERL_ULONG_MIN - PERL_UQUAD_MAX - PERL_UQUAD_MIN - PERL_USHORT_MAX - PERL_USHORT_MIN - PL_hexdigit - PL_rsfp - Poison - PUSHmortal - sv_2pvbyte - sv_2pvbyte_nolen - sv_2pv_nolen - sv_2uv - sv_catpv_mg - sv_catpvn_mg - sv_catpvn_nomg - sv_catsv_mg - sv_catsv_nomg - SvGETMAGIC - SvIV_nomg - SvPV_force_nomg - sv_pvn - sv_pvn_force - sv_pvn_nomg - SvPV_nomg - sv_setiv_mg - sv_setnv_mg - sv_setpv_mg - sv_setpvn_mg - sv_setsv_mg - sv_setsv_nomg - sv_setuv - sv_setuv_mg - sv_usepvn_mg - sv_uv - SvUV - SvUV_nomg - SvUVx - SvUVX - SvUVXx - UNDERBAR - UV_MAX - UV_MIN - UVTYPE - XPUSHmortal - XSRETURN_UV - XST_mUV - ZeroD - -2.008 - 20th October 2003 - - * eval_(pv|sv) added - * PERL_MAGIC_* added - -2.007 - 18th September 2003 - - * small fix in grok_numeric_radix: variable was used uninitialized - -2.006 - 8th September 2003 - - * call_(pv|sv|method|argv) added - * still compiler-warnings for grok_??? and 5.6.x, fixed - -2.005 - 2nd September 2003 - - * Some tweaks to grok_(hex|oct|bin) to make compiler warnings - go away for older perls - * grok_number and grok_numeric_radix added - -2.004 - 22th August 2003 - - * Added grok_(hex|oct|bin) and related constants - -2.003 - 8th May 2003 - - * Added get_av, get_cv, get_hv and get_sv - -2.002 - 2nd December 2001 - - * More portability issues in Makefile.PL addresed. - * Merged the Harness sub-module into Devel::PPPort - * More documentation in PPPort.pm - -2.001 - - * Some portability issues in Makefile.PL addresed. - -2.000 - - * Initial port to the perl core. - -1.007 - - * Original version of the module by Kenneth Albanowski. diff --git a/ext/Devel/PPPort/HACKERS b/ext/Devel/PPPort/HACKERS deleted file mode 100644 index 540947f4d1..0000000000 --- a/ext/Devel/PPPort/HACKERS +++ /dev/null @@ -1,326 +0,0 @@ -=head1 NAME - -HACKERS - Devel::PPPort internals for hackers - -=head1 SYNOPSIS - -So you probably want to hack C? - -Well, here's some information to get you started with what's -lying around in this distribution. - -=head1 DESCRIPTION - -=head2 How to build 114 versions of Perl - -C supports Perl versions between 5.003 and bleadperl. -To guarantee this support, I need some of these versions on my -machine. I currently have 114 different Perl version/configuration -combinations installed on my laptop. - -As many of the old Perl distributions need patching to compile -cleanly on newer systems (and because building 114 Perls by hand -just isn't fun), I wrote a tool to build all the different -versions and configurations. You can find it in F. -It can currently build the following Perl releases: - - 5.003 - 5.004 - 5.004_05 - 5.005 - 5.005_04 - 5.6.x - 5.7.x - 5.8.x - 5.9.x - 5.10.x - -=head2 Fully automatic API checks - -Knowing which parts of the API are not backwards compatible and -probably need C support is another problem that's -not easy to deal with manually. If you run - - perl Makefile.PL --with-apicheck - -a C file is generated by F that is compiled -and linked with C. This C file has the purpose of -using each of the public API functions/macros once. - -The required information is derived from C (just -a copy of bleadperl's C), C (which -is generated by F and simply collects the rest -of the apidoc entries spread over the Perl source code) and -C (which lists all API provided purely by -Devel::PPPort). -The generated C file C is currently about 500k in size -and takes quite a while to compile. - -Usually, C won't compile with older perls. And even if -it compiles, there's still a good chance of the dynamic linker -failing at C time. But that's on purpose! - -We can use these failures to find changes in the API automatically. -The two Perl scripts F and F -repeatedly run C with the apicheck code through -all different versions of perl. Scanning the output of the compiler -and the dynamic linker for errors, the files in F are -generated. These files list all parts of the public API that don't -work with less than a certain version of Perl. - -This information is in turn used by F to mask -API calls in the generated C file for these versions, so the -process can be stopped by the time F compiles cleanly -and the dynamic linker is happy. (Actually, this process may generate -false positives, so by default each API call is checked once more -afterwards.) - -Running C takes about an hour, depending of course -on the machine you're running it on. If you run it with -the C<--nocheck> option, it won't recheck the API calls that failed -in the compilation stage and it'll take significantly less time. -Running with C<--nocheck> should usually be safe. - -When running C with the C<--base> option, it will -generate the I todo files by disabling all functionality -provided by C. These are required for implementing -the C<--compat-version> option of the C script. The -baseline todo files hold the information about which version of -Perl lacks a certain part of the API. - -However, only the documented public API can be checked this way. -And since C provides more macros, these would not be -affected by C<--compat-version>. It's the job of F -to figure out the baseline information for all remaining provided -macros by scanning the include files in the F directory of -various Perl versions. - -The whole process isn't platform independent. It has currently been -tested only under Linux, and it definitely requires at least C and -the C utility. - -It's not very often that one has to regenerate the baseline and todo -files. If you have to, you can either run F or just -execute the following steps by hand: - -=over 4 - -=item * - -You need a whole bunch of different Perls. The more, the better. -You can use F to build them. I keep my perls -in F, so most of the tools take this as a default. - -=item * - -You also need a freshly built bleadperl that is in the path under -exactly this name. (The name of the executable is currently hardcoded -in F and F.) - -=item * - -Remove all existing todo files in the F and -F directories. - -=item * - -Update the API information. Copy the latest F file from -bleadperl to the F directory and run F to -collect the remaining information in F. - -=item * - -Build the new baseline by running - - perl devel/mktodo --base - -in the root directory of the distribution. When it's finished, -move all files from the F directory to F. - -=item * - -Build the new todo files by running - - perl devel/mktodo - -in the root directory of the distribution. - -=item * - -Finally, add the remaining baseline information by running - - perl Makefile.PL && make - perl devel/scanprov write - -=back - -=head2 Implementation - -Residing in F is the "heart" of C. Each -of the files implements a part of the supported API, along with -hints, dependency information, XS code and tests. -The files are in a POD-like format that is parsed using the -functions in F. - -The scripts F, F and F all -use the information in F to generate the main module -F, the XS code in F and various test files -in F. - -All of these files could be generated on the fly while building -C, but not having the tests in C will confuse -TEST/harness in the core. Not having F will be bad for -viewing the docs on C. So unfortunately, it's -unavoidable to put some redundancy into the package. - -=head2 Adding stuff to Devel::PPPort - -First, check if the code you plan to add fits into one of the -existing files in F. If not, just start a new one and -remember to include it from within F. - -Each file holds all relevant data for implementing a certain part -of the API: - -=over 2 - -=item * - -A list of the provided API in the C<=provides> section. - -=item * - -The implementation to add to F in the C<=implementation> -section. - -=item * - -The code required to add to PPPort.xs for testing the implementation. -This code goes into the C<=xshead>, C<=xsinit>, C<=xsmisc>, C<=xsboot> -and C<=xsubs> section. Have a look at the template at the bottom -of F to see where the code ends up. - -=item * - -The tests in the C<=tests> section. Remember not to use any fancy -modules or syntax elements, as the test code should be able to run -with Perl 5.003, which, for example, doesn't support C in -C-loops: - - for my $x (1, 2, 3) { } # won't work with 5.003 - -You can use C to report success or failure: - - ok($got == 42); - ok($got, $expected); - -Regular expressions are not supported as the second argument to C, -because older perls do not support the C operator. - -=back - -It's usually the best approach to just copy an existing file and -use it as a template. - -=head2 Implementation Hints - -In the C<=implementation> section, you can use - - __UNDEFINED__ macro some definition - -instead of - - #ifndef macro - # define macro some definition - #endif - -The macro can have optional arguments and the definition can even -span multiple lines, like in - - __UNDEFINED__ SvMAGIC_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ - (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END - -This usually makes the code more compact and readable. And you -only have to add C<__UNDEFINED__> to the C<=provided> section. - -Version checking can be tricky if you want to do it correct. -You can use - - #if { VERSION < 5.9.3 } - -instead of - - #if ((PERL_VERSION < 9) || (PERL_VERSION == 9 && PERL_SUBVERSION < 3)) - -The version number can be either of the new form C<5.x.x> or of the older -form C<5.00x_yy>. Both are translated into the correct preprocessor -statements. It is also possible to combine this with other statements: - - #if { VERSION >= 5.004 } && !defined(sv_vcatpvf) - /* a */ - #elif { VERSION < 5.004_63 } && { VERSION != 5.004_05 } - /* b */ - #endif - -This not only works in the C<=implementation> section, but also in -the C<=xsubs>, C<=xsinit>, C<=xsmisc>, C<=xshead> and C<=xsboot> sections. - -=head2 Testing - -To automatically test C with lots of different Perl -versions, you can use the F script. Just pass it a list of -all Perl binaries you want to test. - -=head2 Special Makefile targets - -You can use - - make regen - -to regenerate all of the autogenerated files. To get rid of all -generated files (except for F and F), -use - - make purge_all - -That's it. - -=head2 Submitting Patches - -If you've added some functionality to C, please -consider submitting a patch with your work to either the author -(Emhx@cpan.orgE) or to the CPAN Request Tracker at -L. - -When submitting patches, please only add the relevant changes -and don't include the differences of the generated files. You -can use the C target to delete all autogenerated -files. - -=head2 Integrating into the Perl core - -When integrating this module into the Perl core, be sure to -remove the following files from the distribution. They are -either not needed or generated on the fly when building this -module in the core: - - MANIFEST - META.yml - PPPort.pm - -=head1 COPYRIGHT - -Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. - -Version 2.x, Copyright (C) 2001, Paul Marquess. - -Version 1.x, Copyright (C) 1999, Kenneth Albanowski. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L and L. - -=cut - diff --git a/ext/Devel/PPPort/MANIFEST.SKIP b/ext/Devel/PPPort/MANIFEST.SKIP deleted file mode 100644 index 4df9284b91..0000000000 --- a/ext/Devel/PPPort/MANIFEST.SKIP +++ /dev/null @@ -1,18 +0,0 @@ -^Makefile$ -~$ -\.old(?:\..*)?$ -\.swp$ -\.o$ -\.bs$ -\.bak$ -\.orig$ -\.cache\.cm$ -^blib -^pm_to_blib -^backup -^parts/todo- -^parts/base- -^ppport\.h$ -^PPPort\.c$ -^testing -Devel-PPPort.*\.tar\.gz$ diff --git a/ext/Devel/PPPort/Makefile.PL b/ext/Devel/PPPort/Makefile.PL deleted file mode 100644 index e2035b3594..0000000000 --- a/ext/Devel/PPPort/Makefile.PL +++ /dev/null @@ -1,142 +0,0 @@ -################################################################################ -# -# Makefile.PL -- generate Makefile -# -################################################################################ -# -# $Revision: 29 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:49 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -require 5.003; - -use strict; -use ExtUtils::MakeMaker; - -use vars '%opt'; # needs to be global, and we can't use 'our' - -unless ($ENV{'PERL_CORE'}) { - $ENV{'PERL_CORE'} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV; -} - -@ARGV = map { /^--with-(apicheck)$/ && ++$opt{$1} ? () : $_ } @ARGV; - -WriteMakefile( - NAME => 'Devel::PPPort', - VERSION_FROM => 'PPPort_pm.PL', - PM => { 'PPPort.pm' => '$(INST_LIBDIR)/PPPort.pm' }, - H => [ qw(ppport.h) ], - OBJECT => 'RealPPPort$(OBJ_EXT) $(O_FILES)', - XSPROTOARG => '-noprototypes', - CONFIGURE => \&configure, -); - -sub configure -{ - my @clean = qw{ $(H_FILES) RealPPPort.xs RealPPPort.c }; - my %depend = ('$(OBJECT)' => '$(H_FILES)'); - my @C_FILES = qw{ module2.c module3.c }, - my %PL_FILES = ( - 'ppport_h.PL' => 'ppport.h', - 'PPPort_pm.PL' => 'PPPort.pm', - 'PPPort_xs.PL' => 'RealPPPort.xs', - ); - my @moreopts; - - if (eval $ExtUtils::MakeMaker::VERSION >= 6) { - push @moreopts, AUTHOR => 'Marcus Holland-Moritz '; - if (-f 'PPPort.pm') { - push @moreopts, ABSTRACT_FROM => 'PPPort.pm'; - } - } - - if (eval $ExtUtils::MakeMaker::VERSION >= 6.30_01) { - print "Setting license tag...\n"; - push @moreopts, LICENSE => 'perl'; - } - - if ($ENV{'PERL_CORE'}) { - # Pods will be built by installman. - push @moreopts, MAN3PODS => {}; - push @clean, 'PPPort.pm'; - } - else { - # Devel::PPPort is in the core since 5.7.3 - push @moreopts, INSTALLDIRS => ($] >= 5.007003 ? 'perl' : 'site'); - } - - if ($opt{'apicheck'}) { - $PL_FILES{'apicheck_c.PL'} = 'apicheck.c'; - push @C_FILES, qw{ apicheck.c }; - push @clean, qw{ apicheck.c apicheck.i }; - $depend{'apicheck.i'} = 'ppport.h'; - } - - return { - C => \@C_FILES, - XS => { 'RealPPPort.xs' => 'RealPPPort.c' }, - PL_FILES => \%PL_FILES, - depend => \%depend, - clean => { FILES => "@clean" }, - @moreopts, - }; -} - -sub MY::postamble -{ - package MY; - my $post = shift->SUPER::postamble(@_); - $post .= <<'POSTAMBLE'; - -purge_all: realclean - @$(RM_F) PPPort.pm t/*.t - -regen_pm: - $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_pm.PL - -regen_xs: - $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_xs.PL - -regen_tests: - $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) mktests.PL - -regen_h: - $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) ppport_h.PL - -regen: regen_pm regen_xs regen_tests regen_h - -POSTAMBLE - return $post; -} - -sub MY::c_o -{ - package MY; - my $co = shift->SUPER::c_o(@_); - - if ($::opt{'apicheck'} && $co !~ /^\.c\.i:/m) { - print "Adding custom rule for preprocessed apicheck file...\n"; - - $co .= <<'CO' - -.SUFFIXES: .i - -.c.i: - $(CCCMD) -E -I$(PERL_INC) $(DEFINE) $*.c > $*.i -CO - } - - return $co; -} - diff --git a/ext/Devel/PPPort/PPPort.xs b/ext/Devel/PPPort/PPPort.xs deleted file mode 100644 index 2586824ebb..0000000000 --- a/ext/Devel/PPPort/PPPort.xs +++ /dev/null @@ -1,3 +0,0 @@ -This is just a dummy file to let Configure know that Devel::PPPort -is an XS module. The real XS code is autogenerated from PPPort_xs.PL -when this module is built and will go to RealPPPort.xs. diff --git a/ext/Devel/PPPort/PPPort_pm.PL b/ext/Devel/PPPort/PPPort_pm.PL deleted file mode 100644 index fb818eaa91..0000000000 --- a/ext/Devel/PPPort/PPPort_pm.PL +++ /dev/null @@ -1,663 +0,0 @@ -################################################################################ -# -# PPPort_pm.PL -- generate PPPort.pm -# -################################################################################ -# -# $Revision: 64 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:49 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; -$^W = 1; -require "parts/ppptools.pl"; - -my $INCLUDE = 'parts/inc'; -my $DPPP = 'DPPP_'; - -my %embed = map { ( $_->{name} => $_ ) } - parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc)); - -my(%provides, %prototypes, %explicit); - -my $data = do { local $/; }; -$data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$} - {eval "$1('$2', $3)" or die $@}gem; - -$data = expand($data); - -my @api = sort { lc $a cmp lc $b } keys %provides; - -$data =~ s{^(.*)__PROVIDED_API__(\s*?)^} - {join '', map "$1$_\n", @api}gem; - -{ - my $len = 0; - for (keys %explicit) { - length > $len and $len = length; - } - my $format = sprintf '%%-%ds %%-%ds %%s', $len+2, $len+5; - $len = 3*$len + 23; - -$data =~ s!^(.*)__EXPLICIT_API__(\s*?)^! - sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') . - $1 . '-'x$len . "\n" . - join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" } - sort keys %explicit) - !gem; -} - -my %raw_base = %{&parse_todo('parts/base')}; -my %raw_todo = %{&parse_todo('parts/todo')}; - -my %todo; -for (keys %raw_todo) { - push @{$todo{$raw_todo{$_}}}, $_; -} - -# check consistency -for (@api) { - if (exists $raw_todo{$_} and exists $raw_base{$_}) { - if ($raw_base{$_} eq $raw_todo{$_}) { - warn "$INCLUDE/$provides{$_} provides $_, which is still marked " - . "todo for " . format_version($raw_todo{$_}) . "\n"; - } - else { - check(2, "$_ was ported back to " . format_version($raw_todo{$_}) . - " (baseline revision: " . format_version($raw_base{$_}) . ")."); - } - } -} - -my @perl_api; -for (keys %provides) { - next if /^Perl_(.*)/ && exists $embed{$1}; - next if exists $embed{$_}; - push @perl_api, $_; - check(2, "No API definition for provided element $_ found."); -} - -push @perl_api, keys %embed; - -for (@perl_api) { - if (exists $provides{$_} && !exists $raw_base{$_}) { - check(2, "Mmmh, $_ doesn't seem to need backporting."); - } - my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|'; - $line .= ($raw_todo{$_} || '') . '|'; - $line .= 'p' if exists $provides{$_}; - if (exists $embed{$_}) { - my $e = $embed{$_}; - if (exists $e->{flags}{p}) { - my $args = $e->{args}; - $line .= 'v' if @$args && $args->[-1][0] eq '...'; - } - $line .= 'n' if exists $e->{flags}{n}; - } - $_ = $line; -} - -$data =~ s/^([\t ]*)__PERL_API__(\s*?)$/ - join "\n", map "$1$_", sort @perl_api - /gem; - -my @todo; -for (reverse sort keys %todo) { - my $ver = format_version($_); - my $todo = "=item perl $ver\n\n"; - for (sort @{$todo{$_}}) { - $todo .= " $_\n"; - } - push @todo, $todo; -} - -$data =~ s{^__UNSUPPORTED_API__(\s*?)^} - {join "\n", @todo}gem; - -$data =~ s{__MIN_PERL__}{5.003}g; -$data =~ s{__MAX_PERL__}{5.10.0}g; - -open FH, ">PPPort.pm" or die "PPPort.pm: $!\n"; -print FH $data; -close FH; - -exit 0; - -sub include -{ - my($file, $opt) = @_; - - print "including $file\n"; - - my $data = parse_partspec("$INCLUDE/$file"); - - for (@{$data->{provides}}) { - if (exists $provides{$_}) { - if ($provides{$_} ne $file) { - warn "$file: $_ already provided by $provides{$_}\n"; - } - } - else { - $provides{$_} = $file; - } - } - - for (keys %{$data->{prototypes}}) { - $prototypes{$_} = $data->{prototypes}{$_}; - $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg; - } - - my $out = $data->{implementation}; - - if (exists $opt->{indent}) { - $out =~ s/^/$opt->{indent}/gm; - } - - return $out; -} - -sub expand -{ - my $code = shift; - $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem; - $code =~ s{^\s* - __UNDEFINED__ - \s+ - ( - ( \w+ ) - (?: \( [^)]* \) )? - ) - [^\r\n\S]* - ( - (?:[^\r\n\\]|\\[^\r\n])* - (?: - \\ - (?:\r\n|[\r\n]) - (?:[^\r\n\\]|\\[^\r\n])* - )* - ) - \s*$} - {expand_undefined($2, $1, $3)}gemx; - $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$} - {expand_need_var($1, $3, $2, $4)}gem; - $code =~ s{^([^\S\r\n]*)__NEED_DUMMY_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$} - {expand_need_dummy_var($1, $3, $2, $4)}gem; - return $code; -} - -sub expand_need_var -{ - my($indent, $var, $type, $init) = @_; - - $explicit{$var} = 'var'; - - my $myvar = "$DPPP(my_$var)"; - $init = defined $init ? " = $init" : ""; - - my $code = <{name}; - my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} }; - my $lastarg = ${$f->{args}}[-1]; - - if ($f->{flags}{n}) { - if ($f->{flags}{p}) { - return "#define $n $DPPP(my_$n)\n" . - "#define Perl_$n $DPPP(my_$n)"; - } - else { - return "#define $n $DPPP(my_$n)"; - } - } - else { - my $undef = <{flags}{p}) { - if ($f->{flags}{f}) { - return "#define Perl_$n $DPPP(my_$n)"; - } - elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) { - return $undef . "#define $n $DPPP(my_$n)\n" . - "#define Perl_$n $DPPP(my_$n)"; - } - else { - return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" . - "#define Perl_$n $DPPP(my_$n)"; - } - } - else { - return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)"; - } - } -} - -sub check -{ - my $level = shift; - - if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) { - print STDERR @_, "\n"; - } -} - -__DATA__ -################################################################################ -# -# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!! -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ -# -# Perl/Pollution/Portability -# -################################################################################ -# -# $Revision: 64 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:49 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -=head1 NAME - -Devel::PPPort - Perl/Pollution/Portability - -=head1 SYNOPSIS - - Devel::PPPort::WriteFile(); # defaults to ./ppport.h - Devel::PPPort::WriteFile('someheader.h'); - -=head1 DESCRIPTION - -Perl's API has changed over time, gaining new features, new functions, -increasing its flexibility, and reducing the impact on the C namespace -environment (reduced pollution). The header file written by this module, -typically F, attempts to bring some of the newer Perl API -features to older versions of Perl, so that you can worry less about -keeping track of old releases, but users can still reap the benefit. - -C contains a single function, called C. Its -only purpose is to write the F C header file. This file -contains a series of macros and, if explicitly requested, functions that -allow XS modules to be built using older versions of Perl. Currently, -Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported. - -This module is used by C to write the file F. - -=head2 Why use ppport.h? - -You should use F in modern code so that your code will work -with the widest range of Perl interpreters possible, without significant -additional work. - -You should attempt older code to fully use F, because the -reduced pollution of newer Perl versions is an important thing. It's so -important that the old polluting ways of original Perl modules will not be -supported very far into the future, and your module will almost certainly -break! By adapting to it now, you'll gain compatibility and a sense of -having done the electronic ecology some good. - -=head2 How to use ppport.h - -Don't direct the users of your module to download C. -They are most probably no XS writers. Also, don't make F -optional. Rather, just take the most recent copy of F that -you can find (e.g. by generating it with the latest C -release from CPAN), copy it into your project, adjust your project to -use it, and distribute the header along with your module. - -=head2 Running ppport.h - -But F is more than just a C header. It's also a Perl script -that can check your source code. It will suggest hints and portability -notes, and can even make suggestions on how to change your code. You -can run it like any other Perl program: - - perl ppport.h [options] [files] - -It also has embedded documentation, so you can use - - perldoc ppport.h - -to find out more about how to use it. - -=head1 FUNCTIONS - -=head2 WriteFile - -C takes one optional argument. When called with one -argument, it expects to be passed a filename. When called with -no arguments, it defaults to the filename F. - -The function returns a true value if the file was written successfully. -Otherwise it returns a false value. - -=head1 COMPATIBILITY - -F supports Perl versions from __MIN_PERL__ to __MAX_PERL__ -in threaded and non-threaded configurations. - -=head2 Provided Perl compatibility API - -The header file written by this module, typically F, provides -access to the following elements of the Perl API that is not available -in older Perl releases: - - __PROVIDED_API__ - -=head2 Perl API not supported by ppport.h - -There is still a big part of the API not supported by F. -Either because it doesn't make sense to back-port that part of the API, -or simply because it hasn't been implemented yet. Patches welcome! - -Here's a list of the currently unsupported API, and also the version of -Perl below which it is unsupported: - -=over 4 - -__UNSUPPORTED_API__ - -=back - -=head1 BUGS - -If you find any bugs, C doesn't seem to build on your -system or any of its tests fail, please use the CPAN Request Tracker -at L to create a ticket for the module. - -=head1 AUTHORS - -=over 2 - -=item * - -Version 1.x of Devel::PPPort was written by Kenneth Albanowski. - -=item * - -Version 2.x was ported to the Perl core by Paul Marquess. - -=item * - -Version 3.x was ported back to CPAN by Marcus Holland-Moritz. - -=back - -=head1 COPYRIGHT - -Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. - -Version 2.x, Copyright (C) 2001, Paul Marquess. - -Version 1.x, Copyright (C) 1999, Kenneth Albanowski. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L, L. - -=cut - -package Devel::PPPort; - -use strict; -use vars qw($VERSION $data); - -$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.16 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; - -sub _init_data -{ - $data = do { local $/; }; - my $pkg = 'Devel::PPPort'; - $data =~ s/__PERL_VERSION__/$]/g; - $data =~ s/__VERSION__/$VERSION/g; - $data =~ s/__PKG__/$pkg/g; - $data =~ s/^\|>//gm; -} - -sub WriteFile -{ - my $file = shift || 'ppport.h'; - defined $data or _init_data(); - my $copy = $data; - $copy =~ s/\bppport\.h\b/$file/g; - - open F, ">$file" or return undef; - print F $copy; - close F; - - return 1; -} - -1; - -__DATA__ -#if 0 -<<'SKIP'; -#endif -/* ----------------------------------------------------------------------- - - ppport.h -- Perl/Pollution/Portability Version __VERSION__ - - Automatically created by __PKG__ running under perl __PERL_VERSION__. - - Do NOT edit this file directly! -- Edit PPPort_pm.PL and the - includes in parts/inc/ instead. - - Use 'perldoc ppport.h' to view the documentation below. - ----------------------------------------------------------------------- - -SKIP - -%include ppphdoc { indent => '|>' } - -%include ppphbin - -__DATA__ -*/ - -#ifndef _P_P_PORTABILITY_H_ -#define _P_P_PORTABILITY_H_ - -#ifndef DPPP_NAMESPACE -# define DPPP_NAMESPACE DPPP_ -#endif - -#define DPPP_CAT2(x,y) CAT2(x,y) -#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) - -%include version - -%include threads - -%include limits - -%include uv - -%include memory - -%include misc - -%include variables - -%include mPUSH - -%include call - -%include newRV - -%include newCONSTSUB - -%include MY_CXT - -%include format - -%include SvREFCNT - -%include newSVpv - -%include SvPV - -%include Sv_set - -%include sv_xpvf - -%include shared_pv - -%include warn - -%include pvs - -%include magic - -%include cop - -%include grok - -%include snprintf - -%include sprintf - -%include exception - -%include strlfuncs - -%include pv_tools - -#endif /* _P_P_PORTABILITY_H_ */ - -/* End of File ppport.h */ diff --git a/ext/Devel/PPPort/PPPort_xs.PL b/ext/Devel/PPPort/PPPort_xs.PL deleted file mode 100644 index 8d9fd4f674..0000000000 --- a/ext/Devel/PPPort/PPPort_xs.PL +++ /dev/null @@ -1,140 +0,0 @@ -################################################################################ -# -# PPPort_xs.PL -- generate RealPPPort.xs -# -################################################################################ -# -# $Revision: 15 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:48 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; -$^W = 1; -require "parts/ppptools.pl"; - -my %SECTION = ( - xshead => { code => '', header => "/* ---- code from __FILE__ ---- */" }, - xsinit => { code => '', header => "/* ---- code from __FILE__ ---- */" }, - xsmisc => { code => '', header => "/* ---- code from __FILE__ ---- */" }, - xsboot => { code => '', header => "/* ---- code from __FILE__ ---- */", indent => "\t" }, - xsubs => { code => '', header => <{$sec}) { - $msg++ or print "adding XS code from $file\n"; - if (exists $SECTION{$sec}{header}) { - my $header = $SECTION{$sec}{header}; - $header =~ s/__FILE__/$file/g; - $SECTION{$sec}{code} .= $header . "\n"; - } - $SECTION{$sec}{code} .= $spec->{$sec} . "\n"; - } - } -} - -my $data = do { local $/; }; - -for $sec (keys %SECTION) { - my $code = $SECTION{$sec}{code}; - if (exists $SECTION{$sec}{indent}) { - $code =~ s/^/$SECTION{$sec}{indent}/gm; - } - $code =~ s/[\r\n]+$//; - $data =~ s/^__\U$sec\E__$/$code/m; -} - -open FH, ">RealPPPort.xs" or die "RealPPPort.xs: $!\n"; -print FH $data; -close FH; - -exit 0; - -__DATA__ -/******************************************************************************* -* -* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!! -* -* This file was automatically generated from the definition files in the -* parts/inc/ subdirectory by PPPort_xs.PL. To learn more about how all this -* works, please read the F file that came with this distribution. -* -******************************************************************************** -* -* Perl/Pollution/Portability -* -******************************************************************************** -* -* $Revision: 15 $ -* $Author: mhx $ -* $Date: 2009/01/18 14:10:48 +0100 $ -* -******************************************************************************** -* -* Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -* Version 2.x, Copyright (C) 2001, Paul Marquess. -* Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -* -* This program is free software; you can redistribute it and/or -* modify it under the same terms as Perl itself. -* -*******************************************************************************/ - -/* ========== BEGIN XSHEAD ================================================== */ - -__XSHEAD__ - -/* =========== END XSHEAD =================================================== */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -/* ========== BEGIN XSINIT ================================================== */ - -__XSINIT__ - -/* =========== END XSINIT =================================================== */ - -#include "ppport.h" - -/* ========== BEGIN XSMISC ================================================== */ - -__XSMISC__ - -/* =========== END XSMISC =================================================== */ - -MODULE = Devel::PPPort PACKAGE = Devel::PPPort - -BOOT: -__XSBOOT__ - -__XSUBS__ diff --git a/ext/Devel/PPPort/README b/ext/Devel/PPPort/README deleted file mode 100644 index fc24309964..0000000000 --- a/ext/Devel/PPPort/README +++ /dev/null @@ -1,78 +0,0 @@ - - ------------------------------------------------------ - Devel::PPPort - Perl/Pollution/Portability Version 3 - ------------------------------------------------------ - -CONTENTS - -1. DESCRIPTION -2. INSTALLATION -3. DOCUMENTATION -4. BUGS -5. COPYRIGHT - - --------------- -1. DESCRIPTION --------------- - -Perl's API has changed over time, gaining new features, new functions, -increasing its flexibility, and reducing the impact on the C namespace -environment (reduced pollution). The header file written by this module, -typically F, attempts to bring some of the newer Perl API -features to older versions of Perl, so that you can worry less about -keeping track of old releases, but users can still reap the benefit. - ---------------- -2. INSTALLATION ---------------- - -Installation of the Devel::PPPort module follows the standard Perl Way -and should not be harder than: - - perl Makefile.PL - make - make test - make install - -Note that you may need to become superuser to 'make install'. - -If you're building the module under Windows, you may need to use a -different make program, such as 'nmake', instead of 'make'. - ----------------- -3. DOCUMENTATION ----------------- - -To see the documentation, use the perldoc command: - - perldoc Devel::PPPort - -You can also visit CPAN Search and see the documentation online as -pretty nice HTML. This is also where you will find the most recent -version of this module: - - http://search.cpan.org/~mhx/Devel-PPPort/ - -------- -4. BUGS -------- - -If you find any bugs, Devel::PPPort doesn't seem to build on your -system or any of its tests fail, please use the CPAN Request Tracker - - http://rt.cpan.org/ - -to create a ticket for the module. - ------------- -5. COPYRIGHT ------------- - -Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -Version 2.x, Copyright (C) 2001, Paul Marquess. -Version 1.x, Copyright (C) 1999, Kenneth Albanowski. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - diff --git a/ext/Devel/PPPort/TODO b/ext/Devel/PPPort/TODO deleted file mode 100644 index 961acd918c..0000000000 --- a/ext/Devel/PPPort/TODO +++ /dev/null @@ -1,347 +0,0 @@ -TODO: - -* > 3. In several cases, "perl ppport.h --copy=.new" output a new file in - > which the only change was the addition of "#include "ppport.h"". In each - > case, that actually wasn't necessary because the source file in question - > already #included another source file which #included ppport.h itself. - > Would it be possible for the analyzer to follow #include directives to - > spot cases like this? - - Uh, well, I guess it would be possible. But I have some concerns: - - 1. ppport.h is already too big. :-) - - 2. There is code in ppport.h to actually remove an - - #include "ppport.h" - - if it appears not to be needed. If it's not needed in your - included file, it might be dropped from there and moved to - the other file that included the first one. This would make - the logic much more complicated. - - 3. As ppport.h is configurable, it's not (always) a good idea - to put it into a file that's included from another file. - - I guess I'll have to think about this a little more. Maybe I can - come up with a fancy solution that doesn't increase the code size - too much. - - -* On 14/12/06, Nicholas Clark wrote: - > On Thu, Dec 14, 2006 at 05:03:24AM +0100, Andreas J. Koenig wrote: - > - > > Params::Validate and Clone suffer from the same cold: - > - > The same patch will make both compile and pass tests. - > I'm wondering if it might be better to totally drop SVt_PBVM and let source - > code fail to compile. - - I don't think so. Because : - 1. your redefinition of SVt_PBVM is probably what most XS modules want - 2. anyway, if we remove it from the core, it might appear in Devel::PPPort :) - - -* maybe backport bytes_from_utf8() for 5.6.0 (or even before)? - -* check which of the following we need to support: - - amagic_generation - AMG_names - an - Argv - argvgv - argvoutgv - basetime - beginav - block_type - bodytarget - bufend - bufptr - check - chopset - Cmd - compcv - compiling - comppad - comppad_name - comppad_name_fill - copline - cop_seqmax - cryptseen - cshlen - cshname - curcop - curinterp - curpad - curpm - curstash - curstname - dbargs - DBgv - DBline - DBsignal - DBsingle - DBsub - DBtrace - debstash - debug - defgv - defoutgv - defstash - delaymagic - diehook - dirty - doextract - doswitches - do_undump - dowarn - egid - encoding - endav - envgv - errgv - error_count - errors - euid - eval_root - evalseq - eval_start - expect - fdpid - filemode - firstgv - fold - forkprocess - formfeed - formtarget - freq - generation - gensym - gid - hexdigit - hints - incgv - in_eval - in_my - inplace - lastfd - last_in_gv - last_lop - last_lop_op - lastscream - laststatval - laststype - last_uni - lex_brackets - lex_brackstack - lex_casemods - lex_casestack - lex_defer - lex_dojoin - lex_expect - lex_formbrack - lex_inpat - lex_inwhat - lex_op - lex_repl - lex_starts - lex_state - lex_stuff - lineary - linestr - localizing - main_cv - main_root - mainstack - main_start - markstack - markstack_max - markstack_ptr - max_intro_pending - maxo - maxscream - maxsysfd - min_intro_pending - minus_a - minus_c - minus_F - minus_l - minus_n - minus_p - multi_close - multi_end - multi_open - multi_start - na - nexttoke - nexttype - nextval - nice_chunk - nice_chunk_size - No - no_aelem - no_dir_func - no_func - no_mem - nomemok - no_modify - no_myglob - no_security - no_sock_func - no_symref - no_usym - no_wrongref - nrs - oldbufptr - oldname - oldoldbufptr - op - opargs - op_desc - op_mask - op_name - op_seq - origalen - origargc - origargv - origenviron - origfilename - osname - padix - padix_floor - pad_reset_pending - patchlevel - patleave - perldb - perl_destruct_level - pidstatus - ppaddr - preambleav - preambled - preprocess - profiledata - regdummy - regendp - regeol - reginput - regkind - reglastparen - regsize - regstartp - restartop - rs - rsfp - rsfp_filters - runops - savestack - savestack_ix - savestack_max - sawampersand - scopestack - scopestack_ix - scopestack_max - screamfirst - screamnext - secondgv - signals - sig_name - sig_num - simple - sortcop - sortstash - splitstr - stack_base - stack_max - stack_sp - statbuf - statcache - statgv - statname - statusvalue - stdingv - sub_generation - subline - subname - Sv - sv_arenaroot - sv_count - sv_no - sv_objcount - sv_root - sv_undef - sv_yes - tainted - tainting - timesbuf - tmps_floor - tmps_ix - tmps_max - tmps_stack - tokenbuf - top_env - toptarget - uid - unsafe - varies - vtbl_amagic - vtbl_amagicelem - vtbl_arylen - vtbl_bm - vtbl_dbline - vtbl_env - vtbl_envelem - vtbl_glob - vtbl_isa - vtbl_isaelem - vtbl_mglob - vtbl_pack - vtbl_packelem - vtbl_pos - vtbl_sig - vtbl_sigelem - vtbl_substr - vtbl_sv - vtbl_taint - vtbl_uvar - vtbl_vec - warnhook - warn_nl - warn_nosemi - warn_reserved - warn_uninit - watchaddr - watchok - Xpv - Yes - -* have an --env option for soak to set env variable combinations - -* only overwrite generated files if they actually changed - -* try to make parts/apicheck.pl automatically find NEED_ #defines - -* add support for my_vsnprintf? - -* try to perform some core consistency checks: - - - check if 'd' flag in embed.fnc matches with - supplied documentation - - - check if all public API is documented - -* check (during make regen?) if MAX_PERL in PPPort_pm.PL - needs to be updated - -* see if we can implement sv_catpvf() for < 5.004 - -* MULTICALL ? - -* improve apicheck (things like utf8_mg_pos_init() are - not currently checked) - -* more documentation, more tests - -* Resolve dependencies in Makefile.PL and remind of - running 'make regen' - diff --git a/ext/Devel/PPPort/apicheck_c.PL b/ext/Devel/PPPort/apicheck_c.PL deleted file mode 100644 index e4d861e18a..0000000000 --- a/ext/Devel/PPPort/apicheck_c.PL +++ /dev/null @@ -1,29 +0,0 @@ -################################################################################ -# -# apicheck_c.PL -- generate apicheck.c -# -################################################################################ -# -# $Revision: 11 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:49 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; - -my $out = 'apicheck.c'; -my @api = map { /^--api=(\w+)$/ ? ($1) : () } @ARGV; -print "creating $out", (@api ? " (@api)" : ''), "\n"; -system $^X, 'parts/apicheck.pl', @api, $out - and die "couldn't create $out\n"; - diff --git a/ext/Devel/PPPort/devel/buildperl.pl b/ext/Devel/PPPort/devel/buildperl.pl deleted file mode 100644 index 49b7fbbf29..0000000000 --- a/ext/Devel/PPPort/devel/buildperl.pl +++ /dev/null @@ -1,539 +0,0 @@ -#!/usr/bin/perl -w -################################################################################ -# -# buildperl.pl -- build various versions of perl automatically -# -################################################################################ -# -# $Revision: 15 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:50 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; -use Getopt::Long; -use Pod::Usage; -use File::Find; -use File::Path; -use Data::Dumper; -use IO::File; -use Cwd; - -# TODO: - extra arguments to Configure - -# -# --test-archives=1 check if archives can be read -# --test-archives=2 like 1, but also extract archives -# --test-archives=3 like 2, but also apply patches -# - -my %opt = ( - prefix => '/tmp/perl/install//', - build => '/tmp/perl/build/', - source => '/tmp/perl/source', - force => 0, - test => 0, - install => 1, - oneshot => 0, - configure => 0, - 'test-archives' => 0, -); - -my %config = ( - default => { - config_args => '-des', - }, - thread => { - config_args => '-des -Dusethreads', - masked_versions => [ qr/^5\.00[01234]/ ], - }, - thread5005 => { - config_args => '-des -Duse5005threads', - masked_versions => [ qr/^5\.00[012345]|^5.(9|\d\d)/ ], - }, - debug => { - config_args => '-des -Doptimize=-g', - }, -); - -my @patch = ( - { - perl => [ - qr/^5\.00[01234]/, - qw/ - 5.005 - 5.005_01 - 5.005_02 - 5.005_03 - /, - ], - subs => [ - [ \&patch_db, 1 ], - ], - }, - { - perl => [ - qw/ - 5.6.0 - 5.6.1 - 5.7.0 - 5.7.1 - 5.7.2 - 5.7.3 - 5.8.0 - /, - ], - subs => [ - [ \&patch_db, 3 ], - ], - }, - { - perl => [ - qr/^5\.004_0[1234]$/, - ], - subs => [ - [ \&patch_doio ], - ], - }, - { - perl => [ - qw/ - 5.005 - 5.005_01 - 5.005_02 - /, - ], - subs => [ - [ \&patch_sysv, old_format => 1 ], - ], - }, - { - perl => [ - qw/ - 5.005_03 - 5.005_04 - /, - qr/^5\.6\.[0-2]$/, - qr/^5\.7\.[0-3]$/, - qr/^5\.8\.[0-8]$/, - qr/^5\.9\.[0-5]$/ - ], - subs => [ - [ \&patch_sysv ], - ], - }, -); - -my(%perl, @perls); - -GetOptions(\%opt, qw( - config=s@ - prefix=s - build=s - source=s - perl=s@ - force - test - install! - test-archives=i - patch! - oneshot -)) or pod2usage(2); - -my %current; - -if ($opt{patch} || $opt{oneshot}) { - @{$opt{perl}} == 1 or die "Exactly one --perl must be given with --patch or --oneshot\n"; - my $perl = $opt{perl}[0]; - patch_source($perl) if !exists $opt{patch} || $opt{patch}; - if (exists $opt{oneshot}) { - eval { require String::ShellQuote }; - die "--oneshot requires String::ShellQuote to be installed\n" if $@; - %current = (config => 'oneshot', version => $perl); - $config{oneshot} = { config_args => String::ShellQuote::shell_quote(@ARGV) }; - build_and_install($perl{$perl}); - } - exit 0; -} - -if (exists $opt{config}) { - for my $cfg (@{$opt{config}}) { - exists $config{$cfg} or die "Unknown configuration: $cfg\n"; - } -} -else { - $opt{config} = [sort keys %config]; -} - -find(sub { - /^(perl-?(5\..*))\.tar\.(gz|bz2)$/ or return; - $perl{$1} = { version => $2, source => $File::Find::name, compress => $3 }; -}, $opt{source}); - -if (exists $opt{perl}) { - for my $perl (@{$opt{perl}}) { - my $p = $perl; - exists $perl{$p} or $p = "perl$perl"; - exists $perl{$p} or $p = "perl-$perl"; - exists $perl{$p} or die "Cannot find perl: $perl\n"; - push @perls, $p; - } -} -else { - @perls = sort keys %perl; -} - -if ($opt{'test-archives'}) { - my $test = 'test'; - my $cwd = cwd; - -d $test or mkpath($test); - chdir $test or die "chdir $test: $!\n"; - for my $perl (@perls) { - eval { - my $d = extract_source($perl{$perl}); - if ($opt{'test-archives'} > 2) { - my $cwd2 = cwd; - chdir $d or die "chdir $d: $!\n"; - patch_source($perl{$perl}{version}); - chdir $cwd2 or die "chdir $cwd2:$!\n" - } - rmtree($d) if -e $d; - }; - warn $@ if $@; - } - chdir $cwd or die "chdir $cwd: $!\n"; - print STDERR "cleaning up\n"; - rmtree($test); - exit 0; -} - -for my $cfg (@{$opt{config}}) { - for my $perl (@perls) { - my $config = $config{$cfg}; - %current = (config => $cfg, perl => $perl, version => $perl{$perl}{version}); - - if (is($config->{masked_versions}, $current{version})) { - print STDERR "skipping $perl for configuration $cfg (masked)\n"; - next; - } - - if (-d expand($opt{prefix}) and !$opt{force}) { - print STDERR "skipping $perl for configuration $cfg (already installed)\n"; - next; - } - - my $cwd = cwd; - - my $build = expand($opt{build}); - -d $build or mkpath($build); - chdir $build or die "chdir $build: $!\n"; - - print STDERR "building $perl with configuration $cfg\n"; - buildperl($perl, $config); - - chdir $cwd or die "chdir $cwd: $!\n"; - } -} - -sub expand -{ - my $in = shift; - $in =~ s/(<(\w+)>)/exists $current{$2} ? $current{$2} : $1/eg; - return $in; -} - -sub is -{ - my($s1, $s2) = @_; - - defined $s1 != defined $s2 and return 0; - - ref $s2 and ($s1, $s2) = ($s2, $s1); - - if (ref $s1) { - if (ref $s1 eq 'ARRAY') { - is($_, $s2) and return 1 for @$s1; - return 0; - } - return $s2 =~ $s1; - } - - return $s1 eq $s2; -} - -sub buildperl -{ - my($perl, $cfg) = @_; - - my $d = extract_source($perl{$perl}); - chdir $d or die "chdir $d: $!\n"; - - patch_source($perl{$perl}{version}); - - build_and_install($perl{$perl}); -} - -sub extract_source -{ - eval { require Archive::Tar }; - die "Archive processing requires Archive::Tar to be installed\n" if $@; - - my $perl = shift; - - my $what = $opt{'test-archives'} ? 'test' : 'read'; - print "${what}ing $perl->{source}\n"; - - my $target; - - for my $f (Archive::Tar->list_archive($perl->{source})) { - my($t) = $f =~ /^([^\\\/]+)/ or die "ooops, should always match...\n"; - die "refusing to extract $perl->{source}, as it would not extract to a single directory\n" - if defined $target and $target ne $t; - $target = $t; - } - - if ($opt{'test-archives'} == 0 || $opt{'test-archives'} > 1) { - if (-d $target) { - print "removing old build directory $target\n"; - rmtree($target); - } - - print "extracting $perl->{source}\n"; - - Archive::Tar->extract_archive($perl->{source}) - or die "extract failed: " . Archive::Tar->error() . "\n"; - - -d $target or die "oooops, $target not found\n"; - } - - return $target; -} - -sub patch_source -{ - my $version = shift; - - for my $p (@patch) { - if (is($p->{perl}, $version)) { - for my $s (@{$p->{subs}}) { - my($sub, @args) = @$s; - $sub->(@args); - } - } - } -} - -sub build_and_install -{ - my $perl = shift; - my $prefix = expand($opt{prefix}); - - print "building perl $perl->{version} ($current{config})\n"; - - run_or_die("./Configure $config{$current{config}}{config_args} -Dusedevel -Uinstallusrbinperl -Dprefix=$prefix"); - run_or_die("sed -i -e '/^.*/d' -e '/^.*/d' makefile x2p/makefile"); - run_or_die("make all"); - run("make test") if $opt{test}; - if ($opt{install}) { - run_or_die("make install"); - } - else { - print "\n*** NOT INSTALLING PERL ***\n\n"; - } -} - -sub patch_db -{ - my $ver = shift; - print "patching ext/DB_File/DB_File.xs\n"; - run_or_die("sed -i -e 's///' ext/DB_File/DB_File.xs"); -} - -sub patch_doio -{ - patch(<<'END'); ---- doio.c.org 2004-06-07 23:14:45.000000000 +0200 -+++ doio.c 2003-11-04 08:03:03.000000000 +0100 -@@ -75,6 +75,16 @@ - # endif - #endif - -+#if _SEM_SEMUN_UNDEFINED -+union semun -+{ -+ int val; -+ struct semid_ds *buf; -+ unsigned short int *array; -+ struct seminfo *__buf; -+}; -+#endif -+ - bool - do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp) - GV *gv; -END -} - -sub patch_sysv -{ - my %opt = @_; - - # check if patching is required - return if $^O ne 'linux' or -f '/usr/include/asm/page.h'; - - if ($opt{old_format}) { - patch(<<'END'); ---- ext/IPC/SysV/SysV.xs.org 1998-07-20 10:20:07.000000000 +0200 -+++ ext/IPC/SysV/SysV.xs 2007-08-12 10:51:06.000000000 +0200 -@@ -3,9 +3,6 @@ - #include "XSUB.h" - - #include --#ifdef __linux__ --#include --#endif - #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - #include - #ifdef HAS_MSG -END - } - else { - patch(<<'END'); ---- ext/IPC/SysV/SysV.xs.org 2007-08-11 00:12:46.000000000 +0200 -+++ ext/IPC/SysV/SysV.xs 2007-08-11 00:10:51.000000000 +0200 -@@ -3,9 +3,6 @@ - #include "XSUB.h" - - #include --#ifdef __linux__ --# include --#endif - #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - #ifndef HAS_SEM - # include -END - } -} - -sub patch -{ - my($patch) = @_; - print "patching $_\n" for $patch =~ /^\+{3}\s+(\S+)/gm; - my $diff = 'tmp.diff'; - write_or_die($diff, $patch); - run_or_die("patch -s -p0 <$diff"); - unlink $diff or die "unlink $diff: $!\n"; -} - -sub write_or_die -{ - my($file, $data) = @_; - my $fh = new IO::File ">$file" or die "$file: $!\n"; - $fh->print($data); -} - -sub run_or_die -{ - # print "[running @_]\n"; - system "@_" and die "@_: $?\n"; -} - -sub run -{ - # print "[running @_]\n"; - system "@_" and warn "@_: $?\n"; -} - -__END__ - -=head1 NAME - -buildperl.pl - build/install perl distributions - -=head1 SYNOPSIS - - perl buildperl.pl [options] - - --help show this help - - --source=directory directory containing source tarballs - [default: /tmp/perl/source] - - --build=directory directory used for building perls [EXPAND] - [default: /tmp/perl/build/] - - --prefix=directory use this installation prefix [EXPAND] - [default: /tmp/perl/install//] - - --config=configuration build this configuration [MULTI] - [default: all possible configurations] - - --perl=version build this version of perl [MULTI] - [default: all possible versions] - - --force rebuild and install already installed versions - - --test run test suite after building - - --noinstall don't install after building - - --patch only patch the perl source in the current directory - - --oneshot build from the perl source in the current directory - (extra arguments are passed to Configure) - - options tagged with [MULTI] can be given multiple times - - options tagged with [EXPAND] expand the following items - - versioned perl directory (e.g. 'perl-5.6.1') - perl version (e.g. '5.6.1') - name of the configuration (e.g. 'default') - -=head1 EXAMPLES - -The following examples assume that your Perl source tarballs are -in F. If they are somewhere else, use the C<--source> -option to specify a different source directory. - -To build a default configuration of perl5.004_05 and install it -to F, you would say: - - buildperl.pl --prefix='/opt/' --perl=5.004_05 --config=default - -To build debugging configurations of all perls in the source directory -and install them to F, use: - - buildperl.pl --prefix='/opt/' --config=debug - -To build all configurations for perl-5.8.5 and perl-5.8.6, test them -and don't install them, run: - - buildperl.pl --perl=5.8.5 --perl=5.8.6 --test --noinstall - -To build and install a single version of perl with special configuration -options, use: - - buildperl.pl --perl=5.6.0 --prefix=/opt/p560ld --oneshot -- -des -Duselongdouble - -=head1 COPYRIGHT - -Copyright (c) 2004-2009, Marcus Holland-Moritz. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L and L. - diff --git a/ext/Devel/PPPort/devel/devtools.pl b/ext/Devel/PPPort/devel/devtools.pl deleted file mode 100644 index a87c172000..0000000000 --- a/ext/Devel/PPPort/devel/devtools.pl +++ /dev/null @@ -1,129 +0,0 @@ -################################################################################ -# -# devtools.pl -- various utility functions -# -################################################################################ -# -# $Revision: 5 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:50 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use IO::File; - -eval "use Term::ANSIColor"; -$@ and eval "sub colored { pop; @_ }"; - -my @argvcopy = @ARGV; - -sub verbose -{ - if ($opt{verbose}) { - my @out = @_; - s/^(.*)/colored("($0) ", 'bold blue').colored($1, 'blue')/eg for @out; - print STDERR @out; - } -} - -sub ddverbose -{ - return $opt{verbose} ? ('--verbose') : (); -} - -sub runtool -{ - my $opt = ref $_[0] ? shift @_ : {}; - my($prog, @args) = @_; - my $sysstr = join ' ', map { "'$_'" } $prog, @args; - $sysstr .= " >$opt->{'out'}" if exists $opt->{'out'}; - $sysstr .= " 2>$opt->{'err'}" if exists $opt->{'err'}; - verbose("running $sysstr\n"); - my $rv = system $sysstr; - verbose("$prog => exit code $rv\n"); - return not $rv; -} - -sub runperl -{ - my $opt = ref $_[0] ? shift @_ : {}; - runtool($opt, $^X, @_); -} - -sub run -{ - my $prog = shift; - my @args = @_; - - runtool({ 'out' => 'tmp.out', 'err' => 'tmp.err' }, $prog, @args); - - my $out = IO::File->new("tmp.out") or die "tmp.out: $!\n"; - my $err = IO::File->new("tmp.err") or die "tmp.err: $!\n"; - - my %rval = ( - status => $? >> 8, - stdout => [<$out>], - stderr => [<$err>], - didnotrun => 0, - ); - - unlink "tmp.out", "tmp.err"; - - $? & 128 and $rval{core} = 1; - $? & 127 and $rval{signal} = $? & 127; - - return \%rval; -} - -sub ident_str -{ - return "$^X $0 @argvcopy"; -} - -sub identify -{ - verbose(ident_str() . "\n"); -} - -sub ask($) -{ - my $q = shift; - my $a; - local $| = 1; - print "\n$q [y/n] "; - do { $a = <>; } while ($a !~ /^\s*([yn])\s*$/i); - return lc $1 eq 'y'; -} - -sub quit_now -{ - print "\nSorry, cannot continue.\n\n"; - exit 1; -} - -sub ask_or_quit -{ - quit_now unless &ask; -} - -sub eta -{ - my($start, $i, $n) = @_; - return "--:--:--" if $i < 3; - my $elapsed = tv_interval($start); - my $h = int($elapsed*($n-$i)/$i); - my $s = $h % 60; $h /= 60; - my $m = $h % 60; $h /= 60; - return sprintf "%02d:%02d:%02d", $h, $m, $s; -} - -1; diff --git a/ext/Devel/PPPort/devel/mkapidoc.sh b/ext/Devel/PPPort/devel/mkapidoc.sh deleted file mode 100644 index a4de2b4a27..0000000000 --- a/ext/Devel/PPPort/devel/mkapidoc.sh +++ /dev/null @@ -1,87 +0,0 @@ -#!/bin/bash -################################################################################ -# -# mkapidoc.sh -- generate apidoc.fnc from scanning the Perl source -# -################################################################################ -# -# $Revision: 13 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:50 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -function isperlroot -{ - [ -f "$1/embed.fnc" ] && [ -f "$1/perl.h" ] -} - -function usage -{ - echo "USAGE: $0 [perlroot] [output-file] [embed.fnc]" - exit 0 -} - -if [ -z "$1" ]; then - if isperlroot "../../.."; then - PERLROOT=../../.. - else - PERLROOT=. - fi -else - PERLROOT=$1 -fi - -if [ -z "$2" ]; then - if [ -f "parts/apidoc.fnc" ]; then - OUTPUT="parts/apidoc.fnc" - else - usage - fi -else - OUTPUT=$2 -fi - -if [ -z "$3" ]; then - if [ -f "parts/embed.fnc" ]; then - EMBED="parts/embed.fnc" - else - usage - fi -else - EMBED=$3 -fi - -if isperlroot $PERLROOT; then - cat >$OUTPUT < file that came with this distribution. -: -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - -: -: This file lists all API functions/macros that are documented in the Perl -: source code, but are not contained in F. -: - -EOF - grep -hr '^=for apidoc' $PERLROOT | sed -e 's/=for apidoc //' | grep '|' | sort | uniq \ - | perl -e'$f=pop;open(F,$f)||die"$f:$!";while(){(split/\|/)[2]=~/(\w+)/;$h{$1}++} - while(<>){s/[ \t]+$//;(split/\|/)[2]=~/(\w+)/;$h{$1}||print}' $EMBED >>$OUTPUT -else - usage -fi diff --git a/ext/Devel/PPPort/devel/mktodo b/ext/Devel/PPPort/devel/mktodo deleted file mode 100644 index d2bf8b8d8c..0000000000 --- a/ext/Devel/PPPort/devel/mktodo +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/perl -w -################################################################################ -# -# mktodo -- generate baseline and todo files by running mktodo.pl -# -################################################################################ -# -# $Revision: 16 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:50 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; -use Getopt::Long; - -require 'devel/devtools.pl'; - -our %opt = ( - base => 0, - check => 1, - verbose => 0, -); - -GetOptions(\%opt, qw( base check! verbose )) or die; - -identify(); - -my $outdir = 'parts/todo'; - -my $install = '/tmp/perl/install/default'; -# my $install = '/tmp/perl/install/thread'; - -my @perls = sort { $b->{version} <=> $a->{version} } - map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } } - ('bleadperl', glob "$install/*/bin/perl5.*"); - -for (1 .. $#perls) { - $perls[$_]{todo} = $perls[$_-1]{version}; -} - -shift @perls; - -for (@perls) { - my $todo = do { my $v = $_->{todo}; $v =~ s/\D+//g; $v }; - -e "$outdir/$todo" and next; - my @args = ('--perl', $_->{path}, '--todo', "$outdir/$todo", '--version', "$_->{todo}"); - push @args, '--base' if $opt{base}; - push @args, '--verbose' if $opt{verbose}; - push @args, '--nocheck' unless $opt{check}; - runperl('devel/mktodo.pl', @args) or die "error running mktodo.pl [$!] [$?]\n"; -} - diff --git a/ext/Devel/PPPort/devel/mktodo.pl b/ext/Devel/PPPort/devel/mktodo.pl deleted file mode 100644 index 156a1c8518..0000000000 --- a/ext/Devel/PPPort/devel/mktodo.pl +++ /dev/null @@ -1,346 +0,0 @@ -#!/usr/bin/perl -w -################################################################################ -# -# mktodo.pl -- generate baseline and todo files -# -################################################################################ -# -# $Revision: 16 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:51 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; -use Getopt::Long; -use Data::Dumper; -use IO::File; -use IO::Select; -use Config; -use Time::HiRes qw( gettimeofday tv_interval ); - -require 'devel/devtools.pl'; - -our %opt = ( - debug => 0, - base => 0, - verbose => 0, - check => 1, - shlib => 'blib/arch/auto/Devel/PPPort/PPPort.so', -); - -GetOptions(\%opt, qw( - perl=s todo=s version=s shlib=s debug base verbose check! - )) or die; - -identify(); - -print "\n", ident_str(), "\n\n"; - -my $fullperl = `which $opt{perl}`; -chomp $fullperl; - -$ENV{SKIP_SLOW_TESTS} = 1; - -regen_all(); - -my %sym; -for (`$Config{nm} $fullperl`) { - chomp; - /\s+T\s+(\w+)\s*$/ and $sym{$1}++; -} -keys %sym >= 50 or die "less than 50 symbols found in $fullperl\n"; - -my %all = %{load_todo($opt{todo}, $opt{version})}; -my @recheck; - -my $symmap = get_apicheck_symbol_map(); - -for (;;) { - my $retry = 1; - my $trynm = 1; - regen_apicheck(); - -retry: - my(@new, @tmp, %seen); - - my $r = run(qw(make)); - $r->{didnotrun} and die "couldn't run make: $!\n"; - - for my $l (@{$r->{stderr}}) { - if ($l =~ /_DPPP_test_(\w+)/) { - if (!$seen{$1}++) { - my @s = grep { exists $sym{$_} } $1, "Perl_$1", "perl_$1"; - if (@s) { - push @tmp, [$1, "E (@s)"]; - } - else { - push @new, [$1, "E"]; - } - } - } - } - - if ($r->{status} == 0) { - my @u; - my @usym; - - if ($trynm) { - @u = eval { find_undefined_symbols($fullperl, $opt{shlib}) }; - warn "warning: $@" if $@; - $trynm = 0; - } - - unless (@u) { - $r = run(qw(make test)); - $r->{didnotrun} and die "couldn't run make test: $!\n"; - $r->{status} == 0 and last; - - for my $l (@{$r->{stderr}}) { - if ($l =~ /undefined symbol: (\w+)/) { - push @u, $1; - } - } - } - - for my $u (@u) { - for my $m (keys %{$symmap->{$u}}) { - if (!$seen{$m}++) { - my $pl = $m; - $pl =~ s/^[Pp]erl_//; - my @s = grep { exists $sym{$_} } $pl, "Perl_$pl", "perl_$pl"; - push @new, [$m, @s ? "U (@s)" : "U"]; - } - } - } - } - - @new = grep !$all{$_->[0]}, @new; - - unless (@new) { - @new = grep !$all{$_->[0]}, @tmp; - } - - unless (@new) { - if ($retry > 0) { - $retry--; - regen_all(); - goto retry; - } - print Dumper($r); - die "no new TODO symbols found..."; - } - - # don't recheck undefined symbols reported by the dynamic linker - push @recheck, map { $_->[0] } grep { $_->[1] !~ /^U/ } @new; - - for (@new) { - sym('new', @$_); - $all{$_->[0]} = $_->[1]; - } - - write_todo($opt{todo}, $opt{version}, \%all); -} - -if ($opt{check}) { - my $ifmt = '%' . length(scalar @recheck) . 'd'; - my $t0 = [gettimeofday]; - - RECHECK: for my $i (0 .. $#recheck) { - my $sym = $recheck[$i]; - my $cur = delete $all{$sym}; - - sym('chk', $sym, $cur, sprintf(" [$ifmt/$ifmt, ETA %s]", - $i + 1, scalar @recheck, eta($t0, $i, scalar @recheck))); - - write_todo($opt{todo}, $opt{version}, \%all); - - if ($cur eq "E (Perl_$sym)") { - # we can try a shortcut here - regen_apicheck($sym); - - my $r = run(qw(make test)); - - if (!$r->{didnotrun} && $r->{status} == 0) { - sym('del', $sym, $cur); - next RECHECK; - } - } - - # run the full test - regen_all(); - - my $r = run(qw(make test)); - - $r->{didnotrun} and die "couldn't run make test: $!\n"; - - if ($r->{status} == 0) { - sym('del', $sym, $cur); - } - else { - $all{$sym} = $cur; - } - } -} - -write_todo($opt{todo}, $opt{version}, \%all); - -run(qw(make realclean)); - -exit 0; - -sub sym -{ - my($what, $sym, $reason, $extra) = @_; - $extra ||= ''; - my %col = ( - 'new' => 'bold red', - 'chk' => 'bold magenta', - 'del' => 'bold green', - ); - $what = colored("$what symbol", $col{$what}); - - printf "[%s] %s %-30s # %s%s\n", - $opt{version}, $what, $sym, $reason, $extra; -} - -sub regen_all -{ - my @mf_arg = ('--with-apicheck', 'OPTIMIZE=-O0 -w'); - push @mf_arg, qw( DEFINE=-DDPPP_APICHECK_NO_PPPORT_H ) if $opt{base}; - - # just to be sure - run(qw(make realclean)); - run($fullperl, "Makefile.PL", @mf_arg)->{status} == 0 - or die "cannot run Makefile.PL: $!\n"; -} - -sub regen_apicheck -{ - unlink qw(apicheck.c apicheck.o); - runtool({ out => '/dev/null' }, $fullperl, 'apicheck_c.PL', map { "--api=$_" } @_) - or die "cannot regenerate apicheck.c\n"; -} - -sub load_todo -{ - my($file, $expver) = @_; - - if (-e $file) { - my $f = new IO::File $file or die "cannot open $file: $!\n"; - my $ver = <$f>; - chomp $ver; - if ($ver eq $expver) { - my %sym; - while (<$f>) { - chomp; - /^(\w+)\s+#\s+(.*)/ or goto nuke_file; - exists $sym{$1} and goto nuke_file; - $sym{$1} = $2; - } - return \%sym; - } - -nuke_file: - undef $f; - unlink $file or die "cannot remove $file: $!\n"; - } - - return {}; -} - -sub write_todo -{ - my($file, $ver, $sym) = @_; - my $f; - - $f = new IO::File ">$file" or die "cannot open $file: $!\n"; - $f->print("$ver\n"); - - for (sort keys %$sym) { - $f->print(sprintf "%-30s # %s\n", $_, $sym->{$_}); - } -} - -sub find_undefined_symbols -{ - my($perl, $shlib) = @_; - - my $ps = read_sym(file => $perl, options => [qw( --defined-only )]); - my $ls = read_sym(file => $shlib, options => [qw( --undefined-only )]); - - my @undefined; - - for my $sym (keys %$ls) { - unless (exists $ps->{$sym}) { - if ($sym !~ /\@/ and $sym !~ /^_/) { - push @undefined, $sym; - } - } - } - - return @undefined; -} - -sub read_sym -{ - my %opt = ( options => [], @_ ); - - my $r = run($Config{nm}, @{$opt{options}}, $opt{file}); - - if ($r->{didnotrun} or $r->{status}) { - die "cannot run $Config{nm}"; - } - - my %sym; - - for (@{$r->{stdout}}) { - chomp; - my($adr, $fmt, $sym) = /^\s*([[:xdigit:]]+)?\s+([ABCDGINRSTUVW?-])\s+(\S+)\s*$/i - or die "cannot parse $Config{nm} output:\n[$_]\n"; - $sym{$sym} = { format => $fmt }; - $sym{$sym}{address} = $adr if defined $adr; - } - - return \%sym; -} - -sub get_apicheck_symbol_map -{ - my $r = run(qw(make apicheck.i)); - - if ($r->{didnotrun} or $r->{status}) { - die "cannot run make apicheck.i"; - } - - my $fh = IO::File->new('apicheck.i') - or die "cannot open apicheck.i: $!"; - - local $_; - my %symmap; - my $cur; - - while (<$fh>) { - next if /^#/; - if (defined $cur) { - for my $sym (/\b([A-Za-z_]\w+)\b/g) { - $symmap{$sym}{$cur}++; - } - undef $cur if /^}$/; - } - else { - /_DPPP_test_(\w+)/ and $cur = $1; - } - } - - return \%symmap; -} diff --git a/ext/Devel/PPPort/devel/regenerate b/ext/Devel/PPPort/devel/regenerate deleted file mode 100644 index 31765055cd..0000000000 --- a/ext/Devel/PPPort/devel/regenerate +++ /dev/null @@ -1,161 +0,0 @@ -#!/usr/bin/perl -w -################################################################################ -# -# regenerate -- regenerate baseline and todo files -# -################################################################################ -# -# $Revision: 8 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:50 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; -use File::Path; -use File::Copy; -use Getopt::Long; -use Pod::Usage; - -require 'devel/devtools.pl'; - -our %opt = ( - check => 1, - verbose => 0, -); - -GetOptions(\%opt, qw( check! verbose )) or die pod2usage(); - -identify(); - -unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') { - print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n"; - quit_now(); -} - -ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?"); - -my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo ); - -my(@notwr, @wr); -for my $f (map @$_, values %files) { - push @{-w $f ? \@wr : \@notwr}, $f; -} - -if (@notwr) { - if (@wr) { - print "\nThe following files are not writable:\n\n"; - print " $_\n" for @notwr; - print "\nAre you sure you have checked out these files?\n"; - } - else { - print "\nAll baseline / todo file are not writable.\n"; - ask_or_quit("Do you want to try to check out these files?"); - unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) { - print "\nSomething went wrong while checking out the files.\n"; - quit_now(); - } - } -} - -for my $dir (qw( base todo )) { - my $cur = "parts/$dir"; - my $old = "$cur-old"; - if (-e $old) { - ask_or_quit("Do you want me to remove the old $old directory?"); - rmtree($old); - } - mkdir $old; - print "\nBacking up $cur in $old.\n"; - for my $src (@{$files{$dir}}) { - my $dst = $src; - $dst =~ s/\E$cur/$old/ or die "Ooops!"; - move($src, $dst) or die "Moving $src to $dst failed: $!\n"; - } -} - -my $T0 = time; -my @args = ddverbose(); -push @args, '--nocheck' unless $opt{check}; - -print "\nBuilding baseline files...\n\n"; - -unless (runperl('devel/mktodo', '--base', @args)) { - print "\nSomething went wrong while building the baseline files.\n"; - quit_now(); -} - -print "\nMoving baseline files...\n\n"; - -for my $src (glob 'parts/todo/5*') { - my $dst = $src; - $dst =~ s/todo/base/ or die "Ooops!"; - move($src, $dst) or die "Moving $src to $dst failed: $!\n"; -} - -print "\nBuilding todo files...\n\n"; - -unless (runperl('devel/mktodo', @args)) { - print "\nSomething went wrong while building the baseline files.\n"; - quit_now(); -} - -print "\nAdding remaining baseline info...\n\n"; - -unless (runperl('Makefile.PL') and - runtool('make') and - runperl('devel/scanprov', 'write')) { - print "\nSomething went wrong while adding the baseline info.\n"; - quit_now(); -} - -my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times); -my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys; -$usr = sprintf "%.2f", $usr + $cusr; -$sys = sprintf "%.2f", $sys + $csys; - -print < and L. - -=cut - diff --git a/ext/Devel/PPPort/devel/scanprov b/ext/Devel/PPPort/devel/scanprov deleted file mode 100644 index 19d294472a..0000000000 --- a/ext/Devel/PPPort/devel/scanprov +++ /dev/null @@ -1,77 +0,0 @@ -#!/usr/bin/perl -w -################################################################################ -# -# scanprov -- scan Perl headers for provided macros -# -################################################################################ -# -# $Revision: 9 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:50 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; -require 'parts/ppptools.pl'; - -die "Usage: $0 [check|write]\n" unless @ARGV && $ARGV[0] =~ /^(check|write)$/; -my $mode = $1; - -my %embed = map { ( $_->{name} => 1 ) } - parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc )); - -my @provided = grep { !exists $embed{$_} } - map { /^(\w+)/ ? $1 : () } - `$^X ppport.h --list-provided`; - -my $install = '/tmp/perl/install/default'; - -my @perls = sort { $b->{version} <=> $a->{version} } - map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } } - ('bleadperl', glob "$install/*/bin/perl5.*"); - -for (1 .. $#perls) { - $perls[$_]{todo} = $perls[$_-1]{version}; -} - -shift @perls; - -my %v; - -for my $p (@perls) { - print "checking perl $p->{version}...\n"; - my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`; - chomp $archlib; - local @ARGV = glob "$archlib/CORE/*.h"; - my %sym; - while (<>) { $sym{$_}++ for /(\w+)/g; } - @provided = map { $sym{$_} or $v{$p->{todo}}{$_}++; $sym{$_} ? $_ : () } @provided; -} - -my $out = 'parts/base'; -my $todo = parse_todo($out); - -for my $v (keys %v) { - my @new = sort grep { !exists $todo->{$_} } keys %{$v{$v}}; - @new or next; - my $file = $v; - $file =~ s/\.//g; - $file = "$out/$file"; - -e $file or die "non-existent: $file\n"; - print "-- $file --\n"; - $mode eq 'write' and (open F, ">>$file" or die "$file: $!\n"); - for (@new) { - print "adding $_\n"; - $mode eq 'write' and printf F "%-30s # added by $0\n", $_; - } - $mode eq 'write' and close F; -} diff --git a/ext/Devel/PPPort/mktests.PL b/ext/Devel/PPPort/mktests.PL deleted file mode 100644 index a4f6f9259e..0000000000 --- a/ext/Devel/PPPort/mktests.PL +++ /dev/null @@ -1,116 +0,0 @@ -################################################################################ -# -# mktests.PL -- generate test files for Devel::PPPort -# -################################################################################ -# -# $Revision: 30 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:49 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; -$^W = 1; -require "parts/ppptools.pl"; - -my $template = do { local $/; }; - -generate_tests(); - -sub generate_tests -{ - my @tests; - my $file; - - for $file (all_files_in_dir('parts/inc')) { - my($testfile) = $file =~ /(\w+)\.?$/; # VMS has a trailing dot - $testfile = "t/$testfile.t"; - - my $spec = parse_partspec($file); - my $plan = 0; - - if (exists $spec->{tests}) { - exists $spec->{OPTIONS}{tests} && - exists $spec->{OPTIONS}{tests}{plan} - or die "No plan for tests in $file\n"; - - print "generating $testfile\n"; - - my $tmpl = $template; - $tmpl =~ s/__SOURCE__/$file/mg; - $tmpl =~ s/__PLAN__/$spec->{OPTIONS}{tests}{plan}/mg; - $tmpl =~ s/^__TESTS__$/$spec->{tests}/mg; - - open FH, ">$testfile" or die "$testfile: $!\n"; - print FH $tmpl; - close FH; - - push @tests, $testfile; - } - } - - return @tests; -} - -__DATA__ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or __SOURCE__ instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (__PLAN__) { - load(); - plan(tests => __PLAN__); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -__TESTS__ diff --git a/ext/Devel/PPPort/module2.c b/ext/Devel/PPPort/module2.c deleted file mode 100644 index e5f4ef607c..0000000000 --- a/ext/Devel/PPPort/module2.c +++ /dev/null @@ -1,60 +0,0 @@ -/******************************************************************************* -* -* Perl/Pollution/Portability -* -******************************************************************************** -* -* $Revision: 12 $ -* $Author: mhx $ -* $Date: 2009/01/18 14:10:49 +0100 $ -* -******************************************************************************** -* -* Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -* Version 2.x, Copyright (C) 2001, Paul Marquess. -* Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -* -* This program is free software; you can redistribute it and/or -* modify it under the same terms as Perl itself. -* -*******************************************************************************/ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifndef PATCHLEVEL -#include "patchlevel.h" -#endif - -#define NEED_newCONSTSUB_GLOBAL -#define NEED_PL_signals_GLOBAL -#define NEED_PL_parser -#define DPPP_PL_parser_NO_DUMMY -#include "ppport.h" - -void call_newCONSTSUB_2(void) -{ - newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_2", newSViv(2)); -} - -U32 get_PL_signals_2(void) -{ - return PL_signals; -} - -int no_dummy_parser_vars(int check) -{ - if (check == 0 || PL_parser) - { - line_t volatile my_copline; - line_t volatile *my_p_copline; - my_copline = PL_copline; - my_p_copline = &PL_copline; - PL_copline = my_copline; - PL_copline = *my_p_copline; - return 1; - } - - return 0; -} diff --git a/ext/Devel/PPPort/module3.c b/ext/Devel/PPPort/module3.c deleted file mode 100644 index bcfbcd08b3..0000000000 --- a/ext/Devel/PPPort/module3.c +++ /dev/null @@ -1,77 +0,0 @@ -/******************************************************************************* -* -* Perl/Pollution/Portability -* -******************************************************************************** -* -* $Revision: 12 $ -* $Author: mhx $ -* $Date: 2009/01/18 14:10:49 +0100 $ -* -******************************************************************************** -* -* Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -* Version 2.x, Copyright (C) 2001, Paul Marquess. -* Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -* -* This program is free software; you can redistribute it and/or -* modify it under the same terms as Perl itself. -* -*******************************************************************************/ - -#include "EXTERN.h" -#include "perl.h" - -#define NEED_PL_parser -#define NO_XSLOCKS -#include "XSUB.h" - -#include "ppport.h" - -static void throws_exception(int throw_e) -{ - if (throw_e) - croak("boo\n"); -} - -int exception(int throw_e) -{ - dTHR; - dXCPT; - SV *caught = get_sv("Devel::PPPort::exception_caught", 0); - - XCPT_TRY_START { - throws_exception(throw_e); - } XCPT_TRY_END - - XCPT_CATCH - { - sv_setiv(caught, 1); - XCPT_RETHROW; - } - - sv_setiv(caught, 0); - - return 42; -} - -void call_newCONSTSUB_3(void) -{ - newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_3", newSViv(3)); -} - -U32 get_PL_signals_3(void) -{ - return PL_signals; -} - -int dummy_parser_warning(void) -{ - char * volatile my_bufptr; - char * volatile *my_p_bufptr; - my_bufptr = PL_bufptr; - my_p_bufptr = &PL_bufptr; - PL_bufptr = my_bufptr; - PL_bufptr = *my_p_bufptr; - return &PL_bufptr != NULL; -} diff --git a/ext/Devel/PPPort/parts/apicheck.pl b/ext/Devel/PPPort/parts/apicheck.pl deleted file mode 100644 index 35901425e5..0000000000 --- a/ext/Devel/PPPort/parts/apicheck.pl +++ /dev/null @@ -1,322 +0,0 @@ -#!/usr/bin/perl -w -################################################################################ -# -# apicheck.pl -- generate C source for automated API check -# -################################################################################ -# -# $Revision: 34 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:51 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -use strict; -require 'parts/ppptools.pl'; - -if (@ARGV) { - my $file = pop @ARGV; - open OUT, ">$file" or die "$file: $!\n"; -} -else { - *OUT = \*STDOUT; -} - -my @f = parse_embed(qw( parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc )); - -my %todo = %{&parse_todo}; - -my %tmap = ( - void => 'int', -); - -my %amap = ( - SP => 'SP', - type => 'int', - cast => 'int', -); - -my %void = ( - void => 1, - Free_t => 1, - Signal_t => 1, -); - -my %castvoid = ( - map { ($_ => 1) } qw( - Nullav - Nullcv - Nullhv - Nullch - Nullsv - HEf_SVKEY - SP - MARK - SVt_PV - SVt_IV - SVt_NV - SVt_PVMG - SVt_PVAV - SVt_PVHV - SVt_PVCV - SvUOK - G_SCALAR - G_ARRAY - G_VOID - G_DISCARD - G_EVAL - G_NOARGS - XS_VERSION - ), -); - -my %ignorerv = ( - map { ($_ => 1) } qw( - newCONSTSUB - ), -); - -my %stack = ( - ORIGMARK => ['dORIGMARK;'], - POPpx => ['STRLEN n_a;'], - POPpbytex => ['STRLEN n_a;'], - PUSHp => ['dTARG;'], - PUSHn => ['dTARG;'], - PUSHi => ['dTARG;'], - PUSHu => ['dTARG;'], - XPUSHp => ['dTARG;'], - XPUSHn => ['dTARG;'], - XPUSHi => ['dTARG;'], - XPUSHu => ['dTARG;'], - UNDERBAR => ['dUNDERBAR;'], - XCPT_TRY_START => ['dXCPT;'], - XCPT_TRY_END => ['dXCPT;'], - XCPT_CATCH => ['dXCPT;'], - XCPT_RETHROW => ['dXCPT;'], -); - -my %ignore = ( - map { ($_ => 1) } qw( - svtype - items - ix - dXSI32 - XS - CLASS - THIS - RETVAL - StructCopy - ), -); - -print OUT < 0) } @ARGV; - @f = grep { exists $want{$_->{name}} } @f; - for (@f) { $want{$_->{name}}++ } - for (keys %want) { - die "nothing found for '$_'\n" unless $want{$_}; - } -} - -my $f; -for $f (@f) { - $ignore{$f->{name}} and next; - $f->{flags}{A} or next; # only public API members - - $ignore{$f->{name}} = 1; # ignore duplicates - - my $Perl_ = $f->{flags}{p} ? 'Perl_' : ''; - - my $stack = ''; - my @arg; - my $aTHX = ''; - - my $i = 1; - my $ca; - my $varargs = 0; - for $ca (@{$f->{args}}) { - my $a = $ca->[0]; - if ($a eq '...') { - $varargs = 1; - push @arg, qw(VARarg1 VARarg2 VARarg3); - last; - } - my($n, $p, $d) = $a =~ /^ (\w+(?:\s+\w+)*)\s* # type name => $n - (\**) # pointer => $p - (?:\s*const\s*)? # const - ((?:\[[^\]]*\])*) # dimension => $d - $/x - or die "$0 - cannot parse argument: [$a]\n"; - if (exists $amap{$n}) { - push @arg, $amap{$n}; - next; - } - $n = $tmap{$n} || $n; - if ($n eq 'const char' and $p eq '*' and !$f->{flags}{f}) { - push @arg, '"foo"'; - } - else { - my $v = 'arg' . $i++; - push @arg, $v; - $stack .= " static $n $p$v$d;\n"; - } - } - - unless ($f->{flags}{n} || $f->{flags}{'m'}) { - $stack = " dTHX;\n$stack"; - $aTHX = @arg ? 'aTHX_ ' : 'aTHX'; - } - - if ($stack{$f->{name}}) { - my $s = ''; - for (@{$stack{$f->{name}}}) { - $s .= " $_\n"; - } - $stack = "$s$stack"; - } - - my $args = join ', ', @arg; - my $rvt = $f->{ret} || 'void'; - my $ret; - if ($void{$rvt}) { - $ret = $castvoid{$f->{name}} ? '(void) ' : ''; - } - else { - $stack .= " $rvt rval;\n"; - $ret = $ignorerv{$f->{name}} ? '(void) ' : "rval = "; - } - my $aTHX_args = "$aTHX$args"; - - unless ($f->{flags}{'m'} and @arg == 0) { - $args = "($args)"; - $aTHX_args = "($aTHX_args)"; - } - - print OUT <{name} -* -******************************************************************************/ - -HEAD - - if ($todo{$f->{name}}) { - my($ver,$sub) = $todo{$f->{name}} =~ /^5\.(\d{3})(\d{3})$/ or die; - for ($ver, $sub) { - s/^0+(\d)/$1/ - } - if ($ver < 6 && $sub > 0) { - $sub =~ s/0$// or die; - } - print OUT "#if PERL_VERSION > $ver || (PERL_VERSION == $ver && PERL_SUBVERSION >= $sub) /* TODO */\n"; - } - - my $final = $varargs - ? "$Perl_$f->{name}$aTHX_args" - : "$f->{name}$args"; - - $f->{cond} and print OUT "#if $f->{cond}\n"; - - print OUT <{name} (void) -{ - dXSARGS; -$stack - { -#ifdef $f->{name} - $ret$f->{name}$args; -#endif - } - - { -#ifdef $f->{name} - $ret$final; -#else - $ret$Perl_$f->{name}$aTHX_args; -#endif - } -} -END - - $f->{cond} and print OUT "#endif\n"; - $todo{$f->{name}} and print OUT "#endif\n"; - - print OUT "\n"; -} - -@ARGV and close OUT; - diff --git a/ext/Devel/PPPort/parts/apidoc.fnc b/ext/Devel/PPPort/parts/apidoc.fnc deleted file mode 100644 index 63b97468b8..0000000000 --- a/ext/Devel/PPPort/parts/apidoc.fnc +++ /dev/null @@ -1,327 +0,0 @@ -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -: -: !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!! -: -: This file was automatically generated from the API documentation scattered -: all over the Perl source code. To learn more about how all this works, -: please read the F file that came with this distribution. -: -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - -: -: This file lists all API functions/macros that are documented in the Perl -: source code, but are not contained in F. -: - -Ama|char*|savepvs|const char* s -Ama|SV*|newSVpvs|const char* s -Ama|SV*|newSVpvs_flags|const char* s|U32 flags -Ama|SV*|newSVpvs_share|const char* s -Am|bool|isALNUM|char ch -Am|bool|isALPHA|char ch -Am|bool|isDIGIT|char ch -Am|bool|isLOWER|char ch -Am|bool|isSPACE|char ch -Am|bool|isUPPER|char ch -Am|bool|strEQ|char* s1|char* s2 -Am|bool|strGE|char* s1|char* s2 -Am|bool|strGT|char* s1|char* s2 -Am|bool|strLE|char* s1|char* s2 -Am|bool|strLT|char* s1|char* s2 -Am|bool|strNE|char* s1|char* s2 -Am|bool|strnEQ|char* s1|char* s2|STRLEN len -Am|bool|strnNE|char* s1|char* s2|STRLEN len -Am|bool|SvIOK_notUV|SV* sv -Am|bool|SvIOK_UV|SV* sv -Am|bool|SvIsCOW_shared_hash|SV* sv -Am|bool|SvIsCOW|SV* sv -Am|bool|SvRXOK|SV* sv -Am|bool|SvTAINTED|SV* sv -Am|bool|SvTRUE|SV* sv -Am|bool|SvUOK|SV* sv -Am|bool|SvVOK|SV* sv -Am|char*|HePV|HE* he|STRLEN len -Am|char*|HeUTF8|HE* he|STRLEN len -Am|char*|HvNAME|HV* stash -Am|char*|SvEND|SV* sv -Am|char*|SvGAMAGIC|SV* sv -Am|char *|SvGROW|SV* sv|STRLEN len -Am|char*|SvPVbyte_force|SV* sv|STRLEN len -Am|char*|SvPVbyte_nolen|SV* sv -Am|char*|SvPVbyte|SV* sv|STRLEN len -Am|char*|SvPVbytex_force|SV* sv|STRLEN len -Am|char*|SvPVbytex|SV* sv|STRLEN len -Am|char*|SvPV_force_nomg|SV* sv|STRLEN len -Am|char*|SvPV_force|SV* sv|STRLEN len -Am|char*|SvPV_nolen|SV* sv -Am|char*|SvPV_nomg|SV* sv|STRLEN len -Am|char*|SvPV|SV* sv|STRLEN len -Am|char*|SvPVutf8_force|SV* sv|STRLEN len -Am|char*|SvPVutf8_nolen|SV* sv -Am|char*|SvPVutf8|SV* sv|STRLEN len -Am|char*|SvPVutf8x_force|SV* sv|STRLEN len -Am|char*|SvPVutf8x|SV* sv|STRLEN len -Am|char*|SvPVX|SV* sv -Am|char*|SvPVx|SV* sv|STRLEN len -Am|char|toLOWER|char ch -Am|char|toUPPER|char ch -Am|HV*|CvSTASH|CV* cv -Am|HV*|gv_stashpvs|const char* name|I32 create -Am|HV*|SvSTASH|SV* sv -Am|int|AvFILL|AV* av -Am|IV|SvIV_nomg|SV* sv -Am|IV|SvIV|SV* sv -Am|IV|SvIVx|SV* sv -Am|IV|SvIVX|SV* sv -Amn|char*|CLASS -Amn|char*|POPp -Amn|char*|POPpbytex -Amn|char*|POPpx -Amn|HV*|PL_modglobal -Amn|I32|ax -Amn|I32|items -Amn|I32|ix -Amn|IV|POPi -Amn|long|POPl -Amn|NV|POPn -Amn|STRLEN|PL_na -Amn|SV|PL_sv_no -Amn|SV|PL_sv_undef -Amn|SV|PL_sv_yes -Amn|SV*|POPs -Amn|U32|GIMME -Amn|U32|GIMME_V -Am|NV|SvNV|SV* sv -Am|NV|SvNVx|SV* sv -Am|NV|SvNVX|SV* sv -Amn|(whatever)|RETVAL -Amn|(whatever)|THIS -Am|REGEXP *|SvRX|SV *sv -Ams||dAX -Ams||dAXMARK -Ams||dITEMS -Ams||dMARK -Ams||dMULTICALL -Ams||dORIGMARK -Ams||dSP -Ams||dUNDERBAR -Ams||dXCPT -Ams||dXSARGS -Ams||dXSI32 -Ams||ENTER -Ams||FREETMPS -Ams||LEAVE -Ams||MULTICALL -Ams||POP_MULTICALL -Ams||PUSH_MULTICALL -Ams||PUTBACK -Ams||SAVETMPS -Ams||SPAGAIN -Am|STRLEN|HeKLEN|HE* he -Am|STRLEN|SvCUR|SV* sv -Am|STRLEN|SvLEN|SV* sv -Am|SV*|GvSV|GV* gv -Am|SV*|HeSVKEY_force|HE* he -Am|SV*|HeSVKEY|HE* he -Am|SV*|HeSVKEY_set|HE* he|SV* sv -Am|SV*|HeVAL|HE* he -Am|SV**|hv_fetchs|HV* tb|const char* key|I32 lval -Am|SV**|hv_stores|HV* tb|const char* key|NULLOK SV* val -Am|SV*|newRV_inc|SV* sv -Am|SV*|newSVpvn_utf8|NULLOK const char* s|STRLEN len|U32 utf8 -Am|SV*|ST|int ix -Am|SV*|SvREFCNT_inc_NN|SV* sv -Am|SV*|SvREFCNT_inc_simple_NN|SV* sv -Am|SV*|SvREFCNT_inc_simple|SV* sv -Am|SV*|SvREFCNT_inc|SV* sv -Am|SV*|SvRV|SV* sv -Am|svtype|SvTYPE|SV* sv -Ams||XCPT_RETHROW -Ams||XSRETURN_EMPTY -Ams||XSRETURN_NO -Ams||XSRETURN_UNDEF -Ams||XSRETURN_YES -Ams||XS_VERSION_BOOTCHECK -Am|U32|HeHASH|HE* he -Am|U32|SvIOKp|SV* sv -Am|U32|SvIOK|SV* sv -Am|U32|SvNIOKp|SV* sv -Am|U32|SvNIOK|SV* sv -Am|U32|SvNOKp|SV* sv -Am|U32|SvNOK|SV* sv -Am|U32|SvOK|SV* sv -Am|U32|SvOOK|SV* sv -Am|U32|SvPOKp|SV* sv -Am|U32|SvPOK|SV* sv -Am|U32|SvREFCNT|SV* sv -Am|U32|SvROK|SV* sv -Am|U32|SvUTF8|SV* sv -AmU||G_ARRAY -AmU||G_DISCARD -AmU||G_EVAL -AmU||G_NOARGS -AmU||G_SCALAR -AmU||G_VOID -AmU||HEf_SVKEY -AmU||MARK -AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto -AmU||Nullav -AmU||Nullch -AmU||Nullcv -AmU||Nullhv -AmU||Nullsv -AmU||ORIGMARK -AmU||SP -AmU||SVt_IV -AmU||SVt_NV -AmU||SVt_PV -AmU||SVt_PVAV -AmU||SVt_PVCV -AmU||SVt_PVHV -AmU||SVt_PVMG -AmU||svtype -AmU||UNDERBAR -Am|UV|SvUV_nomg|SV* sv -Am|UV|SvUV|SV* sv -Am|UV|SvUVx|SV* sv -Am|UV|SvUVX|SV* sv -AmU||XCPT_CATCH -AmU||XCPT_TRY_END -AmU||XCPT_TRY_START -AmU||XS -AmU||XS_VERSION -Am|void *|CopyD|void* src|void* dest|int nitems|type -Am|void|Copy|void* src|void* dest|int nitems|type -Am|void|EXTEND|SP|int nitems -Am|void*|HeKEY|HE* he -Am|void *|MoveD|void* src|void* dest|int nitems|type -Am|void|Move|void* src|void* dest|int nitems|type -Am|void|mPUSHi|IV iv -Am|void|mPUSHn|NV nv -Am|void|mPUSHp|char* str|STRLEN len -Am|void|mPUSHs|SV* sv -Am|void|mPUSHu|UV uv -Am|void|mXPUSHi|IV iv -Am|void|mXPUSHn|NV nv -Am|void|mXPUSHp|char* str|STRLEN len -Am|void|mXPUSHs|SV* sv -Am|void|mXPUSHu|UV uv -Am|void|Newxc|void* ptr|int nitems|type|cast -Am|void|Newx|void* ptr|int nitems|type -Am|void|Newxz|void* ptr|int nitems|type -Am|void|PoisonFree|void* dest|int nitems|type -Am|void|PoisonNew|void* dest|int nitems|type -Am|void|Poison|void* dest|int nitems|type -Am|void|PoisonWith|void* dest|int nitems|type|U8 byte -Am|void|PUSHi|IV iv -Am|void|PUSHMARK|SP -Am|void|PUSHmortal -Am|void|PUSHn|NV nv -Am|void|PUSHp|char* str|STRLEN len -Am|void|PUSHs|SV* sv -Am|void|PUSHu|UV uv -Am|void|Renewc|void* ptr|int nitems|type|cast -Am|void|Renew|void* ptr|int nitems|type -Am|void|Safefree|void* ptr -Am|void|StructCopy|type src|type dest|type -Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len -Am|void|sv_catpvs|SV* sv|const char* s -Am|void|sv_catsv_nomg|SV* dsv|SV* ssv -Am|void|SvCUR_set|SV* sv|STRLEN len -Am|void|SvGETMAGIC|SV* sv -Am|void|SvIOK_off|SV* sv -Am|void|SvIOK_only|SV* sv -Am|void|SvIOK_only_UV|SV* sv -Am|void|SvIOK_on|SV* sv -Am|void|SvIV_set|SV* sv|IV val -Am|void|SvLEN_set|SV* sv|STRLEN len -Am|void|SvLOCK|SV* sv -Am|void|SvMAGIC_set|SV* sv|MAGIC* val -Am|void|SvNIOK_off|SV* sv -Am|void|SvNOK_off|SV* sv -Am|void|SvNOK_only|SV* sv -Am|void|SvNOK_on|SV* sv -Am|void|SvNV_set|SV* sv|NV val -Am|void|SvOOK_offset|NN SV*sv|STRLEN len -Am|void|SvPOK_off|SV* sv -Am|void|SvPOK_only|SV* sv -Am|void|SvPOK_only_UTF8|SV* sv -Am|void|SvPOK_on|SV* sv -Am|void|SvPV_set|SV* sv|char* val -Am|void|SvREFCNT_dec|SV* sv -Am|void|SvREFCNT_inc_simple_void_NN|SV* sv -Am|void|SvREFCNT_inc_simple_void|SV* sv -Am|void|SvREFCNT_inc_void_NN|SV* sv -Am|void|SvREFCNT_inc_void|SV* sv -Am|void|SvROK_off|SV* sv -Am|void|SvROK_on|SV* sv -Am|void|SvRV_set|SV* sv|SV* val -Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv -Am|void|SvSETMAGIC|SV* sv -Am|void|SvSetMagicSV|SV* dsb|SV* ssv -Am|void|sv_setpvs|SV* sv|const char* s -Am|void|sv_setsv_nomg|SV* dsv|SV* ssv -Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv -Am|void|SvSetSV|SV* dsb|SV* ssv -Am|void|SvSHARE|SV* sv -Am|void|SvSTASH_set|SV* sv|HV* val -Am|void|SvTAINTED_off|SV* sv -Am|void|SvTAINTED_on|SV* sv -Am|void|SvTAINT|SV* sv -Am|void|SvUNLOCK|SV* sv -Am|void|SvUPGRADE|SV* sv|svtype type -Am|void|SvUTF8_off|SV *sv -Am|void|SvUTF8_on|SV *sv -Am|void|SvUV_set|SV* sv|UV val -Am|void|XPUSHi|IV iv -Am|void|XPUSHmortal -Am|void|XPUSHn|NV nv -Am|void|XPUSHp|char* str|STRLEN len -Am|void|XPUSHs|SV* sv -Am|void|XPUSHu|UV uv -Am|void|XSRETURN|int nitems -Am|void|XSRETURN_IV|IV iv -Am|void|XSRETURN_NV|NV nv -Am|void|XSRETURN_PV|char* str -Am|void|XSRETURN_UV|IV uv -Am|void|XST_mIV|int pos|IV iv -Am|void|XST_mNO|int pos -Am|void|XST_mNV|int pos|NV nv -Am|void|XST_mPV|int pos|char* str -Am|void|XST_mUNDEF|int pos -Am|void|XST_mYES|int pos -Am|void *|ZeroD|void* dest|int nitems|type -Am|void|Zero|void* dest|int nitems|type -m|AV *|CvPADLIST|CV *cv -m|bool|CvWEAKOUTSIDE|CV *cv -m|char *|PAD_COMPNAME_PV|PADOFFSET po -m|HV *|PAD_COMPNAME_OURSTASH|PADOFFSET po -m|HV *|PAD_COMPNAME_TYPE|PADOFFSET po -mn|bool|PL_dowarn -mn|GV *|PL_DBsub -mn|GV*|PL_last_in_gv -mn|SV *|PL_DBsingle -mn|SV *|PL_DBtrace -mn|SV*|PL_ofs_sv -mn|SV*|PL_rs -ms||djSP -m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po -m|STRLEN|PAD_COMPNAME_GEN_set|PADOFFSET po|int gen -m|SV *|CX_CURPAD_SV|struct context|PADOFFSET po -m|SV *|PAD_BASE_SV |PADLIST padlist|PADOFFSET po -m|SV *|PAD_SETSV |PADOFFSET po|SV* sv -m|SV *|PAD_SVl |PADOFFSET po -m|U32|PAD_COMPNAME_FLAGS|PADOFFSET po -mU||LVRET -m|void|CX_CURPAD_SAVE|struct context -m|void|PAD_CLONE_VARS|PerlInterpreter *proto_perl|CLONE_PARAMS* param -m|void|PAD_DUP|PADLIST dstpad|PADLIST srcpad|CLONE_PARAMS* param -m|void|PAD_RESTORE_LOCAL|PAD *opad -m|void|PAD_SAVE_LOCAL|PAD *opad|PAD *npad -m|void|PAD_SAVE_SETNULLPAD -m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n -m|void|PAD_SET_CUR |PADLIST padlist|I32 n -m|void|PAD_SV |PADOFFSET po -m|void|SAVECLEARSV |SV **svp -m|void|SAVECOMPPAD -m|void|SAVEPADSV |PADOFFSET po diff --git a/ext/Devel/PPPort/parts/base/5004000 b/ext/Devel/PPPort/parts/base/5004000 deleted file mode 100644 index a196371bfe..0000000000 --- a/ext/Devel/PPPort/parts/base/5004000 +++ /dev/null @@ -1,88 +0,0 @@ -5.004000 -GIMME_V # E -G_VOID # E -HEf_SVKEY # E -HeHASH # U -HeKEY # U -HeKLEN # U -HePV # U -HeSVKEY # U -HeSVKEY_force # U -HeSVKEY_set # U -HeVAL # U -PUSHu # U -SvSetMagicSV # U -SvSetMagicSV_nosteal # U -SvSetSV_nosteal # U -SvTAINTED # U -SvTAINTED_off # U -SvTAINTED_on # U -SvUV # U -SvUVX # U -SvUVx # U -XPUSHu # U -block_gimme # E -call_list # E -cv_const_sv # E -delimcpy # E -do_open # E (Perl_do_open) -gv_autoload4 # E -gv_efullname3 # U -gv_fetchmethod_autoload # E -gv_fullname3 # U -gv_stashpvn # E -hv_delayfree_ent # E -hv_delete_ent # U -hv_exists_ent # U -hv_fetch_ent # U -hv_free_ent # E -hv_iterkeysv # E -hv_ksplit # E -hv_store_ent # U -ibcmp_locale # E -my_failure_exit # E -my_memcmp # U -my_pclose # E (Perl_my_pclose) -my_popen # E (Perl_my_popen) -newRV_inc # U -newRV_noinc # E -rsignal # E -rsignal_state # E -save_I16 # E -save_gp # E -share_hek # E -start_subparse # E (Perl_start_subparse) -sv_2uv # U -sv_cmp_locale # E -sv_derived_from # E -sv_gets # E (Perl_sv_gets) -sv_setuv # E -sv_taint # U -sv_tainted # E -sv_untaint # E -sv_vcatpvfn # E -sv_vsetpvfn # E -unsharepvn # E -PERL_HASH # added by devel/scanprov -PERL_INT_MAX # added by devel/scanprov -PERL_INT_MIN # added by devel/scanprov -PERL_LONG_MAX # added by devel/scanprov -PERL_LONG_MIN # added by devel/scanprov -PERL_QUAD_MAX # added by devel/scanprov -PERL_QUAD_MIN # added by devel/scanprov -PERL_SHORT_MAX # added by devel/scanprov -PERL_SHORT_MIN # added by devel/scanprov -PERL_UCHAR_MAX # added by devel/scanprov -PERL_UCHAR_MIN # added by devel/scanprov -PERL_UINT_MAX # added by devel/scanprov -PERL_UINT_MIN # added by devel/scanprov -PERL_ULONG_MAX # added by devel/scanprov -PERL_ULONG_MIN # added by devel/scanprov -PERL_UQUAD_MAX # added by devel/scanprov -PERL_UQUAD_MIN # added by devel/scanprov -PERL_USHORT_MAX # added by devel/scanprov -PERL_USHORT_MIN # added by devel/scanprov -SvUVXx # added by devel/scanprov -boolSV # added by devel/scanprov -memEQ # added by devel/scanprov -memNE # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5004010 b/ext/Devel/PPPort/parts/base/5004010 deleted file mode 100644 index 8c29866603..0000000000 --- a/ext/Devel/PPPort/parts/base/5004010 +++ /dev/null @@ -1 +0,0 @@ -5.004010 diff --git a/ext/Devel/PPPort/parts/base/5004020 b/ext/Devel/PPPort/parts/base/5004020 deleted file mode 100644 index 4b43fdf8e4..0000000000 --- a/ext/Devel/PPPort/parts/base/5004020 +++ /dev/null @@ -1 +0,0 @@ -5.004020 diff --git a/ext/Devel/PPPort/parts/base/5004030 b/ext/Devel/PPPort/parts/base/5004030 deleted file mode 100644 index e45facbb1f..0000000000 --- a/ext/Devel/PPPort/parts/base/5004030 +++ /dev/null @@ -1 +0,0 @@ -5.004030 diff --git a/ext/Devel/PPPort/parts/base/5004040 b/ext/Devel/PPPort/parts/base/5004040 deleted file mode 100644 index 69ccd5d62c..0000000000 --- a/ext/Devel/PPPort/parts/base/5004040 +++ /dev/null @@ -1 +0,0 @@ -5.004040 diff --git a/ext/Devel/PPPort/parts/base/5004050 b/ext/Devel/PPPort/parts/base/5004050 deleted file mode 100644 index 992642b633..0000000000 --- a/ext/Devel/PPPort/parts/base/5004050 +++ /dev/null @@ -1,43 +0,0 @@ -5.004050 -PL_na # E -PL_sv_no # E -PL_sv_undef # E -PL_sv_yes # E -SvGETMAGIC # U -do_binmode # E -newCONSTSUB # E -newSVpvn # E -save_aelem # E -save_helem # E -sv_catpv_mg # E -sv_catpvn_mg # U -sv_catsv_mg # U -sv_setiv_mg # E -sv_setpv_mg # E -sv_setpvn_mg # E -sv_setsv_mg # E -sv_setuv_mg # E -sv_usepvn_mg # U -AvFILLp # added by devel/scanprov -DEFSV # added by devel/scanprov -ERRSV # added by devel/scanprov -PL_compiling # added by devel/scanprov -PL_curcop # added by devel/scanprov -PL_curstash # added by devel/scanprov -PL_debstash # added by devel/scanprov -PL_defgv # added by devel/scanprov -PL_diehook # added by devel/scanprov -PL_dirty # added by devel/scanprov -PL_errgv # added by devel/scanprov -PL_perl_destruct_level # added by devel/scanprov -PL_perldb # added by devel/scanprov -PL_rsfp # added by devel/scanprov -PL_rsfp_filters # added by devel/scanprov -PL_stack_base # added by devel/scanprov -PL_stack_sp # added by devel/scanprov -PL_stdingv # added by devel/scanprov -PL_sv_arenaroot # added by devel/scanprov -PL_tainted # added by devel/scanprov -PL_tainting # added by devel/scanprov -SAVE_DEFSV # added by devel/scanprov -dTHR # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5005000 b/ext/Devel/PPPort/parts/base/5005000 deleted file mode 100644 index 3c96370a4c..0000000000 --- a/ext/Devel/PPPort/parts/base/5005000 +++ /dev/null @@ -1,36 +0,0 @@ -5.005000 -PL_modglobal # E -cx_dump # U -debop # U -debprofdump # U -fbm_compile # E (Perl_fbm_compile) -fbm_instr # E (Perl_fbm_instr) -get_op_descs # E -get_op_names # E -init_stacks # E -mg_length # E -mg_size # E -newHVhv # E -new_stackinfo # E -regdump # U -regexec_flags # E -regnext # E (Perl_regnext) -runops_debug # E -runops_standard # E -save_iv # E (save_iv) -screaminstr # E (Perl_screaminstr) -sv_iv # E -sv_peek # U -sv_pvn # E -sv_true # E -sv_uv # E -END_EXTERN_C # added by devel/scanprov -EXTERN_C # added by devel/scanprov -NOOP # added by devel/scanprov -PL_DBsignal # added by devel/scanprov -PL_Sv # added by devel/scanprov -PL_hexdigit # added by devel/scanprov -PL_hints # added by devel/scanprov -PL_laststatval # added by devel/scanprov -PL_statcache # added by devel/scanprov -START_EXTERN_C # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5005010 b/ext/Devel/PPPort/parts/base/5005010 deleted file mode 100644 index deebff5bf8..0000000000 --- a/ext/Devel/PPPort/parts/base/5005010 +++ /dev/null @@ -1 +0,0 @@ -5.005010 diff --git a/ext/Devel/PPPort/parts/base/5005020 b/ext/Devel/PPPort/parts/base/5005020 deleted file mode 100644 index d19ff2ae09..0000000000 --- a/ext/Devel/PPPort/parts/base/5005020 +++ /dev/null @@ -1 +0,0 @@ -5.005020 diff --git a/ext/Devel/PPPort/parts/base/5005030 b/ext/Devel/PPPort/parts/base/5005030 deleted file mode 100644 index f268c751da..0000000000 --- a/ext/Devel/PPPort/parts/base/5005030 +++ /dev/null @@ -1,4 +0,0 @@ -5.005030 -POPpx # E -get_vtbl # E -save_generic_svref # E diff --git a/ext/Devel/PPPort/parts/base/5005040 b/ext/Devel/PPPort/parts/base/5005040 deleted file mode 100644 index 8a165c2033..0000000000 --- a/ext/Devel/PPPort/parts/base/5005040 +++ /dev/null @@ -1 +0,0 @@ -5.005040 diff --git a/ext/Devel/PPPort/parts/base/5006000 b/ext/Devel/PPPort/parts/base/5006000 deleted file mode 100644 index b2a93bf246..0000000000 --- a/ext/Devel/PPPort/parts/base/5006000 +++ /dev/null @@ -1,288 +0,0 @@ -5.006000 -POPn # E -PUSHn # E -SvIOK_UV # U -SvIOK_notUV # U -SvIOK_only_UV # U -SvNV # E -SvNVX # E -SvNV_set # E -SvNVx # E -SvPOK_only_UTF8 # U -SvPV_nolen # U -SvPVbyte # U -SvPVbyte_nolen # U -SvPVbytex # U -SvPVbytex_force # U -SvPVutf8 # U -SvPVutf8_force # U -SvPVutf8_nolen # U -SvPVutf8x # U -SvPVutf8x_force # U -SvUTF8 # U -SvUTF8_off # U -SvUTF8_on # U -XPUSHn # E -XSRETURN_NV # E -XST_mNV # E -av_delete # E -av_exists # E -call_argv # E (perl_call_argv) -call_atexit # E -call_method # E (perl_call_method) -call_pv # E (perl_call_pv) -call_sv # E (perl_call_sv) -cast_i32 # E (cast_i32) -cast_iv # E (cast_iv) -cast_ulong # E -cast_uv # E (cast_uv) -croak # E (Perl_croak) -die # E (Perl_die) -do_gv_dump # E -do_gvgv_dump # E -do_hv_dump # E -do_magic_dump # E -do_op_dump # E -do_open9 # E -do_pmop_dump # E -do_sv_dump # E -dump_all # U -dump_eval # U -dump_form # U -dump_indent # E -dump_packsubs # U -dump_sub # U -dump_vindent # E -eval_pv # E (perl_eval_pv) -eval_sv # E (perl_eval_sv) -form # E (Perl_form) -get_av # E (perl_get_av) -get_context # U -get_cv # E (perl_get_cv) -get_hv # E (perl_get_hv) -get_ppaddr # E -get_sv # E (perl_get_sv) -gv_dump # E -init_i18nl10n # E (perl_init_i18nl10n) -init_i18nl14n # E (perl_init_i18nl14n) -is_uni_alnum # E -is_uni_alnum_lc # E -is_uni_alnumc # E -is_uni_alnumc_lc # E -is_uni_alpha # E -is_uni_alpha_lc # E -is_uni_ascii # E -is_uni_ascii_lc # E -is_uni_cntrl # E -is_uni_cntrl_lc # E -is_uni_digit # E -is_uni_digit_lc # E -is_uni_graph # E -is_uni_graph_lc # E -is_uni_idfirst # E -is_uni_idfirst_lc # E -is_uni_lower # E -is_uni_lower_lc # E -is_uni_print # E -is_uni_print_lc # E -is_uni_punct # E -is_uni_punct_lc # E -is_uni_space # E -is_uni_space_lc # E -is_uni_upper # E -is_uni_upper_lc # E -is_uni_xdigit # E -is_uni_xdigit_lc # E -is_utf8_alnum # E -is_utf8_alnumc # E -is_utf8_alpha # E -is_utf8_ascii # E -is_utf8_char # E -is_utf8_cntrl # E -is_utf8_digit # E -is_utf8_graph # E -is_utf8_idfirst # E -is_utf8_lower # E -is_utf8_mark # E -is_utf8_print # E -is_utf8_punct # E -is_utf8_space # E -is_utf8_upper # E -is_utf8_xdigit # E -load_module # E -magic_dump # E -mess # E (Perl_mess) -my_atof # E -my_fflush_all # E -newANONATTRSUB # E -newATTRSUB # E -newSVnv # E (Perl_newSVnv) -newSVpvf # E (Perl_newSVpvf) -newSVuv # E -newXS # E (Perl_newXS) -newXSproto # E -new_collate # E (perl_new_collate) -new_ctype # E (perl_new_ctype) -new_numeric # E (perl_new_numeric) -op_dump # E -perl_parse # E (perl_parse) -pmop_dump # E -pv_display # E -re_intuit_string # E -reginitcolors # E -require_pv # E (perl_require_pv) -safesyscalloc # U -safesysfree # U -safesysmalloc # U -safesysrealloc # U -save_I8 # E -save_alloc # E -save_destructor # E (Perl_save_destructor) -save_destructor_x # E -save_re_context # E -save_vptr # E -scan_bin # E -scan_hex # E (Perl_scan_hex) -scan_oct # E (Perl_scan_oct) -set_context # U -set_numeric_local # E (perl_set_numeric_local) -set_numeric_radix # E -set_numeric_standard # E (perl_set_numeric_standard) -str_to_version # E -sv_2nv # E (Perl_sv_2nv) -sv_2pv_nolen # U -sv_2pvbyte # E -sv_2pvbyte_nolen # U -sv_2pvutf8 # E -sv_2pvutf8_nolen # U -sv_catpvf # E (Perl_sv_catpvf) -sv_catpvf_mg # E (Perl_sv_catpvf_mg) -sv_force_normal # U -sv_len_utf8 # E -sv_nv # E (Perl_sv_nv) -sv_pos_b2u # E -sv_pos_u2b # E -sv_pv # U -sv_pvbyte # U -sv_pvbyten # E -sv_pvbyten_force # E -sv_pvutf8 # U -sv_pvutf8n # E -sv_pvutf8n_force # E -sv_rvweaken # E -sv_setnv # E (Perl_sv_setnv) -sv_setnv_mg # E (Perl_sv_setnv_mg) -sv_setpvf # E (Perl_sv_setpvf) -sv_setpvf_mg # E (Perl_sv_setpvf_mg) -sv_setref_nv # E (Perl_sv_setref_nv) -sv_utf8_decode # E -sv_utf8_downgrade # E -sv_utf8_encode # E -sv_vcatpvf # E -sv_vcatpvf_mg # E -sv_vsetpvf # E -sv_vsetpvf_mg # E -swash_init # E -tmps_grow # E -to_uni_lower_lc # E -to_uni_title_lc # E -to_uni_upper_lc # E -utf8_distance # E -utf8_hop # E -vcroak # E -vform # E -vload_module # E -vmess # E -vnewSVpvf # E -vwarn # E -vwarner # E -warn # E (Perl_warn) -warner # E -CopFILE # added by devel/scanprov -CopFILEAV # added by devel/scanprov -CopFILEGV # added by devel/scanprov -CopFILEGV_set # added by devel/scanprov -CopFILESV # added by devel/scanprov -CopFILE_set # added by devel/scanprov -CopSTASH # added by devel/scanprov -CopSTASHPV # added by devel/scanprov -CopSTASHPV_set # added by devel/scanprov -CopSTASH_eq # added by devel/scanprov -CopSTASH_set # added by devel/scanprov -INT2PTR # added by devel/scanprov -IVSIZE # added by devel/scanprov -IVTYPE # added by devel/scanprov -IVdf # added by devel/scanprov -NUM2PTR # added by devel/scanprov -NVTYPE # added by devel/scanprov -PERL_REVISION # added by devel/scanprov -PERL_SUBVERSION # added by devel/scanprov -PERL_VERSION # added by devel/scanprov -PL_no_modify # added by devel/scanprov -PL_ppaddr # added by devel/scanprov -PTR2IV # added by devel/scanprov -PTR2NV # added by devel/scanprov -PTR2UV # added by devel/scanprov -PTRV # added by devel/scanprov -SVf # added by devel/scanprov -SVf_UTF8 # added by devel/scanprov -UVSIZE # added by devel/scanprov -UVTYPE # added by devel/scanprov -UVof # added by devel/scanprov -UVuf # added by devel/scanprov -UVxf # added by devel/scanprov -WARN_ALL # added by devel/scanprov -WARN_AMBIGUOUS # added by devel/scanprov -WARN_BAREWORD # added by devel/scanprov -WARN_CLOSED # added by devel/scanprov -WARN_CLOSURE # added by devel/scanprov -WARN_DEBUGGING # added by devel/scanprov -WARN_DEPRECATED # added by devel/scanprov -WARN_DIGIT # added by devel/scanprov -WARN_EXEC # added by devel/scanprov -WARN_EXITING # added by devel/scanprov -WARN_GLOB # added by devel/scanprov -WARN_INPLACE # added by devel/scanprov -WARN_INTERNAL # added by devel/scanprov -WARN_IO # added by devel/scanprov -WARN_MALLOC # added by devel/scanprov -WARN_MISC # added by devel/scanprov -WARN_NEWLINE # added by devel/scanprov -WARN_NUMERIC # added by devel/scanprov -WARN_ONCE # added by devel/scanprov -WARN_OVERFLOW # added by devel/scanprov -WARN_PACK # added by devel/scanprov -WARN_PARENTHESIS # added by devel/scanprov -WARN_PIPE # added by devel/scanprov -WARN_PORTABLE # added by devel/scanprov -WARN_PRECEDENCE # added by devel/scanprov -WARN_PRINTF # added by devel/scanprov -WARN_PROTOTYPE # added by devel/scanprov -WARN_QW # added by devel/scanprov -WARN_RECURSION # added by devel/scanprov -WARN_REDEFINE # added by devel/scanprov -WARN_REGEXP # added by devel/scanprov -WARN_RESERVED # added by devel/scanprov -WARN_SEMICOLON # added by devel/scanprov -WARN_SEVERE # added by devel/scanprov -WARN_SIGNAL # added by devel/scanprov -WARN_SUBSTR # added by devel/scanprov -WARN_SYNTAX # added by devel/scanprov -WARN_TAINT # added by devel/scanprov -WARN_UNINITIALIZED # added by devel/scanprov -WARN_UNOPENED # added by devel/scanprov -WARN_UNPACK # added by devel/scanprov -WARN_UNTIE # added by devel/scanprov -WARN_UTF8 # added by devel/scanprov -WARN_VOID # added by devel/scanprov -XSprePUSH # added by devel/scanprov -aTHX # added by devel/scanprov -aTHX_ # added by devel/scanprov -ckWARN # added by devel/scanprov -dNOOP # added by devel/scanprov -dTHX # added by devel/scanprov -dTHXa # added by devel/scanprov -dTHXoa # added by devel/scanprov -dXSTARG # added by devel/scanprov -pTHX # added by devel/scanprov -pTHX_ # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5006001 b/ext/Devel/PPPort/parts/base/5006001 deleted file mode 100644 index a6369d517e..0000000000 --- a/ext/Devel/PPPort/parts/base/5006001 +++ /dev/null @@ -1,14 +0,0 @@ -5.006001 -SvGAMAGIC # U -apply_attrs_string # U -bytes_to_utf8 # U -gv_efullname4 # U -gv_fullname4 # U -is_utf8_string # U -save_generic_pvref # U -utf16_to_utf8 # E (Perl_utf16_to_utf8) -utf16_to_utf8_reversed # E (Perl_utf16_to_utf8_reversed) -utf8_to_bytes # U -NVef # added by devel/scanprov -NVff # added by devel/scanprov -NVgf # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5006002 b/ext/Devel/PPPort/parts/base/5006002 deleted file mode 100644 index dfe09ce2c5..0000000000 --- a/ext/Devel/PPPort/parts/base/5006002 +++ /dev/null @@ -1 +0,0 @@ -5.006002 diff --git a/ext/Devel/PPPort/parts/base/5007000 b/ext/Devel/PPPort/parts/base/5007000 deleted file mode 100644 index 49d08465db..0000000000 --- a/ext/Devel/PPPort/parts/base/5007000 +++ /dev/null @@ -1 +0,0 @@ -5.007000 diff --git a/ext/Devel/PPPort/parts/base/5007001 b/ext/Devel/PPPort/parts/base/5007001 deleted file mode 100644 index 19ae691d12..0000000000 --- a/ext/Devel/PPPort/parts/base/5007001 +++ /dev/null @@ -1,24 +0,0 @@ -5.007001 -POPpbytex # E -SvUOK # U -bytes_from_utf8 # U -despatch_signals # U -do_openn # U -gv_handler # U -is_lvalue_sub # U -my_popen_list # U -newSVpvn_share # U -save_mortalizesv # U -scan_num # E (Perl_scan_num) -sv_force_normal_flags # U -sv_setref_uv # U -sv_unref_flags # U -sv_utf8_upgrade # E (Perl_sv_utf8_upgrade) -utf8_length # U -utf8_to_uvchr # U -utf8_to_uvuni # U -utf8n_to_uvuni # U -uvuni_to_utf8 # U -PTR2ul # added by devel/scanprov -SV_IMMEDIATE_UNREF # added by devel/scanprov -UVXf # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5007002 b/ext/Devel/PPPort/parts/base/5007002 deleted file mode 100644 index 9d31a24f09..0000000000 --- a/ext/Devel/PPPort/parts/base/5007002 +++ /dev/null @@ -1,73 +0,0 @@ -5.007002 -SvPV_force_nomg # U -SvPV_nomg # U -calloc # U -dAX # E -dITEMS # E -getcwd_sv # U -grok_number # U -grok_numeric_radix # U -init_tm # U -malloc # U -mfree # U -mini_mktime # U -my_atof2 # U -my_strftime # U -op_null # U -realloc # U -sv_2pv_flags # U -sv_catpvn_flags # U -sv_catpvn_nomg # U -sv_catsv_flags # U -sv_catsv_nomg # U -sv_pvn_force_flags # U -sv_setsv_flags # U -sv_setsv_nomg # U -sv_utf8_upgrade_flags # U -swash_fetch # E (Perl_swash_fetch) -GROK_NUMERIC_RADIX # added by devel/scanprov -IN_LOCALE # added by devel/scanprov -IN_LOCALE_COMPILETIME # added by devel/scanprov -IN_LOCALE_RUNTIME # added by devel/scanprov -IS_NUMBER_GREATER_THAN_UV_MAX # added by devel/scanprov -IS_NUMBER_INFINITY # added by devel/scanprov -IS_NUMBER_IN_UV # added by devel/scanprov -IS_NUMBER_NEG # added by devel/scanprov -IS_NUMBER_NOT_INT # added by devel/scanprov -PERL_MAGIC_arylen # added by devel/scanprov -PERL_MAGIC_backref # added by devel/scanprov -PERL_MAGIC_bm # added by devel/scanprov -PERL_MAGIC_collxfrm # added by devel/scanprov -PERL_MAGIC_dbfile # added by devel/scanprov -PERL_MAGIC_dbline # added by devel/scanprov -PERL_MAGIC_defelem # added by devel/scanprov -PERL_MAGIC_env # added by devel/scanprov -PERL_MAGIC_envelem # added by devel/scanprov -PERL_MAGIC_ext # added by devel/scanprov -PERL_MAGIC_fm # added by devel/scanprov -PERL_MAGIC_isa # added by devel/scanprov -PERL_MAGIC_isaelem # added by devel/scanprov -PERL_MAGIC_nkeys # added by devel/scanprov -PERL_MAGIC_overload # added by devel/scanprov -PERL_MAGIC_overload_elem # added by devel/scanprov -PERL_MAGIC_overload_table # added by devel/scanprov -PERL_MAGIC_pos # added by devel/scanprov -PERL_MAGIC_qr # added by devel/scanprov -PERL_MAGIC_regdata # added by devel/scanprov -PERL_MAGIC_regdatum # added by devel/scanprov -PERL_MAGIC_regex_global # added by devel/scanprov -PERL_MAGIC_sig # added by devel/scanprov -PERL_MAGIC_sigelem # added by devel/scanprov -PERL_MAGIC_substr # added by devel/scanprov -PERL_MAGIC_sv # added by devel/scanprov -PERL_MAGIC_taint # added by devel/scanprov -PERL_MAGIC_tied # added by devel/scanprov -PERL_MAGIC_tiedelem # added by devel/scanprov -PERL_MAGIC_tiedscalar # added by devel/scanprov -PERL_MAGIC_uvar # added by devel/scanprov -PERL_MAGIC_vec # added by devel/scanprov -PERL_UNUSED_DECL # added by devel/scanprov -PERL_UNUSED_VAR # added by devel/scanprov -SV_GMAGIC # added by devel/scanprov -SvPV_flags # added by devel/scanprov -SvPV_force_flags # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5007003 b/ext/Devel/PPPort/parts/base/5007003 deleted file mode 100644 index 325f06ad93..0000000000 --- a/ext/Devel/PPPort/parts/base/5007003 +++ /dev/null @@ -1,85 +0,0 @@ -5.007003 -PerlIO_clearerr # U (PerlIO_clearerr) -PerlIO_close # U (PerlIO_close) -PerlIO_eof # U (PerlIO_eof) -PerlIO_error # U (PerlIO_error) -PerlIO_fileno # U (PerlIO_fileno) -PerlIO_fill # U (PerlIO_fill) -PerlIO_flush # U (PerlIO_flush) -PerlIO_get_base # U (PerlIO_get_base) -PerlIO_get_bufsiz # U (PerlIO_get_bufsiz) -PerlIO_get_cnt # U (PerlIO_get_cnt) -PerlIO_get_ptr # U (PerlIO_get_ptr) -PerlIO_read # U (PerlIO_read) -PerlIO_seek # U (PerlIO_seek) -PerlIO_set_cnt # U (PerlIO_set_cnt) -PerlIO_set_ptrcnt # U (PerlIO_set_ptrcnt) -PerlIO_setlinebuf # U (PerlIO_setlinebuf) -PerlIO_stderr # U (PerlIO_stderr) -PerlIO_stdin # U (PerlIO_stdin) -PerlIO_stdout # U (PerlIO_stdout) -PerlIO_tell # U (PerlIO_tell) -PerlIO_unread # U (PerlIO_unread) -PerlIO_write # U (PerlIO_write) -SvLOCK # U -SvSHARE # U -SvUNLOCK # U -atfork_lock # U -atfork_unlock # U -custom_op_desc # U -custom_op_name # U -deb # U -debstack # U -debstackptrs # U -grok_bin # U -grok_hex # U -grok_oct # U -gv_fetchmeth_autoload # U -ibcmp_utf8 # U -my_fork # U -my_socketpair # U -pack_cat # U -perl_destruct # E (perl_destruct) -pv_uni_display # U -save_shared_pvref # U -savesharedpv # U -sortsv # U -sv_copypv # U -sv_magicext # U -sv_nolocking # U -sv_nosharing # U -sv_pvn_nomg # U -sv_recode_to_utf8 # U -sv_uni_display # U -to_uni_fold # U -to_uni_lower # E (Perl_to_uni_lower) -to_uni_title # E (Perl_to_uni_title) -to_uni_upper # E (Perl_to_uni_upper) -to_utf8_case # U -to_utf8_fold # U -to_utf8_lower # E (Perl_to_utf8_lower) -to_utf8_title # E (Perl_to_utf8_title) -to_utf8_upper # E (Perl_to_utf8_upper) -unpack_str # U -uvchr_to_utf8_flags # U -uvuni_to_utf8_flags # U -vdeb # U -IS_NUMBER_NAN # added by devel/scanprov -MY_CXT # added by devel/scanprov -MY_CXT_INIT # added by devel/scanprov -PERL_MAGIC_shared # added by devel/scanprov -PERL_MAGIC_shared_scalar # added by devel/scanprov -PERL_MAGIC_uvar_elem # added by devel/scanprov -PERL_SCAN_ALLOW_UNDERSCORES # added by devel/scanprov -PERL_SCAN_DISALLOW_PREFIX # added by devel/scanprov -PERL_SCAN_GREATER_THAN_UV_MAX # added by devel/scanprov -START_MY_CXT # added by devel/scanprov -_aMY_CXT # added by devel/scanprov -_pMY_CXT # added by devel/scanprov -aMY_CXT # added by devel/scanprov -aMY_CXT_ # added by devel/scanprov -dMY_CXT # added by devel/scanprov -dMY_CXT_SV # added by devel/scanprov -pMY_CXT # added by devel/scanprov -pMY_CXT_ # added by devel/scanprov -packWARN # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5008000 b/ext/Devel/PPPort/parts/base/5008000 deleted file mode 100644 index 8af2dfae4d..0000000000 --- a/ext/Devel/PPPort/parts/base/5008000 +++ /dev/null @@ -1,8 +0,0 @@ -5.008000 -Poison # E -hv_iternext_flags # U -hv_store_flags # U -is_utf8_idcont # U -nothreadhook # U -WARN_LAYER # added by devel/scanprov -WARN_THREADS # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5008001 b/ext/Devel/PPPort/parts/base/5008001 deleted file mode 100644 index a389fd85da..0000000000 --- a/ext/Devel/PPPort/parts/base/5008001 +++ /dev/null @@ -1,26 +0,0 @@ -5.008001 -SvVOK # U -XSRETURN_UV # U -doing_taint # U -find_runcv # U -is_utf8_string_loc # U -packlist # U -save_bool # U -savestack_grow_cnt # U -seed # U -sv_cat_decode # U -sv_compile_2op # E (Perl_sv_compile_2op) -sv_setpviv # U -sv_setpviv_mg # U -unpackstring # U -IN_PERL_COMPILETIME # added by devel/scanprov -PERL_ABS # added by devel/scanprov -PERL_GCC_BRACE_GROUPS_FORBIDDEN # added by devel/scanprov -PERL_MAGIC_utf8 # added by devel/scanprov -PERL_MAGIC_vstring # added by devel/scanprov -PERL_SCAN_SILENT_ILLDIGIT # added by devel/scanprov -PERL_SIGNALS_UNSAFE_FLAG # added by devel/scanprov -PL_signals # added by devel/scanprov -SV_COW_DROP_PV # added by devel/scanprov -SV_UTF8_NO_ENCODING # added by devel/scanprov -XST_mUV # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5008002 b/ext/Devel/PPPort/parts/base/5008002 deleted file mode 100644 index 63aac525fe..0000000000 --- a/ext/Devel/PPPort/parts/base/5008002 +++ /dev/null @@ -1 +0,0 @@ -5.008002 diff --git a/ext/Devel/PPPort/parts/base/5008003 b/ext/Devel/PPPort/parts/base/5008003 deleted file mode 100644 index 50c6ce1aa1..0000000000 --- a/ext/Devel/PPPort/parts/base/5008003 +++ /dev/null @@ -1,3 +0,0 @@ -5.008003 -SvIsCOW # U -SvIsCOW_shared_hash # U diff --git a/ext/Devel/PPPort/parts/base/5008004 b/ext/Devel/PPPort/parts/base/5008004 deleted file mode 100644 index bb7bcdf66a..0000000000 --- a/ext/Devel/PPPort/parts/base/5008004 +++ /dev/null @@ -1 +0,0 @@ -5.008004 diff --git a/ext/Devel/PPPort/parts/base/5008005 b/ext/Devel/PPPort/parts/base/5008005 deleted file mode 100644 index 7bd2029f4b..0000000000 --- a/ext/Devel/PPPort/parts/base/5008005 +++ /dev/null @@ -1 +0,0 @@ -5.008005 diff --git a/ext/Devel/PPPort/parts/base/5008006 b/ext/Devel/PPPort/parts/base/5008006 deleted file mode 100644 index ba5cad07ed..0000000000 --- a/ext/Devel/PPPort/parts/base/5008006 +++ /dev/null @@ -1 +0,0 @@ -5.008006 diff --git a/ext/Devel/PPPort/parts/base/5008007 b/ext/Devel/PPPort/parts/base/5008007 deleted file mode 100644 index 7d656f0b9e..0000000000 --- a/ext/Devel/PPPort/parts/base/5008007 +++ /dev/null @@ -1 +0,0 @@ -5.008007 diff --git a/ext/Devel/PPPort/parts/base/5008008 b/ext/Devel/PPPort/parts/base/5008008 deleted file mode 100644 index f17b19ff4b..0000000000 --- a/ext/Devel/PPPort/parts/base/5008008 +++ /dev/null @@ -1 +0,0 @@ -5.008008 diff --git a/ext/Devel/PPPort/parts/base/5009000 b/ext/Devel/PPPort/parts/base/5009000 deleted file mode 100644 index 28bc85958e..0000000000 --- a/ext/Devel/PPPort/parts/base/5009000 +++ /dev/null @@ -1,6 +0,0 @@ -5.009000 -new_version # U -save_set_svflags # U -vcmp # U -vnumify # U -vstringify # U diff --git a/ext/Devel/PPPort/parts/base/5009001 b/ext/Devel/PPPort/parts/base/5009001 deleted file mode 100644 index 0666184e1d..0000000000 --- a/ext/Devel/PPPort/parts/base/5009001 +++ /dev/null @@ -1,8 +0,0 @@ -5.009001 -SvIV_nomg # U -SvUV_nomg # U -hv_clear_placeholders # U -hv_scalar # U -scan_version # E (Perl_scan_version) -sv_2iv_flags # U -sv_2uv_flags # U diff --git a/ext/Devel/PPPort/parts/base/5009002 b/ext/Devel/PPPort/parts/base/5009002 deleted file mode 100644 index 65d7de9072..0000000000 --- a/ext/Devel/PPPort/parts/base/5009002 +++ /dev/null @@ -1,32 +0,0 @@ -5.009002 -CopyD # E -MoveD # E -PUSHmortal # E -SvPVbyte_force # U -UNDERBAR # E -XCPT_CATCH # E -XCPT_RETHROW # E -XCPT_TRY_END # E -XCPT_TRY_START # E -XPUSHmortal # E -ZeroD # E -dUNDERBAR # E -dXCPT # E -find_rundefsvoffset # U -gv_fetchpvn_flags # U -gv_fetchsv # U -mPUSHi # U -mPUSHn # U -mPUSHp # U -mPUSHu # U -mXPUSHi # U -mXPUSHn # U -mXPUSHp # U -mXPUSHu # U -op_refcnt_lock # U -op_refcnt_unlock # U -savesvpv # U -vnormal # U -MY_CXT_CLONE # added by devel/scanprov -SV_NOSTEAL # added by devel/scanprov -UTF8_MAXBYTES # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5009003 b/ext/Devel/PPPort/parts/base/5009003 deleted file mode 100644 index bbf2a61bf6..0000000000 --- a/ext/Devel/PPPort/parts/base/5009003 +++ /dev/null @@ -1,62 +0,0 @@ -5.009003 -Newx # E -Newxc # E -Newxz # E -SvMAGIC_set # U -SvRV_set # U -SvSTASH_set # U -SvUV_set # U -av_arylen_p # U -ckwarn # U -ckwarn_d # U -csighandler # E (Perl_csighandler) -dAXMARK # E -dMULTICALL # E -doref # U -gv_const_sv # U -gv_stashpvs # U -hv_eiter_p # U -hv_eiter_set # U -hv_fetchs # U -hv_name_set # U -hv_placeholders_get # U -hv_placeholders_p # U -hv_placeholders_set # U -hv_riter_p # U -hv_riter_set # U -is_utf8_string_loclen # U -my_sprintf # U -newGIVENOP # U -newSVhek # U -newSVpvs # U -newSVpvs_share # U -newWHENOP # U -newWHILEOP # E (Perl_newWHILEOP) -savepvs # U -sortsv_flags # U -sv_catpvs # U -vverify # U -PERLIO_FUNCS_CAST # added by devel/scanprov -PERLIO_FUNCS_DECL # added by devel/scanprov -PERL_UNUSED_ARG # added by devel/scanprov -STR_WITH_LEN # added by devel/scanprov -SV_CONST_RETURN # added by devel/scanprov -SV_MUTABLE_RETURN # added by devel/scanprov -SV_SMAGIC # added by devel/scanprov -SvPVX_const # added by devel/scanprov -SvPVX_mutable # added by devel/scanprov -SvPV_const # added by devel/scanprov -SvPV_flags_const # added by devel/scanprov -SvPV_flags_const_nolen # added by devel/scanprov -SvPV_flags_mutable # added by devel/scanprov -SvPV_force_flags_mutable # added by devel/scanprov -SvPV_force_flags_nolen # added by devel/scanprov -SvPV_force_mutable # added by devel/scanprov -SvPV_force_nolen # added by devel/scanprov -SvPV_force_nomg_nolen # added by devel/scanprov -SvPV_mutable # added by devel/scanprov -SvPV_nolen_const # added by devel/scanprov -SvPV_nomg_const # added by devel/scanprov -SvPV_nomg_const_nolen # added by devel/scanprov -SvSHARED_HASH # added by devel/scanprov -dVAR # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5009004 b/ext/Devel/PPPort/parts/base/5009004 deleted file mode 100644 index 65dbc853f5..0000000000 --- a/ext/Devel/PPPort/parts/base/5009004 +++ /dev/null @@ -1,29 +0,0 @@ -5.009004 -PerlIO_context_layers # U -PoisonFree # E -PoisonNew # E -PoisonWith # E -SvREFCNT_inc_NN # U -SvREFCNT_inc_simple # U -SvREFCNT_inc_simple_NN # U -SvREFCNT_inc_simple_void # U -SvREFCNT_inc_simple_void_NN # U -SvREFCNT_inc_void # U -SvREFCNT_inc_void_NN # U -gv_name_set # U -hv_stores # U -my_snprintf # U -my_strlcat # U -my_strlcpy # U -my_vsnprintf # U -newXS_flags # U -pv_escape # U -pv_pretty # U -regclass_swash # E (Perl_regclass_swash) -sv_does # U -sv_setpvs # U -sv_usepvn_flags # U -PERL_UNUSED_CONTEXT # added by devel/scanprov -PERL_USE_GCC_BRACE_GROUPS # added by devel/scanprov -SV_HAS_TRAILING_NUL # added by devel/scanprov -SvVSTRING_mg # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5009005 b/ext/Devel/PPPort/parts/base/5009005 deleted file mode 100644 index eb5da81ff4..0000000000 --- a/ext/Devel/PPPort/parts/base/5009005 +++ /dev/null @@ -1,32 +0,0 @@ -5.009005 -Perl_signbit # U -SvRX # U -SvRXOK # U -av_create_and_push # U -av_create_and_unshift_one # U -get_cvn_flags # U -gv_fetchfile_flags # U -mro_get_linear_isa # U -mro_method_changed_in # U -my_dirfd # U -newSV_type # U -pregcomp # E (Perl_pregcomp) -ptr_table_clear # U -ptr_table_fetch # U -ptr_table_free # U -ptr_table_new # U -ptr_table_split # U -ptr_table_store # U -re_compile # U -re_intuit_start # E (Perl_re_intuit_start) -reg_named_buff_all # U -reg_named_buff_exists # U -reg_named_buff_fetch # U -reg_named_buff_firstkey # U -reg_named_buff_nextkey # U -reg_named_buff_scalar # U -regfree_internal # U -savesharedpvn # U -scan_vstring # E (Perl_scan_vstring) -upg_version # E (Perl_upg_version) -SV_COW_SHARED_HASH_KEYS # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/base/5010000 b/ext/Devel/PPPort/parts/base/5010000 deleted file mode 100644 index 737f374ef0..0000000000 --- a/ext/Devel/PPPort/parts/base/5010000 +++ /dev/null @@ -1,7 +0,0 @@ -5.010000 -hv_common # U -hv_common_key_len # U -sv_destroyable # U -sys_init # U -sys_init3 # U -sys_term # U diff --git a/ext/Devel/PPPort/parts/base/5011000 b/ext/Devel/PPPort/parts/base/5011000 deleted file mode 100644 index c9ba122660..0000000000 --- a/ext/Devel/PPPort/parts/base/5011000 +++ /dev/null @@ -1,32 +0,0 @@ -5.011000 -HeUTF8 # U -MULTICALL # E -POP_MULTICALL # E -PUSH_MULTICALL # E -SvOOK_offset # U -av_iter_p # U -croak_xs_usage # U -fetch_cop_label # U -gv_fetchmethod_flags # U -hv_assert # U -mPUSHs # U -mXPUSHs # U -newSVpvn_flags # U -newSVpvn_utf8 # U -newSVpvs_flags # U -pad_sv # U -pregfree2 # U -ref # U (Perl_ref) -save_padsv_and_mortalize # U -stashpv_hvname_match # U -sv_insert_flags # U -sv_magic_portable # U -PERL_BCDVERSION # added by devel/scanprov -PERL_MAGIC_glob # added by devel/scanprov -PERL_MAGIC_mutex # added by devel/scanprov -PL_copline # added by devel/scanprov -PL_expect # added by devel/scanprov -WARN_ASSERTIONS # added by devel/scanprov -aTHXR # added by devel/scanprov -aTHXR_ # added by devel/scanprov -dTHXR # added by devel/scanprov diff --git a/ext/Devel/PPPort/parts/embed.fnc b/ext/Devel/PPPort/parts/embed.fnc deleted file mode 100644 index f08dfef1a5..0000000000 --- a/ext/Devel/PPPort/parts/embed.fnc +++ /dev/null @@ -1,2004 +0,0 @@ -: BEGIN {die "You meant to run embed.pl"} # Stop early if fed to perl. -: -: Lines are of the form: -: flags|return_type|function_name|arg1|arg2|...|argN -: -: A line may be continued on another by ending it with a backslash. -: Leading and trailing whitespace will be ignored in each component. -: -: flags are single letters with following meanings: -: A member of public API -: m Implemented as a macro - no export, no -: proto, no #define -: d function has documentation with its source -: s static function, should have an S_ prefix in -: source file; for macros (m), suffix the usage -: example with a semicolon -: n has no implicit interpreter/thread context argument -: p function has a Perl_ prefix -: f function takes printf style format string, varargs -: r function never returns -: o has no compatibility macro (#define foo Perl_foo) -: x not exported -: X explicitly exported -: M may change -: E visible to extensions included in the Perl core -: b binary backward compatibility; function is a macro -: but has also Perl_ implementation (which is exported) -: U suppress usage example in autogenerated documentation -: a allocates memory a la malloc/calloc. Is also "R". -: R Return value must not be ignored. -: P pure function: no effects except the return value; -: return value depends only on parms and/or globals -: (see also L for those flags.) -: -: Pointer parameters that must not be passed NULLs should be prefixed with NN. -: -: Pointer parameters that may be NULL should be prefixed with NULLOK. This has -: no effect on output yet. It's a notation for the maintainers to know "I have -: defined whether NULL is OK or not" rather than having neither NULL or NULLOK, -: which is ambiguous. -: -: Individual flags may be separated by whitespace. - -START_EXTERN_C - -#if defined(PERL_IMPLICIT_SYS) -Ano |PerlInterpreter*|perl_alloc_using \ - |NN struct IPerlMem *ipM \ - |NN struct IPerlMem *ipMS \ - |NN struct IPerlMem *ipMP \ - |NN struct IPerlEnv *ipE \ - |NN struct IPerlStdIO *ipStd \ - |NN struct IPerlLIO *ipLIO \ - |NN struct IPerlDir *ipD \ - |NN struct IPerlSock *ipS \ - |NN struct IPerlProc *ipP -#endif -Anod |PerlInterpreter* |perl_alloc -Anod |void |perl_construct |NN PerlInterpreter *my_perl -Anod |int |perl_destruct |NN PerlInterpreter *my_perl -Anod |void |perl_free |NN PerlInterpreter *my_perl -Anod |int |perl_run |NN PerlInterpreter *my_perl -Anod |int |perl_parse |NN PerlInterpreter *my_perl|XSINIT_t xsinit \ - |int argc|NULLOK char** argv|NULLOK char** env -AnpR |bool |doing_taint |int argc|NULLOK char** argv|NULLOK char** env -#if defined(USE_ITHREADS) -Anod |PerlInterpreter*|perl_clone|NN PerlInterpreter *proto_perl|UV flags -# if defined(PERL_IMPLICIT_SYS) -Ano |PerlInterpreter*|perl_clone_using \ - |NN PerlInterpreter *proto_perl \ - |UV flags \ - |NN struct IPerlMem* ipM \ - |NN struct IPerlMem* ipMS \ - |NN struct IPerlMem* ipMP \ - |NN struct IPerlEnv* ipE \ - |NN struct IPerlStdIO* ipStd \ - |NN struct IPerlLIO* ipLIO \ - |NN struct IPerlDir* ipD \ - |NN struct IPerlSock* ipS \ - |NN struct IPerlProc* ipP -# endif -#endif - -Aanop |Malloc_t|malloc |MEM_SIZE nbytes -Aanop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size -Aanop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes -Anop |Free_t |mfree |Malloc_t where -#if defined(MYMALLOC) -npR |MEM_SIZE|malloced_size |NN void *p -npR |MEM_SIZE|malloc_good_size |size_t nbytes -#endif - -AnpR |void* |get_context -Anp |void |set_context |NN void *t - -END_EXTERN_C - -/* functions with flag 'n' should come before here */ -START_EXTERN_C -# include "pp_proto.h" -Ap |SV* |amagic_call |NN SV* left|NN SV* right|int method|int dir -Ap |bool |Gv_AMupdate |NN HV* stash -ApR |CV* |gv_handler |NULLOK HV* stash|I32 id -p |OP* |append_elem |I32 optype|NULLOK OP* first|NULLOK OP* last -p |OP* |append_list |I32 optype|NULLOK LISTOP* first|NULLOK LISTOP* last -p |I32 |apply |I32 type|NN SV** mark|NN SV** sp -ApM |void |apply_attrs_string|NN const char *stashpv|NN CV *cv|NN const char *attrstr|STRLEN len -Apd |void |av_clear |NN AV *av -Apd |SV* |av_delete |NN AV *av|I32 key|I32 flags -ApdR |bool |av_exists |NN AV *av|I32 key -Apd |void |av_extend |NN AV *av|I32 key -pR |AV* |av_fake |I32 size|NN SV **strp -ApdR |SV** |av_fetch |NN AV *av|I32 key|I32 lval -Apd |void |av_fill |NN AV *av|I32 fill -ApdR |I32 |av_len |NN const AV *av -ApdR |AV* |av_make |I32 size|NN SV **strp -Apd |SV* |av_pop |NN AV *av -ApdoxM |void |av_create_and_push|NN AV **const avp|NN SV *const val -Apd |void |av_push |NN AV *av|NN SV *val -EXp |void |av_reify |NN AV *av -ApdR |SV* |av_shift |NN AV *av -Apd |SV** |av_store |NN AV *av|I32 key|NULLOK SV *val -Apd |void |av_undef |NN AV *av -ApdoxM |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val -Apd |void |av_unshift |NN AV *av|I32 num -Apo |SV** |av_arylen_p |NN AV *av -Apo |IV* |av_iter_p |NN AV *av -#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) -s |MAGIC* |get_aux_mg |NN AV *av -#endif -pR |OP* |bind_match |I32 type|NN OP *left|NN OP *right -pR |OP* |block_end |I32 floor|NULLOK OP* seq -ApR |I32 |block_gimme -pR |int |block_start |int full -p |void |boot_core_UNIVERSAL -p |void |boot_core_PerlIO -Ap |void |call_list |I32 oldscope|NN AV *paramList -pR |bool |cando |Mode_t mode|bool effective|NN const Stat_t* statbufp -ApR |U32 |cast_ulong |NV f -ApR |I32 |cast_i32 |NV f -ApR |IV |cast_iv |NV f -ApR |UV |cast_uv |NV f -#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) -ApR |I32 |my_chsize |int fd|Off_t length -#endif -pR |OP* |convert |I32 optype|I32 flags|NULLOK OP* o -pM |PERL_CONTEXT* |create_eval_scope|U32 flags -: croak()'s first parm can be NULL. Otherwise, mod_perl breaks. -Afprd |void |croak |NULLOK const char* pat|... -Apr |void |vcroak |NULLOK const char* pat|NULLOK va_list* args -Aprd |void |croak_xs_usage |NN const CV *const cv \ - |NN const char *const params - -#if defined(PERL_IMPLICIT_CONTEXT) -Afnrp |void |croak_nocontext|NULLOK const char* pat|... -Afnp |OP* |die_nocontext |NN const char* pat|... -Afnp |void |deb_nocontext |NN const char* pat|... -Afnp |char* |form_nocontext |NN const char* pat|... -Anp |void |load_module_nocontext|U32 flags|NN SV* name|NULLOK SV* ver|... -Afnp |SV* |mess_nocontext |NN const char* pat|... -Afnp |void |warn_nocontext |NN const char* pat|... -Afnp |void |warner_nocontext|U32 err|NN const char* pat|... -Afnp |SV* |newSVpvf_nocontext|NN const char *const pat|... -Afnp |void |sv_catpvf_nocontext|NN SV *const sv|NN const char *const pat|... -Afnp |void |sv_setpvf_nocontext|NN SV *const sv|NN const char *const pat|... -Afnp |void |sv_catpvf_mg_nocontext|NN SV *const sv|NN const char *const pat|... -Afnp |void |sv_setpvf_mg_nocontext|NN SV *const sv|NN const char *const pat|... -Afnp |int |fprintf_nocontext|NN PerlIO *stream|NN const char *format|... -Afnp |int |printf_nocontext|NN const char *format|... -#endif -bp |void |cv_ckproto |NN const CV* cv|NULLOK const GV* gv\ - |NULLOK const char* p -p |void |cv_ckproto_len |NN const CV* cv|NULLOK const GV* gv\ - |NULLOK const char* p|const STRLEN len -pd |CV* |cv_clone |NN CV* proto -ApdR |SV* |gv_const_sv |NN GV* gv -ApdR |SV* |cv_const_sv |NULLOK CV* cv -pR |SV* |op_const_sv |NULLOK const OP* o|NULLOK CV* cv -Apd |void |cv_undef |NN CV* cv -Ap |void |cx_dump |NN PERL_CONTEXT* cx -Ap |SV* |filter_add |NULLOK filter_t funcp|NULLOK SV* datasv -Ap |void |filter_del |NN filter_t funcp -ApR |I32 |filter_read |int idx|NN SV *buf_sv|int maxlen -ApPR |char** |get_op_descs -ApPR |char** |get_op_names -pPR |const char* |get_no_modify -pPR |U32* |get_opargs -ApPR |PPADDR_t*|get_ppaddr -EXpR |I32 |cxinc -Afp |void |deb |NN const char* pat|... -Ap |void |vdeb |NN const char* pat|NULLOK va_list* args -Ap |void |debprofdump -Ap |I32 |debop |NN const OP* o -Ap |I32 |debstack -Ap |I32 |debstackptrs -Ap |char* |delimcpy |NN char* to|NN const char* toend|NN const char* from \ - |NN const char* fromend|int delim|NN I32* retlen -pM |void |delete_eval_scope -p |void |deprecate |NN const char *const s -p |void |deprecate_old |NN const char *const s -Afp |OP* |die |NULLOK const char* pat|... -p |OP* |vdie |NULLOK const char* pat|NULLOK va_list* args -p |OP* |die_where |NULLOK const char* message|STRLEN msglen -Ap |void |dounwind |I32 cxix -pmb |bool |do_aexec |NULLOK SV* really|NN SV** mark|NN SV** sp -p |bool |do_aexec5 |NULLOK SV* really|NN SV** mark|NN SV** sp|int fd|int do_report -Ap |int |do_binmode |NN PerlIO *fp|int iotype|int mode -p |void |do_chop |NN SV *astr|NN SV *sv -Ap |bool |do_close |NULLOK GV* gv|bool not_implicit -p |bool |do_eof |NN GV* gv - -#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION -pmb |bool |do_exec |NN const char* cmd -#else -p |bool |do_exec |NN const char* cmd -#endif - -#if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS) -Ap |int |do_aspawn |NULLOK SV* really|NN SV** mark|NN SV** sp -Ap |int |do_spawn |NN char* cmd -Ap |int |do_spawn_nowait|NN char* cmd -#endif -#if !defined(WIN32) -p |bool |do_exec3 |NN const char *incmd|int fd|int do_report -#endif -p |void |do_execfree -#ifdef PERL_IN_DOIO_C -s |void |exec_failed |NN const char *cmd|int fd|int do_report -#endif -#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) -p |I32 |do_ipcctl |I32 optype|NN SV** mark|NN SV** sp -p |I32 |do_ipcget |I32 optype|NN SV** mark|NN SV** sp -p |I32 |do_msgrcv |NN SV** mark|NN SV** sp -p |I32 |do_msgsnd |NN SV** mark|NN SV** sp -p |I32 |do_semop |NN SV** mark|NN SV** sp -p |I32 |do_shmio |I32 optype|NN SV** mark|NN SV** sp -#endif -Ap |void |do_join |NN SV *sv|NN SV *delim|NN SV **mark|NN SV **sp -p |OP* |do_kv -Apmb |bool |do_open |NN GV* gv|NN const char* name|I32 len|int as_raw \ - |int rawmode|int rawperm|NULLOK PerlIO* supplied_fp -Ap |bool |do_open9 |NN GV *gv|NN const char *name|I32 len|int as_raw \ - |int rawmode|int rawperm|NULLOK PerlIO *supplied_fp \ - |NN SV *svs|I32 num -Ap |bool |do_openn |NN GV *gv|NN const char *oname|I32 len \ - |int as_raw|int rawmode|int rawperm \ - |NULLOK PerlIO *supplied_fp|NULLOK SV **svp \ - |I32 num -p |bool |do_print |NULLOK SV* sv|NN PerlIO* fp -pR |OP* |do_readline -p |I32 |do_chomp |NN SV* sv -p |bool |do_seek |NULLOK GV* gv|Off_t pos|int whence -Ap |void |do_sprintf |NN SV* sv|I32 len|NN SV** sarg -p |Off_t |do_sysseek |NN GV* gv|Off_t pos|int whence -pR |Off_t |do_tell |NN GV* gv -p |I32 |do_trans |NN SV* sv -p |UV |do_vecget |NN SV* sv|I32 offset|I32 size -p |void |do_vecset |NN SV* sv -p |void |do_vop |I32 optype|NN SV* sv|NN SV* left|NN SV* right -p |OP* |dofile |NN OP* term|I32 force_builtin -ApR |I32 |dowantarray -Ap |void |dump_all -Ap |void |dump_eval -#if defined(DUMP_FDS) -Ap |void |dump_fds |NN char* s -#endif -Ap |void |dump_form |NN const GV* gv -Ap |void |gv_dump |NN GV* gv -Ap |void |op_dump |NN const OP *o -Ap |void |pmop_dump |NULLOK PMOP* pm -Ap |void |dump_packsubs |NN const HV* stash -Ap |void |dump_sub |NN const GV* gv -Apd |void |fbm_compile |NN SV* sv|U32 flags -ApdR |char* |fbm_instr |NN unsigned char* big|NN unsigned char* bigend \ - |NN SV* littlestr|U32 flags -p |char* |find_script |NN const char *scriptname|bool dosearch \ - |NULLOK const char *const *const search_ext|I32 flags -p |OP* |force_list |NULLOK OP* arg -p |OP* |fold_constants |NN OP *o -Afpd |char* |form |NN const char* pat|... -Ap |char* |vform |NN const char* pat|NULLOK va_list* args -Ap |void |free_tmps -p |OP* |gen_constant_list|NULLOK OP* o -#if !defined(HAS_GETENV_LEN) -p |char* |getenv_len |NN const char *env_elem|NN unsigned long *len -#endif -pox |void |get_db_sub |NULLOK SV **svp|NN CV *cv -Ap |void |gp_free |NULLOK GV* gv -Ap |GP* |gp_ref |NULLOK GP* gp -Ap |GV* |gv_AVadd |NN GV* gv -Ap |GV* |gv_HVadd |NN GV* gv -Ap |GV* |gv_IOadd |NN GV* gv -ApR |GV* |gv_autoload4 |NULLOK HV* stash|NN const char* name|STRLEN len|I32 method -Ap |void |gv_check |NN const HV* stash -Ap |void |gv_efullname |NN SV* sv|NN const GV* gv -Apmb |void |gv_efullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix -Ap |void |gv_efullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain -Ap |GV* |gv_fetchfile |NN const char* name -Ap |GV* |gv_fetchfile_flags|NN const char *const name|const STRLEN len\ - |const U32 flags -Apd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level -Apd |GV* |gv_fetchmeth_autoload |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level -Apdmb |GV* |gv_fetchmethod |NN HV* stash|NN const char* name -Apd |GV* |gv_fetchmethod_autoload|NN HV* stash|NN const char* name \ - |I32 autoload -ApdM |GV* |gv_fetchmethod_flags|NN HV* stash|NN const char* name \ - |U32 flags -Ap |GV* |gv_fetchpv |NN const char *nambeg|I32 add|const svtype sv_type -Ap |void |gv_fullname |NN SV* sv|NN const GV* gv -Apmb |void |gv_fullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix -Ap |void |gv_fullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain -pMox |GP * |newGP |NN GV *const gv -Ap |void |gv_init |NN GV* gv|NULLOK HV* stash|NN const char* name|STRLEN len|int multi -Ap |void |gv_name_set |NN GV* gv|NN const char *name|U32 len|U32 flags -Apd |HV* |gv_stashpv |NN const char* name|I32 flags -Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags -Apd |HV* |gv_stashsv |NN SV* sv|I32 flags -Apd |void |hv_clear |NULLOK HV *hv -poM |HV * |hv_copy_hints_hv|NULLOK HV *const ohv -Ap |void |hv_delayfree_ent|NN HV *hv|NULLOK HE *entry -Abmd |SV* |hv_delete |NULLOK HV *hv|NN const char *key|I32 klen \ - |I32 flags -Abmd |SV* |hv_delete_ent |NULLOK HV *hv|NN SV *keysv|I32 flags|U32 hash -AbmdR |bool |hv_exists |NULLOK HV *hv|NN const char *key|I32 klen -AbmdR |bool |hv_exists_ent |NULLOK HV *hv|NN SV *keysv|U32 hash -Abmd |SV** |hv_fetch |NULLOK HV *hv|NN const char *key|I32 klen \ - |I32 lval -Abmd |HE* |hv_fetch_ent |NULLOK HV *hv|NN SV *keysv|I32 lval|U32 hash -Ap |void* |hv_common |NULLOK HV *hv|NULLOK SV *keysv \ - |NULLOK const char* key|STRLEN klen|int flags \ - |int action|NULLOK SV *val|U32 hash -Ap |void* |hv_common_key_len|NULLOK HV *hv|NN const char *key \ - |I32 klen_i32|const int action|NULLOK SV *val \ - |const U32 hash -Ap |void |hv_free_ent |NN HV *hv|NULLOK HE *entryK -Apd |I32 |hv_iterinit |NN HV *hv -ApdR |char* |hv_iterkey |NN HE* entry|NN I32* retlen -ApdR |SV* |hv_iterkeysv |NN HE* entry -ApdRbm |HE* |hv_iternext |NN HV *hv -ApdR |SV* |hv_iternextsv |NN HV *hv|NN char **key|NN I32 *retlen -ApMdR |HE* |hv_iternext_flags|NN HV *hv|I32 flags -ApdR |SV* |hv_iterval |NN HV *hv|NN HE *entry -Ap |void |hv_ksplit |NN HV *hv|IV newmax -Apdbm |void |hv_magic |NN HV *hv|NULLOK GV *gv|int how -XEdpoM |HV * |refcounted_he_chain_2hv|NULLOK const struct refcounted_he *c -XEpoM |SV * |refcounted_he_fetch|NULLOK const struct refcounted_he *chain \ - |NULLOK SV *keysv|NULLOK const char *key \ - |STRLEN klen, int flags, U32 hash -dpoM |void |refcounted_he_free|NULLOK struct refcounted_he *he -XEdpoM |struct refcounted_he *|refcounted_he_new \ - |NULLOK struct refcounted_he *const parent \ - |NULLOK SV *const key|NULLOK SV *const value -#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) -s |struct refcounted_he * |refcounted_he_new_common \ - |NULLOK struct refcounted_he *const parent \ - |NN const char *const key_p \ - |const STRLEN key_len|const char flags \ - |char value_type|NN const void *value \ - |const STRLEN value_len -#endif -Abmd |SV** |hv_store |NULLOK HV *hv|NULLOK const char *key \ - |I32 klen|NULLOK SV *val|U32 hash -Abmd |HE* |hv_store_ent |NULLOK HV *hv|NULLOK SV *key|NULLOK SV *val\ - |U32 hash -AbmdM |SV** |hv_store_flags |NULLOK HV *hv|NULLOK const char *key \ - |I32 klen|NULLOK SV *val|U32 hash|int flags -Apd |void |hv_undef |NULLOK HV *hv -ApP |I32 |ibcmp |NN const char* a|NN const char* b|I32 len -ApP |I32 |ibcmp_locale |NN const char* a|NN const char* b|I32 len -Apd |I32 |ibcmp_utf8 |NN const char *s1|NULLOK char **pe1|UV l1 \ - |bool u1|NN const char *s2|NULLOK char **pe2 \ - |UV l2|bool u2 -pR |bool |ingroup |Gid_t testgid|bool effective -p |void |init_argv_symbols|int argc|NN char **argv -p |void |init_debugger -Ap |void |init_stacks -Ap |void |init_tm |NN struct tm *ptm -pd |U32 |intro_my -ApPR |char* |instr |NN const char* big|NN const char* little -p |bool |io_close |NN IO* io|bool not_implicit -pR |OP* |invert |NULLOK OP* cmd -dpR |bool |is_gv_magical |NN const char *name|STRLEN len|U32 flags -ApR |I32 |is_lvalue_sub -ApPR |U32 |to_uni_upper_lc|U32 c -ApPR |U32 |to_uni_title_lc|U32 c -ApPR |U32 |to_uni_lower_lc|U32 c -ApPR |bool |is_uni_alnum |UV c -ApPR |bool |is_uni_alnumc |UV c -ApPR |bool |is_uni_idfirst |UV c -ApPR |bool |is_uni_alpha |UV c -ApPR |bool |is_uni_ascii |UV c -ApPR |bool |is_uni_space |UV c -ApPR |bool |is_uni_cntrl |UV c -ApPR |bool |is_uni_graph |UV c -ApPR |bool |is_uni_digit |UV c -ApPR |bool |is_uni_upper |UV c -ApPR |bool |is_uni_lower |UV c -ApPR |bool |is_uni_print |UV c -ApPR |bool |is_uni_punct |UV c -ApPR |bool |is_uni_xdigit |UV c -Ap |UV |to_uni_upper |UV c|NN U8 *p|NN STRLEN *lenp -Ap |UV |to_uni_title |UV c|NN U8 *p|NN STRLEN *lenp -Ap |UV |to_uni_lower |UV c|NN U8 *p|NN STRLEN *lenp -Ap |UV |to_uni_fold |UV c|NN U8 *p|NN STRLEN *lenp -ApPR |bool |is_uni_alnum_lc|UV c -ApPR |bool |is_uni_alnumc_lc|UV c -ApPR |bool |is_uni_idfirst_lc|UV c -ApPR |bool |is_uni_alpha_lc|UV c -ApPR |bool |is_uni_ascii_lc|UV c -ApPR |bool |is_uni_space_lc|UV c -ApPR |bool |is_uni_cntrl_lc|UV c -ApPR |bool |is_uni_graph_lc|UV c -ApPR |bool |is_uni_digit_lc|UV c -ApPR |bool |is_uni_upper_lc|UV c -ApPR |bool |is_uni_lower_lc|UV c -ApPR |bool |is_uni_print_lc|UV c -ApPR |bool |is_uni_punct_lc|UV c -ApPR |bool |is_uni_xdigit_lc|UV c -Apd |STRLEN |is_utf8_char |NN const U8 *s -Apd |bool |is_utf8_string |NN const U8 *s|STRLEN len -Apdmb |bool |is_utf8_string_loc|NN const U8 *s|STRLEN len|NULLOK const U8 **p -Apd |bool |is_utf8_string_loclen|NN const U8 *s|STRLEN len|NULLOK const U8 **ep|NULLOK STRLEN *el -ApR |bool |is_utf8_alnum |NN const U8 *p -ApR |bool |is_utf8_alnumc |NN const U8 *p -ApR |bool |is_utf8_idfirst|NN const U8 *p -ApR |bool |is_utf8_idcont |NN const U8 *p -ApR |bool |is_utf8_alpha |NN const U8 *p -ApR |bool |is_utf8_ascii |NN const U8 *p -ApR |bool |is_utf8_space |NN const U8 *p -ApR |bool |is_utf8_cntrl |NN const U8 *p -ApR |bool |is_utf8_digit |NN const U8 *p -ApR |bool |is_utf8_graph |NN const U8 *p -ApR |bool |is_utf8_upper |NN const U8 *p -ApR |bool |is_utf8_lower |NN const U8 *p -ApR |bool |is_utf8_print |NN const U8 *p -ApR |bool |is_utf8_punct |NN const U8 *p -ApR |bool |is_utf8_xdigit |NN const U8 *p -ApR |bool |is_utf8_mark |NN const U8 *p -p |OP* |jmaybe |NN OP *o -pP |I32 |keyword |NN const char *name|I32 len|bool all_keywords -Ap |void |leave_scope |I32 base -EXp |void |lex_end -p |void |lex_start |NULLOK SV* line|NULLOK PerlIO *rsfp|bool new_filter -Ap |void |op_null |NN OP* o -EXp |void |op_clear |NN OP* o -Ap |void |op_refcnt_lock -Ap |void |op_refcnt_unlock -p |OP* |linklist |NN OP* o -p |OP* |list |NULLOK OP* o -p |OP* |listkids |NULLOK OP* o -Apd |void |load_module|U32 flags|NN SV* name|NULLOK SV* ver|... -Ap |void |vload_module|U32 flags|NN SV* name|NULLOK SV* ver|NULLOK va_list* args -p |OP* |localize |NN OP *o|I32 lex -ApdR |I32 |looks_like_number|NN SV *const sv -Apd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result -Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result -Apd |int |grok_number |NN const char *pv|STRLEN len|NULLOK UV *valuep -ApdR |bool |grok_numeric_radix|NN const char **sp|NN const char *send -Apd |UV |grok_oct |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result -p |int |magic_clearenv |NN SV* sv|NN MAGIC* mg -p |int |magic_clear_all_env|NN SV* sv|NN MAGIC* mg -dp |int |magic_clearhint|NN SV* sv|NN MAGIC* mg -p |int |magic_clearisa |NN SV* sv|NN MAGIC* mg -p |int |magic_clearpack|NN SV* sv|NN MAGIC* mg -p |int |magic_clearsig |NN SV* sv|NN MAGIC* mg -p |int |magic_existspack|NN SV* sv|NN const MAGIC* mg -p |int |magic_freeovrld|NN SV* sv|NN MAGIC* mg -p |int |magic_get |NN SV* sv|NN MAGIC* mg -p |int |magic_getarylen|NN SV* sv|NN const MAGIC* mg -p |int |magic_getdefelem|NN SV* sv|NN MAGIC* mg -p |int |magic_getnkeys |NN SV* sv|NN MAGIC* mg -p |int |magic_getpack |NN SV* sv|NN MAGIC* mg -p |int |magic_getpos |NN SV* sv|NN MAGIC* mg -p |int |magic_getsig |NN SV* sv|NN MAGIC* mg -p |int |magic_getsubstr|NN SV* sv|NN MAGIC* mg -p |int |magic_gettaint |NN SV* sv|NN MAGIC* mg -p |int |magic_getuvar |NN SV* sv|NN MAGIC* mg -p |int |magic_getvec |NN SV* sv|NN MAGIC* mg -p |U32 |magic_len |NN SV* sv|NN MAGIC* mg -p |int |magic_nextpack |NN SV *sv|NN MAGIC *mg|NN SV *key -p |U32 |magic_regdata_cnt|NN SV* sv|NN MAGIC* mg -p |int |magic_regdatum_get|NN SV* sv|NN MAGIC* mg -pr |int |magic_regdatum_set|NN SV* sv|NN MAGIC* mg -p |int |magic_set |NN SV* sv|NN MAGIC* mg -p |int |magic_setamagic|NN SV* sv|NN MAGIC* mg -p |int |magic_setarylen|NN SV* sv|NN MAGIC* mg -p |int |magic_freearylen_p|NN SV* sv|NN MAGIC* mg -p |int |magic_setdbline|NN SV* sv|NN MAGIC* mg -p |int |magic_setdefelem|NN SV* sv|NN MAGIC* mg -p |int |magic_setenv |NN SV* sv|NN MAGIC* mg -dp |int |magic_sethint |NN SV* sv|NN MAGIC* mg -p |int |magic_setisa |NN SV* sv|NN MAGIC* mg -p |int |magic_setmglob |NN SV* sv|NN MAGIC* mg -p |int |magic_setnkeys |NN SV* sv|NN MAGIC* mg -p |int |magic_setpack |NN SV* sv|NN MAGIC* mg -p |int |magic_setpos |NN SV* sv|NN MAGIC* mg -p |int |magic_setregexp|NN SV* sv|NN MAGIC* mg -p |int |magic_setsig |NN SV* sv|NN MAGIC* mg -p |int |magic_setsubstr|NN SV* sv|NN MAGIC* mg -p |int |magic_settaint |NN SV* sv|NN MAGIC* mg -p |int |magic_setuvar |NN SV* sv|NN MAGIC* mg -p |int |magic_setvec |NN SV* sv|NN MAGIC* mg -p |int |magic_setutf8 |NN SV* sv|NN MAGIC* mg -p |int |magic_set_all_env|NN SV* sv|NN MAGIC* mg -p |U32 |magic_sizepack |NN SV* sv|NN MAGIC* mg -p |int |magic_wipepack |NN SV* sv|NN MAGIC* mg -p |void |magicname |NN const char* sym|NULLOK const char* name|I32 namlen -Ap |void |markstack_grow -#if defined(USE_LOCALE_COLLATE) -p |int |magic_setcollxfrm|NN SV* sv|NN MAGIC* mg -p |char* |mem_collxfrm |NN const char* s|STRLEN len|NN STRLEN* xlen -#endif -Afp |SV* |mess |NN const char* pat|... -Ap |SV* |vmess |NN const char* pat|NULLOK va_list* args -EXp |void |qerror |NN SV* err -Apd |void |sortsv |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp -Apd |void |sortsv_flags |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U32 flags -Apd |int |mg_clear |NN SV* sv -Apd |int |mg_copy |NN SV *sv|NN SV *nsv|NULLOK const char *key \ - |I32 klen -pd |void |mg_localize |NN SV* sv|NN SV* nsv -ApdR |MAGIC* |mg_find |NULLOK const SV* sv|int type -Apd |int |mg_free |NN SV* sv -Apd |int |mg_get |NN SV* sv -Apd |U32 |mg_length |NN SV* sv -Apd |void |mg_magical |NN SV* sv -Apd |int |mg_set |NN SV* sv -Ap |I32 |mg_size |NN SV* sv -Ap |void |mini_mktime |NN struct tm *ptm -EXp |OP* |mod |NULLOK OP* o|I32 type -p |int |mode_from_discipline|NULLOK const char* s|STRLEN len -Ap |const char* |moreswitches |NN const char* s -p |OP* |my |NN OP* o -Ap |NV |my_atof |NN const char *s -#if (!defined(HAS_MEMCPY) && !defined(HAS_BCOPY)) || (!defined(HAS_MEMMOVE) && !defined(HAS_SAFE_MEMCPY) && !defined(HAS_SAFE_BCOPY)) -Anp |char* |my_bcopy |NN const char* from|NN char* to|I32 len -#endif -#if !defined(HAS_BZERO) && !defined(HAS_MEMSET) -Anp |char* |my_bzero |NN char* loc|I32 len -#endif -Apr |void |my_exit |U32 status -Apr |void |my_failure_exit -Ap |I32 |my_fflush_all -Anp |Pid_t |my_fork -Anp |void |atfork_lock -Anp |void |atfork_unlock -Ap |I32 |my_lstat -#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) -AnpP |I32 |my_memcmp |NN const char* s1|NN const char* s2|I32 len -#endif -#if !defined(HAS_MEMSET) -Anp |void* |my_memset |NN char* loc|I32 ch|I32 len -#endif -Ap |I32 |my_pclose |NULLOK PerlIO* ptr -Ap |PerlIO*|my_popen |NN const char* cmd|NN const char* mode -Ap |PerlIO*|my_popen_list |NN const char* mode|int n|NN SV ** args -Ap |void |my_setenv |NULLOK const char* nam|NULLOK const char* val -Ap |I32 |my_stat -Ap |char * |my_strftime |NN const char *fmt|int sec|int min|int hour|int mday|int mon|int year|int wday|int yday|int isdst -#if defined(MYSWAP) -ApPa |short |my_swap |short s -ApPa |long |my_htonl |long l -ApPa |long |my_ntohl |long l -#endif -p |void |my_unexec -Apa |OP* |newANONLIST |NULLOK OP* o -Apa |OP* |newANONHASH |NULLOK OP* o -Ap |OP* |newANONSUB |I32 floor|NULLOK OP* proto|NULLOK OP* block -Apa |OP* |newASSIGNOP |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right -Apa |OP* |newCONDOP |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop -Apd |CV* |newCONSTSUB |NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv -#ifdef PERL_MAD -Ap |OP* |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block -#else -Ap |void |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block -#endif -Apa |OP* |newFOROP |I32 flags|NULLOK char* label|line_t forline \ - |NULLOK OP* sv|NN OP* expr|NULLOK OP* block|NULLOK OP* cont -Apa |OP* |newGIVENOP |NN OP* cond|NN OP* block|PADOFFSET defsv_off -Apa |OP* |newLOGOP |I32 optype|I32 flags|NN OP *first|NN OP *other -Apa |OP* |newLOOPEX |I32 type|NN OP* label -Apa |OP* |newLOOPOP |I32 flags|I32 debuggable|NULLOK OP* expr|NULLOK OP* block -Apa |OP* |newNULLLIST -Apa |OP* |newOP |I32 optype|I32 flags -Ap |void |newPROG |NN OP* o -Apa |OP* |newRANGE |I32 flags|NN OP* left|NN OP* right -Apa |OP* |newSLICEOP |I32 flags|NULLOK OP* subscript|NULLOK OP* listop -Apa |OP* |newSTATEOP |I32 flags|NULLOK char* label|NULLOK OP* o -Ap |CV* |newSUB |I32 floor|NULLOK OP* o|NULLOK OP* proto|NULLOK OP* block -ApM |CV * |newXS_flags |NULLOK const char *name|NN XSUBADDR_t subaddr\ - |NN const char *const filename \ - |NULLOK const char *const proto|U32 flags -Apd |CV* |newXS |NULLOK const char *name|NN XSUBADDR_t subaddr\ - |NN const char *filename -AmdbR |AV* |newAV -Apa |OP* |newAVREF |NN OP* o -Apa |OP* |newBINOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last -Apa |OP* |newCVREF |I32 flags|NULLOK OP* o -Apa |OP* |newGVOP |I32 type|I32 flags|NN GV* gv -Apa |GV* |newGVgen |NN const char* pack -Apa |OP* |newGVREF |I32 type|NULLOK OP* o -ApaR |OP* |newHVREF |NN OP* o -AmdbR |HV* |newHV -ApaR |HV* |newHVhv |NULLOK HV *hv -Apa |IO* |newIO -Apa |OP* |newLISTOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last -#ifdef USE_ITHREADS -Apa |OP* |newPADOP |I32 type|I32 flags|NN SV* sv -#endif -Apa |OP* |newPMOP |I32 type|I32 flags -Apa |OP* |newPVOP |I32 type|I32 flags|NULLOK char* pv -Apa |SV* |newRV |NN SV *const sv -Apda |SV* |newRV_noinc |NN SV *const sv -Apda |SV* |newSV |const STRLEN len -Apa |OP* |newSVREF |NN OP* o -Apa |OP* |newSVOP |I32 type|I32 flags|NN SV* sv -Apda |SV* |newSViv |const IV i -Apda |SV* |newSVuv |const UV u -Apda |SV* |newSVnv |const NV n -Apda |SV* |newSVpv |NULLOK const char *const s|const STRLEN len -Apda |SV* |newSVpvn |NULLOK const char *const s|const STRLEN len -Apda |SV* |newSVpvn_flags |NULLOK const char *const s|const STRLEN len|const U32 flags -Apda |SV* |newSVhek |NULLOK const HEK *const hek -Apda |SV* |newSVpvn_share |NULLOK const char* s|I32 len|U32 hash -Afpda |SV* |newSVpvf |NN const char *const pat|... -Apa |SV* |vnewSVpvf |NN const char *const pat|NULLOK va_list *const args -Apd |SV* |newSVrv |NN SV *const rv|NULLOK const char *const classname -Apda |SV* |newSVsv |NULLOK SV *const old -Apda |SV* |newSV_type |const svtype type -Apa |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first -Apa |OP* |newWHENOP |NULLOK OP* cond|NN OP* block -Apa |OP* |newWHILEOP |I32 flags|I32 debuggable|NULLOK LOOP* loop \ - |I32 whileline|NULLOK OP* expr|NULLOK OP* block|NULLOK OP* cont \ - |I32 has_my -Apa |PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems -Ap |char* |scan_vstring |NN const char *s|NN const char *const e \ - |NN SV *sv -Apd |const char* |scan_version |NN const char *s|NN SV *rv|bool qv -Apd |SV* |new_version |NN SV *ver -Apd |SV* |upg_version |NN SV *ver|bool qv -Apd |bool |vverify |NN SV *vs -Apd |SV* |vnumify |NN SV *vs -Apd |SV* |vnormal |NN SV *vs -Apd |SV* |vstringify |NN SV *vs -Apd |int |vcmp |NN SV *lhv|NN SV *rhv -p |PerlIO*|nextargv |NN GV* gv -ApP |char* |ninstr |NN const char* big|NN const char* bigend \ - |NN const char* little|NN const char* lend -pr |OP* |oopsCV |NN OP* o -Ap |void |op_free |NULLOK OP* arg -#ifdef PERL_MAD -p |OP* |package |NN OP* o -#else -p |void |package |NN OP* o -#endif -pd |PADOFFSET|pad_alloc |I32 optype|U32 tmptype -p |PADOFFSET|allocmy |NN const char *const name -pdR |PADOFFSET|pad_findmy |NN const char* name -Ap |PADOFFSET|find_rundefsvoffset | -pR |OP* |oopsAV |NN OP* o -pR |OP* |oopsHV |NN OP* o -pd |void |pad_leavemy -Apd |SV* |pad_sv |PADOFFSET po -pd |void |pad_free |PADOFFSET po -pd |void |pad_reset -pd |void |pad_swipe |PADOFFSET po|bool refadjust -p |void |peep |NULLOK OP* o -dopM |PerlIO*|start_glob |NN SV *tmpglob|NN IO *io -#if defined(USE_REENTRANT_API) -Ap |void |reentrant_size -Ap |void |reentrant_init -Ap |void |reentrant_free -Anp |void* |reentrant_retry|NN const char *f|... -#endif -Ap |void |call_atexit |ATEXIT_t fn|NULLOK void *ptr -Apd |I32 |call_argv |NN const char* sub_name|I32 flags|NN char** argv -Apd |I32 |call_method |NN const char* methname|I32 flags -Apd |I32 |call_pv |NN const char* sub_name|I32 flags -Apd |I32 |call_sv |NN SV* sv|VOL I32 flags -Ap |void |despatch_signals -Ap |OP * |doref |NN OP *o|I32 type|bool set_op_ref -Apd |SV* |eval_pv |NN const char* p|I32 croak_on_error -Apd |I32 |eval_sv |NN SV* sv|I32 flags -Apd |SV* |get_sv |NN const char* name|I32 create -Apd |AV* |get_av |NN const char* name|I32 create -Apd |HV* |get_hv |NN const char* name|I32 create -Apd |CV* |get_cv |NN const char* name|I32 flags -Apd |CV* |get_cvn_flags |NN const char* name|STRLEN len|I32 flags -Ap |int |init_i18nl10n |int printwarn -Ap |int |init_i18nl14n |int printwarn -Ap |void |new_collate |NULLOK const char* newcoll -Ap |void |new_ctype |NN const char* newctype -Ap |void |new_numeric |NULLOK const char* newcoll -Ap |void |set_numeric_local -Ap |void |set_numeric_radix -Ap |void |set_numeric_standard -Apd |void |require_pv |NN const char* pv -Apd |void |pack_cat |NN SV *cat|NN const char *pat|NN const char *patend \ - |NN SV **beglist|NN SV **endlist|NN SV ***next_in_list|U32 flags -Apd |void |packlist |NN SV *cat|NN const char *pat|NN const char *patend|NN SV **beglist|NN SV **endlist -#ifdef PERL_USES_PL_PIDSTATUS -p |void |pidgone |Pid_t pid|int status -#endif -Ap |void |pmflag |NN U32* pmfl|int ch -p |OP* |pmruntime |NN OP *o|NN OP *expr|bool isreg -p |OP* |pmtrans |NN OP* o|NN OP* expr|NN OP* repl -Ap |void |pop_scope -p |OP* |prepend_elem |I32 optype|NULLOK OP* head|NULLOK OP* tail -Ap |void |push_scope -Amb |OP* |ref |NULLOK OP* o|I32 type -p |OP* |refkids |NULLOK OP* o|I32 type -Ap |void |regdump |NN const regexp* r -Ap |void |regdump |NN const regexp* r -Ap |SV* |regclass_swash |NULLOK const regexp *prog \ - |NN const struct regnode *node|bool doinit \ - |NULLOK SV **listsvp|NULLOK SV **altsvp -Ap |I32 |pregexec |NN REGEXP * const prog|NN char* stringarg \ - |NN char* strend|NN char* strbeg|I32 minend \ - |NN SV* screamer|U32 nosave -Ap |void |pregfree |NULLOK REGEXP* r -Ap |void |pregfree2 |NN REGEXP *rx -EXp |REGEXP*|reg_temp_copy |NN REGEXP* r -Ap |void |regfree_internal|NN REGEXP *const rx -#if defined(USE_ITHREADS) -Ap |void* |regdupe_internal|NN REGEXP * const r|NN CLONE_PARAMS* param -#endif -Ap |REGEXP*|pregcomp |NN const SV * const pattern|const U32 flags -Ap |REGEXP*|re_compile |NN const SV * const pattern|U32 flags -Ap |char* |re_intuit_start|NN REGEXP * const rx|NULLOK SV* sv|NN char* strpos \ - |NN char* strend|const U32 flags \ - |NULLOK re_scream_pos_data *data -Ap |SV* |re_intuit_string|NN REGEXP *const r -Ap |I32 |regexec_flags |NN REGEXP *const rx|NN char *stringarg \ - |NN char *strend|NN char *strbeg|I32 minend \ - |NN SV *sv|NULLOK void *data|U32 flags -ApR |regnode*|regnext |NULLOK regnode* p - -EXp |SV*|reg_named_buff |NN REGEXP * const rx|NULLOK SV * const key \ - |NULLOK SV * const value|const U32 flags -EXp |SV*|reg_named_buff_iter |NN REGEXP * const rx|NULLOK const SV * const lastkey \ - |const U32 flags -Ap |SV*|reg_named_buff_fetch |NN REGEXP * const rx|NN SV * const namesv|const U32 flags -Ap |bool|reg_named_buff_exists |NN REGEXP * const rx|NN SV * const key|const U32 flags -Ap |SV*|reg_named_buff_firstkey |NN REGEXP * const rx|const U32 flags -Ap |SV*|reg_named_buff_nextkey |NN REGEXP * const rx|const U32 flags -Ap |SV*|reg_named_buff_scalar |NN REGEXP * const rx|const U32 flags -Ap |SV*|reg_named_buff_all |NN REGEXP * const rx|const U32 flags - -EXp |void|reg_numbered_buff_fetch|NN REGEXP * const rx|const I32 paren|NULLOK SV * const sv -EXp |void|reg_numbered_buff_store|NN REGEXP * const rx|const I32 paren|NULLOK SV const * const value -EXp |I32|reg_numbered_buff_length|NN REGEXP * const rx|NN const SV * const sv|const I32 paren - -EXp |SV*|reg_qr_package|NN REGEXP * const rx - -Ep |void |regprop |NULLOK const regexp *prog|NN SV* sv|NN const regnode* o -Ap |void |repeatcpy |NN char* to|NN const char* from|I32 len|I32 count -ApP |char* |rninstr |NN const char* big|NN const char* bigend \ - |NN const char* little|NN const char* lend -Ap |Sighandler_t|rsignal |int i|Sighandler_t t -p |int |rsignal_restore|int i|NULLOK Sigsave_t* t -p |int |rsignal_save |int i|Sighandler_t t1|NN Sigsave_t* save -Ap |Sighandler_t|rsignal_state|int i -p |void |rxres_free |NN void** rsp -p |void |rxres_restore |NN void **rsp|NN REGEXP *rx -p |void |rxres_save |NN void **rsp|NN REGEXP *rx -#if !defined(HAS_RENAME) -p |I32 |same_dirent |NN const char* a|NN const char* b -#endif -Apda |char* |savepv |NULLOK const char* pv -Apda |char* |savepvn |NULLOK const char* pv|I32 len -Apda |char* |savesharedpv |NULLOK const char* pv -Apda |char* |savesharedpvn |NN const char *const pv|const STRLEN len -Apda |char* |savesvpv |NN SV* sv -Ap |void |savestack_grow -Ap |void |savestack_grow_cnt |I32 need -Ap |void |save_aelem |NN AV* av|I32 idx|NN SV **sptr -Ap |I32 |save_alloc |I32 size|I32 pad -Ap |void |save_aptr |NN AV** aptr -Ap |AV* |save_ary |NN GV* gv -Ap |void |save_bool |NN bool* boolp -Ap |void |save_clearsv |NN SV** svp -Ap |void |save_delete |NN HV *hv|NN char *key|I32 klen -Ap |void |save_destructor|DESTRUCTORFUNC_NOCONTEXT_t f|NN void* p -Ap |void |save_destructor_x|DESTRUCTORFUNC_t f|NULLOK void* p -Ap |void |save_freesv |NULLOK SV* sv -p |void |save_freeop |NULLOK OP* o -Ap |void |save_freepv |NULLOK char* pv -Ap |void |save_generic_svref|NN SV** sptr -Ap |void |save_generic_pvref|NN char** str -Ap |void |save_shared_pvref|NN char** str -Ap |void |save_gp |NN GV* gv|I32 empty -Ap |HV* |save_hash |NN GV* gv -Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr -Ap |void |save_hptr |NN HV** hptr -Ap |void |save_I16 |NN I16* intp -Ap |void |save_I32 |NN I32* intp -Ap |void |save_I8 |NN I8* bytep -Ap |void |save_int |NN int* intp -Ap |void |save_item |NN SV* item -Ap |void |save_iv |NN IV *ivp -Ap |void |save_list |NN SV** sarg|I32 maxsarg -Ap |void |save_long |NN long* longp -Ap |void |save_mortalizesv|NN SV* sv -Ap |void |save_nogv |NN GV* gv -p |void |save_op -Ap |SV* |save_scalar |NN GV* gv -Ap |void |save_pptr |NN char** pptr -Ap |void |save_vptr |NN void *ptr -Ap |void |save_re_context -Ap |void |save_padsv_and_mortalize|PADOFFSET off -Ap |void |save_sptr |NN SV** sptr -Ap |SV* |save_svref |NN SV** sptr -p |OP* |sawparens |NULLOK OP* o -p |OP* |scalar |NULLOK OP* o -p |OP* |scalarkids |NULLOK OP* o -p |OP* |scalarseq |NULLOK OP* o -p |OP* |scalarvoid |NN OP* o -Apd |NV |scan_bin |NN const char* start|STRLEN len|NN STRLEN* retlen -Apd |NV |scan_hex |NN const char* start|STRLEN len|NN STRLEN* retlen -Ap |char* |scan_num |NN const char* s|NN YYSTYPE *lvalp -Apd |NV |scan_oct |NN const char* start|STRLEN len|NN STRLEN* retlen -p |OP* |scope |NULLOK OP* o -Ap |char* |screaminstr |NN SV *bigstr|NN SV *littlestr|I32 start_shift \ - |I32 end_shift|NN I32 *old_posp|I32 last -#if !defined(VMS) -p |I32 |setenv_getix |NN const char* nam -#endif -EXp |void |setdefout |NULLOK GV* gv -Ap |HEK* |share_hek |NN const char* str|I32 len|U32 hash -#if defined(HAS_SIGACTION) && defined(SA_SIGINFO) -np |Signal_t |sighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap -Anp |Signal_t |csighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap -#else -np |Signal_t |sighandler |int sig -Anp |Signal_t |csighandler |int sig -#endif -Ap |SV** |stack_grow |NN SV** sp|NN SV** p|int n -Ap |I32 |start_subparse |I32 is_format|U32 flags -p |void |sub_crush_depth|NN CV* cv -Apd |bool |sv_2bool |NN SV *const sv -Apd |CV* |sv_2cv |NULLOK SV* sv|NN HV **const st|NN GV **const gvp \ - |const I32 lref -Apd |IO* |sv_2io |NN SV *const sv -#ifdef PERL_IN_SV_C -s |bool |glob_2number |NN GV* const gv -s |char* |glob_2pv |NN GV* const gv|NULLOK STRLEN * const len -#endif -Amb |IV |sv_2iv |NULLOK SV *sv -Apd |IV |sv_2iv_flags |NULLOK SV *const sv|const I32 flags -Apd |SV* |sv_2mortal |NULLOK SV *const sv -Apd |NV |sv_2nv |NULLOK SV *const sv -pMd |SV* |sv_2num |NN SV *const sv -Amb |char* |sv_2pv |NULLOK SV *sv|NULLOK STRLEN *lp -Apd |char* |sv_2pv_flags |NULLOK SV *const sv|NULLOK STRLEN *const lp|const I32 flags -Apd |char* |sv_2pvutf8 |NN SV *const sv|NULLOK STRLEN *const lp -Apd |char* |sv_2pvbyte |NN SV *const sv|NULLOK STRLEN *const lp -Ap |char* |sv_pvn_nomg |NN SV* sv|NULLOK STRLEN* lp -Amb |UV |sv_2uv |NULLOK SV *sv -Apd |UV |sv_2uv_flags |NULLOK SV *const sv|const I32 flags -Apd |IV |sv_iv |NN SV* sv -Apd |UV |sv_uv |NN SV* sv -Apd |NV |sv_nv |NN SV* sv -Apd |char* |sv_pvn |NN SV *sv|NN STRLEN *lp -Apd |char* |sv_pvutf8n |NN SV *sv|NN STRLEN *lp -Apd |char* |sv_pvbyten |NN SV *sv|NN STRLEN *lp -Apd |I32 |sv_true |NULLOK SV *const sv -pd |void |sv_add_arena |NN char *const ptr|const U32 size|const U32 flags -Apd |int |sv_backoff |NN SV *const sv -Apd |SV* |sv_bless |NN SV *const sv|NN HV *const stash -Afpd |void |sv_catpvf |NN SV *const sv|NN const char *const pat|... -Apd |void |sv_vcatpvf |NN SV *const sv|NN const char *const pat \ - |NULLOK va_list *const args -Apd |void |sv_catpv |NN SV *const sv|NULLOK const char* ptr -Amdb |void |sv_catpvn |NN SV *dsv|NN const char *sstr|STRLEN len -Amdb |void |sv_catsv |NN SV *dstr|NULLOK SV *sstr -Apd |void |sv_chop |NN SV *const sv|NULLOK const char *const ptr -pd |I32 |sv_clean_all -pd |void |sv_clean_objs -Apd |void |sv_clear |NN SV *const sv -Apd |I32 |sv_cmp |NULLOK SV *const sv1|NULLOK SV *const sv2 -Apd |I32 |sv_cmp_locale |NULLOK SV *const sv1|NULLOK SV *const sv2 -#if defined(USE_LOCALE_COLLATE) -Apd |char* |sv_collxfrm |NN SV *const sv|NN STRLEN *const nxp -#endif -Ap |OP* |sv_compile_2op |NN SV *sv|NN OP **startop \ - |NN const char *code|NN PAD **padp -Apd |int |getcwd_sv |NN SV* sv -Apd |void |sv_dec |NULLOK SV *const sv -Ap |void |sv_dump |NN SV* sv -ApdR |bool |sv_derived_from|NN SV* sv|NN const char *const name -ApdR |bool |sv_does |NN SV* sv|NN const char *const name -Apd |I32 |sv_eq |NULLOK SV* sv1|NULLOK SV* sv2 -Apd |void |sv_free |NULLOK SV *const sv -poMX |void |sv_free2 |NN SV *const sv -pd |void |sv_free_arenas -Apd |char* |sv_gets |NN SV *const sv|NN PerlIO *const fp|I32 append -Apd |char* |sv_grow |NN SV *const sv|STRLEN newlen -Apd |void |sv_inc |NULLOK SV *const sv -Amdb |void |sv_insert |NN SV *const bigstr|const STRLEN offset \ - |const STRLEN len|NN const char *const little \ - |const STRLEN littlelen -Apd |void |sv_insert_flags|NN SV *const bigstr|const STRLEN offset|const STRLEN len \ - |NN const char *const little|const STRLEN littlelen|const U32 flags -Apd |int |sv_isa |NULLOK SV* sv|NN const char *const name -Apd |int |sv_isobject |NULLOK SV* sv -Apd |STRLEN |sv_len |NULLOK SV *const sv -Apd |STRLEN |sv_len_utf8 |NULLOK SV *const sv -Apd |void |sv_magic |NN SV *const sv|NULLOK SV *const obj|const int how \ - |NULLOK const char *const name|const I32 namlen -Apd |MAGIC *|sv_magicext |NN SV *const sv|NULLOK SV *const obj|const int how \ - |NULLOK const MGVTBL *const vtbl|NULLOK const char *const name \ - |const I32 namlen -ApdaR |SV* |sv_mortalcopy |NULLOK SV *const oldsv -ApdR |SV* |sv_newmortal -Apd |SV* |sv_newref |NULLOK SV *const sv -Ap |char* |sv_peek |NULLOK SV* sv -Apd |void |sv_pos_u2b |NULLOK SV *const sv|NN I32 *const offsetp|NULLOK I32 *const lenp -Apd |void |sv_pos_b2u |NULLOK SV *const sv|NN I32 *const offsetp -Amdb |char* |sv_pvn_force |NN SV* sv|NULLOK STRLEN* lp -Apd |char* |sv_pvutf8n_force|NN SV *const sv|NULLOK STRLEN *const lp -Apd |char* |sv_pvbyten_force|NN SV *const sv|NULLOK STRLEN *const lp -Apd |char* |sv_recode_to_utf8 |NN SV* sv|NN SV *encoding -Apd |bool |sv_cat_decode |NN SV* dsv|NN SV *encoding|NN SV *ssv|NN int *offset \ - |NN char* tstr|int tlen -ApdR |const char* |sv_reftype |NN const SV *const sv|const int ob -Apd |void |sv_replace |NN SV *const sv|NN SV *const nsv -Apd |void |sv_report_used -Apd |void |sv_reset |NN const char* s|NULLOK HV *const stash -Afpd |void |sv_setpvf |NN SV *const sv|NN const char *const pat|... -Apd |void |sv_vsetpvf |NN SV *const sv|NN const char *const pat|NULLOK va_list *const args -Apd |void |sv_setiv |NN SV *const sv|const IV num -Apdb |void |sv_setpviv |NN SV *const sv|const IV num -Apd |void |sv_setuv |NN SV *const sv|const UV num -Apd |void |sv_setnv |NN SV *const sv|const NV num -Apd |SV* |sv_setref_iv |NN SV *const rv|NULLOK const char *const classname|const IV iv -Apd |SV* |sv_setref_uv |NN SV *const rv|NULLOK const char *const classname|const UV uv -Apd |SV* |sv_setref_nv |NN SV *const rv|NULLOK const char *const classname|const NV nv -Apd |SV* |sv_setref_pv |NN SV *const rv|NULLOK const char *const classname \ - |NULLOK void *const pv -Apd |SV* |sv_setref_pvn |NN SV *const rv|NULLOK const char *const classname \ - |NN const char *const pv|const STRLEN n -Apd |void |sv_setpv |NN SV *const sv|NULLOK const char *const ptr -Apd |void |sv_setpvn |NN SV *const sv|NULLOK const char *const ptr|const STRLEN len -Amdb |void |sv_setsv |NN SV *dstr|NULLOK SV *sstr -Amdb |void |sv_taint |NN SV* sv -ApdR |bool |sv_tainted |NN SV *const sv -Apd |int |sv_unmagic |NN SV *const sv|const int type -Apdmb |void |sv_unref |NN SV* sv -Apd |void |sv_unref_flags |NN SV *const ref|const U32 flags -Apd |void |sv_untaint |NN SV *const sv -Apd |void |sv_upgrade |NN SV *const sv|svtype new_type -Apdmb |void |sv_usepvn |NN SV* sv|NULLOK char* ptr|STRLEN len -Apd |void |sv_usepvn_flags|NN SV *const sv|NULLOK char* ptr|const STRLEN len\ - |const U32 flags -Apd |void |sv_vcatpvfn |NN SV *const sv|NN const char *const pat|const STRLEN patlen \ - |NULLOK va_list *const args|NULLOK SV **const svargs|const I32 svmax \ - |NULLOK bool *const maybe_tainted -Apd |void |sv_vsetpvfn |NN SV *const sv|NN const char *const pat|const STRLEN patlen \ - |NULLOK va_list *const args|NULLOK SV **const svargs \ - |const I32 svmax|NULLOK bool *const maybe_tainted -ApR |NV |str_to_version |NN SV *sv -Ap |SV* |swash_init |NN const char* pkg|NN const char* name|NN SV* listsv|I32 minbits|I32 none -Ap |UV |swash_fetch |NN SV *swash|NN const U8 *ptr|bool do_utf8 -Ap |void |taint_env -Ap |void |taint_proper |NULLOK const char* f|NN const char *const s -Apd |UV |to_utf8_case |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp \ - |NN SV **swashp|NN const char *normal|NN const char *special -Apd |UV |to_utf8_lower |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp -Apd |UV |to_utf8_upper |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp -Apd |UV |to_utf8_title |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp -Apd |UV |to_utf8_fold |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp -#if defined(UNLINK_ALL_VERSIONS) -Ap |I32 |unlnk |NN const char* f -#endif -Apd |I32 |unpack_str |NN const char *pat|NN const char *patend|NN const char *s \ - |NULLOK const char *strbeg|NN const char *strend|NULLOK char **new_s \ - |I32 ocnt|U32 flags -Apd |I32 |unpackstring |NN const char *pat|NN const char *patend|NN const char *s \ - |NN const char *strend|U32 flags -Ap |void |unsharepvn |NULLOK const char* sv|I32 len|U32 hash -p |void |unshare_hek |NULLOK HEK* hek -#ifdef PERL_MAD -p |OP * |utilize |int aver|I32 floor|NULLOK OP* version \ - |NN OP* idop|NULLOK OP* arg -#else -p |void |utilize |int aver|I32 floor|NULLOK OP* version|NN OP* idop|NULLOK OP* arg -#endif -Ap |U8* |utf16_to_utf8 |NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen -Ap |U8* |utf16_to_utf8_reversed|NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen -AdpPR |STRLEN |utf8_length |NN const U8* s|NN const U8 *e -ApdPR |IV |utf8_distance |NN const U8 *a|NN const U8 *b -ApdPR |U8* |utf8_hop |NN const U8 *s|I32 off -ApMd |U8* |utf8_to_bytes |NN U8 *s|NN STRLEN *len -ApMd |U8* |bytes_from_utf8|NN const U8 *s|NN STRLEN *len|NULLOK bool *is_utf8 -ApMd |U8* |bytes_to_utf8 |NN const U8 *s|NN STRLEN *len -Apd |UV |utf8_to_uvchr |NN const U8 *s|NULLOK STRLEN *retlen -Apd |UV |utf8_to_uvuni |NN const U8 *s|NULLOK STRLEN *retlen - -#ifdef EBCDIC -Adp |UV |utf8n_to_uvchr |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags -#else -Adpbm |UV |utf8n_to_uvchr |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags -#endif - -Adp |UV |utf8n_to_uvuni |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags - -#ifdef EBCDIC -Apd |U8* |uvchr_to_utf8 |NN U8 *d|UV uv -#else -Apdbm |U8* |uvchr_to_utf8 |NN U8 *d|UV uv -#endif - -Apbm |U8* |uvuni_to_utf8 |NN U8 *d|UV uv -Ap |U8* |uvchr_to_utf8_flags |NN U8 *d|UV uv|UV flags -Apd |U8* |uvuni_to_utf8_flags |NN U8 *d|UV uv|UV flags -Apd |char* |pv_uni_display |NN SV *dsv|NN const U8 *spv|STRLEN len|STRLEN pvlim|UV flags -ApdR |char* |sv_uni_display |NN SV *dsv|NN SV *ssv|STRLEN pvlim|UV flags -EXp |void |vivify_defelem |NN SV* sv -p |void |vivify_ref |NN SV* sv|U32 to_what -p |I32 |wait4pid |Pid_t pid|NN int* statusp|int flags -p |U32 |parse_unicode_opts|NN const char **popt -Ap |U32 |seed -pR |UV |get_hash_seed -p |void |report_evil_fh |NULLOK const GV *gv|NULLOK const IO *io|I32 op -XEpd |void |report_uninit |NULLOK SV* uninit_sv -Afpd |void |warn |NN const char* pat|... -Ap |void |vwarn |NN const char* pat|NULLOK va_list* args -Afp |void |warner |U32 err|NN const char* pat|... -Ap |void |vwarner |U32 err|NN const char* pat|NULLOK va_list* args -p |void |watch |NN char** addr -Ap |I32 |whichsig |NN const char* sig -p |void |write_to_stderr|NN const char* message|int msglen -p |int |yyerror |NN const char *const s -EXp |int |yylex -p |int |yyparse -p |void |parser_free |NN const yy_parser *parser -p |int |yywarn |NN const char *const s -#if defined(MYMALLOC) -Ap |void |dump_mstats |NN const char* s -Ap |int |get_mstats |NN perl_mstats_t *buf|int buflen|int level -#endif -Anpa |Malloc_t|safesysmalloc |MEM_SIZE nbytes -Anpa |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size -Anpa |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes -Anp |Free_t |safesysfree |Malloc_t where -#if defined(PERL_GLOBAL_STRUCT) -Ap |struct perl_vars *|GetVars -Ap |struct perl_vars*|init_global_struct -Ap |void |free_global_struct|NN struct perl_vars *plvarsp -#endif -Ap |int |runops_standard -Ap |int |runops_debug -Afpd |void |sv_catpvf_mg |NN SV *const sv|NN const char *const pat|... -Apd |void |sv_vcatpvf_mg |NN SV *const sv|NN const char *const pat \ - |NULLOK va_list *const args -Apd |void |sv_catpv_mg |NN SV *const sv|NULLOK const char *const ptr -Apdbm |void |sv_catpvn_mg |NN SV *sv|NN const char *ptr|STRLEN len -Apdbm |void |sv_catsv_mg |NN SV *dsv|NULLOK SV *ssv -Afpd |void |sv_setpvf_mg |NN SV *const sv|NN const char *const pat|... -Apd |void |sv_vsetpvf_mg |NN SV *const sv|NN const char *const pat \ - |NULLOK va_list *const args -Apd |void |sv_setiv_mg |NN SV *const sv|const IV i -Apdb |void |sv_setpviv_mg |NN SV *const sv|const IV iv -Apd |void |sv_setuv_mg |NN SV *const sv|const UV u -Apd |void |sv_setnv_mg |NN SV *const sv|const NV num -Apd |void |sv_setpv_mg |NN SV *const sv|NULLOK const char *const ptr -Apd |void |sv_setpvn_mg |NN SV *const sv|NN const char *const ptr|const STRLEN len -Apd |void |sv_setsv_mg |NN SV *const dstr|NULLOK SV *const sstr -Apdbm |void |sv_usepvn_mg |NN SV *sv|NULLOK char *ptr|STRLEN len -ApR |MGVTBL*|get_vtbl |int vtbl_id -Apd |char* |pv_display |NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \ - |STRLEN pvlim -Apd |char* |pv_escape |NN SV *dsv|NN char const * const str\ - |const STRLEN count|const STRLEN max\ - |NULLOK STRLEN * const escaped\ - |const U32 flags -Apd |char* |pv_pretty |NN SV *dsv|NN char const * const str\ - |const STRLEN count|const STRLEN max\ - |NULLOK char const * const start_color\ - |NULLOK char const * const end_color\ - |const U32 flags -Afp |void |dump_indent |I32 level|NN PerlIO *file|NN const char* pat|... -Ap |void |dump_vindent |I32 level|NN PerlIO *file|NN const char* pat \ - |NULLOK va_list *args -Ap |void |do_gv_dump |I32 level|NN PerlIO *file|NN const char *name\ - |NULLOK GV *sv -Ap |void |do_gvgv_dump |I32 level|NN PerlIO *file|NN const char *name\ - |NULLOK GV *sv -Ap |void |do_hv_dump |I32 level|NN PerlIO *file|NN const char *name\ - |NULLOK HV *sv -Ap |void |do_magic_dump |I32 level|NN PerlIO *file|NN const MAGIC *mg|I32 nest \ - |I32 maxnest|bool dumpops|STRLEN pvlim -Ap |void |do_op_dump |I32 level|NN PerlIO *file|NULLOK const OP *o -Ap |void |do_pmop_dump |I32 level|NN PerlIO *file|NULLOK const PMOP *pm -Ap |void |do_sv_dump |I32 level|NN PerlIO *file|NULLOK SV *sv|I32 nest \ - |I32 maxnest|bool dumpops|STRLEN pvlim -Ap |void |magic_dump |NULLOK const MAGIC *mg -Ap |void |reginitcolors -ApdRmb |char* |sv_2pv_nolen |NN SV* sv -ApdRmb |char* |sv_2pvutf8_nolen|NN SV* sv -ApdRmb |char* |sv_2pvbyte_nolen|NN SV* sv -AmdbR |char* |sv_pv |NN SV *sv -AmdbR |char* |sv_pvutf8 |NN SV *sv -AmdbR |char* |sv_pvbyte |NN SV *sv -Amdb |STRLEN |sv_utf8_upgrade|NN SV *sv -ApdM |bool |sv_utf8_downgrade|NN SV *const sv|const bool fail_ok -Apd |void |sv_utf8_encode |NN SV *const sv -ApdM |bool |sv_utf8_decode |NN SV *const sv -Apdmb |void |sv_force_normal|NN SV *sv -Apd |void |sv_force_normal_flags|NN SV *const sv|const U32 flags -Ap |void |tmps_grow |I32 n -Apd |SV* |sv_rvweaken |NN SV *const sv -p |int |magic_killbackrefs|NN SV *sv|NN MAGIC *mg -Ap |OP* |newANONATTRSUB |I32 floor|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block -Ap |CV* |newATTRSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block -#ifdef PERL_MAD -Apr |OP * |newMYSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto \ - |NULLOK OP *attrs|NULLOK OP *block -#else -Apr |void |newMYSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block -#endif -p |OP * |my_attrs |NN OP *o|NULLOK OP *attrs -p |void |boot_core_xsutils -#if defined(USE_ITHREADS) -ApR |PERL_CONTEXT*|cx_dup |NULLOK PERL_CONTEXT* cx|I32 ix|I32 max|NN CLONE_PARAMS* param -ApR |PERL_SI*|si_dup |NULLOK PERL_SI* si|NN CLONE_PARAMS* param -Apa |ANY* |ss_dup |NN PerlInterpreter* proto_perl|NN CLONE_PARAMS* param -ApR |void* |any_dup |NULLOK void* v|NN const PerlInterpreter* proto_perl -ApR |HE* |he_dup |NULLOK const HE* e|bool shared|NN CLONE_PARAMS* param -ApR |HEK* |hek_dup |NULLOK HEK* e|NN CLONE_PARAMS* param -Ap |void |re_dup_guts |NN const REGEXP *sstr|NN REGEXP *dstr \ - |NN CLONE_PARAMS* param -Ap |PerlIO*|fp_dup |NULLOK PerlIO *const fp|const char type|NN CLONE_PARAMS *const param -ApR |DIR* |dirp_dup |NULLOK DIR *const dp -ApR |GP* |gp_dup |NULLOK GP *const gp|NN CLONE_PARAMS *const param -ApR |MAGIC* |mg_dup |NULLOK MAGIC *mg|NN CLONE_PARAMS *const param -ApR |SV* |sv_dup |NULLOK const SV *const sstr|NN CLONE_PARAMS *const param -Ap |void |rvpv_dup |NN SV *const dstr|NN const SV *const sstr|NN CLONE_PARAMS *const param -Ap |yy_parser*|parser_dup |NULLOK const yy_parser *const proto|NN CLONE_PARAMS *const param -#endif -Apa |PTR_TBL_t*|ptr_table_new -ApR |void* |ptr_table_fetch|NN PTR_TBL_t *const tbl|NULLOK const void *const sv -Ap |void |ptr_table_store|NN PTR_TBL_t *const tbl|NULLOK const void *const oldsv \ - |NN void *const newsv -Ap |void |ptr_table_split|NN PTR_TBL_t *const tbl -Ap |void |ptr_table_clear|NULLOK PTR_TBL_t *const tbl -Ap |void |ptr_table_free|NULLOK PTR_TBL_t *const tbl -#if defined(USE_ITHREADS) -# if defined(HAVE_INTERP_INTERN) -Ap |void |sys_intern_dup |NN struct interp_intern* src|NN struct interp_intern* dst -# endif -#endif -#if defined(HAVE_INTERP_INTERN) -Ap |void |sys_intern_clear -Ap |void |sys_intern_init -#endif - -ApR |const char * |custom_op_name |NN const OP *o -ApR |const char * |custom_op_desc |NN const OP *o - -Adp |void |sv_nosharing |NULLOK SV *sv -Adpbm |void |sv_nolocking |NULLOK SV *sv -Adp |bool |sv_destroyable |NULLOK SV *sv -#ifdef NO_MATHOMS -Adpbm |void |sv_nounlocking |NULLOK SV *sv -#else -Adpb |void |sv_nounlocking |NULLOK SV *sv -#endif -Adp |int |nothreadhook - -END_EXTERN_C - -#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -sR |I32 |do_trans_simple |NN SV * const sv -sR |I32 |do_trans_count |NN SV * const sv -sR |I32 |do_trans_complex |NN SV * const sv -sR |I32 |do_trans_simple_utf8 |NN SV * const sv -sR |I32 |do_trans_count_utf8 |NN SV * const sv -sR |I32 |do_trans_complex_utf8 |NN SV * const sv -#endif - -#if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) -s |void |gv_init_sv |NN GV *gv|const svtype sv_type -s |HV* |gv_get_super_pkg|NN const char* name|I32 namelen -s |HV* |require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \ - |NN const char *methpv|const U32 flags -#endif - -: #if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) -paRxo |void* |get_arena |const size_t svtype|const U32 misc -: #endif - -#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) -s |void |hsplit |NN HV *hv -s |void |hfreeentries |NN HV *hv -sa |HE* |new_he -sanR |HEK* |save_hek_flags |NN const char *str|I32 len|U32 hash|int flags -sn |void |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store -s |void |unshare_hek_or_pvn|NULLOK const HEK* hek|NULLOK const char* str|I32 len|U32 hash -sR |HEK* |share_hek_flags|NN const char *str|I32 len|U32 hash|int flags -rs |void |hv_notallowed |int flags|NN const char *key|I32 klen|NN const char *msg -sn |struct xpvhv_aux*|hv_auxinit|NN HV *hv -sM |SV* |hv_delete_common|NULLOK HV *hv|NULLOK SV *keysv \ - |NULLOK const char *key|STRLEN klen|int k_flags|I32 d_flags \ - |U32 hash -sM |void |clear_placeholders |NN HV *hv|U32 items -sM |SV * |refcounted_he_value |NN const struct refcounted_he *he -#endif - -#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) -s |void |save_magic |I32 mgs_ix|NN SV *sv -s |int |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN const char *meth -s |int |magic_methcall |NN SV *sv|NN const MAGIC *mg|NN const char *meth|I32 f \ - |int n|NULLOK SV *val -s |void |restore_magic |NULLOK const void *p -s |void |unwind_handler_stack|NN const void *p - -#endif - -#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) -pR |OP* |ck_anoncode |NN OP *o -pR |OP* |ck_bitop |NN OP *o -pR |OP* |ck_concat |NN OP *o -pR |OP* |ck_defined |NN OP *o -pR |OP* |ck_delete |NN OP *o -pR |OP* |ck_die |NN OP *o -pR |OP* |ck_eof |NN OP *o -pR |OP* |ck_eval |NN OP *o -pR |OP* |ck_exec |NN OP *o -pR |OP* |ck_exists |NN OP *o -pR |OP* |ck_exit |NN OP *o -pR |OP* |ck_ftst |NN OP *o -pR |OP* |ck_fun |NN OP *o -pR |OP* |ck_glob |NN OP *o -pR |OP* |ck_grep |NN OP *o -pR |OP* |ck_index |NN OP *o -pR |OP* |ck_join |NN OP *o -pR |OP* |ck_lfun |NN OP *o -pR |OP* |ck_listiob |NN OP *o -pR |OP* |ck_match |NN OP *o -pR |OP* |ck_method |NN OP *o -pR |OP* |ck_null |NN OP *o -pR |OP* |ck_open |NN OP *o -pR |OP* |ck_readline |NN OP *o -pR |OP* |ck_repeat |NN OP *o -pR |OP* |ck_require |NN OP *o -pR |OP* |ck_return |NN OP *o -pR |OP* |ck_rfun |NN OP *o -pR |OP* |ck_rvconst |NN OP *o -pR |OP* |ck_sassign |NN OP *o -pR |OP* |ck_select |NN OP *o -pR |OP* |ck_shift |NN OP *o -pR |OP* |ck_sort |NN OP *o -pR |OP* |ck_spair |NN OP *o -pR |OP* |ck_split |NN OP *o -pR |OP* |ck_subr |NN OP *o -pR |OP* |ck_substr |NN OP *o -pR |OP* |ck_svconst |NN OP *o -pR |OP* |ck_trunc |NN OP *o -pR |OP* |ck_unpack |NN OP *o -pR |OP* |ck_each |NN OP *o -sRn |bool |is_handle_constructor|NN const OP *o|I32 numargs -sR |I32 |is_list_assignment|NULLOK const OP *o -# ifdef USE_ITHREADS -so |void |forget_pmop |NN PMOP *const o|U32 flags -# else -so |void |forget_pmop |NN PMOP *const o -# endif -s |void |find_and_forget_pmops |NN OP *o -s |void |cop_free |NN COP *cop -s |OP* |modkids |NULLOK OP *o|I32 type -s |OP* |scalarboolean |NN OP *o -sR |OP* |newDEFSVOP -sR |OP* |new_logop |I32 type|I32 flags|NN OP **firstp|NN OP **otherp -s |void |simplify_sort |NN OP *o -s |const char* |gv_ename |NN GV *gv -sRn |bool |scalar_mod_type|NN const OP *o|I32 type -s |OP * |my_kid |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp -s |OP * |dup_attrlist |NN OP *o -s |void |apply_attrs |NN HV *stash|NN SV *target|NULLOK OP *attrs|bool for_my -s |void |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp -s |void |bad_type |I32 n|NN const char *t|NN const char *name|NN const OP *kid -s |void |no_bareword_allowed|NN const OP *o -sR |OP* |no_fh_allowed|NN OP *o -sR |OP* |too_few_arguments|NN OP *o|NN const char* name -sR |OP* |too_many_arguments|NN OP *o|NN const char* name -s |bool |looks_like_bool|NN const OP* o -s |OP* |newGIVWHENOP |NULLOK OP* cond|NN OP *block \ - |I32 enter_opcode|I32 leave_opcode \ - |PADOFFSET entertarg -s |OP* |ref_array_or_hash|NULLOK OP* cond -s |void |process_special_blocks |NN const char *const fullname\ - |NN GV *const gv|NN CV *const cv -#endif -#if defined(PL_OP_SLAB_ALLOC) -Apa |void* |Slab_Alloc |size_t sz -Ap |void |Slab_Free |NN void *op -# if defined(PERL_DEBUG_READONLY_OPS) -poxM |void |pending_Slabs_to_ro -poxM |OP * |op_refcnt_inc |NULLOK OP *o -poxM |PADOFFSET |op_refcnt_dec |NN OP *o -# if defined(PERL_IN_OP_C) -s |void |Slab_to_rw |NN void *op -# endif -# endif -#endif - -#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) -s |void |find_beginning |NN SV* linestr_sv|NN PerlIO *rsfp -s |void |forbid_setid |const char flag|const bool suidscript -s |void |incpush |NULLOK const char *dir|bool addsubdirs|bool addoldvers|bool usesep|bool canrelocate -s |void |init_interp -s |void |init_ids -s |void |init_main_stash -s |void |init_perllib -s |void |init_postdump_symbols|int argc|NN char **argv|NULLOK char **env -s |void |init_predump_symbols -rs |void |my_exit_jump -s |void |nuke_stacks -s |int |open_script |NN const char *scriptname|bool dosearch \ - |NN bool *suidscript|NN PerlIO **rsfpp -s |void |usage |NN const char *name -#ifdef DOSUID -# ifdef IAMSUID -so |void |validate_suid |NN const char *validarg \ - |int fdscript \ - |bool suidscript|NN SV* linestr_sv \ - |NN PerlIO *rsfp -# else -so |void |validate_suid |NN const char *validarg \ - |NN const char *scriptname|int fdscript \ - |NN SV* linestr_sv \ - |NN PerlIO *rsfp -# endif -#else -# ifndef SETUID_SCRIPTS_ARE_SECURE_NOW -so |void |validate_suid |NN PerlIO *rsfp -# endif -#endif - -# if defined(IAMSUID) -s |int |fd_on_nosuid_fs|int fd -# endif -s |void* |parse_body |NULLOK char **env|XSINIT_t xsinit -rs |void |run_body |I32 oldscope -s |SV * |incpush_if_exists|NN SV *dir -#endif - -#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) -sR |SV* |refto |NN SV* sv -#endif -#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) -pRxo |GV* |softref2xv |NN SV *const sv|NN const char *const what \ - |const svtype type|NN SV ***spp -#endif - -#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT) -s |I32 |unpack_rec |NN struct tempsym* symptr|NN const char *s \ - |NN const char *strbeg|NN const char *strend|NULLOK const char **new_s -s |SV ** |pack_rec |NN SV *cat|NN struct tempsym* symptr|NN SV **beglist|NN SV **endlist -s |SV* |mul128 |NN SV *sv|U8 m -s |I32 |measure_struct |NN struct tempsym* symptr -s |bool |next_symbol |NN struct tempsym* symptr -sR |SV* |is_an_int |NN const char *s|STRLEN l -s |int |div128 |NN SV *pnum|NN bool *done -s |const char *|group_end |NN const char *patptr|NN const char *patend \ - |char ender -sR |const char *|get_num |NN const char *patptr|NN I32 *lenptr -ns |bool |need_utf8 |NN const char *pat|NN const char *patend -ns |char |first_symbol |NN const char *pat|NN const char *patend -sR |char * |sv_exp_grow |NN SV *sv|STRLEN needed -snR |char * |bytes_to_uni |NN const U8 *start|STRLEN len|NN char *dest -#endif - -#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) -sR |OP* |docatch |NULLOK OP *o -sR |OP* |dofindlabel |NN OP *o|NN const char *label|NN OP **opstack|NN OP **oplimit -sR |OP* |doparseform |NN SV *sv -snR |bool |num_overflow |NV value|I32 fldsize|I32 frcsize -sR |I32 |dopoptoeval |I32 startingblock -sR |I32 |dopoptogiven |I32 startingblock -sR |I32 |dopoptolabel |NN const char *label -sR |I32 |dopoptoloop |I32 startingblock -sR |I32 |dopoptosub_at |NN const PERL_CONTEXT* cxstk|I32 startingblock -sR |I32 |dopoptowhen |I32 startingblock -s |void |save_lines |NULLOK AV *array|NN SV *sv -s |bool |doeval |int gimme|NULLOK OP** startop|NULLOK CV* outside|U32 seq -sR |PerlIO *|check_type_and_open|NN const char *name -#ifndef PERL_DISABLE_PMC -sR |PerlIO *|doopen_pm |NN const char *name|const STRLEN namelen -#endif -sRn |bool |path_is_absolute|NN const char *name -sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen -sR |PMOP* |make_matcher |NN REGEXP* re -sR |bool |matcher_matches_sv|NN PMOP* matcher|NN SV* sv -s |void |destroy_matcher|NN PMOP* matcher -s |OP* |do_smartmatch |NULLOK HV* seen_this|NULLOK HV* seen_other -#endif - -#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) -s |void |do_oddball |NN HV *hash|NN SV **relem|NN SV **firstrelem -sR |SV* |method_common |NN SV* meth|NULLOK U32* hashp -#endif - -#if defined(PERL_IN_PP_SORT_C) || defined(PERL_DECL_PROT) -s |I32 |sv_ncmp |NN SV *const a|NN SV *const b -s |I32 |sv_i_ncmp |NN SV *const a|NN SV *const b -s |I32 |amagic_ncmp |NN SV *const a|NN SV *const b -s |I32 |amagic_i_ncmp |NN SV *const a|NN SV *const b -s |I32 |amagic_cmp |NN SV *const str1|NN SV *const str2 -s |I32 |amagic_cmp_locale|NN SV *const str1|NN SV *const str2 -s |I32 |sortcv |NN SV *const a|NN SV *const b -s |I32 |sortcv_xsub |NN SV *const a|NN SV *const b -s |I32 |sortcv_stacked |NN SV *const a|NN SV *const b -s |void |qsortsvu |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t compare -#endif - -#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT) -s |OP* |doform |NN CV *cv|NN GV *gv|NN OP *retop -# if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) -sR |int |dooneliner |NN const char *cmd|NN const char *filename -# endif -s |SV * |space_join_names_mortal|NN char *const *array -#endif - -#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT) -Es |regnode*|reg |NN struct RExC_state_t *pRExC_state \ - |I32 paren|NN I32 *flagp|U32 depth -Es |regnode*|reganode |NN struct RExC_state_t *pRExC_state|U8 op \ - |U32 arg -Es |regnode*|regatom |NN struct RExC_state_t *pRExC_state \ - |NN I32 *flagp|U32 depth -Es |regnode*|regbranch |NN struct RExC_state_t *pRExC_state \ - |NN I32 *flagp|I32 first|U32 depth -Es |STRLEN |reguni |NN const struct RExC_state_t *pRExC_state \ - |UV uv|NN char *s -Es |regnode*|regclass |NN struct RExC_state_t *pRExC_state|U32 depth -ERsn |I32 |regcurly |NN const char *s -Es |regnode*|reg_node |NN struct RExC_state_t *pRExC_state|U8 op -Es |UV |reg_recode |const char value|NN SV **encp -Es |regnode*|regpiece |NN struct RExC_state_t *pRExC_state \ - |NN I32 *flagp|U32 depth -Es |regnode*|reg_namedseq |NN struct RExC_state_t *pRExC_state \ - |NULLOK UV *valuep -Es |void |reginsert |NN struct RExC_state_t *pRExC_state \ - |U8 op|NN regnode *opnd|U32 depth -Es |void |regtail |NN struct RExC_state_t *pRExC_state \ - |NN regnode *p|NN const regnode *val|U32 depth -Es |SV * |reg_scan_name |NN struct RExC_state_t *pRExC_state \ - |U32 flags -Es |U32 |join_exact |NN struct RExC_state_t *pRExC_state \ - |NN regnode *scan|NN I32 *min|U32 flags|NULLOK regnode *val|U32 depth -EsRn |char * |regwhite |NN struct RExC_state_t *pRExC_state \ - |NN char *p -Es |char * |nextchar |NN struct RExC_state_t *pRExC_state -Es |bool |reg_skipcomment|NN struct RExC_state_t *pRExC_state -Es |void |scan_commit |NN const struct RExC_state_t *pRExC_state \ - |NN struct scan_data_t *data|NN I32 *minlenp \ - |int is_inf -Esn |void |cl_anything |NN const struct RExC_state_t *pRExC_state \ - |NN struct regnode_charclass_class *cl -EsRn |int |cl_is_anything |NN const struct regnode_charclass_class *cl -Esn |void |cl_init |NN const struct RExC_state_t *pRExC_state \ - |NN struct regnode_charclass_class *cl -Esn |void |cl_init_zero |NN const struct RExC_state_t *pRExC_state \ - |NN struct regnode_charclass_class *cl -Esn |void |cl_and |NN struct regnode_charclass_class *cl \ - |NN const struct regnode_charclass_class *and_with -Esn |void |cl_or |NN const struct RExC_state_t *pRExC_state \ - |NN struct regnode_charclass_class *cl \ - |NN const struct regnode_charclass_class *or_with -Es |I32 |study_chunk |NN struct RExC_state_t *pRExC_state \ - |NN regnode **scanp|NN I32 *minlenp \ - |NN I32 *deltap|NN regnode *last \ - |NULLOK struct scan_data_t *data \ - |I32 stopparen|NULLOK U8* recursed \ - |NULLOK struct regnode_charclass_class *and_withp \ - |U32 flags|U32 depth -EsRn |U32 |add_data |NN struct RExC_state_t *pRExC_state|U32 n \ - |NN const char *s -rs |void |re_croak2 |NN const char* pat1|NN const char* pat2|... -Es |I32 |regpposixcc |NN struct RExC_state_t *pRExC_state|I32 value -Es |void |checkposixcc |NN struct RExC_state_t *pRExC_state -Es |I32 |make_trie |NN struct RExC_state_t *pRExC_state \ - |NN regnode *startbranch|NN regnode *first \ - |NN regnode *last|NN regnode *tail \ - |U32 word_count|U32 flags|U32 depth -Es |void |make_trie_failtable |NN struct RExC_state_t *pRExC_state \ - |NN regnode *source|NN regnode *stclass \ - |U32 depth -# ifdef DEBUGGING -Es |void |regdump_extflags|NULLOK const char *lead| const U32 flags -Es |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \ - |NN const regnode *node \ - |NULLOK const regnode *last \ - |NULLOK const regnode *plast \ - |NN SV* sv|I32 indent|U32 depth -Es |void |put_byte |NN SV* sv|int c -Es |void |dump_trie |NN const struct _reg_trie_data *trie\ - |NULLOK HV* widecharmap|NN AV *revcharmap\ - |U32 depth -Es |void |dump_trie_interim_list|NN const struct _reg_trie_data *trie\ - |NULLOK HV* widecharmap|NN AV *revcharmap\ - |U32 next_alloc|U32 depth -Es |void |dump_trie_interim_table|NN const struct _reg_trie_data *trie\ - |NULLOK HV* widecharmap|NN AV *revcharmap\ - |U32 next_alloc|U32 depth -Es |U8 |regtail_study |NN struct RExC_state_t *pRExC_state \ - |NN regnode *p|NN const regnode *val|U32 depth -# endif -#endif - -#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT) -ERs |I32 |regmatch |NN regmatch_info *reginfo|NN regnode *prog -ERs |I32 |regrepeat |NN const regexp *prog|NN const regnode *p|I32 max|int depth -ERs |I32 |regtry |NN regmatch_info *reginfo|NN char **startpos -ERs |bool |reginclass |NULLOK const regexp *prog|NN const regnode *n|NN const U8 *p|NULLOK STRLEN *lenp\ - |bool do_utf8sv_is_utf8 -Es |CHECKPOINT|regcppush |I32 parenfloor -Es |char* |regcppop |NN const regexp *rex -ERsn |U8* |reghop3 |NN U8 *s|I32 off|NN const U8 *lim -#ifdef XXX_dmq -ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN const U8 *llim \ - |NN const U8 *rlim -#endif -ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim -ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo -Es |void |swap_match_buff|NN regexp * prog -Es |void |to_utf8_substr |NN regexp * prog -Es |void |to_byte_substr |NN regexp * prog -ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \ - |NN const regnode *scan -# ifdef DEBUGGING -Es |void |dump_exec_pos |NN const char *locinput|NN const regnode *scan|NN const char *loc_regeol\ - |NN const char *loc_bostr|NN const char *loc_reg_starttry|const bool do_utf8 -Es |void |debug_start_match|NN const REGEXP *prog|const bool do_utf8\ - |NN const char *start|NN const char *end\ - |NN const char *blurb -# endif -#endif - -#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) -s |CV* |deb_curcv |const I32 ix -s |void |debprof |NN const OP *o -s |void |sequence |NULLOK const OP *o -s |void |sequence_tail |NULLOK const OP *o -s |UV |sequence_num |NULLOK const OP *o -s |SV* |pm_description |NN const PMOP *pm -#endif - -#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) -s |SV* |save_scalar_at |NN SV **sptr -#endif - -#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) -po |void |sv_add_backref |NN SV *const tsv|NN SV *const sv -#endif - -#if defined(PERL_IN_HV_C) || defined(PERL_IN_MG_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) -poM |int |sv_kill_backrefs |NN SV *const sv|NN AV *const av -#endif - -#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) -nsR |char * |uiv_2buf |NN char *const buf|const IV iv|UV uv|const int is_uv|NN char **const peob -s |void |sv_unglob |NN SV *const sv -s |void |not_a_number |NN SV *const sv -s |I32 |visit |NN SVFUNC_t f|const U32 flags|const U32 mask -s |void |sv_del_backref |NN SV *const tsv|NN SV *const sv -sR |SV * |varname |NULLOK GV *gv|const char gvtype|PADOFFSET targ \ - |NULLOK SV *keyname|I32 aindex|int subscript_type -# ifdef DEBUGGING -s |void |del_sv |NN SV *p -# endif -# if !defined(NV_PRESERVES_UV) -# ifdef DEBUGGING -s |int |sv_2iuv_non_preserve |NN SV *const sv|I32 numtype -# else -s |int |sv_2iuv_non_preserve |NN SV *const sv -# endif -# endif -sR |I32 |expect_number |NN char **const pattern -# -sn |STRLEN |sv_pos_u2b_forwards|NN const U8 *const start \ - |NN const U8 *const send|STRLEN uoffset -sn |STRLEN |sv_pos_u2b_midway|NN const U8 *const start \ - |NN const U8 *send|const STRLEN uoffset|const STRLEN uend -s |STRLEN |sv_pos_u2b_cached|NN SV *const sv|NN MAGIC **const mgp \ - |NN const U8 *const start|NN const U8 *const send \ - |const STRLEN uoffset|STRLEN uoffset0|STRLEN boffset0 -s |void |utf8_mg_pos_cache_update|NN SV *const sv|NN MAGIC **const mgp \ - |const STRLEN byte|const STRLEN utf8|const STRLEN blen -s |STRLEN |sv_pos_b2u_midway|NN const U8 *const s|NN const U8 *const target \ - |NN const U8 *end|STRLEN endu -sn |char * |F0convert |NV nv|NN char *const endbuf|NN STRLEN *const len -# if defined(PERL_OLD_COPY_ON_WRITE) -sM |void |sv_release_COW |NN SV *sv|NN const char *pvx|NN SV *after -# endif -s |SV * |more_sv -s |void * |more_bodies |const svtype sv_type -s |bool |sv_2iuv_common |NN SV *const sv -s |void |glob_assign_glob|NN SV *const dstr|NN SV *const sstr \ - |const int dtype -s |void |glob_assign_ref|NN SV *const dstr|NN SV *const sstr -sRn |PTR_TBL_ENT_t *|ptr_table_find|NN PTR_TBL_t *const tbl|NULLOK const void *const sv -#endif - -#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) -s |void |check_uni -s |void |force_next |I32 type -s |char* |force_version |NN char *s|int guessing -s |char* |force_word |NN char *start|int token|int check_keyword \ - |int allow_pack|int allow_tick -s |SV* |tokeq |NN SV *sv -s |void |readpipe_override| -sR |char* |scan_const |NN char *start -sR |char* |scan_formline |NN char *s -sR |char* |scan_heredoc |NN char *s -s |char* |scan_ident |NN char *s|NN const char *send|NN char *dest \ - |STRLEN destlen|I32 ck_uni -sR |char* |scan_inputsymbol|NN char *start -sR |char* |scan_pat |NN char *start|I32 type -sR |char* |scan_str |NN char *start|int keep_quoted|int keep_delims -sR |char* |scan_subst |NN char *start -sR |char* |scan_trans |NN char *start -s |char* |scan_word |NN char *s|NN char *dest|STRLEN destlen \ - |int allow_package|NN STRLEN *slp -s |void |update_debugger_info|NULLOK SV *orig_sv \ - |NULLOK const char *const buf|STRLEN len -sR |char* |skipspace |NN char *s -sR |char* |swallow_bom |NN U8 *s -s |void |checkcomma |NN const char *s|NN const char *name \ - |NN const char *what -s |bool |feature_is_enabled|NN const char *const name|STRLEN namelen -s |void |force_ident |NN const char *s|int kind -s |void |incline |NN const char *s -s |int |intuit_method |NN char *s|NULLOK GV *gv|NULLOK CV *cv -s |int |intuit_more |NN char *s -s |I32 |lop |I32 f|int x|NN char *s -rs |void |missingterm |NULLOK char *s -s |void |no_op |NN const char *const what|NULLOK char *s -sR |I32 |sublex_done -sR |I32 |sublex_push -sR |I32 |sublex_start -sR |char * |filter_gets |NN SV *sv|NN PerlIO *fp|STRLEN append -sR |HV * |find_in_my_stash|NN const char *pkgname|STRLEN len -sR |char * |tokenize_use |int is_use|NN char *s -so |SV* |new_constant |NULLOK const char *s|STRLEN len \ - |NN const char *key|STRLEN keylen|NN SV *sv \ - |NULLOK SV *pv|NULLOK const char *type \ - |STRLEN typelen -s |int |ao |int toketype -# if defined(PERL_CR_FILTER) -s |I32 |cr_textfilter |int idx|NULLOK SV *sv|int maxlen -s |void |strip_return |NN SV *sv -# endif -# if defined(DEBUGGING) -s |int |tokereport |I32 rv|NN const YYSTYPE* lvalp -s |void |printbuf |NN const char *const fmt|NN const char *const s -# endif -#endif - -#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) -s |bool|isa_lookup |NULLOK HV *stash|NN const char * const name|NULLOK const HV * const name_stash -#endif - -#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT) -#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE) -s |char* |stdize_locale |NN char* locs -#endif -#endif - -#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) -s |const COP*|closest_cop |NN const COP *cop|NULLOK const OP *o -s |SV* |mess_alloc -s |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args \ - |NULLOK STRLEN *msglen|NULLOK I32* utf8 -s |bool |vdie_common |NULLOK const char *message|STRLEN msglen\ - |I32 utf8|bool warn -sr |char * |write_no_mem -#endif - -#if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT) -sn |NV|mulexp10 |NV value|I32 exponent -#endif - -#if defined(PERL_IN_UTF8_C) || defined(PERL_DECL_PROT) -sRn |STRLEN |is_utf8_char_slow|NN const U8 *s|const STRLEN len -sR |bool |is_utf8_common |NN const U8 *const p|NN SV **swash|NN const char * const swashname -sR |SV* |swash_get |NN SV* swash|UV start|UV span -#endif - -START_EXTERN_C - -Apd |void |sv_setsv_flags |NN SV *dstr|NULLOK SV *sstr|const I32 flags -Apd |void |sv_catpvn_flags|NN SV *const dstr|NN const char *sstr|const STRLEN len \ - |const I32 flags -Apd |void |sv_catsv_flags |NN SV *const dsv|NULLOK SV *const ssv|const I32 flags -Apd |STRLEN |sv_utf8_upgrade_flags|NN SV *const sv|const I32 flags -Apd |char* |sv_pvn_force_flags|NN SV *const sv|NULLOK STRLEN *const lp|const I32 flags -Apd |void |sv_copypv |NN SV *const dsv|NN SV *const ssv -Ap |char* |my_atof2 |NN const char *s|NN NV* value -Apn |int |my_socketpair |int family|int type|int protocol|int fd[2] -Ap |int |my_dirfd |NULLOK DIR* dir -#ifdef PERL_OLD_COPY_ON_WRITE -pMXE |SV* |sv_setsv_cow |NN SV* dstr|NN SV* sstr -#endif - -Aop |const char *|PerlIO_context_layers|NULLOK const char *mode - -#if defined(USE_PERLIO) && !defined(USE_SFIO) -Ap |int |PerlIO_close |NULLOK PerlIO *f -Ap |int |PerlIO_fill |NULLOK PerlIO *f -Ap |int |PerlIO_fileno |NULLOK PerlIO *f -Ap |int |PerlIO_eof |NULLOK PerlIO *f -Ap |int |PerlIO_error |NULLOK PerlIO *f -Ap |int |PerlIO_flush |NULLOK PerlIO *f -Ap |void |PerlIO_clearerr |NULLOK PerlIO *f -Ap |void |PerlIO_set_cnt |NULLOK PerlIO *f|int cnt -Ap |void |PerlIO_set_ptrcnt |NULLOK PerlIO *f|NULLOK STDCHAR *ptr \ - |int cnt -Ap |void |PerlIO_setlinebuf |NULLOK PerlIO *f -Ap |SSize_t|PerlIO_read |NULLOK PerlIO *f|NN void *vbuf \ - |Size_t count -Ap |SSize_t|PerlIO_write |NULLOK PerlIO *f|NN const void *vbuf \ - |Size_t count -Ap |SSize_t|PerlIO_unread |NULLOK PerlIO *f|NN const void *vbuf \ - |Size_t count -Ap |Off_t |PerlIO_tell |NULLOK PerlIO *f -Ap |int |PerlIO_seek |NULLOK PerlIO *f|Off_t offset|int whence - -Ap |STDCHAR *|PerlIO_get_base |NULLOK PerlIO *f -Ap |STDCHAR *|PerlIO_get_ptr |NULLOK PerlIO *f -ApR |int |PerlIO_get_bufsiz |NULLOK PerlIO *f -ApR |int |PerlIO_get_cnt |NULLOK PerlIO *f - -ApR |PerlIO *|PerlIO_stdin -ApR |PerlIO *|PerlIO_stdout -ApR |PerlIO *|PerlIO_stderr -#endif /* PERLIO_LAYERS */ - -p |void |deb_stack_all -#ifdef PERL_IN_DEB_C -s |void |deb_stack_n |NN SV** stack_base|I32 stack_min \ - |I32 stack_max|I32 mark_min|I32 mark_max -#endif - -pda |PADLIST*|pad_new |int flags -pd |void |pad_undef |NN CV* cv -pd |PADOFFSET|pad_add_name |NN const char *name\ - |NULLOK HV* typestash|NULLOK HV* ourstash|bool clone|bool state -pd |PADOFFSET|pad_add_anon |NN SV* sv|OPCODE op_type -pd |void |pad_check_dup |NN const char* name|bool is_our|NN const HV* ourstash -#ifdef DEBUGGING -pd |void |pad_setsv |PADOFFSET po|NN SV* sv -#endif -pd |void |pad_block_start|int full -pd |void |pad_tidy |padtidy_type type -pd |void |do_dump_pad |I32 level|NN PerlIO *file|NULLOK PADLIST *padlist|int full -pd |void |pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv - -pdX |void |pad_push |NN PADLIST *padlist|int depth -pR |HV* |pad_compname_type|const PADOFFSET po - -#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) -sd |PADOFFSET|pad_findlex |NN const char *name|NN const CV* cv|U32 seq|int warn \ - |NULLOK SV** out_capture|NN SV** out_name_sv \ - |NN int *out_flags -# if defined(DEBUGGING) -sd |void |cv_dump |NN const CV *cv|NN const char *title -# endif -#endif -ApdR |CV* |find_runcv |NULLOK U32 *db_seqp -p |void |free_tied_hv_pool -#if defined(DEBUGGING) -pR |int |get_debug_opts |NN const char **s|bool givehelp -#endif -Ap |void |save_set_svflags|NN SV *sv|U32 mask|U32 val -Apod |void |hv_assert |NN HV *hv - -ApdR |SV* |hv_scalar |NN HV *hv -ApoR |I32* |hv_riter_p |NN HV *hv -ApoR |HE** |hv_eiter_p |NN HV *hv -Apo |void |hv_riter_set |NN HV *hv|I32 riter -Apo |void |hv_eiter_set |NN HV *hv|NULLOK HE *eiter -Ap |void |hv_name_set |NN HV *hv|NULLOK const char *name|U32 len|U32 flags -poM |AV** |hv_backreferences_p |NN HV *hv -#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) -poM |void |hv_kill_backrefs |NN HV *hv -#endif -Apd |void |hv_clear_placeholders |NN HV *hv -ApoR |I32* |hv_placeholders_p |NN HV *hv -ApoR |I32 |hv_placeholders_get |NN HV *hv -Apo |void |hv_placeholders_set |NN HV *hv|I32 ph - -p |SV* |magic_scalarpack|NN HV *hv|NN MAGIC *mg - -#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) -s |SV * |find_hash_subscript|NULLOK HV *hv|NN SV *val -s |I32 |find_array_subscript|NULLOK AV *av|NN SV *val -sMd |SV* |find_uninit_var|NULLOK OP* obase|NULLOK SV* uninit_sv|bool top -#endif - -#ifdef PERL_NEED_MY_HTOLE16 -np |U16 |my_htole16 |U16 n -#endif -#ifdef PERL_NEED_MY_LETOH16 -np |U16 |my_letoh16 |U16 n -#endif -#ifdef PERL_NEED_MY_HTOBE16 -np |U16 |my_htobe16 |U16 n -#endif -#ifdef PERL_NEED_MY_BETOH16 -np |U16 |my_betoh16 |U16 n -#endif -#ifdef PERL_NEED_MY_HTOLE32 -np |U32 |my_htole32 |U32 n -#endif -#ifdef PERL_NEED_MY_LETOH32 -np |U32 |my_letoh32 |U32 n -#endif -#ifdef PERL_NEED_MY_HTOBE32 -np |U32 |my_htobe32 |U32 n -#endif -#ifdef PERL_NEED_MY_BETOH32 -np |U32 |my_betoh32 |U32 n -#endif -#ifdef PERL_NEED_MY_HTOLE64 -np |U64 |my_htole64 |U64 n -#endif -#ifdef PERL_NEED_MY_LETOH64 -np |U64 |my_letoh64 |U64 n -#endif -#ifdef PERL_NEED_MY_HTOBE64 -np |U64 |my_htobe64 |U64 n -#endif -#ifdef PERL_NEED_MY_BETOH64 -np |U64 |my_betoh64 |U64 n -#endif - -#ifdef PERL_NEED_MY_HTOLES -np |short |my_htoles |short n -#endif -#ifdef PERL_NEED_MY_LETOHS -np |short |my_letohs |short n -#endif -#ifdef PERL_NEED_MY_HTOBES -np |short |my_htobes |short n -#endif -#ifdef PERL_NEED_MY_BETOHS -np |short |my_betohs |short n -#endif -#ifdef PERL_NEED_MY_HTOLEI -np |int |my_htolei |int n -#endif -#ifdef PERL_NEED_MY_LETOHI -np |int |my_letohi |int n -#endif -#ifdef PERL_NEED_MY_HTOBEI -np |int |my_htobei |int n -#endif -#ifdef PERL_NEED_MY_BETOHI -np |int |my_betohi |int n -#endif -#ifdef PERL_NEED_MY_HTOLEL -np |long |my_htolel |long n -#endif -#ifdef PERL_NEED_MY_LETOHL -np |long |my_letohl |long n -#endif -#ifdef PERL_NEED_MY_HTOBEL -np |long |my_htobel |long n -#endif -#ifdef PERL_NEED_MY_BETOHL -np |long |my_betohl |long n -#endif - -np |void |my_swabn |NN void* ptr|int n - -Ap |GV* |gv_fetchpvn_flags|NN const char* name|STRLEN len|I32 flags|const svtype sv_type -Ap |GV* |gv_fetchsv|NN SV *name|I32 flags|const svtype sv_type -dpR |bool |is_gv_magical_sv|NN SV *name|U32 flags - -ApR |bool |stashpv_hvname_match|NN const COP *c|NN const HV *hv - -#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP -p |void |dump_sv_child |NN SV *sv -#endif - -#ifdef PERL_DONT_CREATE_GVSV -Ap |GV* |gv_SVadd |NN GV* gv -#endif -Apo |bool |ckwarn |U32 w -Apo |bool |ckwarn_d |U32 w -XEopMa |STRLEN *|new_warnings_bitfield|NULLOK STRLEN *buffer \ - |NN const char *const bits|STRLEN size - -p |void |offer_nice_chunk |NN void *const chunk|const U32 chunk_size - -#ifndef SPRINTF_RETURNS_STRLEN -Apnod |int |my_sprintf |NN char *buffer|NN const char *pat|... -#endif - -Apnodf |int |my_snprintf |NN char *buffer|const Size_t len|NN const char *format|... -Apnod |int |my_vsnprintf |NN char *buffer|const Size_t len|NN const char *format|va_list ap - -px |void |my_clearenv - -#ifdef PERL_IMPLICIT_CONTEXT -#ifdef PERL_GLOBAL_STRUCT_PRIVATE -Apo |void* |my_cxt_init |NN const char *my_cxt_key|size_t size -Apo |int |my_cxt_index |NN const char *my_cxt_key -#else -Apo |void* |my_cxt_init |NN int *index|size_t size -#endif -#endif - -#ifndef HAS_STRLCAT -Apno |Size_t |my_strlcat |NULLOK char *dst|NULLOK const char *src|Size_t size -#endif - -#ifndef HAS_STRLCPY -Apno |Size_t |my_strlcpy |NULLOK char *dst|NULLOK const char *src|Size_t size -#endif - -#ifdef PERL_MAD -Mnp |void |pad_peg |NN const char* s -#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) -sf |void |xmldump_attr |I32 level|NN PerlIO *file|NN const char* pat \ - |... -#endif -Mfp |void |xmldump_indent |I32 level|NN PerlIO *file|NN const char* pat \ - |... -Mp |void |xmldump_vindent|I32 level|NN PerlIO *file|NN const char* pat \ - |NULLOK va_list *args -Mp |void |xmldump_all -Mp |void |xmldump_packsubs |NN const HV* stash -Mp |void |xmldump_sub |NN const GV* gv -Mp |void |xmldump_form |NN const GV* gv -Mp |void |xmldump_eval -Mp |char* |sv_catxmlsv |NN SV *dsv|NN SV *ssv -Mp |char* |sv_catxmlpvn |NN SV *dsv|NN const char *pv|STRLEN len|int utf8 -Mp |char* |sv_xmlpeek |NN SV* sv -Mp |void |do_pmop_xmldump|I32 level|NN PerlIO *file \ - |NULLOK const PMOP *pm -Mp |void |pmop_xmldump |NULLOK const PMOP* pm -Mp |void |do_op_xmldump |I32 level|NN PerlIO *file|NULLOK const OP *o -Mp |void |op_xmldump |NN const OP *o - -Mp |TOKEN* |newTOKEN |I32 optype|YYSTYPE lval \ - |NULLOK MADPROP* madprop -Mp |void |token_free |NN TOKEN *tk -Mp |void |token_getmad |NN TOKEN *tk|NULLOK OP *o|char slot -Mp |void |op_getmad_weak |NULLOK OP* from|NULLOK OP* o|char slot -Mp |void |op_getmad |NULLOK OP* from|NULLOK OP* o|char slot -Mp |void |prepend_madprops|NULLOK MADPROP* mp|NULLOK OP* o|char slot -Mp |void |append_madprops|NULLOK MADPROP* tm|NULLOK OP* o|char slot -Mp |void |addmad |NULLOK MADPROP* tm|NULLOK MADPROP** root \ - |char slot -Mp |MADPROP*|newMADsv |char key|NN SV* sv -Mp |MADPROP*|newMADPROP |char key|char type|NULLOK const void* val \ - |I32 vlen -Mp |void |mad_free |NULLOK MADPROP* mp - -# if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) -s |char* |skipspace0 |NN char *s -s |char* |skipspace1 |NN char *s -s |char* |skipspace2 |NN char *s|NULLOK SV **sv -s |void |start_force |int where -s |void |curmad |char slot|NULLOK SV *sv -# endif -Mp |int |madlex -Mp |int |madparse -#endif -#if !defined(HAS_SIGNBIT) -AMdnoP |int |Perl_signbit |NV f -#endif - -XEMop |void |emulate_cop_io |NN const COP *const c|NN SV *const sv -XEMop |REGEXP *|get_re_arg|NULLOK SV *sv - -p |struct mro_meta* |mro_meta_init |NN HV* stash -#if defined(USE_ITHREADS) -p |struct mro_meta* |mro_meta_dup |NN struct mro_meta* smeta|NN CLONE_PARAMS* param -#endif -Apd |AV* |mro_get_linear_isa|NN HV* stash -#if defined(PERL_IN_MRO_C) || defined(PERL_DECL_PROT) -sd |AV* |mro_get_linear_isa_c3|NN HV* stash|I32 level -sd |AV* |mro_get_linear_isa_dfs|NN HV* stash|I32 level -#endif -pd |void |mro_isa_changed_in|NN HV* stash -Apd |void |mro_method_changed_in |NN HV* stash -p |void |boot_core_mro -Apon |void |sys_init |NN int* argc|NN char*** argv -Apon |void |sys_init3 |NN int* argc|NN char*** argv|NN char*** env -Apon |void |sys_term -ApoM |const char *|fetch_cop_label|NULLOK struct refcounted_he *const chain \ - |NULLOK STRLEN *len|NULLOK U32 *flags -xpoM |struct refcounted_he *|store_cop_label \ - |NULLOK struct refcounted_he *const chain|NN const char *label - -END_EXTERN_C -/* - * ex: set ts=8 sts=4 sw=4 noet: - */ diff --git a/ext/Devel/PPPort/parts/inc/MY_CXT b/ext/Devel/PPPort/parts/inc/MY_CXT deleted file mode 100644 index d67af01377..0000000000 --- a/ext/Devel/PPPort/parts/inc/MY_CXT +++ /dev/null @@ -1,192 +0,0 @@ -################################################################################ -## -## $Revision: 16 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:55 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -START_MY_CXT -dMY_CXT_SV -dMY_CXT -MY_CXT_INIT -MY_CXT_CLONE -MY_CXT -pMY_CXT -pMY_CXT_ -_pMY_CXT -aMY_CXT -aMY_CXT_ -_aMY_CXT - -=implementation - -/* - * Boilerplate macros for initializing and accessing interpreter-local - * data from C. All statics in extensions should be reworked to use - * this, if you want to make the extension thread-safe. See ext/re/re.xs - * for an example of the use of these macros. - * - * Code that uses these macros is responsible for the following: - * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" - * 2. Declare a typedef named my_cxt_t that is a structure that contains - * all the data that needs to be interpreter-local. - * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. - * 4. Use the MY_CXT_INIT macro such that it is called exactly once - * (typically put in the BOOT: section). - * 5. Use the members of the my_cxt_t structure everywhere as - * MY_CXT.member. - * 6. Use the dMY_CXT macro (a declaration) in all the functions that - * access MY_CXT. - */ - -#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ - defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) - -#ifndef START_MY_CXT - -/* This must appear in all extensions that define a my_cxt_t structure, - * right after the definition (i.e. at file scope). The non-threads - * case below uses it to declare the data as static. */ -#define START_MY_CXT - -#if { VERSION < 5.004_68 } -/* Fetches the SV that keeps the per-interpreter data. */ -#define dMY_CXT_SV \ - SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) -#else /* >= perl5.004_68 */ -#define dMY_CXT_SV \ - SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ - sizeof(MY_CXT_KEY)-1, TRUE) -#endif /* < perl5.004_68 */ - -/* This declaration should be used within all functions that use the - * interpreter-local data. */ -#define dMY_CXT \ - dMY_CXT_SV; \ - my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) - -/* Creates and zeroes the per-interpreter data. - * (We allocate my_cxtp in a Perl SV so that it will be released when - * the interpreter goes away.) */ -#define MY_CXT_INIT \ - dMY_CXT_SV; \ - /* newSV() allocates one more than needed */ \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - Zero(my_cxtp, 1, my_cxt_t); \ - sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) - -/* This macro must be used to access members of the my_cxt_t structure. - * e.g. MYCXT.some_data */ -#define MY_CXT (*my_cxtp) - -/* Judicious use of these macros can reduce the number of times dMY_CXT - * is used. Use is similar to pTHX, aTHX etc. */ -#define pMY_CXT my_cxt_t *my_cxtp -#define pMY_CXT_ pMY_CXT, -#define _pMY_CXT ,pMY_CXT -#define aMY_CXT my_cxtp -#define aMY_CXT_ aMY_CXT, -#define _aMY_CXT ,aMY_CXT - -#endif /* START_MY_CXT */ - -#ifndef MY_CXT_CLONE -/* Clones the per-interpreter data. */ -#define MY_CXT_CLONE \ - dMY_CXT_SV; \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ - sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) -#endif - -#else /* single interpreter */ - -#ifndef START_MY_CXT - -#define START_MY_CXT static my_cxt_t my_cxt; -#define dMY_CXT_SV dNOOP -#define dMY_CXT dNOOP -#define MY_CXT_INIT NOOP -#define MY_CXT my_cxt - -#define pMY_CXT void -#define pMY_CXT_ -#define _pMY_CXT -#define aMY_CXT -#define aMY_CXT_ -#define _aMY_CXT - -#endif /* START_MY_CXT */ - -#ifndef MY_CXT_CLONE -#define MY_CXT_CLONE NOOP -#endif - -#endif - -=xsmisc - -#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION - -typedef struct { - /* Put Global Data in here */ - int dummy; -} my_cxt_t; - -START_MY_CXT - -=xsboot - -{ - MY_CXT_INIT; - /* If any of the fields in the my_cxt_t struct need - * to be initialised, do it here. - */ - MY_CXT.dummy = 42; -} - -=xsubs - -int -MY_CXT_1() - CODE: - dMY_CXT; - RETVAL = MY_CXT.dummy == 42; - ++MY_CXT.dummy; - OUTPUT: - RETVAL - -int -MY_CXT_2() - CODE: - dMY_CXT; - RETVAL = MY_CXT.dummy == 43; - OUTPUT: - RETVAL - -int -MY_CXT_CLONE() - CODE: - MY_CXT_CLONE; - RETVAL = 42; - OUTPUT: - RETVAL - -=tests plan => 3 - -ok(&Devel::PPPort::MY_CXT_1()); -ok(&Devel::PPPort::MY_CXT_2()); -ok(&Devel::PPPort::MY_CXT_CLONE()); - diff --git a/ext/Devel/PPPort/parts/inc/SvPV b/ext/Devel/PPPort/parts/inc/SvPV deleted file mode 100644 index e81fb684c1..0000000000 --- a/ext/Devel/PPPort/parts/inc/SvPV +++ /dev/null @@ -1,524 +0,0 @@ -################################################################################ -## -## $Revision: 22 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:54 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ -SvPVbyte -sv_2pvbyte -sv_2pv_flags -sv_pvn_force_flags - -=dontwarn - -NEED_sv_2pv_flags -NEED_sv_2pv_flags_GLOBAL -DPPP_SVPV_NOLEN_LP_ARG - -=implementation - -/* Backwards compatibility stuff... :-( */ -#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen) -# define NEED_sv_2pv_flags -#endif -#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL) -# define NEED_sv_2pv_flags_GLOBAL -#endif - -/* Hint: sv_2pv_nolen - * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen(). - */ - -__UNDEFINED__ sv_2pv_nolen(sv) SvPV_nolen(sv) - -#ifdef SvPVbyte - -/* Hint: SvPVbyte - * Does not work in perl-5.6.1, ppport.h implements a version - * borrowed from perl-5.7.3. - */ - -#if { VERSION < 5.7.0 } - -#if { NEED sv_2pvbyte } - -char * -sv_2pvbyte(pTHX_ SV *sv, STRLEN *lp) -{ - sv_utf8_downgrade(sv,0); - return SvPV(sv,*lp); -} - -#endif - -/* Hint: sv_2pvbyte - * Use the SvPVbyte() macro instead of sv_2pvbyte(). - */ - -#undef SvPVbyte - -#define SvPVbyte(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) - -#endif - -#else - -# define SvPVbyte SvPV -# define sv_2pvbyte sv_2pv - -#endif - -__UNDEFINED__ sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv) - -/* Hint: sv_pvn - * Always use the SvPV() macro instead of sv_pvn(). - */ - -/* Hint: sv_pvn_force - * Always use the SvPV_force() macro instead of sv_pvn_force(). - */ - -/* If these are undefined, they're not handled by the core anyway */ -__UNDEFINED__ SV_IMMEDIATE_UNREF 0 -__UNDEFINED__ SV_GMAGIC 0 -__UNDEFINED__ SV_COW_DROP_PV 0 -__UNDEFINED__ SV_UTF8_NO_ENCODING 0 -__UNDEFINED__ SV_NOSTEAL 0 -__UNDEFINED__ SV_CONST_RETURN 0 -__UNDEFINED__ SV_MUTABLE_RETURN 0 -__UNDEFINED__ SV_SMAGIC 0 -__UNDEFINED__ SV_HAS_TRAILING_NUL 0 -__UNDEFINED__ SV_COW_SHARED_HASH_KEYS 0 - -#if { VERSION < 5.7.2 } - -#if { NEED sv_2pv_flags } - -char * -sv_2pv_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) -{ - STRLEN n_a = (STRLEN) flags; - return sv_2pv(sv, lp ? lp : &n_a); -} - -#endif - -#if { NEED sv_pvn_force_flags } - -char * -sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) -{ - STRLEN n_a = (STRLEN) flags; - return sv_pvn_force(sv, lp ? lp : &n_a); -} - -#endif - -#endif - -#if { VERSION < 5.8.8 } || ( { VERSION >= 5.9.0 } && { VERSION < 5.9.3 } ) -# define DPPP_SVPV_NOLEN_LP_ARG &PL_na -#else -# define DPPP_SVPV_NOLEN_LP_ARG 0 -#endif - -__UNDEFINED__ SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) -__UNDEFINED__ SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC) - -__UNDEFINED__ SvPV_flags(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) - -__UNDEFINED__ SvPV_flags_const(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ - (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN)) - -__UNDEFINED__ SvPV_flags_const_nolen(sv, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? SvPVX_const(sv) : \ - (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN)) - -__UNDEFINED__ SvPV_flags_mutable(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ - sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) - -__UNDEFINED__ SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC) -__UNDEFINED__ SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC) -__UNDEFINED__ SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC) -__UNDEFINED__ SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0) -__UNDEFINED__ SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) - -__UNDEFINED__ SvPV_force_flags(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) - -__UNDEFINED__ SvPV_force_flags_nolen(sv, flags) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ - ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags)) - -__UNDEFINED__ SvPV_force_flags_mutable(sv, lp, flags) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ - ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ - : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) - -__UNDEFINED__ SvPV_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC)) - -__UNDEFINED__ SvPV_nolen_const(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN)) - -__UNDEFINED__ SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) -__UNDEFINED__ SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0) -__UNDEFINED__ SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0) - -__UNDEFINED__ SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \ - SvPV_set((sv), (char *) saferealloc( \ - (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \ - } STMT_END - -=xsinit - -#define NEED_sv_2pv_flags -#define NEED_sv_pvn_force_flags -#define NEED_sv_2pvbyte - -=xsubs - -IV -SvPVbyte(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPVbyte(sv, len); - RETVAL = strEQ(str, "mhx") ? (IV) len : (IV) -1; - OUTPUT: - RETVAL - -IV -SvPV_nolen(sv) - SV *sv - PREINIT: - char *str; - CODE: - str = SvPV_nolen(sv); - RETVAL = strEQ(str, "mhx") ? 42 : 0; - OUTPUT: - RETVAL - -IV -SvPV_const(sv) - SV *sv - PREINIT: - const char *str; - STRLEN len; - CODE: - str = SvPV_const(sv, len); - RETVAL = len + (strEQ(str, "mhx") ? 40 : 0); - OUTPUT: - RETVAL - -IV -SvPV_mutable(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV_mutable(sv, len); - RETVAL = len + (strEQ(str, "mhx") ? 41 : 0); - OUTPUT: - RETVAL - -IV -SvPV_flags(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV_flags(sv, len, SV_GMAGIC); - RETVAL = len + (strEQ(str, "mhx") ? 42 : 0); - OUTPUT: - RETVAL - -IV -SvPV_flags_const(sv) - SV *sv - PREINIT: - const char *str; - STRLEN len; - CODE: - str = SvPV_flags_const(sv, len, SV_GMAGIC); - RETVAL = len + (strEQ(str, "mhx") ? 43 : 0); - OUTPUT: - RETVAL - -IV -SvPV_flags_const_nolen(sv) - SV *sv - PREINIT: - const char *str; - CODE: - str = SvPV_flags_const_nolen(sv, SV_GMAGIC); - RETVAL = strEQ(str, "mhx") ? 47 : 0; - OUTPUT: - RETVAL - -IV -SvPV_flags_mutable(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV_flags_mutable(sv, len, SV_GMAGIC); - RETVAL = len + (strEQ(str, "mhx") ? 45 : 0); - OUTPUT: - RETVAL - -IV -SvPV_force(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV_force(sv, len); - RETVAL = len + (strEQ(str, "mhx") ? 46 : 0); - OUTPUT: - RETVAL - -IV -SvPV_force_nolen(sv) - SV *sv - PREINIT: - char *str; - CODE: - str = SvPV_force_nolen(sv); - RETVAL = strEQ(str, "mhx") ? 50 : 0; - OUTPUT: - RETVAL - -IV -SvPV_force_mutable(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV_force_mutable(sv, len); - RETVAL = len + (strEQ(str, "mhx") ? 48 : 0); - OUTPUT: - RETVAL - -IV -SvPV_force_nomg(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV_force_nomg(sv, len); - RETVAL = len + (strEQ(str, "mhx") ? 49 : 0); - OUTPUT: - RETVAL - -IV -SvPV_force_nomg_nolen(sv) - SV *sv - PREINIT: - char *str; - CODE: - str = SvPV_force_nomg_nolen(sv); - RETVAL = strEQ(str, "mhx") ? 53 : 0; - OUTPUT: - RETVAL - -IV -SvPV_force_flags(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV_force_flags(sv, len, SV_GMAGIC); - RETVAL = len + (strEQ(str, "mhx") ? 51 : 0); - OUTPUT: - RETVAL - -IV -SvPV_force_flags_nolen(sv) - SV *sv - PREINIT: - char *str; - CODE: - str = SvPV_force_flags_nolen(sv, SV_GMAGIC); - RETVAL = strEQ(str, "mhx") ? 55 : 0; - OUTPUT: - RETVAL - -IV -SvPV_force_flags_mutable(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV_force_flags_mutable(sv, len, SV_GMAGIC); - RETVAL = len + (strEQ(str, "mhx") ? 53 : 0); - OUTPUT: - RETVAL - -IV -SvPV_nolen_const(sv) - SV *sv - PREINIT: - const char *str; - CODE: - str = SvPV_nolen_const(sv); - RETVAL = strEQ(str, "mhx") ? 57 : 0; - OUTPUT: - RETVAL - -IV -SvPV_nomg(sv) - SV *sv - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV_nomg(sv, len); - RETVAL = len + (strEQ(str, "mhx") ? 55 : 0); - OUTPUT: - RETVAL - -IV -SvPV_nomg_const(sv) - SV *sv - PREINIT: - const char *str; - STRLEN len; - CODE: - str = SvPV_nomg_const(sv, len); - RETVAL = len + (strEQ(str, "mhx") ? 56 : 0); - OUTPUT: - RETVAL - -IV -SvPV_nomg_const_nolen(sv) - SV *sv - PREINIT: - const char *str; - CODE: - str = SvPV_nomg_const_nolen(sv); - RETVAL = strEQ(str, "mhx") ? 60 : 0; - OUTPUT: - RETVAL - -void -SvPV_renew(sv, nlen, insv) - SV *sv - IV nlen - SV *insv - PREINIT: - STRLEN slen; - const char *str; - PPCODE: - str = SvPV_const(insv, slen); - XPUSHs(sv); - mXPUSHi(SvLEN(sv)); - SvPV_renew(sv, nlen); - Copy(str, SvPVX(sv), slen + 1, char); - SvCUR_set(sv, slen); - mXPUSHi(SvLEN(sv)); - - -=tests plan => 47 - -my $mhx = "mhx"; - -ok(&Devel::PPPort::SvPVbyte($mhx), 3); - -my $i = 42; - -ok(&Devel::PPPort::SvPV_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_const($mhx), $i++); -ok(&Devel::PPPort::SvPV_mutable($mhx), $i++); -ok(&Devel::PPPort::SvPV_flags($mhx), $i++); -ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++); - -ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++); -ok(&Devel::PPPort::SvPV_force($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++); - -ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++); - -ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++); -ok(&Devel::PPPort::SvPV_nomg($mhx), $i++); -ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++); -ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++); - -$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2); - -$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2); - -$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2); - -$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0); - -my $str = ""; -my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80); -ok($str, "x"x80); -ok($s2, "x"x80); -ok($before < 81); -ok($after, 81); - -$str = "x"x400; -($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40); -ok($str, "x"x40); -ok($s2, "x"x40); -ok($before > 41); -ok($after, 41); diff --git a/ext/Devel/PPPort/parts/inc/SvREFCNT b/ext/Devel/PPPort/parts/inc/SvREFCNT deleted file mode 100644 index 46c5deb356..0000000000 --- a/ext/Devel/PPPort/parts/inc/SvREFCNT +++ /dev/null @@ -1,130 +0,0 @@ -################################################################################ -## -## $Revision: 5 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:52 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -SvREFCNT_inc -SvREFCNT_inc_simple -SvREFCNT_inc_NN -SvREFCNT_inc_void -__UNDEFINED__ - -=implementation - -#ifndef SvREFCNT_inc -# ifdef PERL_USE_GCC_BRACE_GROUPS -# define SvREFCNT_inc(sv) \ - ({ \ - SV * const _sv = (SV*)(sv); \ - if (_sv) \ - (SvREFCNT(_sv))++; \ - _sv; \ - }) -# else -# define SvREFCNT_inc(sv) \ - ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL) -# endif -#endif - -#ifndef SvREFCNT_inc_simple -# ifdef PERL_USE_GCC_BRACE_GROUPS -# define SvREFCNT_inc_simple(sv) \ - ({ \ - if (sv) \ - (SvREFCNT(sv))++; \ - (SV *)(sv); \ - }) -# else -# define SvREFCNT_inc_simple(sv) \ - ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL) -# endif -#endif - -#ifndef SvREFCNT_inc_NN -# ifdef PERL_USE_GCC_BRACE_GROUPS -# define SvREFCNT_inc_NN(sv) \ - ({ \ - SV * const _sv = (SV*)(sv); \ - SvREFCNT(_sv)++; \ - _sv; \ - }) -# else -# define SvREFCNT_inc_NN(sv) \ - (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv) -# endif -#endif - -#ifndef SvREFCNT_inc_void -# ifdef PERL_USE_GCC_BRACE_GROUPS -# define SvREFCNT_inc_void(sv) \ - ({ \ - SV * const _sv = (SV*)(sv); \ - if (_sv) \ - (void)(SvREFCNT(_sv)++); \ - }) -# else -# define SvREFCNT_inc_void(sv) \ - (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0) -# endif -#endif - -__UNDEFINED__ SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END -__UNDEFINED__ SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv)) -__UNDEFINED__ SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) -__UNDEFINED__ SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) - -=xsubs - -void -SvREFCNT() - PREINIT: - SV *sv, *svr; - PPCODE: - sv = newSV(0); - mXPUSHi(SvREFCNT(sv) == 1); - svr = SvREFCNT_inc(sv); - mXPUSHi(sv == svr); - mXPUSHi(SvREFCNT(sv) == 2); - svr = SvREFCNT_inc_simple(sv); - mXPUSHi(sv == svr); - mXPUSHi(SvREFCNT(sv) == 3); - svr = SvREFCNT_inc_NN(sv); - mXPUSHi(sv == svr); - mXPUSHi(SvREFCNT(sv) == 4); - svr = SvREFCNT_inc_simple_NN(sv); - mXPUSHi(sv == svr); - mXPUSHi(SvREFCNT(sv) == 5); - SvREFCNT_inc_void(sv); - mXPUSHi(SvREFCNT(sv) == 6); - SvREFCNT_inc_simple_void(sv); - mXPUSHi(SvREFCNT(sv) == 7); - SvREFCNT_inc_void_NN(sv); - mXPUSHi(SvREFCNT(sv) == 8); - SvREFCNT_inc_simple_void_NN(sv); - mXPUSHi(SvREFCNT(sv) == 9); - while (SvREFCNT(sv) > 1) - SvREFCNT_dec(sv); - mXPUSHi(SvREFCNT(sv) == 1); - SvREFCNT_dec(sv); - XSRETURN(14); - -=tests plan => 14 - -for (Devel::PPPort::SvREFCNT()) { - ok(defined $_ and $_); -} - diff --git a/ext/Devel/PPPort/parts/inc/Sv_set b/ext/Devel/PPPort/parts/inc/Sv_set deleted file mode 100644 index 95cf2d672e..0000000000 --- a/ext/Devel/PPPort/parts/inc/Sv_set +++ /dev/null @@ -1,124 +0,0 @@ -################################################################################ -## -## $Revision: 7 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:53 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ - -=implementation - -__UNDEFINED__ SvMAGIC_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ - (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END - -#if { VERSION < 5.9.3 } - -__UNDEFINED__ SvPVX_const(sv) ((const char*) (0 + SvPVX(sv))) -__UNDEFINED__ SvPVX_mutable(sv) (0 + SvPVX(sv)) - -__UNDEFINED__ SvRV_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ - (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END - -#else - -__UNDEFINED__ SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) -__UNDEFINED__ SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) - -__UNDEFINED__ SvRV_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ - ((sv)->sv_u.svu_rv = (val)); } STMT_END - -#endif - -__UNDEFINED__ SvSTASH_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ - (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END - -#if { VERSION < 5.004 } - -__UNDEFINED__ SvUV_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ - (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END - -#else - -__UNDEFINED__ SvUV_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ - (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END - -#endif - -=xsubs - -IV -TestSvUV_set(sv, val) - SV *sv - UV val - CODE: - SvUV_set(sv, val); - RETVAL = SvUVX(sv) == val ? 42 : -1; - OUTPUT: - RETVAL - -IV -TestSvPVX_const(sv) - SV *sv - CODE: - RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1; - OUTPUT: - RETVAL - -IV -TestSvPVX_mutable(sv) - SV *sv - CODE: - RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1; - OUTPUT: - RETVAL - -void -TestSvSTASH_set(sv, name) - SV *sv - char *name - CODE: - sv = SvRV(sv); - SvREFCNT_dec(SvSTASH(sv)); - SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0))); - -=tests plan => 5 - -my $foo = 5; -ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42); -ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43); -ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44); - -my $bar = []; - -bless $bar, 'foo'; -ok($bar->x(), 'foobar'); - -Devel::PPPort::TestSvSTASH_set($bar, 'bar'); -ok($bar->x(), 'hacker'); - -package foo; - -sub x { 'foobar' } - -package bar; - -sub x { 'hacker' } diff --git a/ext/Devel/PPPort/parts/inc/call b/ext/Devel/PPPort/parts/inc/call deleted file mode 100644 index 85159e22a8..0000000000 --- a/ext/Devel/PPPort/parts/inc/call +++ /dev/null @@ -1,367 +0,0 @@ -################################################################################ -## -## $Revision: 19 $ -## $Author: mhx $ -## $Date: 2009/01/23 18:27:48 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -eval_pv -eval_sv -call_sv -call_pv -call_argv -call_method -load_module -vload_module -G_METHOD - -=implementation - -/* Replace: 1 */ -__UNDEFINED__ call_sv perl_call_sv -__UNDEFINED__ call_pv perl_call_pv -__UNDEFINED__ call_argv perl_call_argv -__UNDEFINED__ call_method perl_call_method - -__UNDEFINED__ eval_sv perl_eval_sv -/* Replace: 0 */ - -__UNDEFINED__ PERL_LOADMOD_DENY 0x1 -__UNDEFINED__ PERL_LOADMOD_NOIMPORT 0x2 -__UNDEFINED__ PERL_LOADMOD_IMPORT_OPS 0x4 - -#ifndef G_METHOD -# define G_METHOD 64 -# ifdef call_sv -# undef call_sv -# endif -# if { VERSION < 5.6.0 } -# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \ - (flags) & ~G_METHOD) : perl_call_sv(sv, flags)) -# else -# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \ - (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags)) -# endif -#endif - -/* Replace perl_eval_pv with eval_pv */ - -#ifndef eval_pv -#if { NEED eval_pv } - -SV* -eval_pv(char *p, I32 croak_on_error) -{ - dSP; - SV* sv = newSVpv(p, 0); - - PUSHMARK(sp); - eval_sv(sv, G_SCALAR); - SvREFCNT_dec(sv); - - SPAGAIN; - sv = POPs; - PUTBACK; - - if (croak_on_error && SvTRUE(GvSV(errgv))) - croak(SvPVx(GvSV(errgv), na)); - - return sv; -} - -#endif -#endif - -#ifndef vload_module -#if { NEED vload_module } - -void -vload_module(U32 flags, SV *name, SV *ver, va_list *args) -{ - dTHR; - dVAR; - OP *veop, *imop; - - OP * const modname = newSVOP(OP_CONST, 0, name); - /* 5.005 has a somewhat hacky force_normal that doesn't croak on - SvREADONLY() if PL_compling is true. Current perls take care in - ck_require() to correctly turn off SvREADONLY before calling - force_normal_flags(). This seems a better fix than fudging PL_compling - */ - SvREADONLY_off(((SVOP*)modname)->op_sv); - modname->op_private |= OPpCONST_BARE; - if (ver) { - veop = newSVOP(OP_CONST, 0, ver); - } - else - veop = NULL; - if (flags & PERL_LOADMOD_NOIMPORT) { - imop = sawparens(newNULLLIST()); - } - else if (flags & PERL_LOADMOD_IMPORT_OPS) { - imop = va_arg(*args, OP*); - } - else { - SV *sv; - imop = NULL; - sv = va_arg(*args, SV*); - while (sv) { - imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv)); - sv = va_arg(*args, SV*); - } - } - { - const line_t ocopline = PL_copline; - COP * const ocurcop = PL_curcop; - const int oexpect = PL_expect; - -#if { VERSION >= 5.004 } - utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), - veop, modname, imop); -#else - utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), - modname, imop); -#endif - PL_expect = oexpect; - PL_copline = ocopline; - PL_curcop = ocurcop; - } -} - -#endif -#endif - -#ifndef load_module -#if { NEED load_module } - -void -load_module(U32 flags, SV *name, SV *ver, ...) -{ - va_list args; - va_start(args, ver); - vload_module(flags, name, ver, &args); - va_end(args); -} - -#endif -#endif - -=xsinit - -#define NEED_eval_pv -#define NEED_load_module -#define NEED_vload_module - -=xsubs - -I32 -G_SCALAR() - CODE: - RETVAL = G_SCALAR; - OUTPUT: - RETVAL - -I32 -G_ARRAY() - CODE: - RETVAL = G_ARRAY; - OUTPUT: - RETVAL - -I32 -G_DISCARD() - CODE: - RETVAL = G_DISCARD; - OUTPUT: - RETVAL - -void -eval_sv(sv, flags) - SV* sv - I32 flags - PREINIT: - I32 i; - PPCODE: - PUTBACK; - i = eval_sv(sv, flags); - SPAGAIN; - EXTEND(SP, 1); - mPUSHi(i); - -void -eval_pv(p, croak_on_error) - char* p - I32 croak_on_error - PPCODE: - PUTBACK; - EXTEND(SP, 1); - PUSHs(eval_pv(p, croak_on_error)); - -void -call_sv(sv, flags, ...) - SV* sv - I32 flags - PREINIT: - I32 i; - PPCODE: - for (i=0; i 8) /* play safe */ - XSRETURN_UNDEF; - for (i=2; i 52 - -sub eq_array -{ - my($a, $b) = @_; - join(':', @$a) eq join(':', @$b); -} - -sub f -{ - shift; - unshift @_, 'b'; - pop @_; - @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; -} - -my $obj = bless [], 'Foo'; - -sub Foo::meth -{ - return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo'; - shift; - shift; - unshift @_, 'b'; - pop @_; - @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; -} - -my $test; - -for $test ( - # flags args expected description - [ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ], - [ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ], - [ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ], - [ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ], - [ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ], - [ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ], -) -{ - my ($flags, $args, $expected, $description) = @$test; - print "# --- $description ---\n"; - ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected)); -}; - -ok(&Devel::PPPort::eval_pv('f()', 0), 'y'); -ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y'); - -ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet"); -Devel::PPPort::load_module(0, "less", undef); -ok(defined $::{'less::'}, 1, "Have now loaded less"); diff --git a/ext/Devel/PPPort/parts/inc/cop b/ext/Devel/PPPort/parts/inc/cop deleted file mode 100644 index 7c8674112d..0000000000 --- a/ext/Devel/PPPort/parts/inc/cop +++ /dev/null @@ -1,84 +0,0 @@ -################################################################################ -## -## $Revision: 8 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:54 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ - -=implementation - -#ifdef USE_ITHREADS - -__UNDEFINED__ CopFILE(c) ((c)->cop_file) -__UNDEFINED__ CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) -__UNDEFINED__ CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) -__UNDEFINED__ CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) -__UNDEFINED__ CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) -__UNDEFINED__ CopSTASHPV(c) ((c)->cop_stashpv) -__UNDEFINED__ CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) -__UNDEFINED__ CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) -__UNDEFINED__ CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) -__UNDEFINED__ CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \ - || (CopSTASHPV(c) && HvNAME(hv) \ - && strEQ(CopSTASHPV(c), HvNAME(hv))))) - -#else - -__UNDEFINED__ CopFILEGV(c) ((c)->cop_filegv) -__UNDEFINED__ CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) -__UNDEFINED__ CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) -__UNDEFINED__ CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) -__UNDEFINED__ CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) -__UNDEFINED__ CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) -__UNDEFINED__ CopSTASH(c) ((c)->cop_stash) -__UNDEFINED__ CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) -__UNDEFINED__ CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) -__UNDEFINED__ CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) -__UNDEFINED__ CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) - -#endif /* USE_ITHREADS */ - -=xsubs - -char * -CopSTASHPV() - CODE: - RETVAL = CopSTASHPV(PL_curcop); - OUTPUT: - RETVAL - -char * -CopFILE() - CODE: - RETVAL = CopFILE(PL_curcop); - OUTPUT: - RETVAL - -=tests plan => 2 - -my $package; -{ - package MyPackage; - $package = &Devel::PPPort::CopSTASHPV(); -} -print "# $package\n"; -ok($package, "MyPackage"); - -my $file = &Devel::PPPort::CopFILE(); -print "# $file\n"; -ok($file =~ /cop/i); - diff --git a/ext/Devel/PPPort/parts/inc/exception b/ext/Devel/PPPort/parts/inc/exception deleted file mode 100644 index 122277bbb1..0000000000 --- a/ext/Devel/PPPort/parts/inc/exception +++ /dev/null @@ -1,74 +0,0 @@ -################################################################################ -## -## $Revision: 7 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:53 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -dXCPT -XCPT_TRY_START -XCPT_TRY_END -XCPT_CATCH -XCPT_RETHROW - -=implementation - -#ifdef NO_XSLOCKS -# ifdef dJMPENV -# define dXCPT dJMPENV; int rEtV = 0 -# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) -# define XCPT_TRY_END JMPENV_POP; -# define XCPT_CATCH if (rEtV != 0) -# define XCPT_RETHROW JMPENV_JUMP(rEtV) -# else -# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0 -# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0) -# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf); -# define XCPT_CATCH if (rEtV != 0) -# define XCPT_RETHROW Siglongjmp(top_env, rEtV) -# endif -#endif - -=xsmisc - -/* defined in module3.c */ -int exception(int throw_e); - -=xsubs - -int -exception(throw_e) - int throw_e - OUTPUT: - RETVAL - -=tests plan => 7 - -my $rv; - -$Devel::PPPort::exception_caught = undef; - -$rv = eval { &Devel::PPPort::exception(0) }; -ok($@, ''); -ok(defined $rv); -ok($rv, 42); -ok($Devel::PPPort::exception_caught, 0); - -$Devel::PPPort::exception_caught = undef; - -$rv = eval { &Devel::PPPort::exception(1) }; -ok($@, "boo\n"); -ok(not defined $rv); -ok($Devel::PPPort::exception_caught, 1); diff --git a/ext/Devel/PPPort/parts/inc/format b/ext/Devel/PPPort/parts/inc/format deleted file mode 100644 index d39670416c..0000000000 --- a/ext/Devel/PPPort/parts/inc/format +++ /dev/null @@ -1,70 +0,0 @@ -################################################################################ -## -## $Revision: 9 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:55 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -/^#\s*define\s+(\w+)/ - -=implementation - -#ifndef IVdf -# if IVSIZE == LONGSIZE -# define IVdf "ld" -# define UVuf "lu" -# define UVof "lo" -# define UVxf "lx" -# define UVXf "lX" -# else -# if IVSIZE == INTSIZE -# define IVdf "d" -# define UVuf "u" -# define UVof "o" -# define UVxf "x" -# define UVXf "X" -# endif -# endif -#endif - -#ifndef NVef -# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ - defined(PERL_PRIfldbl) && { VERSION != 5.6.0 } - /* Not very likely, but let's try anyway. */ -# define NVef PERL_PRIeldbl -# define NVff PERL_PRIfldbl -# define NVgf PERL_PRIgldbl -# else -# define NVef "e" -# define NVff "f" -# define NVgf "g" -# endif -#endif - -=xsubs - -void -croak_NVgf(num) - NV num - PPCODE: - Perl_croak(aTHX_ "%.20" NVgf "\n", num); - -=tests plan => 1 - -my $num = 1.12345678901234567890; - -eval { Devel::PPPort::croak_NVgf($num) }; -ok($@ =~ /^1.1234567890/); - diff --git a/ext/Devel/PPPort/parts/inc/grok b/ext/Devel/PPPort/parts/inc/grok deleted file mode 100644 index 5e32f8e990..0000000000 --- a/ext/Devel/PPPort/parts/inc/grok +++ /dev/null @@ -1,677 +0,0 @@ -################################################################################ -## -## $Revision: 16 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:55 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -grok_hex -grok_oct -grok_bin -grok_numeric_radix -grok_number -__UNDEFINED__ - -=implementation - -__UNDEFINED__ IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) -__UNDEFINED__ IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) -__UNDEFINED__ IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) -__UNDEFINED__ IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) - -__UNDEFINED__ IS_NUMBER_IN_UV 0x01 -__UNDEFINED__ IS_NUMBER_GREATER_THAN_UV_MAX 0x02 -__UNDEFINED__ IS_NUMBER_NOT_INT 0x04 -__UNDEFINED__ IS_NUMBER_NEG 0x08 -__UNDEFINED__ IS_NUMBER_INFINITY 0x10 -__UNDEFINED__ IS_NUMBER_NAN 0x20 - -__UNDEFINED__ GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) - -__UNDEFINED__ PERL_SCAN_GREATER_THAN_UV_MAX 0x02 -__UNDEFINED__ PERL_SCAN_SILENT_ILLDIGIT 0x04 -__UNDEFINED__ PERL_SCAN_ALLOW_UNDERSCORES 0x01 -__UNDEFINED__ PERL_SCAN_DISALLOW_PREFIX 0x02 - -#ifndef grok_numeric_radix -#if { NEED grok_numeric_radix } -bool -grok_numeric_radix(pTHX_ const char **sp, const char *send) -{ -#ifdef USE_LOCALE_NUMERIC -#ifdef PL_numeric_radix_sv - if (PL_numeric_radix_sv && IN_LOCALE) { - STRLEN len; - char* radix = SvPV(PL_numeric_radix_sv, len); - if (*sp + len <= send && memEQ(*sp, radix, len)) { - *sp += len; - return TRUE; - } - } -#else - /* older perls don't have PL_numeric_radix_sv so the radix - * must manually be requested from locale.h - */ -#include - dTHR; /* needed for older threaded perls */ - struct lconv *lc = localeconv(); - char *radix = lc->decimal_point; - if (radix && IN_LOCALE) { - STRLEN len = strlen(radix); - if (*sp + len <= send && memEQ(*sp, radix, len)) { - *sp += len; - return TRUE; - } - } -#endif -#endif /* USE_LOCALE_NUMERIC */ - /* always try "." if numeric radix didn't match because - * we may have data from different locales mixed */ - if (*sp < send && **sp == '.') { - ++*sp; - return TRUE; - } - return FALSE; -} -#endif -#endif - -#ifndef grok_number -#if { NEED grok_number } -int -grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) -{ - const char *s = pv; - const char *send = pv + len; - const UV max_div_10 = UV_MAX / 10; - const char max_mod_10 = UV_MAX % 10; - int numtype = 0; - int sawinf = 0; - int sawnan = 0; - - while (s < send && isSPACE(*s)) - s++; - if (s == send) { - return 0; - } else if (*s == '-') { - s++; - numtype = IS_NUMBER_NEG; - } - else if (*s == '+') - s++; - - if (s == send) - return 0; - - /* next must be digit or the radix separator or beginning of infinity */ - if (isDIGIT(*s)) { - /* UVs are at least 32 bits, so the first 9 decimal digits cannot - overflow. */ - UV value = *s - '0'; - /* This construction seems to be more optimiser friendly. - (without it gcc does the isDIGIT test and the *s - '0' separately) - With it gcc on arm is managing 6 instructions (6 cycles) per digit. - In theory the optimiser could deduce how far to unroll the loop - before checking for overflow. */ - if (++s < send) { - int digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - /* Now got 9 digits, so need to check - each time for overflow. */ - digit = *s - '0'; - while (digit >= 0 && digit <= 9 - && (value < max_div_10 - || (value == max_div_10 - && digit <= max_mod_10))) { - value = value * 10 + digit; - if (++s < send) - digit = *s - '0'; - else - break; - } - if (digit >= 0 && digit <= 9 - && (s < send)) { - /* value overflowed. - skip the remaining digits, don't - worry about setting *valuep. */ - do { - s++; - } while (s < send && isDIGIT(*s)); - numtype |= - IS_NUMBER_GREATER_THAN_UV_MAX; - goto skip_value; - } - } - } - } - } - } - } - } - } - } - } - } - } - } - } - } - } - } - numtype |= IS_NUMBER_IN_UV; - if (valuep) - *valuep = value; - - skip_value: - if (GROK_NUMERIC_RADIX(&s, send)) { - numtype |= IS_NUMBER_NOT_INT; - while (s < send && isDIGIT(*s)) /* optional digits after the radix */ - s++; - } - } - else if (GROK_NUMERIC_RADIX(&s, send)) { - numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ - /* no digits before the radix means we need digits after it */ - if (s < send && isDIGIT(*s)) { - do { - s++; - } while (s < send && isDIGIT(*s)); - if (valuep) { - /* integer approximation is valid - it's 0. */ - *valuep = 0; - } - } - else - return 0; - } else if (*s == 'I' || *s == 'i') { - s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; - s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; - s++; if (s < send && (*s == 'I' || *s == 'i')) { - s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; - s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; - s++; if (s == send || (*s != 'T' && *s != 't')) return 0; - s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; - s++; - } - sawinf = 1; - } else if (*s == 'N' || *s == 'n') { - /* XXX TODO: There are signaling NaNs and quiet NaNs. */ - s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; - s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; - s++; - sawnan = 1; - } else - return 0; - - if (sawinf) { - numtype &= IS_NUMBER_NEG; /* Keep track of sign */ - numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; - } else if (sawnan) { - numtype &= IS_NUMBER_NEG; /* Keep track of sign */ - numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; - } else if (s < send) { - /* we can have an optional exponent part */ - if (*s == 'e' || *s == 'E') { - /* The only flag we keep is sign. Blow away any "it's UV" */ - numtype &= IS_NUMBER_NEG; - numtype |= IS_NUMBER_NOT_INT; - s++; - if (s < send && (*s == '-' || *s == '+')) - s++; - if (s < send && isDIGIT(*s)) { - do { - s++; - } while (s < send && isDIGIT(*s)); - } - else - return 0; - } - } - while (s < send && isSPACE(*s)) - s++; - if (s >= send) - return numtype; - if (len == 10 && memEQ(pv, "0 but true", 10)) { - if (valuep) - *valuep = 0; - return IS_NUMBER_IN_UV; - } - return 0; -} -#endif -#endif - -/* - * The grok_* routines have been modified to use warn() instead of - * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, - * which is why the stack variable has been renamed to 'xdigit'. - */ - -#ifndef grok_bin -#if { NEED grok_bin } -UV -grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) -{ - const char *s = start; - STRLEN len = *len_p; - UV value = 0; - NV value_nv = 0; - - const UV max_div_2 = UV_MAX / 2; - bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; - bool overflowed = FALSE; - - if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { - /* strip off leading b or 0b. - for compatibility silently suffer "b" and "0b" as valid binary - numbers. */ - if (len >= 1) { - if (s[0] == 'b') { - s++; - len--; - } - else if (len >= 2 && s[0] == '0' && s[1] == 'b') { - s+=2; - len-=2; - } - } - } - - for (; len-- && *s; s++) { - char bit = *s; - if (bit == '0' || bit == '1') { - /* Write it in this wonky order with a goto to attempt to get the - compiler to make the common case integer-only loop pretty tight. - With gcc seems to be much straighter code than old scan_bin. */ - redo: - if (!overflowed) { - if (value <= max_div_2) { - value = (value << 1) | (bit - '0'); - continue; - } - /* Bah. We're just overflowed. */ - warn("Integer overflow in binary number"); - overflowed = TRUE; - value_nv = (NV) value; - } - value_nv *= 2.0; - /* If an NV has not enough bits in its mantissa to - * represent a UV this summing of small low-order numbers - * is a waste of time (because the NV cannot preserve - * the low-order bits anyway): we could just remember when - * did we overflow and in the end just multiply value_nv by the - * right amount. */ - value_nv += (NV)(bit - '0'); - continue; - } - if (bit == '_' && len && allow_underscores && (bit = s[1]) - && (bit == '0' || bit == '1')) - { - --len; - ++s; - goto redo; - } - if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) - warn("Illegal binary digit '%c' ignored", *s); - break; - } - - if ( ( overflowed && value_nv > 4294967295.0) -#if UVSIZE > 4 - || (!overflowed && value > 0xffffffff ) -#endif - ) { - warn("Binary number > 0b11111111111111111111111111111111 non-portable"); - } - *len_p = s - start; - if (!overflowed) { - *flags = 0; - return value; - } - *flags = PERL_SCAN_GREATER_THAN_UV_MAX; - if (result) - *result = value_nv; - return UV_MAX; -} -#endif -#endif - -#ifndef grok_hex -#if { NEED grok_hex } -UV -grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) -{ - const char *s = start; - STRLEN len = *len_p; - UV value = 0; - NV value_nv = 0; - - const UV max_div_16 = UV_MAX / 16; - bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; - bool overflowed = FALSE; - const char *xdigit; - - if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { - /* strip off leading x or 0x. - for compatibility silently suffer "x" and "0x" as valid hex numbers. - */ - if (len >= 1) { - if (s[0] == 'x') { - s++; - len--; - } - else if (len >= 2 && s[0] == '0' && s[1] == 'x') { - s+=2; - len-=2; - } - } - } - - for (; len-- && *s; s++) { - xdigit = strchr((char *) PL_hexdigit, *s); - if (xdigit) { - /* Write it in this wonky order with a goto to attempt to get the - compiler to make the common case integer-only loop pretty tight. - With gcc seems to be much straighter code than old scan_hex. */ - redo: - if (!overflowed) { - if (value <= max_div_16) { - value = (value << 4) | ((xdigit - PL_hexdigit) & 15); - continue; - } - warn("Integer overflow in hexadecimal number"); - overflowed = TRUE; - value_nv = (NV) value; - } - value_nv *= 16.0; - /* If an NV has not enough bits in its mantissa to - * represent a UV this summing of small low-order numbers - * is a waste of time (because the NV cannot preserve - * the low-order bits anyway): we could just remember when - * did we overflow and in the end just multiply value_nv by the - * right amount of 16-tuples. */ - value_nv += (NV)((xdigit - PL_hexdigit) & 15); - continue; - } - if (*s == '_' && len && allow_underscores && s[1] - && (xdigit = strchr((char *) PL_hexdigit, s[1]))) - { - --len; - ++s; - goto redo; - } - if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) - warn("Illegal hexadecimal digit '%c' ignored", *s); - break; - } - - if ( ( overflowed && value_nv > 4294967295.0) -#if UVSIZE > 4 - || (!overflowed && value > 0xffffffff ) -#endif - ) { - warn("Hexadecimal number > 0xffffffff non-portable"); - } - *len_p = s - start; - if (!overflowed) { - *flags = 0; - return value; - } - *flags = PERL_SCAN_GREATER_THAN_UV_MAX; - if (result) - *result = value_nv; - return UV_MAX; -} -#endif -#endif - -#ifndef grok_oct -#if { NEED grok_oct } -UV -grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) -{ - const char *s = start; - STRLEN len = *len_p; - UV value = 0; - NV value_nv = 0; - - const UV max_div_8 = UV_MAX / 8; - bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; - bool overflowed = FALSE; - - for (; len-- && *s; s++) { - /* gcc 2.95 optimiser not smart enough to figure that this subtraction - out front allows slicker code. */ - int digit = *s - '0'; - if (digit >= 0 && digit <= 7) { - /* Write it in this wonky order with a goto to attempt to get the - compiler to make the common case integer-only loop pretty tight. - */ - redo: - if (!overflowed) { - if (value <= max_div_8) { - value = (value << 3) | digit; - continue; - } - /* Bah. We're just overflowed. */ - warn("Integer overflow in octal number"); - overflowed = TRUE; - value_nv = (NV) value; - } - value_nv *= 8.0; - /* If an NV has not enough bits in its mantissa to - * represent a UV this summing of small low-order numbers - * is a waste of time (because the NV cannot preserve - * the low-order bits anyway): we could just remember when - * did we overflow and in the end just multiply value_nv by the - * right amount of 8-tuples. */ - value_nv += (NV)digit; - continue; - } - if (digit == ('_' - '0') && len && allow_underscores - && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) - { - --len; - ++s; - goto redo; - } - /* Allow \octal to work the DWIM way (that is, stop scanning - * as soon as non-octal characters are seen, complain only iff - * someone seems to want to use the digits eight and nine). */ - if (digit == 8 || digit == 9) { - if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) - warn("Illegal octal digit '%c' ignored", *s); - } - break; - } - - if ( ( overflowed && value_nv > 4294967295.0) -#if UVSIZE > 4 - || (!overflowed && value > 0xffffffff ) -#endif - ) { - warn("Octal number > 037777777777 non-portable"); - } - *len_p = s - start; - if (!overflowed) { - *flags = 0; - return value; - } - *flags = PERL_SCAN_GREATER_THAN_UV_MAX; - if (result) - *result = value_nv; - return UV_MAX; -} -#endif -#endif - -=xsinit - -#define NEED_grok_number -#define NEED_grok_numeric_radix -#define NEED_grok_bin -#define NEED_grok_hex -#define NEED_grok_oct - -=xsubs - -UV -grok_number(string) - SV *string - PREINIT: - const char *pv; - STRLEN len; - CODE: - pv = SvPV(string, len); - if (!grok_number(pv, len, &RETVAL)) - XSRETURN_UNDEF; - OUTPUT: - RETVAL - -UV -grok_bin(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = grok_bin(pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -grok_hex(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = grok_hex(pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -grok_oct(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = grok_oct(pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -Perl_grok_number(string) - SV *string - PREINIT: - const char *pv; - STRLEN len; - CODE: - pv = SvPV(string, len); - if (!Perl_grok_number(aTHX_ pv, len, &RETVAL)) - XSRETURN_UNDEF; - OUTPUT: - RETVAL - -UV -Perl_grok_bin(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -Perl_grok_hex(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -Perl_grok_oct(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -=tests plan => 10 - -ok(&Devel::PPPort::grok_number("42"), 42); -ok(!defined(&Devel::PPPort::grok_number("A"))); -ok(&Devel::PPPort::grok_bin("10000001"), 129); -ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef); -ok(&Devel::PPPort::grok_oct("377"), 255); - -ok(&Devel::PPPort::Perl_grok_number("42"), 42); -ok(!defined(&Devel::PPPort::Perl_grok_number("A"))); -ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129); -ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef); -ok(&Devel::PPPort::Perl_grok_oct("377"), 255); - diff --git a/ext/Devel/PPPort/parts/inc/limits b/ext/Devel/PPPort/parts/inc/limits deleted file mode 100644 index 25b3940179..0000000000 --- a/ext/Devel/PPPort/parts/inc/limits +++ /dev/null @@ -1,331 +0,0 @@ -################################################################################ -## -## $Revision: 7 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:54 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -PERL_UCHAR_MIN -PERL_UCHAR_MAX -PERL_USHORT_MIN -PERL_USHORT_MAX -PERL_SHORT_MAX -PERL_SHORT_MIN -PERL_UINT_MAX -PERL_UINT_MIN -PERL_INT_MAX -PERL_INT_MIN -PERL_ULONG_MAX -PERL_ULONG_MIN -PERL_LONG_MAX -PERL_LONG_MIN -PERL_UQUAD_MAX -PERL_UQUAD_MIN -PERL_QUAD_MAX -PERL_QUAD_MIN -IVSIZE -UVSIZE -IVTYPE -UVTYPE - -=implementation - -#ifdef I_LIMITS -# include -#endif - -#ifndef PERL_UCHAR_MIN -# define PERL_UCHAR_MIN ((unsigned char)0) -#endif - -#ifndef PERL_UCHAR_MAX -# ifdef UCHAR_MAX -# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) -# else -# ifdef MAXUCHAR -# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) -# else -# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) -# endif -# endif -#endif - -#ifndef PERL_USHORT_MIN -# define PERL_USHORT_MIN ((unsigned short)0) -#endif - -#ifndef PERL_USHORT_MAX -# ifdef USHORT_MAX -# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) -# else -# ifdef MAXUSHORT -# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) -# else -# ifdef USHRT_MAX -# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) -# else -# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) -# endif -# endif -# endif -#endif - -#ifndef PERL_SHORT_MAX -# ifdef SHORT_MAX -# define PERL_SHORT_MAX ((short)SHORT_MAX) -# else -# ifdef MAXSHORT /* Often used in */ -# define PERL_SHORT_MAX ((short)MAXSHORT) -# else -# ifdef SHRT_MAX -# define PERL_SHORT_MAX ((short)SHRT_MAX) -# else -# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) -# endif -# endif -# endif -#endif - -#ifndef PERL_SHORT_MIN -# ifdef SHORT_MIN -# define PERL_SHORT_MIN ((short)SHORT_MIN) -# else -# ifdef MINSHORT -# define PERL_SHORT_MIN ((short)MINSHORT) -# else -# ifdef SHRT_MIN -# define PERL_SHORT_MIN ((short)SHRT_MIN) -# else -# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) -# endif -# endif -# endif -#endif - -#ifndef PERL_UINT_MAX -# ifdef UINT_MAX -# define PERL_UINT_MAX ((unsigned int)UINT_MAX) -# else -# ifdef MAXUINT -# define PERL_UINT_MAX ((unsigned int)MAXUINT) -# else -# define PERL_UINT_MAX (~(unsigned int)0) -# endif -# endif -#endif - -#ifndef PERL_UINT_MIN -# define PERL_UINT_MIN ((unsigned int)0) -#endif - -#ifndef PERL_INT_MAX -# ifdef INT_MAX -# define PERL_INT_MAX ((int)INT_MAX) -# else -# ifdef MAXINT /* Often used in */ -# define PERL_INT_MAX ((int)MAXINT) -# else -# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) -# endif -# endif -#endif - -#ifndef PERL_INT_MIN -# ifdef INT_MIN -# define PERL_INT_MIN ((int)INT_MIN) -# else -# ifdef MININT -# define PERL_INT_MIN ((int)MININT) -# else -# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) -# endif -# endif -#endif - -#ifndef PERL_ULONG_MAX -# ifdef ULONG_MAX -# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) -# else -# ifdef MAXULONG -# define PERL_ULONG_MAX ((unsigned long)MAXULONG) -# else -# define PERL_ULONG_MAX (~(unsigned long)0) -# endif -# endif -#endif - -#ifndef PERL_ULONG_MIN -# define PERL_ULONG_MIN ((unsigned long)0L) -#endif - -#ifndef PERL_LONG_MAX -# ifdef LONG_MAX -# define PERL_LONG_MAX ((long)LONG_MAX) -# else -# ifdef MAXLONG -# define PERL_LONG_MAX ((long)MAXLONG) -# else -# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) -# endif -# endif -#endif - -#ifndef PERL_LONG_MIN -# ifdef LONG_MIN -# define PERL_LONG_MIN ((long)LONG_MIN) -# else -# ifdef MINLONG -# define PERL_LONG_MIN ((long)MINLONG) -# else -# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) -# endif -# endif -#endif - -#if defined(HAS_QUAD) && (defined(convex) || defined(uts)) -# ifndef PERL_UQUAD_MAX -# ifdef ULONGLONG_MAX -# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) -# else -# ifdef MAXULONGLONG -# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) -# else -# define PERL_UQUAD_MAX (~(unsigned long long)0) -# endif -# endif -# endif - -# ifndef PERL_UQUAD_MIN -# define PERL_UQUAD_MIN ((unsigned long long)0L) -# endif - -# ifndef PERL_QUAD_MAX -# ifdef LONGLONG_MAX -# define PERL_QUAD_MAX ((long long)LONGLONG_MAX) -# else -# ifdef MAXLONGLONG -# define PERL_QUAD_MAX ((long long)MAXLONGLONG) -# else -# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1)) -# endif -# endif -# endif - -# ifndef PERL_QUAD_MIN -# ifdef LONGLONG_MIN -# define PERL_QUAD_MIN ((long long)LONGLONG_MIN) -# else -# ifdef MINLONGLONG -# define PERL_QUAD_MIN ((long long)MINLONGLONG) -# else -# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) -# endif -# endif -# endif -#endif - -/* This is based on code from 5.003 perl.h */ -#ifdef HAS_QUAD -# ifdef cray - __UNDEFINED__ IVTYPE int - __UNDEFINED__ IV_MIN PERL_INT_MIN - __UNDEFINED__ IV_MAX PERL_INT_MAX - __UNDEFINED__ UV_MIN PERL_UINT_MIN - __UNDEFINED__ UV_MAX PERL_UINT_MAX -# ifdef INTSIZE - __UNDEFINED__ IVSIZE INTSIZE -# endif -# else -# if defined(convex) || defined(uts) - __UNDEFINED__ IVTYPE long long - __UNDEFINED__ IV_MIN PERL_QUAD_MIN - __UNDEFINED__ IV_MAX PERL_QUAD_MAX - __UNDEFINED__ UV_MIN PERL_UQUAD_MIN - __UNDEFINED__ UV_MAX PERL_UQUAD_MAX -# ifdef LONGLONGSIZE - __UNDEFINED__ IVSIZE LONGLONGSIZE -# endif -# else - __UNDEFINED__ IVTYPE long - __UNDEFINED__ IV_MIN PERL_LONG_MIN - __UNDEFINED__ IV_MAX PERL_LONG_MAX - __UNDEFINED__ UV_MIN PERL_ULONG_MIN - __UNDEFINED__ UV_MAX PERL_ULONG_MAX -# ifdef LONGSIZE - __UNDEFINED__ IVSIZE LONGSIZE -# endif -# endif -# endif - __UNDEFINED__ IVSIZE 8 - __UNDEFINED__ PERL_QUAD_MIN IV_MIN - __UNDEFINED__ PERL_QUAD_MAX IV_MAX - __UNDEFINED__ PERL_UQUAD_MIN UV_MIN - __UNDEFINED__ PERL_UQUAD_MAX UV_MAX -#else - __UNDEFINED__ IVTYPE long - __UNDEFINED__ IV_MIN PERL_LONG_MIN - __UNDEFINED__ IV_MAX PERL_LONG_MAX - __UNDEFINED__ UV_MIN PERL_ULONG_MIN - __UNDEFINED__ UV_MAX PERL_ULONG_MAX -#endif - -#ifndef IVSIZE -# ifdef LONGSIZE -# define IVSIZE LONGSIZE -# else -# define IVSIZE 4 /* A bold guess, but the best we can make. */ -# endif -#endif - -__UNDEFINED__ UVTYPE unsigned IVTYPE -__UNDEFINED__ UVSIZE IVSIZE - -=xsubs - -IV -iv_size() - CODE: - RETVAL = IVSIZE == sizeof(IV); - OUTPUT: - RETVAL - -IV -uv_size() - CODE: - RETVAL = UVSIZE == sizeof(UV); - OUTPUT: - RETVAL - -IV -iv_type() - CODE: - RETVAL = sizeof(IVTYPE) == sizeof(IV); - OUTPUT: - RETVAL - -IV -uv_type() - CODE: - RETVAL = sizeof(UVTYPE) == sizeof(UV); - OUTPUT: - RETVAL - -=tests plan => 4 - -ok(&Devel::PPPort::iv_size()); -ok(&Devel::PPPort::uv_size()); -ok(&Devel::PPPort::iv_type()); -ok(&Devel::PPPort::uv_type()); - diff --git a/ext/Devel/PPPort/parts/inc/mPUSH b/ext/Devel/PPPort/parts/inc/mPUSH deleted file mode 100644 index 3613058837..0000000000 --- a/ext/Devel/PPPort/parts/inc/mPUSH +++ /dev/null @@ -1,138 +0,0 @@ -################################################################################ -## -## $Revision: 11 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:54 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ - -=implementation - -__UNDEFINED__ mPUSHs(s) PUSHs(sv_2mortal(s)) -__UNDEFINED__ PUSHmortal PUSHs(sv_newmortal()) -__UNDEFINED__ mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l)) -__UNDEFINED__ mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n)) -__UNDEFINED__ mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i)) -__UNDEFINED__ mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u)) - -__UNDEFINED__ mXPUSHs(s) XPUSHs(sv_2mortal(s)) -__UNDEFINED__ XPUSHmortal XPUSHs(sv_newmortal()) -__UNDEFINED__ mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END -__UNDEFINED__ mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END -__UNDEFINED__ mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END -__UNDEFINED__ mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END - -=xsubs - -void -mPUSHs() - PPCODE: - EXTEND(SP, 3); - mPUSHs(newSVpv("foo", 0)); - mPUSHs(newSVpv("bar13", 3)); - mPUSHs(newSViv(42)); - XSRETURN(3); - -void -mPUSHp() - PPCODE: - EXTEND(SP, 3); - mPUSHp("one", 3); - mPUSHp("two", 3); - mPUSHp("three", 5); - XSRETURN(3); - -void -mPUSHn() - PPCODE: - EXTEND(SP, 3); - mPUSHn(0.5); - mPUSHn(-0.25); - mPUSHn(0.125); - XSRETURN(3); - -void -mPUSHi() - PPCODE: - EXTEND(SP, 3); - mPUSHi(-1); - mPUSHi(2); - mPUSHi(-3); - XSRETURN(3); - -void -mPUSHu() - PPCODE: - EXTEND(SP, 3); - mPUSHu(1); - mPUSHu(2); - mPUSHu(3); - XSRETURN(3); - -void -mXPUSHs() - PPCODE: - mXPUSHs(newSVpv("foo", 0)); - mXPUSHs(newSVpv("bar13", 3)); - mXPUSHs(newSViv(42)); - XSRETURN(3); - -void -mXPUSHp() - PPCODE: - mXPUSHp("one", 3); - mXPUSHp("two", 3); - mXPUSHp("three", 5); - XSRETURN(3); - -void -mXPUSHn() - PPCODE: - mXPUSHn(0.5); - mXPUSHn(-0.25); - mXPUSHn(0.125); - XSRETURN(3); - -void -mXPUSHi() - PPCODE: - mXPUSHi(-1); - mXPUSHi(2); - mXPUSHi(-3); - XSRETURN(3); - -void -mXPUSHu() - PPCODE: - mXPUSHu(1); - mXPUSHu(2); - mXPUSHu(3); - XSRETURN(3); - -=tests plan => 10 - -ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42"); -ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three"); -ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125"); -ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3"); -ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3"); - -ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42"); -ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three"); -ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125"); -ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3"); -ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3"); - diff --git a/ext/Devel/PPPort/parts/inc/magic b/ext/Devel/PPPort/parts/inc/magic deleted file mode 100644 index 31721715ea..0000000000 --- a/ext/Devel/PPPort/parts/inc/magic +++ /dev/null @@ -1,369 +0,0 @@ -################################################################################ -## -## $Revision: 17 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:55 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ -/sv_\w+_mg/ -sv_magic_portable - -=implementation - -__UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END - -__UNDEFINED__ PERL_MAGIC_sv '\0' -__UNDEFINED__ PERL_MAGIC_overload 'A' -__UNDEFINED__ PERL_MAGIC_overload_elem 'a' -__UNDEFINED__ PERL_MAGIC_overload_table 'c' -__UNDEFINED__ PERL_MAGIC_bm 'B' -__UNDEFINED__ PERL_MAGIC_regdata 'D' -__UNDEFINED__ PERL_MAGIC_regdatum 'd' -__UNDEFINED__ PERL_MAGIC_env 'E' -__UNDEFINED__ PERL_MAGIC_envelem 'e' -__UNDEFINED__ PERL_MAGIC_fm 'f' -__UNDEFINED__ PERL_MAGIC_regex_global 'g' -__UNDEFINED__ PERL_MAGIC_isa 'I' -__UNDEFINED__ PERL_MAGIC_isaelem 'i' -__UNDEFINED__ PERL_MAGIC_nkeys 'k' -__UNDEFINED__ PERL_MAGIC_dbfile 'L' -__UNDEFINED__ PERL_MAGIC_dbline 'l' -__UNDEFINED__ PERL_MAGIC_mutex 'm' -__UNDEFINED__ PERL_MAGIC_shared 'N' -__UNDEFINED__ PERL_MAGIC_shared_scalar 'n' -__UNDEFINED__ PERL_MAGIC_collxfrm 'o' -__UNDEFINED__ PERL_MAGIC_tied 'P' -__UNDEFINED__ PERL_MAGIC_tiedelem 'p' -__UNDEFINED__ PERL_MAGIC_tiedscalar 'q' -__UNDEFINED__ PERL_MAGIC_qr 'r' -__UNDEFINED__ PERL_MAGIC_sig 'S' -__UNDEFINED__ PERL_MAGIC_sigelem 's' -__UNDEFINED__ PERL_MAGIC_taint 't' -__UNDEFINED__ PERL_MAGIC_uvar 'U' -__UNDEFINED__ PERL_MAGIC_uvar_elem 'u' -__UNDEFINED__ PERL_MAGIC_vstring 'V' -__UNDEFINED__ PERL_MAGIC_vec 'v' -__UNDEFINED__ PERL_MAGIC_utf8 'w' -__UNDEFINED__ PERL_MAGIC_substr 'x' -__UNDEFINED__ PERL_MAGIC_defelem 'y' -__UNDEFINED__ PERL_MAGIC_glob '*' -__UNDEFINED__ PERL_MAGIC_arylen '#' -__UNDEFINED__ PERL_MAGIC_pos '.' -__UNDEFINED__ PERL_MAGIC_backref '<' -__UNDEFINED__ PERL_MAGIC_ext '~' - -/* That's the best we can do... */ -__UNDEFINED__ sv_catpvn_nomg sv_catpvn -__UNDEFINED__ sv_catsv_nomg sv_catsv -__UNDEFINED__ sv_setsv_nomg sv_setsv -__UNDEFINED__ sv_pvn_nomg sv_pvn -__UNDEFINED__ SvIV_nomg SvIV -__UNDEFINED__ SvUV_nomg SvUV - -#ifndef sv_catpv_mg -# define sv_catpv_mg(sv, ptr) \ - STMT_START { \ - SV *TeMpSv = sv; \ - sv_catpv(TeMpSv,ptr); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#ifndef sv_catpvn_mg -# define sv_catpvn_mg(sv, ptr, len) \ - STMT_START { \ - SV *TeMpSv = sv; \ - sv_catpvn(TeMpSv,ptr,len); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#ifndef sv_catsv_mg -# define sv_catsv_mg(dsv, ssv) \ - STMT_START { \ - SV *TeMpSv = dsv; \ - sv_catsv(TeMpSv,ssv); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#ifndef sv_setiv_mg -# define sv_setiv_mg(sv, i) \ - STMT_START { \ - SV *TeMpSv = sv; \ - sv_setiv(TeMpSv,i); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#ifndef sv_setnv_mg -# define sv_setnv_mg(sv, num) \ - STMT_START { \ - SV *TeMpSv = sv; \ - sv_setnv(TeMpSv,num); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#ifndef sv_setpv_mg -# define sv_setpv_mg(sv, ptr) \ - STMT_START { \ - SV *TeMpSv = sv; \ - sv_setpv(TeMpSv,ptr); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#ifndef sv_setpvn_mg -# define sv_setpvn_mg(sv, ptr, len) \ - STMT_START { \ - SV *TeMpSv = sv; \ - sv_setpvn(TeMpSv,ptr,len); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#ifndef sv_setsv_mg -# define sv_setsv_mg(dsv, ssv) \ - STMT_START { \ - SV *TeMpSv = dsv; \ - sv_setsv(TeMpSv,ssv); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#ifndef sv_setuv_mg -# define sv_setuv_mg(sv, i) \ - STMT_START { \ - SV *TeMpSv = sv; \ - sv_setuv(TeMpSv,i); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#ifndef sv_usepvn_mg -# define sv_usepvn_mg(sv, ptr, len) \ - STMT_START { \ - SV *TeMpSv = sv; \ - sv_usepvn(TeMpSv,ptr,len); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -__UNDEFINED__ SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL) - -/* Hint: sv_magic_portable - * This is a compatibility function that is only available with - * Devel::PPPort. It is NOT in the perl core. - * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when - * it is being passed a name pointer with namlen == 0. In that - * case, perl 5.8.0 and later store the pointer, not a copy of it. - * The compatibility can be provided back to perl 5.004. With - * earlier versions, the code will not compile. - */ - -#if { VERSION < 5.004 } - - /* code that uses sv_magic_portable will not compile */ - -#elif { VERSION < 5.8.0 } - -# define sv_magic_portable(sv, obj, how, name, namlen) \ - STMT_START { \ - SV *SvMp_sv = (sv); \ - char *SvMp_name = (char *) (name); \ - I32 SvMp_namlen = (namlen); \ - if (SvMp_name && SvMp_namlen == 0) \ - { \ - MAGIC *mg; \ - sv_magic(SvMp_sv, obj, how, 0, 0); \ - mg = SvMAGIC(SvMp_sv); \ - mg->mg_len = -42; /* XXX: this is the tricky part */ \ - mg->mg_ptr = SvMp_name; \ - } \ - else \ - { \ - sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \ - } \ - } STMT_END - -#else - -# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e) - -#endif - -=xsubs - -void -sv_catpv_mg(sv, string) - SV *sv; - char *string; - CODE: - sv_catpv_mg(sv, string); - -void -sv_catpvn_mg(sv, sv2) - SV *sv; - SV *sv2; - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV(sv2, len); - sv_catpvn_mg(sv, str, len); - -void -sv_catsv_mg(sv, sv2) - SV *sv; - SV *sv2; - CODE: - sv_catsv_mg(sv, sv2); - -void -sv_setiv_mg(sv, iv) - SV *sv; - IV iv; - CODE: - sv_setiv_mg(sv, iv); - -void -sv_setnv_mg(sv, nv) - SV *sv; - NV nv; - CODE: - sv_setnv_mg(sv, nv); - -void -sv_setpv_mg(sv, pv) - SV *sv; - char *pv; - CODE: - sv_setpv_mg(sv, pv); - -void -sv_setpvn_mg(sv, sv2) - SV *sv; - SV *sv2; - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV(sv2, len); - sv_setpvn_mg(sv, str, len); - -void -sv_setsv_mg(sv, sv2) - SV *sv; - SV *sv2; - CODE: - sv_setsv_mg(sv, sv2); - -void -sv_setuv_mg(sv, uv) - SV *sv; - UV uv; - CODE: - sv_setuv_mg(sv, uv); - -void -sv_usepvn_mg(sv, sv2) - SV *sv; - SV *sv2; - PREINIT: - char *str, *copy; - STRLEN len; - CODE: - str = SvPV(sv2, len); - New(42, copy, len+1, char); - Copy(str, copy, len+1, char); - sv_usepvn_mg(sv, copy, len); - -int -SvVSTRING_mg(sv) - SV *sv; - CODE: - RETVAL = SvVSTRING_mg(sv) != NULL; - OUTPUT: - RETVAL - -int -sv_magic_portable(sv) - SV *sv - PREINIT: - MAGIC *mg; - const char *foo = "foo"; - CODE: -#if { VERSION >= 5.004 } - sv_magic_portable(sv, 0, '~', foo, 0); - mg = mg_find(sv, '~'); - RETVAL = mg->mg_ptr == foo; -#else - sv_magic(sv, 0, '~', (char *) foo, strlen(foo)); - mg = mg_find(sv, '~'); - RETVAL = strEQ(mg->mg_ptr, foo); -#endif - sv_unmagic(sv, '~'); - OUTPUT: - RETVAL - -=tests plan => 15 - -use Tie::Hash; -my %h; -tie %h, 'Tie::StdHash'; -$h{foo} = 'foo'; -$h{bar} = ''; - -&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); -ok($h{foo}, 'foobar'); - -&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); -ok($h{bar}, 'baz'); - -&Devel::PPPort::sv_catsv_mg($h{foo}, '42'); -ok($h{foo}, 'foobar42'); - -&Devel::PPPort::sv_setiv_mg($h{bar}, 42); -ok($h{bar}, 42); - -&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); -ok(abs($h{PI} - 3.14159) < 0.01); - -&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); -ok($h{mhx}, 'mhx'); - -&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); -ok($h{mhx}, 'Marcus'); - -&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); -ok($h{sv}, 'SV'); - -&Devel::PPPort::sv_setuv_mg($h{sv}, 4711); -ok($h{sv}, 4711); - -&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); -ok($h{sv}, 'Perl'); - -my $ver = eval qq[qv("v1.2.0")]; -ok($[ < 5.009 || $@ eq ''); -ok($@ || Devel::PPPort::SvVSTRING_mg($ver)); -ok(!Devel::PPPort::SvVSTRING_mg(4711)); - -my $foo = 'bar'; -ok(Devel::PPPort::sv_magic_portable($foo)); -ok($foo eq 'bar'); - diff --git a/ext/Devel/PPPort/parts/inc/memory b/ext/Devel/PPPort/parts/inc/memory deleted file mode 100644 index 761d80c959..0000000000 --- a/ext/Devel/PPPort/parts/inc/memory +++ /dev/null @@ -1,84 +0,0 @@ -################################################################################ -## -## $Revision: 5 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:53 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ - -=implementation - -#ifdef HAS_MEMCMP -__UNDEFINED__ memNE(s1,s2,l) (memcmp(s1,s2,l)) -__UNDEFINED__ memEQ(s1,s2,l) (!memcmp(s1,s2,l)) -#else -__UNDEFINED__ memNE(s1,s2,l) (bcmp(s1,s2,l)) -__UNDEFINED__ memEQ(s1,s2,l) (!bcmp(s1,s2,l)) -#endif - -__UNDEFINED__ MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) -__UNDEFINED__ CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) -#ifdef HAS_MEMSET -__UNDEFINED__ ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) -#else -__UNDEFINED__ ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) -#endif - -__UNDEFINED__ PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) -__UNDEFINED__ PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) -__UNDEFINED__ PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) -__UNDEFINED__ Poison(d,n,t) PoisonFree(d,n,t) - -__UNDEFINED__ Newx(v,n,t) New(0,v,n,t) -__UNDEFINED__ Newxc(v,n,t,c) Newc(0,v,n,t,c) -__UNDEFINED__ Newxz(v,n,t) Newz(0,v,n,t) - -=xsubs - -int -checkmem() - PREINIT: - char *p; - - CODE: - RETVAL = 0; - Newx(p, 6, char); - CopyD("Hello", p, 6, char); - if (memEQ(p, "Hello", 6)) - RETVAL++; - ZeroD(p, 6, char); - if (memEQ(p, "\0\0\0\0\0\0", 6)) - RETVAL++; - Poison(p, 6, char); - if (memNE(p, "\0\0\0\0\0\0", 6)) - RETVAL++; - Safefree(p); - - Newxz(p, 6, char); - if (memEQ(p, "\0\0\0\0\0\0", 6)) - RETVAL++; - Safefree(p); - - Newxc(p, 3, short, char); - Safefree(p); - - OUTPUT: - RETVAL - -=tests plan => 1 - -ok(Devel::PPPort::checkmem(), 4); - diff --git a/ext/Devel/PPPort/parts/inc/misc b/ext/Devel/PPPort/parts/inc/misc deleted file mode 100644 index 8044df92a1..0000000000 --- a/ext/Devel/PPPort/parts/inc/misc +++ /dev/null @@ -1,536 +0,0 @@ -################################################################################ -## -## $Revision: 51 $ -## $Author: mhx $ -## $Date: 2009/01/23 18:28:31 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ -PERL_UNUSED_DECL -PERL_UNUSED_ARG -PERL_UNUSED_VAR -PERL_UNUSED_CONTEXT -PERL_GCC_BRACE_GROUPS_FORBIDDEN -PERL_USE_GCC_BRACE_GROUPS -PERLIO_FUNCS_DECL -PERLIO_FUNCS_CAST -NVTYPE -INT2PTR -PTRV -NUM2PTR -PERL_HASH -PTR2IV -PTR2UV -PTR2NV -PTR2ul -START_EXTERN_C -END_EXTERN_C -EXTERN_C -STMT_START -STMT_END -UTF8_MAXBYTES -XSRETURN - -=implementation - -#ifndef PERL_UNUSED_DECL -# ifdef HASATTRIBUTE -# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) -# define PERL_UNUSED_DECL -# else -# define PERL_UNUSED_DECL __attribute__((unused)) -# endif -# else -# define PERL_UNUSED_DECL -# endif -#endif - -#ifndef PERL_UNUSED_ARG -# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ -# include -# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) -# else -# define PERL_UNUSED_ARG(x) ((void)x) -# endif -#endif - -#ifndef PERL_UNUSED_VAR -# define PERL_UNUSED_VAR(x) ((void)x) -#endif - -#ifndef PERL_UNUSED_CONTEXT -# ifdef USE_ITHREADS -# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) -# else -# define PERL_UNUSED_CONTEXT -# endif -#endif - -__UNDEFINED__ NOOP /*EMPTY*/(void)0 -__UNDEFINED__ dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL - -#ifndef NVTYPE -# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) -# define NVTYPE long double -# else -# define NVTYPE double -# endif -typedef NVTYPE NV; -#endif - -#ifndef INT2PTR - -# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) -# define PTRV UV -# define INT2PTR(any,d) (any)(d) -# else -# if PTRSIZE == LONGSIZE -# define PTRV unsigned long -# else -# define PTRV unsigned -# endif -# define INT2PTR(any,d) (any)(PTRV)(d) -# endif - -# define NUM2PTR(any,d) (any)(PTRV)(d) -# define PTR2IV(p) INT2PTR(IV,p) -# define PTR2UV(p) INT2PTR(UV,p) -# define PTR2NV(p) NUM2PTR(NV,p) - -# if PTRSIZE == LONGSIZE -# define PTR2ul(p) (unsigned long)(p) -# else -# define PTR2ul(p) INT2PTR(unsigned long,p) -# endif - -#endif /* !INT2PTR */ - -#undef START_EXTERN_C -#undef END_EXTERN_C -#undef EXTERN_C -#ifdef __cplusplus -# define START_EXTERN_C extern "C" { -# define END_EXTERN_C } -# define EXTERN_C extern "C" -#else -# define START_EXTERN_C -# define END_EXTERN_C -# define EXTERN_C extern -#endif - -#if defined(PERL_GCC_PEDANTIC) -# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN -# define PERL_GCC_BRACE_GROUPS_FORBIDDEN -# endif -#endif - -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) -# ifndef PERL_USE_GCC_BRACE_GROUPS -# define PERL_USE_GCC_BRACE_GROUPS -# endif -#endif - -#undef STMT_START -#undef STMT_END -#ifdef PERL_USE_GCC_BRACE_GROUPS -# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ -# define STMT_END ) -#else -# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) -# define STMT_START if (1) -# define STMT_END else (void)0 -# else -# define STMT_START do -# define STMT_END while (0) -# endif -#endif - -__UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) - -/* DEFSV appears first in 5.004_56 */ -__UNDEFINED__ DEFSV GvSV(PL_defgv) -__UNDEFINED__ SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) -__UNDEFINED__ DEFSV_set(sv) (DEFSV = (sv)) - -/* Older perls (<=5.003) lack AvFILLp */ -__UNDEFINED__ AvFILLp AvFILL - -__UNDEFINED__ ERRSV get_sv("@",FALSE) - -/* Hint: gv_stashpvn - * This function's backport doesn't support the length parameter, but - * rather ignores it. Portability can only be ensured if the length - * parameter is used for speed reasons, but the length can always be - * correctly computed from the string argument. - */ - -__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create) - -/* Replace: 1 */ -__UNDEFINED__ get_cv perl_get_cv -__UNDEFINED__ get_sv perl_get_sv -__UNDEFINED__ get_av perl_get_av -__UNDEFINED__ get_hv perl_get_hv -/* Replace: 0 */ - -__UNDEFINED__ dUNDERBAR dNOOP -__UNDEFINED__ UNDERBAR DEFSV - -__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1 -__UNDEFINED__ dITEMS I32 items = SP - MARK - -__UNDEFINED__ dXSTARG SV * targ = sv_newmortal() - -__UNDEFINED__ dAXMARK I32 ax = POPMARK; \ - register SV ** const mark = PL_stack_base + ax++ - - -__UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1) - -#if { VERSION < 5.005 } -# undef XSRETURN -# define XSRETURN(off) \ - STMT_START { \ - PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ - return; \ - } STMT_END -#endif - -__UNDEFINED__ PERL_ABS(x) ((x) < 0 ? -(x) : (x)) - -__UNDEFINED__ dVAR dNOOP - -__UNDEFINED__ SVf "_" - -__UNDEFINED__ UTF8_MAXBYTES UTF8_MAXLEN - -__UNDEFINED__ CPERLscope(x) x - -__UNDEFINED__ PERL_HASH(hash,str,len) \ - STMT_START { \ - const char *s_PeRlHaSh = str; \ - I32 i_PeRlHaSh = len; \ - U32 hash_PeRlHaSh = 0; \ - while (i_PeRlHaSh--) \ - hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \ - (hash) = hash_PeRlHaSh; \ - } STMT_END - -#ifndef PERLIO_FUNCS_DECL -# ifdef PERLIO_FUNCS_CONST -# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs -# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs) -# else -# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs -# define PERLIO_FUNCS_CAST(funcs) (funcs) -# endif -#endif - -/* provide these typedefs for older perls */ -#if { VERSION < 5.9.3 } - -# ifdef ARGSproto -typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto); -# else -typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); -# endif - -typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); - -#endif - -__UNDEFINED__ isPSXSPC(c) (isSPACE(c) || (c) == '\v') -__UNDEFINED__ isBLANK(c) ((c) == ' ' || (c) == '\t') -#ifdef EBCDIC -__UNDEFINED__ isALNUMC(c) isalnum(c) -__UNDEFINED__ isASCII(c) isascii(c) -__UNDEFINED__ isCNTRL(c) iscntrl(c) -__UNDEFINED__ isGRAPH(c) isgraph(c) -__UNDEFINED__ isPRINT(c) isprint(c) -__UNDEFINED__ isPUNCT(c) ispunct(c) -__UNDEFINED__ isXDIGIT(c) isxdigit(c) -#else -# if { VERSION < 5.10.0 } -/* Hint: isPRINT - * The implementation in older perl versions includes all of the - * isSPACE() characters, which is wrong. The version provided by - * Devel::PPPort always overrides a present buggy version. - */ -# undef isPRINT -# endif -__UNDEFINED__ isALNUMC(c) (isALPHA(c) || isDIGIT(c)) -__UNDEFINED__ isASCII(c) ((c) <= 127) -__UNDEFINED__ isCNTRL(c) ((c) < ' ' || (c) == 127) -__UNDEFINED__ isGRAPH(c) (isALNUM(c) || isPUNCT(c)) -__UNDEFINED__ isPRINT(c) (((c) >= 32 && (c) < 127)) -__UNDEFINED__ isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126)) -__UNDEFINED__ isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F')) -#endif - -=xsmisc - -XS(XS_Devel__PPPort_dXSTARG); /* prototype */ -XS(XS_Devel__PPPort_dXSTARG) -{ - dXSARGS; - dXSTARG; - IV iv; - SP -= items; - iv = SvIV(ST(0)) + 1; - PUSHi(iv); - XSRETURN(1); -} - -XS(XS_Devel__PPPort_dAXMARK); /* prototype */ -XS(XS_Devel__PPPort_dAXMARK) -{ - dSP; - dAXMARK; - dITEMS; - IV iv; - SP -= items; - iv = SvIV(ST(0)) - 1; - mPUSHi(iv); - XSRETURN(1); -} - -=xsboot - -newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file); -newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file); - -=xsubs - -int -gv_stashpvn(name, create) - char *name - I32 create - CODE: - RETVAL = gv_stashpvn(name, strlen(name), create) != NULL; - OUTPUT: - RETVAL - -int -get_sv(name, create) - char *name - I32 create - CODE: - RETVAL = get_sv(name, create) != NULL; - OUTPUT: - RETVAL - -int -get_av(name, create) - char *name - I32 create - CODE: - RETVAL = get_av(name, create) != NULL; - OUTPUT: - RETVAL - -int -get_hv(name, create) - char *name - I32 create - CODE: - RETVAL = get_hv(name, create) != NULL; - OUTPUT: - RETVAL - -int -get_cv(name, create) - char *name - I32 create - CODE: - RETVAL = get_cv(name, create) != NULL; - OUTPUT: - RETVAL - -void -xsreturn(two) - int two - PPCODE: - mXPUSHp("test1", 5); - if (two) - mXPUSHp("test2", 5); - if (two) - XSRETURN(2); - else - XSRETURN(1); - -SV* -boolSV(value) - int value - CODE: - RETVAL = newSVsv(boolSV(value)); - OUTPUT: - RETVAL - -SV* -DEFSV() - CODE: - RETVAL = newSVsv(DEFSV); - OUTPUT: - RETVAL - -void -DEFSV_modify() - PPCODE: - XPUSHs(sv_mortalcopy(DEFSV)); - ENTER; - SAVE_DEFSV; - DEFSV_set(newSVpvs("DEFSV")); - XPUSHs(sv_mortalcopy(DEFSV)); - /* Yes, this leaks the above scalar; 5.005 with threads for some reason */ - /* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */ - /* sv_2mortal(DEFSV); */ - LEAVE; - XPUSHs(sv_mortalcopy(DEFSV)); - XSRETURN(3); - -int -ERRSV() - CODE: - RETVAL = SvTRUE(ERRSV); - OUTPUT: - RETVAL - -SV* -UNDERBAR() - CODE: - { - dUNDERBAR; - RETVAL = newSVsv(UNDERBAR); - } - OUTPUT: - RETVAL - -void -prepush() - CODE: - { - dXSTARG; - XSprePUSH; - PUSHi(42); - XSRETURN(1); - } - -int -PERL_ABS(a) - int a - -void -SVf(x) - SV *x - PPCODE: -#if { VERSION >= 5.004 } - x = sv_2mortal(newSVpvf("[%"SVf"]", x)); -#endif - XPUSHs(x); - XSRETURN(1); - -void -Perl_ppaddr_t(string) - char *string - PREINIT: - Perl_ppaddr_t lower; - PPCODE: - lower = PL_ppaddr[OP_LC]; - PUSHMARK(SP); - mXPUSHs(newSVpv(string, 0)); - PUTBACK; - ENTER; - (void)*(lower)(aTHXR); - SPAGAIN; - LEAVE; - XSRETURN(1); - -=tests plan => 38 - -use vars qw($my_sv @my_av %my_hv); - -ok(&Devel::PPPort::boolSV(1)); -ok(!&Devel::PPPort::boolSV(0)); - -$_ = "Fred"; -ok(&Devel::PPPort::DEFSV(), "Fred"); -ok(&Devel::PPPort::UNDERBAR(), "Fred"); - -if ($] >= 5.009002) { - eval q{ - my $_ = "Tony"; - ok(&Devel::PPPort::DEFSV(), "Fred"); - ok(&Devel::PPPort::UNDERBAR(), "Tony"); - }; -} -else { - ok(1); - ok(1); -} - -my @r = &Devel::PPPort::DEFSV_modify(); - -ok(@r == 3); -ok($r[0], 'Fred'); -ok($r[1], 'DEFSV'); -ok($r[2], 'Fred'); - -ok(&Devel::PPPort::DEFSV(), "Fred"); - -eval { 1 }; -ok(!&Devel::PPPort::ERRSV()); -eval { cannot_call_this_one() }; -ok(&Devel::PPPort::ERRSV()); - -ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0)); -ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0)); -ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1)); - -$my_sv = 1; -ok(&Devel::PPPort::get_sv('my_sv', 0)); -ok(!&Devel::PPPort::get_sv('not_my_sv', 0)); -ok(&Devel::PPPort::get_sv('not_my_sv', 1)); - -@my_av = (1); -ok(&Devel::PPPort::get_av('my_av', 0)); -ok(!&Devel::PPPort::get_av('not_my_av', 0)); -ok(&Devel::PPPort::get_av('not_my_av', 1)); - -%my_hv = (a=>1); -ok(&Devel::PPPort::get_hv('my_hv', 0)); -ok(!&Devel::PPPort::get_hv('not_my_hv', 0)); -ok(&Devel::PPPort::get_hv('not_my_hv', 1)); - -sub my_cv { 1 }; -ok(&Devel::PPPort::get_cv('my_cv', 0)); -ok(!&Devel::PPPort::get_cv('not_my_cv', 0)); -ok(&Devel::PPPort::get_cv('not_my_cv', 1)); - -ok(Devel::PPPort::dXSTARG(42), 43); -ok(Devel::PPPort::dAXMARK(4711), 4710); - -ok(Devel::PPPort::prepush(), 42); - -ok(join(':', Devel::PPPort::xsreturn(0)), 'test1'); -ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); - -ok(Devel::PPPort::PERL_ABS(42), 42); -ok(Devel::PPPort::PERL_ABS(-13), 13); - -ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42'); -ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc'); - -ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo"); - diff --git a/ext/Devel/PPPort/parts/inc/newCONSTSUB b/ext/Devel/PPPort/parts/inc/newCONSTSUB deleted file mode 100644 index 4b266d7990..0000000000 --- a/ext/Devel/PPPort/parts/inc/newCONSTSUB +++ /dev/null @@ -1,111 +0,0 @@ -################################################################################ -## -## $Revision: 15 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:55 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -newCONSTSUB - -=implementation - -/* Hint: newCONSTSUB - * Returns a CV* as of perl-5.7.1. This return value is not supported - * by Devel::PPPort. - */ - -/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ -#if { VERSION < 5.004_63 } && { VERSION != 5.004_05 } -#if { NEED newCONSTSUB } - -/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */ -/* (There's no PL_parser in perl < 5.005, so this is completely safe) */ -#define D_PPP_PL_copline PL_copline - -void -newCONSTSUB(HV *stash, const char *name, SV *sv) -{ - U32 oldhints = PL_hints; - HV *old_cop_stash = PL_curcop->cop_stash; - HV *old_curstash = PL_curstash; - line_t oldline = PL_curcop->cop_line; - PL_curcop->cop_line = D_PPP_PL_copline; - - PL_hints &= ~HINT_BLOCK_SCOPE; - if (stash) - PL_curstash = PL_curcop->cop_stash = stash; - - newSUB( - -#if { VERSION < 5.003_22 } - start_subparse(), -#elif { VERSION == 5.003_22 } - start_subparse(0), -#else /* 5.003_23 onwards */ - start_subparse(FALSE, 0), -#endif - - newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)), - newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ - newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) - ); - - PL_hints = oldhints; - PL_curcop->cop_stash = old_cop_stash; - PL_curstash = old_curstash; - PL_curcop->cop_line = oldline; -} -#endif -#endif - -=xsinit - -#define NEED_newCONSTSUB - -=xsmisc - -void call_newCONSTSUB_1(void) -{ -#ifdef PERL_NO_GET_CONTEXT - dTHX; -#endif - newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1)); -} - -extern void call_newCONSTSUB_2(void); -extern void call_newCONSTSUB_3(void); - -=xsubs - -void -call_newCONSTSUB_1() - -void -call_newCONSTSUB_2() - -void -call_newCONSTSUB_3() - -=tests plan => 3 - -&Devel::PPPort::call_newCONSTSUB_1(); -ok(&Devel::PPPort::test_value_1(), 1); - -&Devel::PPPort::call_newCONSTSUB_2(); -ok(&Devel::PPPort::test_value_2(), 2); - -&Devel::PPPort::call_newCONSTSUB_3(); -ok(&Devel::PPPort::test_value_3(), 3); - diff --git a/ext/Devel/PPPort/parts/inc/newRV b/ext/Devel/PPPort/parts/inc/newRV deleted file mode 100644 index 1467d1ae9d..0000000000 --- a/ext/Devel/PPPort/parts/inc/newRV +++ /dev/null @@ -1,74 +0,0 @@ -################################################################################ -## -## $Revision: 9 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:55 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -newRV_inc -newRV_noinc - -=implementation - -__UNDEFINED__ newRV_inc(sv) newRV(sv) /* Replace */ - -#ifndef newRV_noinc -#if { NEED newRV_noinc } -SV * -newRV_noinc(SV *sv) -{ - SV *rv = (SV *)newRV(sv); - SvREFCNT_dec(sv); - return rv; -} -#endif -#endif - -=xsinit - -#define NEED_newRV_noinc - -=xsubs - -U32 -newRV_inc_REFCNT() - PREINIT: - SV *sv, *rv; - CODE: - sv = newSViv(42); - rv = newRV_inc(sv); - SvREFCNT_dec(sv); - RETVAL = SvREFCNT(sv); - sv_2mortal(rv); - OUTPUT: - RETVAL - -U32 -newRV_noinc_REFCNT() - PREINIT: - SV *sv, *rv; - CODE: - sv = newSViv(42); - rv = newRV_noinc(sv); - RETVAL = SvREFCNT(sv); - sv_2mortal(rv); - OUTPUT: - RETVAL - -=tests plan => 2 - -ok(&Devel::PPPort::newRV_inc_REFCNT, 1); -ok(&Devel::PPPort::newRV_noinc_REFCNT, 1); - diff --git a/ext/Devel/PPPort/parts/inc/newSVpv b/ext/Devel/PPPort/parts/inc/newSVpv deleted file mode 100644 index 3a38549f98..0000000000 --- a/ext/Devel/PPPort/parts/inc/newSVpv +++ /dev/null @@ -1,115 +0,0 @@ -################################################################################ -## -## $Revision: 6 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:51 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ -newSVpvn_flags - -=implementation - -#if { VERSION < 5.6.0 } -# define D_PPP_CONSTPV_ARG(x) ((char *) (x)) -#else -# define D_PPP_CONSTPV_ARG(x) (x) -#endif - -__UNDEFINED__ newSVpvn(data,len) ((data) \ - ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \ - : newSV(0)) - -__UNDEFINED__ newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) - -__UNDEFINED__ SVf_UTF8 0 - -#ifndef newSVpvn_flags - -#if { NEED newSVpvn_flags } - -SV * -newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags) -{ - SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len); - SvFLAGS(sv) |= (flags & SVf_UTF8); - return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv; -} - -#endif - -#endif - -=xsinit - -#define NEED_newSVpvn_flags - -=xsubs - -void -newSVpvn() - PPCODE: - mXPUSHs(newSVpvn("test", 4)); - mXPUSHs(newSVpvn("test", 2)); - mXPUSHs(newSVpvn("test", 0)); - mXPUSHs(newSVpvn(NULL, 2)); - mXPUSHs(newSVpvn(NULL, 0)); - XSRETURN(5); - -void -newSVpvn_flags() - PPCODE: - XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP)); - XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP)); - XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP)); - XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP)); - XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP)); - XSRETURN(5); - -void -newSVpvn_utf8() - PPCODE: - XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8)); - XSRETURN(1); - -=tests plan => 15 - -my @s = &Devel::PPPort::newSVpvn(); -ok(@s == 5); -ok($s[0], "test"); -ok($s[1], "te"); -ok($s[2], ""); -ok(!defined($s[3])); -ok(!defined($s[4])); - -@s = &Devel::PPPort::newSVpvn_flags(); -ok(@s == 5); -ok($s[0], "test"); -ok($s[1], "te"); -ok($s[2], ""); -ok(!defined($s[3])); -ok(!defined($s[4])); - -@s = &Devel::PPPort::newSVpvn_utf8(); -ok(@s == 1); -ok($s[0], "test"); - -if ($] >= 5.008001) { - require utf8; - ok(utf8::is_utf8($s[0])); -} -else { - skip("skip: no is_utf8()", 0); -} diff --git a/ext/Devel/PPPort/parts/inc/podtest b/ext/Devel/PPPort/parts/inc/podtest deleted file mode 100644 index ceea0cf7a2..0000000000 --- a/ext/Devel/PPPort/parts/inc/podtest +++ /dev/null @@ -1,52 +0,0 @@ -################################################################################ -## -## $Revision: 9 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:52 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=tests plan => 0 - -my @pods = qw( HACKERS PPPort.pm ppport.h soak devel/regenerate devel/buildperl.pl ); - -my $reason = ''; - -if ($ENV{'SKIP_SLOW_TESTS'}) { - $reason = 'SKIP_SLOW_TESTS'; -} -else { - # Try loading Test::Pod - eval q{ - use Test::Pod; - $Test::Pod::VERSION >= 0.95 - or die "Test::Pod version only $Test::Pod::VERSION"; - import Test::Pod tests => scalar @pods; - }; - $reason = 'Test::Pod >= 0.95 required' if $@; -} - -if ($reason) { - load(); - plan(tests => scalar @pods); -} - -for (@pods) { - print "# checking $_\n"; - if ($reason) { - skip("skip: $reason", 0); - } - else { - pod_file_ok($_); - } -} - diff --git a/ext/Devel/PPPort/parts/inc/ppphbin b/ext/Devel/PPPort/parts/inc/ppphbin deleted file mode 100644 index 583f266a77..0000000000 --- a/ext/Devel/PPPort/parts/inc/ppphbin +++ /dev/null @@ -1,828 +0,0 @@ -################################################################################ -## -## $Revision: 50 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:54 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -=implementation - -use strict; - -# Disable broken TRIE-optimization -BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 } - -my $VERSION = __VERSION__; - -my %opt = ( - quiet => 0, - diag => 1, - hints => 1, - changes => 1, - cplusplus => 0, - filter => 1, - strip => 0, - version => 0, -); - -my($ppport) = $0 =~ /([\w.]+)$/; -my $LF = '(?:\r\n|[\r\n])'; # line feed -my $HS = "[ \t]"; # horizontal whitespace - -# Never use C comments in this file! -my $ccs = '/'.'*'; -my $cce = '*'.'/'; -my $rccs = quotemeta $ccs; -my $rcce = quotemeta $cce; - -eval { - require Getopt::Long; - Getopt::Long::GetOptions(\%opt, qw( - help quiet diag! filter! hints! changes! cplusplus strip version - patch=s copy=s diff=s compat-version=s - list-provided list-unsupported api-info=s - )) or usage(); -}; - -if ($@ and grep /^-/, @ARGV) { - usage() if "@ARGV" =~ /^--?h(?:elp)?$/; - die "Getopt::Long not found. Please don't use any options.\n"; -} - -if ($opt{version}) { - print "This is $0 $VERSION.\n"; - exit 0; -} - -usage() if $opt{help}; -strip() if $opt{strip}; - -if (exists $opt{'compat-version'}) { - my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; - if ($@) { - die "Invalid version number format: '$opt{'compat-version'}'\n"; - } - die "Only Perl 5 is supported\n" if $r != 5; - die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000; - $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; -} -else { - $opt{'compat-version'} = 5; -} - -my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ - ? ( $1 => { - ($2 ? ( base => $2 ) : ()), - ($3 ? ( todo => $3 ) : ()), - (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), - (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), - (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), - } ) - : die "invalid spec: $_" } qw( -__PERL_API__ -); - -if (exists $opt{'list-unsupported'}) { - my $f; - for $f (sort { lc $a cmp lc $b } keys %API) { - next unless $API{$f}{todo}; - print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; - } - exit 0; -} - -# Scan for possible replacement candidates - -my(%replace, %need, %hints, %warnings, %depends); -my $replace = 0; -my($hint, $define, $function); - -sub find_api -{ - my $code = shift; - $code =~ s{ - / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) - | "[^"\\]*(?:\\.[^"\\]*)*" - | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx; - grep { exists $API{$_} } $code =~ /(\w+)/mg; -} - -while () { - if ($hint) { - my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings; - if (m{^\s*\*\s(.*?)\s*$}) { - for (@{$hint->[1]}) { - $h->{$_} ||= ''; # suppress warning with older perls - $h->{$_} .= "$1\n"; - } - } - else { undef $hint } - } - - $hint = [$1, [split /,?\s+/, $2]] - if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$}; - - if ($define) { - if ($define->[1] =~ /\\$/) { - $define->[1] .= $_; - } - else { - if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) { - my @n = find_api($define->[1]); - push @{$depends{$define->[0]}}, @n if @n - } - undef $define; - } - } - - $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)}; - - if ($function) { - if (/^}/) { - if (exists $API{$function->[0]}) { - my @n = find_api($function->[1]); - push @{$depends{$function->[0]}}, @n if @n - } - undef $function; - } - else { - $function->[1] .= $_; - } - } - - $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)}; - - $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; - $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; - $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; - $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; - - if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { - my @deps = map { s/\s+//g; $_ } split /,/, $3; - my $d; - for $d (map { s/\s+//g; $_ } split /,/, $1) { - push @{$depends{$d}}, @deps; - } - } - - $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; -} - -for (values %depends) { - my %s; - $_ = [sort grep !$s{$_}++, @$_]; -} - -if (exists $opt{'api-info'}) { - my $f; - my $count = 0; - my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; - for $f (sort { lc $a cmp lc $b } keys %API) { - next unless $f =~ /$match/; - print "\n=== $f ===\n\n"; - my $info = 0; - if ($API{$f}{base} || $API{$f}{todo}) { - my $base = format_version($API{$f}{base} || $API{$f}{todo}); - print "Supported at least starting from perl-$base.\n"; - $info++; - } - if ($API{$f}{provided}) { - my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "__MIN_PERL__"; - print "Support by $ppport provided back to perl-$todo.\n"; - print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f}; - print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; - print "\n$hints{$f}" if exists $hints{$f}; - print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f}; - $info++; - } - print "No portability information available.\n" unless $info; - $count++; - } - $count or print "Found no API matching '$opt{'api-info'}'."; - print "\n"; - exit 0; -} - -if (exists $opt{'list-provided'}) { - my $f; - for $f (sort { lc $a cmp lc $b } keys %API) { - next unless $API{$f}{provided}; - my @flags; - push @flags, 'explicit' if exists $need{$f}; - push @flags, 'depend' if exists $depends{$f}; - push @flags, 'hint' if exists $hints{$f}; - push @flags, 'warning' if exists $warnings{$f}; - my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; - print "$f$flags\n"; - } - exit 0; -} - -my @files; -my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc ); -my $srcext = join '|', map { quotemeta $_ } @srcext; - -if (@ARGV) { - my %seen; - for (@ARGV) { - if (-e) { - if (-f) { - push @files, $_ unless $seen{$_}++; - } - else { warn "'$_' is not a file.\n" } - } - else { - my @new = grep { -f } glob $_ - or warn "'$_' does not exist.\n"; - push @files, grep { !$seen{$_}++ } @new; - } - } -} -else { - eval { - require File::Find; - File::Find::find(sub { - $File::Find::name =~ /($srcext)$/i - and push @files, $File::Find::name; - }, '.'); - }; - if ($@) { - @files = map { glob "*$_" } @srcext; - } -} - -if (!@ARGV || $opt{filter}) { - my(@in, @out); - my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files; - for (@files) { - my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i; - push @{ $out ? \@out : \@in }, $_; - } - if (@ARGV && @out) { - warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out); - } - @files = @in; -} - -die "No input files given!\n" unless @files; - -my(%files, %global, %revreplace); -%revreplace = reverse %replace; -my $filename; -my $patch_opened = 0; - -for $filename (@files) { - unless (open IN, "<$filename") { - warn "Unable to read from $filename: $!\n"; - next; - } - - info("Scanning $filename ..."); - - my $c = do { local $/; }; - close IN; - - my %file = (orig => $c, changes => 0); - - # Temporarily remove C/XS comments and strings from the code - my @ccom; - - $c =~ s{ - ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]* - | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* ) - | ( ^$HS*\#[^\r\n]* - | "[^"\\]*(?:\\.[^"\\]*)*" - | '[^'\\]*(?:\\.[^'\\]*)*' - | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) ) - }{ defined $2 and push @ccom, $2; - defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex; - - $file{ccom} = \@ccom; - $file{code} = $c; - $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m; - - my $func; - - for $func (keys %API) { - my $match = $func; - $match .= "|$revreplace{$func}" if exists $revreplace{$func}; - if ($c =~ /\b(?:Perl_)?($match)\b/) { - $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; - $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; - if (exists $API{$func}{provided}) { - $file{uses_provided}{$func}++; - if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { - $file{uses}{$func}++; - my @deps = rec_depend($func); - if (@deps) { - $file{uses_deps}{$func} = \@deps; - for (@deps) { - $file{uses}{$_} = 0 unless exists $file{uses}{$_}; - } - } - for ($func, @deps) { - $file{needs}{$_} = 'static' if exists $need{$_}; - } - } - } - if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { - if ($c =~ /\b$func\b/) { - $file{uses_todo}{$func}++; - } - } - } - } - - while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { - if (exists $need{$2}) { - $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; - } - else { warning("Possibly wrong #define $1 in $filename") } - } - - for (qw(uses needs uses_todo needed_global needed_static)) { - for $func (keys %{$file{$_}}) { - push @{$global{$_}{$func}}, $filename; - } - } - - $files{$filename} = \%file; -} - -# Globally resolve NEED_'s -my $need; -for $need (keys %{$global{needs}}) { - if (@{$global{needs}{$need}} > 1) { - my @targets = @{$global{needs}{$need}}; - my @t = grep $files{$_}{needed_global}{$need}, @targets; - @targets = @t if @t; - @t = grep /\.xs$/i, @targets; - @targets = @t if @t; - my $target = shift @targets; - $files{$target}{needs}{$need} = 'global'; - for (@{$global{needs}{$need}}) { - $files{$_}{needs}{$need} = 'extern' if $_ ne $target; - } - } -} - -for $filename (@files) { - exists $files{$filename} or next; - - info("=== Analyzing $filename ==="); - - my %file = %{$files{$filename}}; - my $func; - my $c = $file{code}; - my $warnings = 0; - - for $func (sort keys %{$file{uses_Perl}}) { - if ($API{$func}{varargs}) { - unless ($API{$func}{nothxarg}) { - my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} - { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); - if ($changes) { - warning("Doesn't pass interpreter argument aTHX to Perl_$func"); - $file{changes} += $changes; - } - } - } - else { - warning("Uses Perl_$func instead of $func"); - $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} - {$func$1(}g); - } - } - - for $func (sort keys %{$file{uses_replace}}) { - warning("Uses $func instead of $replace{$func}"); - $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); - } - - for $func (sort keys %{$file{uses_provided}}) { - if ($file{uses}{$func}) { - if (exists $file{uses_deps}{$func}) { - diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); - } - else { - diag("Uses $func"); - } - } - $warnings += hint($func); - } - - unless ($opt{quiet}) { - for $func (sort keys %{$file{uses_todo}}) { - print "*** WARNING: Uses $func, which may not be portable below perl ", - format_version($API{$func}{todo}), ", even with '$ppport'\n"; - $warnings++; - } - } - - for $func (sort keys %{$file{needed_static}}) { - my $message = ''; - if (not exists $file{uses}{$func}) { - $message = "No need to define NEED_$func if $func is never used"; - } - elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { - $message = "No need to define NEED_$func when already needed globally"; - } - if ($message) { - diag($message); - $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); - } - } - - for $func (sort keys %{$file{needed_global}}) { - my $message = ''; - if (not exists $global{uses}{$func}) { - $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; - } - elsif (exists $file{needs}{$func}) { - if ($file{needs}{$func} eq 'extern') { - $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; - } - elsif ($file{needs}{$func} eq 'static') { - $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; - } - } - if ($message) { - diag($message); - $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); - } - } - - $file{needs_inc_ppport} = keys %{$file{uses}}; - - if ($file{needs_inc_ppport}) { - my $pp = ''; - - for $func (sort keys %{$file{needs}}) { - my $type = $file{needs}{$func}; - next if $type eq 'extern'; - my $suffix = $type eq 'global' ? '_GLOBAL' : ''; - unless (exists $file{"needed_$type"}{$func}) { - if ($type eq 'global') { - diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); - } - else { - diag("File needs $func, adding static request"); - } - $pp .= "#define NEED_$func$suffix\n"; - } - } - - if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { - $pp = ''; - $file{changes}++; - } - - unless ($file{has_inc_ppport}) { - diag("Needs to include '$ppport'"); - $pp .= qq(#include "$ppport"\n) - } - - if ($pp) { - $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) - || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) - || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) - || ($c =~ s/^/$pp/); - } - } - else { - if ($file{has_inc_ppport}) { - diag("No need to include '$ppport'"); - $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); - } - } - - # put back in our C comments - my $ix; - my $cppc = 0; - my @ccom = @{$file{ccom}}; - for $ix (0 .. $#ccom) { - if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { - $cppc++; - $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; - } - else { - $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; - } - } - - if ($cppc) { - my $s = $cppc != 1 ? 's' : ''; - warning("Uses $cppc C++ style comment$s, which is not portable"); - } - - my $s = $warnings != 1 ? 's' : ''; - my $warn = $warnings ? " ($warnings warning$s)" : ''; - info("Analysis completed$warn"); - - if ($file{changes}) { - if (exists $opt{copy}) { - my $newfile = "$filename$opt{copy}"; - if (-e $newfile) { - error("'$newfile' already exists, refusing to write copy of '$filename'"); - } - else { - local *F; - if (open F, ">$newfile") { - info("Writing copy of '$filename' with changes to '$newfile'"); - print F $c; - close F; - } - else { - error("Cannot open '$newfile' for writing: $!"); - } - } - } - elsif (exists $opt{patch} || $opt{changes}) { - if (exists $opt{patch}) { - unless ($patch_opened) { - if (open PATCH, ">$opt{patch}") { - $patch_opened = 1; - } - else { - error("Cannot open '$opt{patch}' for writing: $!"); - delete $opt{patch}; - $opt{changes} = 1; - goto fallback; - } - } - mydiff(\*PATCH, $filename, $c); - } - else { -fallback: - info("Suggested changes:"); - mydiff(\*STDOUT, $filename, $c); - } - } - else { - my $s = $file{changes} == 1 ? '' : 's'; - info("$file{changes} potentially required change$s detected"); - } - } - else { - info("Looks good"); - } -} - -close PATCH if $patch_opened; - -exit 0; - -####################################################################### - -sub try_use { eval "use @_;"; return $@ eq '' } - -sub mydiff -{ - local *F = shift; - my($file, $str) = @_; - my $diff; - - if (exists $opt{diff}) { - $diff = run_diff($opt{diff}, $file, $str); - } - - if (!defined $diff and try_use('Text::Diff')) { - $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); - $diff = <
$tmp") { - print F $str; - close F; - - if (open F, "$prog $file $tmp |") { - while () { - s/\Q$tmp\E/$file.patched/; - $diff .= $_; - } - close F; - unlink $tmp; - return $diff; - } - - unlink $tmp; - } - else { - error("Cannot open '$tmp' for writing: $!"); - } - - return undef; -} - -sub rec_depend -{ - my($func, $seen) = @_; - return () unless exists $depends{$func}; - $seen = {%{$seen||{}}}; - return () if $seen->{$func}++; - my %s; - grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}}; -} - -sub parse_version -{ - my $ver = shift; - - if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { - return ($1, $2, $3); - } - elsif ($ver !~ /^\d+\.[\d_]+$/) { - die "cannot parse version '$ver'\n"; - } - - $ver =~ s/_//g; - $ver =~ s/$/000000/; - - my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; - - $v = int $v; - $s = int $s; - - if ($r < 5 || ($r == 5 && $v < 6)) { - if ($s % 10) { - die "cannot parse version '$ver'\n"; - } - } - - return ($r, $v, $s); -} - -sub format_version -{ - my $ver = shift; - - $ver =~ s/$/000000/; - my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; - - $v = int $v; - $s = int $s; - - if ($r < 5 || ($r == 5 && $v < 6)) { - if ($s % 10) { - die "invalid version '$ver'\n"; - } - $s /= 10; - - $ver = sprintf "%d.%03d", $r, $v; - $s > 0 and $ver .= sprintf "_%02d", $s; - - return $ver; - } - - return sprintf "%d.%d.%d", $r, $v, $s; -} - -sub info -{ - $opt{quiet} and return; - print @_, "\n"; -} - -sub diag -{ - $opt{quiet} and return; - $opt{diag} and print @_, "\n"; -} - -sub warning -{ - $opt{quiet} and return; - print "*** ", @_, "\n"; -} - -sub error -{ - print "*** ERROR: ", @_, "\n"; -} - -my %given_hints; -my %given_warnings; -sub hint -{ - $opt{quiet} and return; - my $func = shift; - my $rv = 0; - if (exists $warnings{$func} && !$given_warnings{$func}++) { - my $warn = $warnings{$func}; - $warn =~ s!^!*** !mg; - print "*** WARNING: $func\n", $warn; - $rv++; - } - if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) { - my $hint = $hints{$func}; - $hint =~ s/^/ /mg; - print " --- hint for $func ---\n", $hint; - } - $rv; -} - -sub usage -{ - my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; - my %M = ( 'I' => '*' ); - $usage =~ s/^\s*perl\s+\S+/$^X $0/; - $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; - - print < }; - my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms; - $copy =~ s/^(?=\S+)/ /gms; - $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms; - $self =~ s/^SKIP.*(?=^__DATA__)/SKIP -if (\@ARGV && \$ARGV[0] eq '--unstrip') { - eval { require Devel::PPPort }; - \$@ and die "Cannot require Devel::PPPort, please install.\\n"; - if (eval \$Devel::PPPort::VERSION < $VERSION) { - die "$0 was originally generated with Devel::PPPort $VERSION.\\n" - . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n" - . "Please install a newer version, or --unstrip will not work.\\n"; - } - Devel::PPPort::WriteFile(\$0); - exit 0; -} -print <$0" or die "cannot strip $0: $!\n"; - print OUT "$pl$c\n"; - - exit 0; -} diff --git a/ext/Devel/PPPort/parts/inc/ppphdoc b/ext/Devel/PPPort/parts/inc/ppphdoc deleted file mode 100644 index 62d484106f..0000000000 --- a/ext/Devel/PPPort/parts/inc/ppphdoc +++ /dev/null @@ -1,353 +0,0 @@ -################################################################################ -## -## $Revision: 32 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:54 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -=dontwarn - -NEED_function -NEED_function_GLOBAL -NEED_variable -NEED_variable_GLOBAL -DPPP_NAMESPACE - -=implementation - -=pod - -=head1 NAME - -ppport.h - Perl/Pollution/Portability version __VERSION__ - -=head1 SYNOPSIS - - perl ppport.h [options] [source files] - - Searches current directory for files if no [source files] are given - - --help show short help - - --version show version - - --patch=file write one patch file with changes - --copy=suffix write changed copies with suffix - --diff=program use diff program and options - - --compat-version=version provide compatibility with Perl version - --cplusplus accept C++ comments - - --quiet don't output anything except fatal errors - --nodiag don't show diagnostics - --nohints don't show hints - --nochanges don't suggest changes - --nofilter don't filter input files - - --strip strip all script and doc functionality from - ppport.h - - --list-provided list provided API - --list-unsupported list unsupported API - --api-info=name show Perl API portability information - -=head1 COMPATIBILITY - -This version of F is designed to support operation with Perl -installations back to __MIN_PERL__, and has been tested up to __MAX_PERL__. - -=head1 OPTIONS - -=head2 --help - -Display a brief usage summary. - -=head2 --version - -Display the version of F. - -=head2 --patch=I - -If this option is given, a single patch file will be created if -any changes are suggested. This requires a working diff program -to be installed on your system. - -=head2 --copy=I - -If this option is given, a copy of each file will be saved with -the given suffix that contains the suggested changes. This does -not require any external programs. Note that this does not -automagially add a dot between the original filename and the -suffix. If you want the dot, you have to include it in the option -argument. - -If neither C<--patch> or C<--copy> are given, the default is to -simply print the diffs for each file. This requires either -C or a C program to be installed. - -=head2 --diff=I - -Manually set the diff program and options to use. The default -is to use C, when installed, and output unified -context diffs. - -=head2 --compat-version=I - -Tell F to check for compatibility with the given -Perl version. The default is to check for compatibility with Perl -version __MIN_PERL__. You can use this option to reduce the output -of F if you intend to be backward compatible only -down to a certain Perl version. - -=head2 --cplusplus - -Usually, F will detect C++ style comments and -replace them with C style comments for portability reasons. -Using this option instructs F to leave C++ -comments untouched. - -=head2 --quiet - -Be quiet. Don't print anything except fatal errors. - -=head2 --nodiag - -Don't output any diagnostic messages. Only portability -alerts will be printed. - -=head2 --nohints - -Don't output any hints. Hints often contain useful portability -notes. Warnings will still be displayed. - -=head2 --nochanges - -Don't suggest any changes. Only give diagnostic output and hints -unless these are also deactivated. - -=head2 --nofilter - -Don't filter the list of input files. By default, files not looking -like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped. - -=head2 --strip - -Strip all script and documentation functionality from F. -This reduces the size of F dramatically and may be useful -if you want to include F in smaller modules without -increasing their distribution size too much. - -The stripped F will have a C<--unstrip> option that allows -you to undo the stripping, but only if an appropriate C -module is installed. - -=head2 --list-provided - -Lists the API elements for which compatibility is provided by -F. Also lists if it must be explicitly requested, -if it has dependencies, and if there are hints or warnings for it. - -=head2 --list-unsupported - -Lists the API elements that are known not to be supported by -F and below which version of Perl they probably -won't be available or work. - -=head2 --api-info=I - -Show portability information for API elements matching I. -If I is surrounded by slashes, it is interpreted as a regular -expression. - -=head1 DESCRIPTION - -In order for a Perl extension (XS) module to be as portable as possible -across differing versions of Perl itself, certain steps need to be taken. - -=over 4 - -=item * - -Including this header is the first major one. This alone will give you -access to a large part of the Perl API that hasn't been available in -earlier Perl releases. Use - - perl ppport.h --list-provided - -to see which API elements are provided by ppport.h. - -=item * - -You should avoid using deprecated parts of the API. For example, using -global Perl variables without the C prefix is deprecated. Also, -some API functions used to have a C prefix. Using this form is -also deprecated. You can safely use the supported API, as F -will provide wrappers for older Perl versions. - -=item * - -If you use one of a few functions or variables that were not present in -earlier versions of Perl, and that can't be provided using a macro, you -have to explicitly request support for these functions by adding one or -more C<#define>s in your source code before the inclusion of F. - -These functions or variables will be marked C in the list shown -by C<--list-provided>. - -Depending on whether you module has a single or multiple files that -use such functions or variables, you want either C or global -variants. - -For a C function or variable (used only in a single source -file), use: - - #define NEED_function - #define NEED_variable - -For a global function or variable (used in multiple source files), -use: - - #define NEED_function_GLOBAL - #define NEED_variable_GLOBAL - -Note that you mustn't have more than one global request for the -same function or variable in your project. - - __EXPLICIT_API__ - -To avoid namespace conflicts, you can change the namespace of the -explicitly exported functions / variables using the C -macro. Just C<#define> the macro before including C: - - #define DPPP_NAMESPACE MyOwnNamespace_ - #include "ppport.h" - -The default namespace is C. - -=back - -The good thing is that most of the above can be checked by running -F on your source code. See the next section for -details. - -=head1 EXAMPLES - -To verify whether F is needed for your module, whether you -should make any changes to your code, and whether any special defines -should be used, F can be run as a Perl script to check your -source code. Simply say: - - perl ppport.h - -The result will usually be a list of patches suggesting changes -that should at least be acceptable, if not necessarily the most -efficient solution, or a fix for all possible problems. - -If you know that your XS module uses features only available in -newer Perl releases, if you're aware that it uses C++ comments, -and if you want all suggestions as a single patch file, you could -use something like this: - - perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff - -If you only want your code to be scanned without any suggestions -for changes, use: - - perl ppport.h --nochanges - -You can specify a different C program or options, using -the C<--diff> option: - - perl ppport.h --diff='diff -C 10' - -This would output context diffs with 10 lines of context. - -If you want to create patched copies of your files instead, use: - - perl ppport.h --copy=.new - -To display portability information for the C function, -use: - - perl ppport.h --api-info=newSVpvn - -Since the argument to C<--api-info> can be a regular expression, -you can use - - perl ppport.h --api-info=/_nomg$/ - -to display portability information for all C<_nomg> functions or - - perl ppport.h --api-info=/./ - -to display information for all known API elements. - -=head1 BUGS - -If this version of F is causing failure during -the compilation of this module, please check if newer versions -of either this module or C are available on CPAN -before sending a bug report. - -If F was generated using the latest version of -C and is causing failure of this module, please -file a bug report using the CPAN Request Tracker at L. - -Please include the following information: - -=over 4 - -=item 1. - -The complete output from running "perl -V" - -=item 2. - -This file. - -=item 3. - -The name and version of the module you were trying to build. - -=item 4. - -A full log of the build that failed. - -=item 5. - -Any other information that you think could be relevant. - -=back - -For the latest version of this code, please get the C -module from CPAN. - -=head1 COPYRIGHT - -Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz. - -Version 2.x, Copyright (C) 2001, Paul Marquess. - -Version 1.x, Copyright (C) 1999, Kenneth Albanowski. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L. - -=cut - diff --git a/ext/Devel/PPPort/parts/inc/ppphtest b/ext/Devel/PPPort/parts/inc/ppphtest deleted file mode 100644 index f94cc7de2d..0000000000 --- a/ext/Devel/PPPort/parts/inc/ppphtest +++ /dev/null @@ -1,901 +0,0 @@ -################################################################################ -## -## $Revision: 46 $ -## $Author: mhx $ -## $Date: 2009/01/23 18:28:00 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=tests plan => 235 - -BEGIN { - if ($ENV{'SKIP_SLOW_TESTS'}) { - for (1 .. 235) { - skip("skip: SKIP_SLOW_TESTS", 0); - } - exit 0; - } -} - -use File::Path qw/rmtree mkpath/; -use Config; - -my $tmp = 'ppptmp'; -my $inc = ''; -my $isVMS = $^O eq 'VMS'; -my $isMAC = $^O eq 'MacOS'; -my $perl = find_perl(); - -rmtree($tmp) if -d $tmp; -mkpath($tmp) or die "mkpath $tmp: $!\n"; -chdir($tmp) or die "chdir $tmp: $!\n"; - -if ($ENV{'PERL_CORE'}) { - if (-d '../../lib') { - if ($isVMS) { - $inc = '"-I../../lib"'; - } - elsif ($isMAC) { - $inc = '-I:::lib'; - } - else { - $inc = '-I../../lib'; - } - unshift @INC, '../../lib'; - } -} -if ($perl =~ m!^\./!) { - $perl = ".$perl"; -} - -END { - chdir('..') if !-d $tmp && -d "../$tmp"; - rmtree($tmp) if -d $tmp; -} - -ok(&Devel::PPPort::WriteFile("ppport.h")); - -sub comment -{ - my $c = shift; - $c =~ s/^/# | /mg; - $c .= "\n" unless $c =~ /[\r\n]$/; - print $c; -} - -sub ppport -{ - my @args = ('ppport.h', @_); - unshift @args, $inc if $inc; - my $run = $perl =~ m/\s/ ? qq("$perl") : $perl; - $run .= ' -MMac::err=unix' if $isMAC; - for (@args) { - $_ = qq("$_") if $isVMS && /^[^"]/; - $run .= " $_"; - } - print "# *** running $run ***\n"; - $run .= ' 2>&1' unless $isMAC; - my @out = `$run`; - my $out = join '', @out; - comment($out); - return wantarray ? @out : $out; -} - -sub matches -{ - my($str, $re, $mod) = @_; - my @n; - eval "\@n = \$str =~ /$re/g$mod;"; - if ($@) { - my $err = $@; - $err =~ s/^/# *** /mg; - print "# *** ERROR ***\n$err\n"; - } - return $@ ? -42 : scalar @n; -} - -sub eq_files -{ - my($f1, $f2) = @_; - return 0 unless -e $f1 && -e $f2; - local *F; - for ($f1, $f2) { - print "# File: $_\n"; - unless (open F, $_) { - print "# couldn't open $_: $!\n"; - return 0; - } - $_ = do { local $/; }; - close F; - comment($_); - } - return $f1 eq $f2; -} - -my @tests; - -for (split /\s*={70,}\s*/, do { local $/; }) { - s/^\s+//; s/\s+$//; - my($c, %f); - ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/; - push @tests, { code => $c, files => \%f }; -} - -my $t; -for $t (@tests) { - print "#\n", ('# ', '-'x70, "\n")x3, "#\n"; - my $f; - for $f (keys %{$t->{files}}) { - my @f = split /\//, $f; - if (@f > 1) { - pop @f; - my $path = join '/', @f; - mkpath($path) or die "mkpath('$path'): $!\n"; - } - my $txt = $t->{files}{$f}; - local *F; - open F, ">$f" or die "open $f: $!\n"; - print F "$txt\n"; - close F; - $txt =~ s/^/# | /mg; - print "# *** writing $f ***\n$txt\n"; - } - - my $code = $t->{code}; - $code =~ s/^/# | /mg; - - print "# *** evaluating test code ***\n$code\n"; - - eval $t->{code}; - if ($@) { - my $err = $@; - $err =~ s/^/# *** /mg; - print "# *** ERROR ***\n$err\n"; - } - ok($@, ''); - - for (keys %{$t->{files}}) { - unlink $_ or die "unlink('$_'): $!\n"; - } -} - -sub find_perl -{ - my $perl = $^X; - - return $perl if $isVMS; - - my $exe = $Config{'_exe'} || ''; - - if ($perl =~ /^perl\Q$exe\E$/i) { - $perl = "perl$exe"; - eval "require File::Spec"; - if ($@) { - $perl = "./$perl"; - } else { - $perl = File::Spec->catfile(File::Spec->curdir(), $perl); - } - } - - if ($perl !~ /\Q$exe\E$/i) { - $perl .= $exe; - } - - warn "find_perl: cannot find $perl from $^X" unless -f $perl; - - return $perl; -} - -__DATA__ - -my $o = ppport(qw(--help)); -ok($o =~ /^Usage:.*ppport\.h/m); -ok($o =~ /--help/m); - -$o = ppport(qw(--version)); -ok($o =~ /^This is.*ppport.*\d+\.\d+(?:_?\d+)?\.$/); - -$o = ppport(qw(--nochanges)); -ok($o =~ /^Scanning.*test\.xs/mi); -ok($o =~ /Analyzing.*test\.xs/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok(matches($o, 'Analyzing', 'm'), 1); -ok($o =~ /Uses Perl_newSViv instead of newSViv/); - -$o = ppport(qw(--quiet --nochanges)); -ok($o =~ /^\s*$/); - ----------------------------- test.xs ------------------------------------------ - -Perl_newSViv(); - -=============================================================================== - -# check if C and C++ comments are filtered correctly - -my $o = ppport(qw(--copy=a)); -ok($o =~ /^Scanning.*MyExt\.xs/mi); -ok($o =~ /Analyzing.*MyExt\.xs/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Uses grok_bin/m); -ok($o !~ /^Uses newSVpv/m); -ok($o =~ /Uses 1 C\+\+ style comment/m); -ok(eq_files('MyExt.xsa', 'MyExt.ra')); - -# check if C++ are left untouched with --cplusplus - -$o = ppport(qw(--copy=b --cplusplus)); -ok($o =~ /^Scanning.*MyExt\.xs/mi); -ok($o =~ /Analyzing.*MyExt\.xs/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Uses grok_bin/m); -ok($o !~ /^Uses newSVpv/m); -ok($o !~ /Uses \d+ C\+\+ style comment/m); -ok(eq_files('MyExt.xsb', 'MyExt.rb')); - -unlink qw(MyExt.xsa MyExt.xsb); - ----------------------------- MyExt.xs ----------------------------------------- - -newSVuv(); - // newSVpv(); - XPUSHs(foo); -/* grok_bin(); */ - ----------------------------- MyExt.ra ----------------------------------------- - -#include "ppport.h" -newSVuv(); - /* newSVpv(); */ - XPUSHs(foo); -/* grok_bin(); */ - ----------------------------- MyExt.rb ----------------------------------------- - -#include "ppport.h" -newSVuv(); - // newSVpv(); - XPUSHs(foo); -/* grok_bin(); */ - -=============================================================================== - -my $o = ppport(qw(--nochanges file1.xs)); -ok($o =~ /^Scanning.*file1\.xs/mi); -ok($o =~ /Analyzing.*file1\.xs/mi); -ok($o !~ /^Scanning.*file2\.xs/mi); -ok($o =~ /^Uses newCONSTSUB/m); -ok($o =~ /^Uses PL_expect/m); -ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); -ok($o =~ /WARNING: PL_expect/m); -ok($o =~ /hint for newCONSTSUB/m); -ok($o =~ /^Analysis completed \(1 warning\)/m); -ok($o =~ /^Looks good/m); - -$o = ppport(qw(--nochanges --nohints file1.xs)); -ok($o =~ /^Scanning.*file1\.xs/mi); -ok($o =~ /Analyzing.*file1\.xs/mi); -ok($o !~ /^Scanning.*file2\.xs/mi); -ok($o =~ /^Uses newCONSTSUB/m); -ok($o =~ /^Uses PL_expect/m); -ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); -ok($o =~ /WARNING: PL_expect/m); -ok($o !~ /hint for newCONSTSUB/m); -ok($o =~ /^Analysis completed \(1 warning\)/m); -ok($o =~ /^Looks good/m); - -$o = ppport(qw(--nochanges --nohints --nodiag file1.xs)); -ok($o =~ /^Scanning.*file1\.xs/mi); -ok($o =~ /Analyzing.*file1\.xs/mi); -ok($o !~ /^Scanning.*file2\.xs/mi); -ok($o !~ /^Uses newCONSTSUB/m); -ok($o !~ /^Uses PL_expect/m); -ok($o !~ /^Uses SvPV_nolen/m); -ok($o =~ /WARNING: PL_expect/m); -ok($o !~ /hint for newCONSTSUB/m); -ok($o =~ /^Analysis completed \(1 warning\)/m); -ok($o =~ /^Looks good/m); - -$o = ppport(qw(--nochanges --quiet file1.xs)); -ok($o =~ /^\s*$/); - -$o = ppport(qw(--nochanges file2.xs)); -ok($o =~ /^Scanning.*file2\.xs/mi); -ok($o =~ /Analyzing.*file2\.xs/mi); -ok($o !~ /^Scanning.*file1\.xs/mi); -ok($o =~ /^Uses mXPUSHp/m); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Looks good/m); -ok($o =~ /^1 potentially required change detected/m); - -$o = ppport(qw(--nochanges --nohints file2.xs)); -ok($o =~ /^Scanning.*file2\.xs/mi); -ok($o =~ /Analyzing.*file2\.xs/mi); -ok($o !~ /^Scanning.*file1\.xs/mi); -ok($o =~ /^Uses mXPUSHp/m); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Looks good/m); -ok($o =~ /^1 potentially required change detected/m); - -$o = ppport(qw(--nochanges --nohints --nodiag file2.xs)); -ok($o =~ /^Scanning.*file2\.xs/mi); -ok($o =~ /Analyzing.*file2\.xs/mi); -ok($o !~ /^Scanning.*file1\.xs/mi); -ok($o !~ /^Uses mXPUSHp/m); -ok($o !~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Looks good/m); -ok($o =~ /^1 potentially required change detected/m); - -$o = ppport(qw(--nochanges --quiet file2.xs)); -ok($o =~ /^\s*$/); - ----------------------------- file1.xs ----------------------------------------- - -#define NEED_newCONSTSUB -#define NEED_sv_2pv_flags -#define NEED_PL_parser -#include "ppport.h" - -newCONSTSUB(); -SvPV_nolen(); -PL_expect = 0; - ----------------------------- file2.xs ----------------------------------------- - -mXPUSHp(foo); - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /^Scanning.*FooBar\.xs/mi); -ok($o =~ /Analyzing.*FooBar\.xs/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok($o !~ /^Looks good/m); -ok($o =~ /^Uses grok_bin/m); - ----------------------------- FooBar.xs ---------------------------------------- - -newSViv(); -XPUSHs(foo); -grok_bin(); - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /^Scanning.*First\.xs/mi); -ok($o =~ /Analyzing.*First\.xs/mi); -ok($o =~ /^Scanning.*second\.h/mi); -ok($o =~ /Analyzing.*second\.h/mi); -ok($o =~ /^Scanning.*sub.*third\.c/mi); -ok($o =~ /Analyzing.*sub.*third\.c/mi); -ok($o !~ /^Scanning.*foobar/mi); -ok(matches($o, '^Scanning', 'm'), 3); - ----------------------------- First.xs ----------------------------------------- - -one - ----------------------------- foobar.xyz --------------------------------------- - -two - ----------------------------- second.h ----------------------------------------- - -three - ----------------------------- sub/third.c -------------------------------------- - -four - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i); - ----------------------------- test.xs ------------------------------------------ - -#define NEED_foobar - -=============================================================================== - -# And now some complex "real-world" example - -my $o = ppport(qw(--copy=f)); -for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) { - ok($o =~ /^Scanning.*\Q$_\E/mi); - ok($o =~ /Analyzing.*\Q$_\E/i); -} -ok(matches($o, '^Scanning', 'm'), 6); - -ok(matches($o, '^Writing copy of', 'm'), 5); -ok(!-e "mod5.cf"); - -for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) { - ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); - ok(-e "${_}f"); - ok(eq_files("${_}f", "${_}r")); - unlink "${_}f"; -} - ----------------------------- main.xs ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_newCONSTSUB -#define NEED_grok_hex_GLOBAL -#include "ppport.h" - -newCONSTSUB(); -grok_hex(); -Perl_grok_bin(aTHX_ foo, bar); - -/* some comment */ - -perl_eval_pv(); -grok_bin(); -Perl_grok_bin(bar, sv_no); - ----------------------------- mod1.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_grok_bin_GLOBAL -#define NEED_newCONSTSUB -#include "ppport.h" - -newCONSTSUB(); -grok_bin(); -{ - Perl_croak ("foo"); - Perl_sv_catpvf(); /* I know it's wrong ;-) */ -} - ----------------------------- mod2.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_eval_pv -#include "ppport.h" - -newSViv(); - -/* - eval_pv(); -*/ - ----------------------------- mod3.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -grok_oct(); -eval_pv(); - ----------------------------- mod4.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -START_MY_CXT; - ----------------------------- mod5.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include "ppport.h" -call_pv(); - ----------------------------- main.xsr ----------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_eval_pv_GLOBAL -#define NEED_grok_hex -#define NEED_newCONSTSUB_GLOBAL -#include "ppport.h" - -newCONSTSUB(); -grok_hex(); -grok_bin(foo, bar); - -/* some comment */ - -eval_pv(); -grok_bin(); -grok_bin(bar, PL_sv_no); - ----------------------------- mod1.cr ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_grok_bin_GLOBAL -#include "ppport.h" - -newCONSTSUB(); -grok_bin(); -{ - Perl_croak (aTHX_ "foo"); - Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */ -} - ----------------------------- mod2.cr ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - - -newSViv(); - -/* - eval_pv(); -*/ - ----------------------------- mod3.cr ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#define NEED_grok_oct -#include "ppport.h" - -grok_oct(); -eval_pv(); - ----------------------------- mod4.cr ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include "ppport.h" - -START_MY_CXT; - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /Uses grok_hex/m); -ok($o !~ /Looks good/m); - -$o = ppport(qw(--nochanges --compat-version=5.8.0)); -ok($o !~ /Uses grok_hex/m); -ok($o =~ /Looks good/m); - ----------------------------- FooBar.xs ---------------------------------------- - -grok_hex(); - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); - -$o = ppport(qw(--nochanges --compat-version=5.5.3)); -ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); - -$o = ppport(qw(--nochanges --compat-version=5.005_03)); -ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); - -$o = ppport(qw(--nochanges --compat-version=5.6.0)); -ok($o !~ /Uses SvPVutf8_force/m); - -$o = ppport(qw(--nochanges --compat-version=5.006)); -ok($o !~ /Uses SvPVutf8_force/m); - -$o = ppport(qw(--nochanges --compat-version=5.999.999)); -ok($o !~ /Uses SvPVutf8_force/m); - -$o = ppport(qw(--nochanges --compat-version=6.0.0)); -ok($o =~ /Only Perl 5 is supported/m); - -$o = ppport(qw(--nochanges --compat-version=5.1000.999)); -ok($o =~ /Invalid version number: 5.1000.999/m); - -$o = ppport(qw(--nochanges --compat-version=5.999.1000)); -ok($o =~ /Invalid version number: 5.999.1000/m); - ----------------------------- FooBar.xs ---------------------------------------- - -SvPVutf8_force(); - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o !~ /potentially required change/); -ok(matches($o, '^Looks good', 'm'), 2); - ----------------------------- FooBar.xs ---------------------------------------- - -#define NEED_grok_numeric_radix -#define NEED_grok_number -#include "ppport.h" - -GROK_NUMERIC_RADIX(); -grok_number(); - ----------------------------- foo.c -------------------------------------------- - -#include "ppport.h" - -call_pv(); - -=============================================================================== - -# check --api-info option - -my $o = ppport(qw(--api-info=INT2PTR)); -my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; -ok(scalar keys %found, 1); -ok(exists $found{INT2PTR}); -ok(matches($o, '^Supported at least starting from perl-5\.6\.0\.', 'm'), 1); -ok(matches($o, '^Support by .*ppport.* provided back to perl-5\.003\.', 'm'), 1); - -$o = ppport(qw(--api-info=Zero)); -%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; -ok(scalar keys %found, 1); -ok(exists $found{Zero}); -ok(matches($o, '^No portability information available\.', 'm'), 1); - -$o = ppport(qw(--api-info=/Zero/)); -%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; -ok(scalar keys %found, 2); -ok(exists $found{Zero}); -ok(exists $found{ZeroD}); - -=============================================================================== - -# check --list-provided option - -my @o = ppport(qw(--list-provided)); -my %p; -my $fail = 0; -for (@o) { - my($name, $flags) = /^(\w+)(?:\s+\[(\w+(?:,\s+\w+)*)\])?$/ or $fail++; - exists $p{$name} and $fail++; - $p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : ''; -} -ok(@o > 100); -ok($fail, 0); - -ok(exists $p{call_pv}); -ok(not ref $p{call_pv}); - -ok(exists $p{grok_bin}); -ok(ref $p{grok_bin}, 'HASH'); -ok(scalar keys %{$p{grok_bin}}, 2); -ok($p{grok_bin}{explicit}); -ok($p{grok_bin}{depend}); - -ok(exists $p{gv_stashpvn}); -ok(ref $p{gv_stashpvn}, 'HASH'); -ok(scalar keys %{$p{gv_stashpvn}}, 2); -ok($p{gv_stashpvn}{depend}); -ok($p{gv_stashpvn}{hint}); - -ok(exists $p{sv_catpvf_mg}); -ok(ref $p{sv_catpvf_mg}, 'HASH'); -ok(scalar keys %{$p{sv_catpvf_mg}}, 2); -ok($p{sv_catpvf_mg}{explicit}); -ok($p{sv_catpvf_mg}{depend}); - -ok(exists $p{PL_signals}); -ok(ref $p{PL_signals}, 'HASH'); -ok(scalar keys %{$p{PL_signals}}, 1); -ok($p{PL_signals}{explicit}); - -=============================================================================== - -# check --list-unsupported option - -my @o = ppport(qw(--list-unsupported)); -my %p; -my $fail = 0; -for (@o) { - my($name, $ver) = /^(\w+)\s*\.+\s*([\d._]+)$/ or $fail++; - exists $p{$name} and $fail++; - $p{$name} = $ver; -} -ok(@o > 100); -ok($fail, 0); - -ok(exists $p{utf8_distance}); -ok($p{utf8_distance}, '5.6.0'); - -ok(exists $p{save_generic_svref}); -ok($p{save_generic_svref}, '5.005_03'); - -=============================================================================== - -# check --nofilter option - -my $o = ppport(qw(--nochanges)); -ok($o =~ /^Scanning.*foo\.cpp/mi); -ok($o =~ /Analyzing.*foo\.cpp/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok(matches($o, 'Analyzing', 'm'), 1); - -$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL)); -ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m); -ok(matches($o, '^\|\s+foo\.o', 'mi'), 1); -ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1); -ok($o =~ /^Scanning.*foo\.cpp/mi); -ok($o =~ /Analyzing.*foo\.cpp/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok(matches($o, 'Analyzing', 'm'), 1); - -$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL)); -ok($o =~ /^Scanning.*foo\.cpp/mi); -ok($o =~ /Analyzing.*foo\.cpp/mi); -ok($o =~ /^Scanning.*foo\.o/mi); -ok($o =~ /Analyzing.*foo\.o/mi); -ok($o =~ /^Scanning.*Makefile/mi); -ok($o =~ /Analyzing.*Makefile/mi); -ok(matches($o, '^Scanning', 'm'), 3); -ok(matches($o, 'Analyzing', 'm'), 3); - ----------------------------- foo.cpp ------------------------------------------ - -newSViv(); - ----------------------------- foo.o -------------------------------------------- - -newSViv(); - ----------------------------- Makefile.PL -------------------------------------- - -newSViv(); - -=============================================================================== - -# check if explicit variables are handled propery - -my $o = ppport(qw(--copy=a)); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o =~ /^Uses PL_signals/m); -ok($o =~ /^File needs PL_signals, adding static request/m); -ok(eq_files('MyExt.xsa', 'MyExt.ra')); - -unlink qw(MyExt.xsa); - ----------------------------- MyExt.xs ----------------------------------------- - -PL_signals = 123; -if (PL_signals == 42) - foo(); - ----------------------------- MyExt.ra ----------------------------------------- - -#define NEED_PL_signals -#include "ppport.h" -PL_signals = 123; -if (PL_signals == 42) - foo(); - -=============================================================================== - -my $o = ppport(qw(--nochanges file.xs)); -ok($o =~ /^Uses PL_copline/m); -ok($o =~ /WARNING: PL_copline/m); -ok($o =~ /^Uses SvUOK/m); -ok($o =~ /WARNING: Uses SvUOK, which may not be portable/m); -ok($o =~ /^Analysis completed \(2 warnings\)/m); -ok($o =~ /^Looks good/m); - -$o = ppport(qw(--nochanges --compat-version=5.8.0 file.xs)); -ok($o =~ /^Uses PL_copline/m); -ok($o =~ /WARNING: PL_copline/m); -ok($o !~ /WARNING: Uses SvUOK, which may not be portable/m); -ok($o =~ /^Analysis completed \(1 warning\)/m); -ok($o =~ /^Looks good/m); - ----------------------------- file.xs ----------------------------------------- - -#define NEED_PL_parser -#include "ppport.h" -SvUOK -PL_copline - -=============================================================================== - -my $o = ppport(qw(--copy=f)); - -for (qw(file.xs)) { - ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); - ok(-e "${_}f"); - ok(eq_files("${_}f", "${_}r")); - unlink "${_}f"; -} - ----------------------------- file.xs ----------------------------------------- - -a_string = "sv_undef" -a_char = 'sv_yes' -#define SOMETHING defgv -/* C-comment: sv_tainted */ -# -# This is just a big XS comment using sv_no -# -/* The following, is NOT an XS comment! */ -# define SOMETHING_ELSE defgv + \ - sv_undef - ----------------------------- file.xsr ----------------------------------------- - -#include "ppport.h" -a_string = "sv_undef" -a_char = 'sv_yes' -#define SOMETHING PL_defgv -/* C-comment: sv_tainted */ -# -# This is just a big XS comment using sv_no -# -/* The following, is NOT an XS comment! */ -# define SOMETHING_ELSE PL_defgv + \ - PL_sv_undef - -=============================================================================== - -my $o = ppport(qw(--copy=f)); - -for (qw(file.xs)) { - ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); - ok(-e "${_}f"); - ok(eq_files("${_}f", "${_}r")); - unlink "${_}f"; -} - ----------------------------- file.xs ----------------------------------------- - -#define NEED_sv_2pv_flags -#define NEED_vnewSVpvf -#define NEED_warner -#include "ppport.h" -Perl_croak_nocontext("foo"); -Perl_croak("bar"); -croak("foo"); -croak_nocontext("foo"); -Perl_warner_nocontext("foo"); -Perl_warner("foo"); -warner_nocontext("foo"); -warner("foo"); - ----------------------------- file.xsr ----------------------------------------- - -#define NEED_sv_2pv_flags -#define NEED_vnewSVpvf -#define NEED_warner -#include "ppport.h" -Perl_croak_nocontext("foo"); -Perl_croak(aTHX_ "bar"); -croak("foo"); -croak_nocontext("foo"); -Perl_warner_nocontext("foo"); -Perl_warner(aTHX_ "foo"); -warner_nocontext("foo"); -warner("foo"); - diff --git a/ext/Devel/PPPort/parts/inc/pv_tools b/ext/Devel/PPPort/parts/inc/pv_tools deleted file mode 100644 index c7e4c1e907..0000000000 --- a/ext/Devel/PPPort/parts/inc/pv_tools +++ /dev/null @@ -1,281 +0,0 @@ -################################################################################ -## -## $Revision: 5 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:51 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ -pv_escape -pv_pretty -pv_display - -=implementation - -__UNDEFINED__ PERL_PV_ESCAPE_QUOTE 0x0001 -__UNDEFINED__ PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE -__UNDEFINED__ PERL_PV_PRETTY_ELLIPSES 0x0002 -__UNDEFINED__ PERL_PV_PRETTY_LTGT 0x0004 -__UNDEFINED__ PERL_PV_ESCAPE_FIRSTCHAR 0x0008 -__UNDEFINED__ PERL_PV_ESCAPE_UNI 0x0100 -__UNDEFINED__ PERL_PV_ESCAPE_UNI_DETECT 0x0200 -__UNDEFINED__ PERL_PV_ESCAPE_ALL 0x1000 -__UNDEFINED__ PERL_PV_ESCAPE_NOBACKSLASH 0x2000 -__UNDEFINED__ PERL_PV_ESCAPE_NOCLEAR 0x4000 -__UNDEFINED__ PERL_PV_ESCAPE_RE 0x8000 -__UNDEFINED__ PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR - -__UNDEFINED__ PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE -__UNDEFINED__ PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE - -/* Hint: pv_escape - * Note that unicode functionality is only backported to - * those perl versions that support it. For older perl - * versions, the implementation will fall back to bytes. - */ - -#ifndef pv_escape -#if { NEED pv_escape } - -char * -pv_escape(pTHX_ SV *dsv, char const * const str, - const STRLEN count, const STRLEN max, - STRLEN * const escaped, const U32 flags) -{ - const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\'; - const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc; - char octbuf[32] = "%123456789ABCDF"; - STRLEN wrote = 0; - STRLEN chsize = 0; - STRLEN readsize = 1; -#if defined(is_utf8_string) && defined(utf8_to_uvchr) - bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0; -#endif - const char *pv = str; - const char * const end = pv + count; - octbuf[0] = esc; - - if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) - sv_setpvs(dsv, ""); - -#if defined(is_utf8_string) && defined(utf8_to_uvchr) - if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count)) - isuni = 1; -#endif - - for (; pv < end && (!max || wrote < max) ; pv += readsize) { - const UV u = -#if defined(is_utf8_string) && defined(utf8_to_uvchr) - isuni ? utf8_to_uvchr((U8*)pv, &readsize) : -#endif - (U8)*pv; - const U8 c = (U8)u & 0xFF; - - if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) { - if (flags & PERL_PV_ESCAPE_FIRSTCHAR) - chsize = my_snprintf(octbuf, sizeof octbuf, - "%"UVxf, u); - else - chsize = my_snprintf(octbuf, sizeof octbuf, - "%cx{%"UVxf"}", esc, u); - } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) { - chsize = 1; - } else { - if (c == dq || c == esc || !isPRINT(c)) { - chsize = 2; - switch (c) { - case '\\' : /* fallthrough */ - case '%' : if (c == esc) - octbuf[1] = esc; - else - chsize = 1; - break; - case '\v' : octbuf[1] = 'v'; break; - case '\t' : octbuf[1] = 't'; break; - case '\r' : octbuf[1] = 'r'; break; - case '\n' : octbuf[1] = 'n'; break; - case '\f' : octbuf[1] = 'f'; break; - case '"' : if (dq == '"') - octbuf[1] = '"'; - else - chsize = 1; - break; - default: chsize = my_snprintf(octbuf, sizeof octbuf, - pv < end && isDIGIT((U8)*(pv+readsize)) - ? "%c%03o" : "%c%o", esc, c); - } - } else { - chsize = 1; - } - } - if (max && wrote + chsize > max) { - break; - } else if (chsize > 1) { - sv_catpvn(dsv, octbuf, chsize); - wrote += chsize; - } else { - char tmp[2]; - my_snprintf(tmp, sizeof tmp, "%c", c); - sv_catpvn(dsv, tmp, 1); - wrote++; - } - if (flags & PERL_PV_ESCAPE_FIRSTCHAR) - break; - } - if (escaped != NULL) - *escaped= pv - str; - return SvPVX(dsv); -} - -#endif -#endif - -#ifndef pv_pretty -#if { NEED pv_pretty } - -char * -pv_pretty(pTHX_ SV *dsv, char const * const str, const STRLEN count, - const STRLEN max, char const * const start_color, char const * const end_color, - const U32 flags) -{ - const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%'; - STRLEN escaped; - - if (!(flags & PERL_PV_PRETTY_NOCLEAR)) - sv_setpvs(dsv, ""); - - if (dq == '"') - sv_catpvs(dsv, "\""); - else if (flags & PERL_PV_PRETTY_LTGT) - sv_catpvs(dsv, "<"); - - if (start_color != NULL) - sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color)); - - pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR); - - if (end_color != NULL) - sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color)); - - if (dq == '"') - sv_catpvs(dsv, "\""); - else if (flags & PERL_PV_PRETTY_LTGT) - sv_catpvs(dsv, ">"); - - if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count) - sv_catpvs(dsv, "..."); - - return SvPVX(dsv); -} - -#endif -#endif - -#ifndef pv_display -#if { NEED pv_display } - -char * -pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) -{ - pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP); - if (len > cur && pv[cur] == '\0') - sv_catpvs(dsv, "\\0"); - return SvPVX(dsv); -} - -#endif -#endif - -=xsinit - -#define NEED_pv_escape -#define NEED_pv_pretty -#define NEED_pv_display - -=xsubs - -void -pv_escape_can_unicode() - PPCODE: -#if defined(is_utf8_string) && defined(utf8_to_uvchr) - XSRETURN_YES; -#else - XSRETURN_NO; -#endif - -void -pv_pretty() - PREINIT: - char *rv; - PPCODE: - EXTEND(SP, 8); - ST(0) = sv_newmortal(); - rv = pv_pretty(ST(0), "foobarbaz", - 9, 40, NULL, NULL, 0); - ST(1) = sv_2mortal(newSVpv(rv, 0)); - ST(2) = sv_newmortal(); - rv = pv_pretty(ST(2), "pv_p\retty\n", - 10, 40, "left", "right", PERL_PV_PRETTY_LTGT); - ST(3) = sv_2mortal(newSVpv(rv, 0)); - ST(4) = sv_newmortal(); - rv = pv_pretty(ST(4), "N\303\275 Batter\303\255", - 12, 20, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT); - ST(5) = sv_2mortal(newSVpv(rv, 0)); - ST(6) = sv_newmortal(); - rv = pv_pretty(ST(6), "\303\201g\303\246tis Byrjun", - 15, 18, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT|PERL_PV_PRETTY_ELLIPSES); - ST(7) = sv_2mortal(newSVpv(rv, 0)); - XSRETURN(8); - -void -pv_display() - PREINIT: - char *rv; - PPCODE: - EXTEND(SP, 4); - ST(0) = sv_newmortal(); - rv = pv_display(ST(0), "foob\0rbaz", 9, 10, 20); - ST(1) = sv_2mortal(newSVpv(rv, 0)); - ST(2) = sv_newmortal(); - rv = pv_display(ST(2), "pv_display", 10, 11, 5); - ST(3) = sv_2mortal(newSVpv(rv, 0)); - XSRETURN(4); - -=tests plan => 13 - -my $uni = &Devel::PPPort::pv_escape_can_unicode(); - -# sanity check -ok($uni ? $] >= 5.006 : $] < 5.008); - -my @r; - -@r = &Devel::PPPort::pv_pretty(); -ok($r[0], $r[1]); -ok($r[0], "foobarbaz"); -ok($r[2], $r[3]); -ok($r[2], ''); -ok($r[4], $r[5]); -ok($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303'); -ok($r[6], $r[7]); -ok($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...'); - -@r = &Devel::PPPort::pv_display(); -ok($r[0], $r[1]); -ok($r[0], '"foob\0rbaz"\0'); -ok($r[2], $r[3]); -ok($r[2] eq '"pv_di"...\0' || - $r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :( - diff --git a/ext/Devel/PPPort/parts/inc/pvs b/ext/Devel/PPPort/parts/inc/pvs deleted file mode 100644 index 73bc9fb57a..0000000000 --- a/ext/Devel/PPPort/parts/inc/pvs +++ /dev/null @@ -1,99 +0,0 @@ -################################################################################ -## -## $Revision: 9 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:52 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ - -=implementation - -/* concatenating with "" ensures that only literal strings are accepted as argument - * note that STR_WITH_LEN() can't be used as argument to macros or functions that - * under some configurations might be macros - */ - -__UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1) - -__UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) -__UNDEFINED__ newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags) -__UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) -__UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) -__UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) -__UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) - -=xsubs - -void -newSVpvs() - PPCODE: - mXPUSHs(newSVpvs("newSVpvs")); - XSRETURN(1); - -void -newSVpvs_flags() - PPCODE: - XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP)); - XSRETURN(1); - -void -sv_catpvs(sv) - SV *sv - PPCODE: - sv_catpvs(sv, "sv_catpvs"); - -void -sv_setpvs(sv) - SV *sv - PPCODE: - sv_setpvs(sv, "sv_setpvs"); - -void -hv_fetchs(hv) - SV *hv - PREINIT: - SV **s; - PPCODE: - s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0); - XPUSHs(sv_mortalcopy(*s)); - XSRETURN(1); - -void -hv_stores(hv, sv) - SV *hv - SV *sv - PPCODE: - (void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv)); - -=tests plan => 8 - -my $x = 'foo'; - -ok(Devel::PPPort::newSVpvs(), "newSVpvs"); -ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); - -Devel::PPPort::sv_catpvs($x); -ok($x, "foosv_catpvs"); - -Devel::PPPort::sv_setpvs($x); -ok($x, "sv_setpvs"); - -my %h = ('hv_fetchs' => 42); -Devel::PPPort::hv_stores(\%h, 4711); -ok(scalar keys %h, 2); -ok(exists $h{'hv_stores'}); -ok($h{'hv_stores'}, 4711); -ok(Devel::PPPort::hv_fetchs(\%h), 42); diff --git a/ext/Devel/PPPort/parts/inc/shared_pv b/ext/Devel/PPPort/parts/inc/shared_pv deleted file mode 100644 index db779be835..0000000000 --- a/ext/Devel/PPPort/parts/inc/shared_pv +++ /dev/null @@ -1,91 +0,0 @@ -################################################################################ -## -## $Revision: 5 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:52 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -newSVpvn_share -__UNDEFINED__ - -=implementation - -#ifndef newSVpvn_share - -#if { NEED newSVpvn_share } - -SV * -newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash) -{ - SV *sv; - if (len < 0) - len = -len; - if (!hash) - PERL_HASH(hash, (char*) src, len); - sv = newSVpvn((char *) src, len); - sv_upgrade(sv, SVt_PVIV); - SvIVX(sv) = hash; - SvREADONLY_on(sv); - SvPOK_on(sv); - return sv; -} - -#endif - -#endif - -__UNDEFINED__ SvSHARED_HASH(sv) (0 + SvUVX(sv)) - -=xsinit - -#define NEED_newSVpvn_share - -=xsubs - -int -newSVpvn_share() - PREINIT: - const char *s; - SV *sv; - STRLEN len; - U32 hash; - CODE: - RETVAL = 0; - s = "mhx"; - len = 3; - PERL_HASH(hash, (char *) s, len); - sv = newSVpvn_share(s, len, 0); - s = 0; - RETVAL += strEQ(SvPV_nolen_const(sv), "mhx"); - RETVAL += SvCUR(sv) == len; - RETVAL += SvSHARED_HASH(sv) == hash; - SvREFCNT_dec(sv); - s = "foobar"; - len = 6; - PERL_HASH(hash, (char *) s, len); - sv = newSVpvn_share(s, -(I32) len, hash); - s = 0; - RETVAL += strEQ(SvPV_nolen_const(sv), "foobar"); - RETVAL += SvCUR(sv) == len; - RETVAL += SvSHARED_HASH(sv) == hash; - SvREFCNT_dec(sv); - OUTPUT: - RETVAL - - -=tests plan => 1 - -ok(&Devel::PPPort::newSVpvn_share(), 6); - diff --git a/ext/Devel/PPPort/parts/inc/snprintf b/ext/Devel/PPPort/parts/inc/snprintf deleted file mode 100644 index 310bfbaa10..0000000000 --- a/ext/Devel/PPPort/parts/inc/snprintf +++ /dev/null @@ -1,70 +0,0 @@ -################################################################################ -## -## $Revision: 6 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:52 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -my_snprintf - -=implementation - -#if !defined(my_snprintf) -#if { NEED my_snprintf } - -int -my_snprintf(char *buffer, const Size_t len, const char *format, ...) -{ - dTHX; - int retval; - va_list ap; - va_start(ap, format); -#ifdef HAS_VSNPRINTF - retval = vsnprintf(buffer, len, format, ap); -#else - retval = vsprintf(buffer, format, ap); -#endif - va_end(ap); - if (retval < 0 || (len > 0 && (Size_t)retval >= len)) - Perl_croak(aTHX_ "panic: my_snprintf buffer overflow"); - return retval; -} - -#endif -#endif - -=xsinit - -#define NEED_my_snprintf - -=xsubs - -void -my_snprintf() - PREINIT: - char buf[128]; - int len; - PPCODE: - len = my_snprintf(buf, sizeof buf, "foo%s%d", "bar", 42); - mXPUSHi(len); - mXPUSHs(newSVpv(buf, 0)); - XSRETURN(2); - -=tests plan => 2 - -my($l, $s) = Devel::PPPort::my_snprintf(); -ok($l, 8); -ok($s, "foobar42"); - diff --git a/ext/Devel/PPPort/parts/inc/sprintf b/ext/Devel/PPPort/parts/inc/sprintf deleted file mode 100644 index 6756f9abc9..0000000000 --- a/ext/Devel/PPPort/parts/inc/sprintf +++ /dev/null @@ -1,62 +0,0 @@ -################################################################################ -## -## $Revision: 2 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:51 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -my_sprintf - -=implementation - -#if !defined(my_sprintf) -#if { NEED my_sprintf } - -int -my_sprintf(char *buffer, const char* pat, ...) -{ - va_list args; - va_start(args, pat); - vsprintf(buffer, pat, args); - va_end(args); - return strlen(buffer); -} - -#endif -#endif - -=xsinit - -#define NEED_my_sprintf - -=xsubs - -void -my_sprintf() - PREINIT: - char buf[128]; - int len; - PPCODE: - len = my_sprintf(buf, "foo%s%d", "bar", 42); - mXPUSHi(len); - mXPUSHs(newSVpv(buf, 0)); - XSRETURN(2); - -=tests plan => 2 - -my($l, $s) = Devel::PPPort::my_sprintf(); -ok($l, 8); -ok($s, "foobar42"); - diff --git a/ext/Devel/PPPort/parts/inc/strlfuncs b/ext/Devel/PPPort/parts/inc/strlfuncs deleted file mode 100644 index d351703e19..0000000000 --- a/ext/Devel/PPPort/parts/inc/strlfuncs +++ /dev/null @@ -1,114 +0,0 @@ -################################################################################ -## -## $Revision: 6 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:52 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -my_strlcat -my_strlcpy - -=implementation - -#if !defined(my_strlcat) -#if { NEED my_strlcat } - -Size_t -my_strlcat(char *dst, const char *src, Size_t size) -{ - Size_t used, length, copy; - - used = strlen(dst); - length = strlen(src); - if (size > 0 && used < size - 1) { - copy = (length >= size - used) ? size - used - 1 : length; - memcpy(dst + used, src, copy); - dst[used + copy] = '\0'; - } - return used + length; -} -#endif -#endif - -#if !defined(my_strlcpy) -#if { NEED my_strlcpy } - -Size_t -my_strlcpy(char *dst, const char *src, Size_t size) -{ - Size_t length, copy; - - length = strlen(src); - if (size > 0) { - copy = (length >= size) ? size - 1 : length; - memcpy(dst, src, copy); - dst[copy] = '\0'; - } - return length; -} - -#endif -#endif - -=xsinit - -#define NEED_my_strlcat -#define NEED_my_strlcpy - -=xsubs - -void -my_strlfunc() - PREINIT: - char buf[8]; - int len; - PPCODE: - len = my_strlcpy(buf, "foo", sizeof(buf)); - mXPUSHi(len); - mXPUSHs(newSVpv(buf, 0)); - len = my_strlcat(buf, "bar", sizeof(buf)); - mXPUSHi(len); - mXPUSHs(newSVpv(buf, 0)); - len = my_strlcat(buf, "baz", sizeof(buf)); - mXPUSHi(len); - mXPUSHs(newSVpv(buf, 0)); - len = my_strlcpy(buf, "1234567890", sizeof(buf)); - mXPUSHi(len); - mXPUSHs(newSVpv(buf, 0)); - len = my_strlcpy(buf, "1234", sizeof(buf)); - mXPUSHi(len); - mXPUSHs(newSVpv(buf, 0)); - len = my_strlcat(buf, "567890123456", sizeof(buf)); - mXPUSHi(len); - mXPUSHs(newSVpv(buf, 0)); - XSRETURN(12); - -=tests plan => 13 - -my @e = (3, 'foo', - 6, 'foobar', - 9, 'foobarb', - 10, '1234567', - 4, '1234', - 16, '1234567', - ); -my @r = Devel::PPPort::my_strlfunc(); - -ok(@e == @r); - -for (0 .. $#e) { - ok($r[$_], $e[$_]); -} - diff --git a/ext/Devel/PPPort/parts/inc/sv_xpvf b/ext/Devel/PPPort/parts/inc/sv_xpvf deleted file mode 100644 index 3c990c6e93..0000000000 --- a/ext/Devel/PPPort/parts/inc/sv_xpvf +++ /dev/null @@ -1,321 +0,0 @@ -################################################################################ -## -## $Revision: 10 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:53 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -vnewSVpvf -sv_vcatpvf -sv_vsetpvf - -sv_catpvf_mg -sv_catpvf_mg_nocontext -sv_vcatpvf_mg - -sv_setpvf_mg -sv_setpvf_mg_nocontext -sv_vsetpvf_mg - -=implementation - -#if { VERSION >= 5.004 } && !defined(vnewSVpvf) -#if { NEED vnewSVpvf } - -SV * -vnewSVpvf(pTHX_ const char *pat, va_list *args) -{ - register SV *sv = newSV(0); - sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); - return sv; -} - -#endif -#endif - -#if { VERSION >= 5.004 } && !defined(sv_vcatpvf) -# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) -#endif - -#if { VERSION >= 5.004 } && !defined(sv_vsetpvf) -# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) -#endif - -#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg) -#if { NEED sv_catpvf_mg } - -void -sv_catpvf_mg(pTHX_ SV *sv, const char *pat, ...) -{ - va_list args; - va_start(args, pat); - sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); - SvSETMAGIC(sv); - va_end(args); -} - -#endif -#endif - -#ifdef PERL_IMPLICIT_CONTEXT -#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg_nocontext) -#if { NEED sv_catpvf_mg_nocontext } - -void -sv_catpvf_mg_nocontext(SV *sv, const char *pat, ...) -{ - dTHX; - va_list args; - va_start(args, pat); - sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); - SvSETMAGIC(sv); - va_end(args); -} - -#endif -#endif -#endif - -/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */ -#ifndef sv_catpvf_mg -# ifdef PERL_IMPLICIT_CONTEXT -# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext -# else -# define sv_catpvf_mg Perl_sv_catpvf_mg -# endif -#endif - -#if { VERSION >= 5.004 } && !defined(sv_vcatpvf_mg) -# define sv_vcatpvf_mg(sv, pat, args) \ - STMT_START { \ - sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ - SvSETMAGIC(sv); \ - } STMT_END -#endif - -#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg) -#if { NEED sv_setpvf_mg } - -void -sv_setpvf_mg(pTHX_ SV *sv, const char *pat, ...) -{ - va_list args; - va_start(args, pat); - sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); - SvSETMAGIC(sv); - va_end(args); -} - -#endif -#endif - -#ifdef PERL_IMPLICIT_CONTEXT -#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg_nocontext) -#if { NEED sv_setpvf_mg_nocontext } - -void -sv_setpvf_mg_nocontext(SV *sv, const char *pat, ...) -{ - dTHX; - va_list args; - va_start(args, pat); - sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); - SvSETMAGIC(sv); - va_end(args); -} - -#endif -#endif -#endif - -/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */ -#ifndef sv_setpvf_mg -# ifdef PERL_IMPLICIT_CONTEXT -# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext -# else -# define sv_setpvf_mg Perl_sv_setpvf_mg -# endif -#endif - -#if { VERSION >= 5.004 } && !defined(sv_vsetpvf_mg) -# define sv_vsetpvf_mg(sv, pat, args) \ - STMT_START { \ - sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ - SvSETMAGIC(sv); \ - } STMT_END -#endif - -=xsinit - -#define NEED_vnewSVpvf -#define NEED_sv_catpvf_mg -#define NEED_sv_catpvf_mg_nocontext -#define NEED_sv_setpvf_mg -#define NEED_sv_setpvf_mg_nocontext - -=xsmisc - -static SV * test_vnewSVpvf(pTHX_ const char *pat, ...) -{ - SV *sv; - va_list args; - va_start(args, pat); -#if { VERSION >= 5.004 } - sv = vnewSVpvf(pat, &args); -#else - sv = newSVpv((char *) pat, 0); -#endif - va_end(args); - return sv; -} - -static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...) -{ - va_list args; - va_start(args, pat); -#if { VERSION >= 5.004 } - sv_vcatpvf(sv, pat, &args); -#else - sv_catpv(sv, (char *) pat); -#endif - va_end(args); -} - -static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...) -{ - va_list args; - va_start(args, pat); -#if { VERSION >= 5.004 } - sv_vsetpvf(sv, pat, &args); -#else - sv_setpv(sv, (char *) pat); -#endif - va_end(args); -} - -=xsubs - -SV * -vnewSVpvf() - CODE: - RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42); - OUTPUT: - RETVAL - -SV * -sv_vcatpvf(sv) - SV *sv - CODE: - RETVAL = newSVsv(sv); - test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42); - OUTPUT: - RETVAL - -SV * -sv_vsetpvf(sv) - SV *sv - CODE: - RETVAL = newSVsv(sv); - test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42); - OUTPUT: - RETVAL - -void -sv_catpvf_mg(sv) - SV *sv - CODE: -#if { VERSION >= 5.004 } - sv_catpvf_mg(sv, "%s-%d", "Perl", 42); -#endif - -void -Perl_sv_catpvf_mg(sv) - SV *sv - CODE: -#if { VERSION >= 5.004 } - Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43); -#endif - -void -sv_catpvf_mg_nocontext(sv) - SV *sv - CODE: -#if { VERSION >= 5.004 } -#ifdef PERL_IMPLICIT_CONTEXT - sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44); -#else - sv_catpvf_mg(sv, "%s-%d", "-Perl", 44); -#endif -#endif - -void -sv_setpvf_mg(sv) - SV *sv - CODE: -#if { VERSION >= 5.004 } - sv_setpvf_mg(sv, "%s-%d", "mhx", 42); -#endif - -void -Perl_sv_setpvf_mg(sv) - SV *sv - CODE: -#if { VERSION >= 5.004 } - Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43); -#endif - -void -sv_setpvf_mg_nocontext(sv) - SV *sv - CODE: -#if { VERSION >= 5.004 } -#ifdef PERL_IMPLICIT_CONTEXT - sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44); -#else - sv_setpvf_mg(sv, "%s-%d", "bar", 44); -#endif -#endif - -=tests plan => 9 - -use Tie::Hash; -my %h; -tie %h, 'Tie::StdHash'; -$h{foo} = 'foo-'; -$h{bar} = ''; - -ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d'); -ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d'); -ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d'); - -&Devel::PPPort::sv_catpvf_mg($h{foo}); -ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-'); - -&Devel::PPPort::Perl_sv_catpvf_mg($h{foo}); -ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-'); - -&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo}); -ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-'); - -&Devel::PPPort::sv_setpvf_mg($h{bar}); -ok($h{bar}, $] >= 5.004 ? 'mhx-42' : ''); - -&Devel::PPPort::Perl_sv_setpvf_mg($h{bar}); -ok($h{bar}, $] >= 5.004 ? 'foo-43' : ''); - -&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar}); -ok($h{bar}, $] >= 5.004 ? 'bar-44' : ''); - - diff --git a/ext/Devel/PPPort/parts/inc/threads b/ext/Devel/PPPort/parts/inc/threads deleted file mode 100644 index 518bdf1fcb..0000000000 --- a/ext/Devel/PPPort/parts/inc/threads +++ /dev/null @@ -1,75 +0,0 @@ -################################################################################ -## -## $Revision: 11 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:53 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ -aTHXR -aTHXR_ -dTHXR - -=implementation - -__UNDEFINED__ dTHR dNOOP - -__UNDEFINED__ dTHX dNOOP -__UNDEFINED__ dTHXa(x) dNOOP - -__UNDEFINED__ pTHX void -__UNDEFINED__ pTHX_ -__UNDEFINED__ aTHX -__UNDEFINED__ aTHX_ - -#if { VERSION < 5.6.0 } -# ifdef USE_THREADS -# define aTHXR thr -# define aTHXR_ thr, -# else -# define aTHXR -# define aTHXR_ -# endif -# define dTHXR dTHR -#else -# define aTHXR aTHX -# define aTHXR_ aTHX_ -# define dTHXR dTHX -#endif - -__UNDEFINED__ dTHXoa(x) dTHXa(x) - -=xsubs - -IV -no_THX_arg(sv) - SV *sv - CODE: - RETVAL = 1 + sv_2iv(sv); - OUTPUT: - RETVAL - -void -with_THX_arg(error) - char *error - PPCODE: - Perl_croak(aTHX_ "%s", error); - -=tests plan => 2 - -ok(&Devel::PPPort::no_THX_arg("42"), 43); -eval { &Devel::PPPort::with_THX_arg("yes\n"); }; -ok($@ =~ /^yes/); - diff --git a/ext/Devel/PPPort/parts/inc/uv b/ext/Devel/PPPort/parts/inc/uv deleted file mode 100644 index 5fdec7afa0..0000000000 --- a/ext/Devel/PPPort/parts/inc/uv +++ /dev/null @@ -1,129 +0,0 @@ -################################################################################ -## -## $Revision: 17 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:54 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ -SvUOK - -=implementation - -__UNDEFINED__ sv_setuv(sv, uv) \ - STMT_START { \ - UV TeMpUv = uv; \ - if (TeMpUv <= IV_MAX) \ - sv_setiv(sv, TeMpUv); \ - else \ - sv_setnv(sv, (double)TeMpUv); \ - } STMT_END - -__UNDEFINED__ newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) - -__UNDEFINED__ sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) -__UNDEFINED__ SvUVX(sv) ((UV)SvIVX(sv)) -__UNDEFINED__ SvUVXx(sv) SvUVX(sv) -__UNDEFINED__ SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) -__UNDEFINED__ SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) - -/* Hint: sv_uv - * Always use the SvUVx() macro instead of sv_uv(). - */ -__UNDEFINED__ sv_uv(sv) SvUVx(sv) - -#if !defined(SvUOK) && defined(SvIOK_UV) -# define SvUOK(sv) SvIOK_UV(sv) -#endif - -__UNDEFINED__ XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) -__UNDEFINED__ XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END - -__UNDEFINED__ PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END -__UNDEFINED__ XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END - -=xsubs - -SV * -sv_setuv(uv) - UV uv - CODE: - RETVAL = newSViv(1); - sv_setuv(RETVAL, uv); - OUTPUT: - RETVAL - -SV * -newSVuv(uv) - UV uv - CODE: - RETVAL = newSVuv(uv); - OUTPUT: - RETVAL - -UV -sv_2uv(sv) - SV *sv - CODE: - RETVAL = sv_2uv(sv); - OUTPUT: - RETVAL - -UV -SvUVx(sv) - SV *sv - CODE: - sv--; - RETVAL = SvUVx(++sv); - OUTPUT: - RETVAL - -void -XSRETURN_UV() - PPCODE: - XSRETURN_UV(42); - -void -PUSHu() - PREINIT: - dTARG; - PPCODE: - TARG = sv_newmortal(); - EXTEND(SP, 1); - PUSHu(42); - XSRETURN(1); - -void -XPUSHu() - PREINIT: - dTARG; - PPCODE: - TARG = sv_newmortal(); - XPUSHu(43); - XSRETURN(1); - -=tests plan => 10 - -ok(&Devel::PPPort::sv_setuv(42), 42); -ok(&Devel::PPPort::newSVuv(123), 123); -ok(&Devel::PPPort::sv_2uv("4711"), 4711); -ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559); -ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559); -ok(&Devel::PPPort::SvUVx(1735928559), 1735928559); -ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef); -ok(&Devel::PPPort::XSRETURN_UV(), 42); -ok(&Devel::PPPort::PUSHu(), 42); -ok(&Devel::PPPort::XPUSHu(), 43); - diff --git a/ext/Devel/PPPort/parts/inc/variables b/ext/Devel/PPPort/parts/inc/variables deleted file mode 100644 index 3058412507..0000000000 --- a/ext/Devel/PPPort/parts/inc/variables +++ /dev/null @@ -1,449 +0,0 @@ -################################################################################ -## -## $Revision: 19 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:53 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -PL_ppaddr -PL_no_modify -PL_DBsignal -PL_DBsingle -PL_DBsub -PL_DBtrace -PL_Sv -PL_bufend -PL_bufptr -PL_compiling -PL_copline -PL_curcop -PL_curstash -PL_debstash -PL_defgv -PL_diehook -PL_dirty -PL_dowarn -PL_errgv -PL_expect -PL_hexdigit -PL_hints -PL_laststatval -PL_lex_state -PL_lex_stuff -PL_linestr -PL_na -PL_parser -PL_perl_destruct_level -PL_perldb -PL_rsfp_filters -PL_rsfp -PL_stack_base -PL_stack_sp -PL_statcache -PL_stdingv -PL_sv_arenaroot -PL_sv_no -PL_sv_undef -PL_sv_yes -PL_tainted -PL_tainting -PL_tokenbuf -PL_signals -PERL_SIGNALS_UNSAFE_FLAG - -=implementation - -#ifndef PERL_SIGNALS_UNSAFE_FLAG - -#define PERL_SIGNALS_UNSAFE_FLAG 0x0001 - -#if { VERSION < 5.8.0 } -# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG -#else -# define D_PPP_PERL_SIGNALS_INIT 0 -#endif - -__NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT; - -#endif - -/* Hint: PL_ppaddr - * Calling an op via PL_ppaddr requires passing a context argument - * for threaded builds. Since the context argument is different for - * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will - * automatically be defined as the correct argument. - */ - -#if { VERSION <= 5.005_05 } -/* Replace: 1 */ -# define PL_ppaddr ppaddr -# define PL_no_modify no_modify -/* Replace: 0 */ -#endif - -#if { VERSION <= 5.004_05 } -/* Replace: 1 */ -# define PL_DBsignal DBsignal -# define PL_DBsingle DBsingle -# define PL_DBsub DBsub -# define PL_DBtrace DBtrace -# define PL_Sv Sv -# define PL_bufend bufend -# define PL_bufptr bufptr -# define PL_compiling compiling -# define PL_copline copline -# define PL_curcop curcop -# define PL_curstash curstash -# define PL_debstash debstash -# define PL_defgv defgv -# define PL_diehook diehook -# define PL_dirty dirty -# define PL_dowarn dowarn -# define PL_errgv errgv -# define PL_expect expect -# define PL_hexdigit hexdigit -# define PL_hints hints -# define PL_laststatval laststatval -# define PL_lex_state lex_state -# define PL_lex_stuff lex_stuff -# define PL_linestr linestr -# define PL_na na -# define PL_perl_destruct_level perl_destruct_level -# define PL_perldb perldb -# define PL_rsfp_filters rsfp_filters -# define PL_rsfp rsfp -# define PL_stack_base stack_base -# define PL_stack_sp stack_sp -# define PL_statcache statcache -# define PL_stdingv stdingv -# define PL_sv_arenaroot sv_arenaroot -# define PL_sv_no sv_no -# define PL_sv_undef sv_undef -# define PL_sv_yes sv_yes -# define PL_tainted tainted -# define PL_tainting tainting -# define PL_tokenbuf tokenbuf -/* Replace: 0 */ -#endif - -/* Warning: PL_parser - * For perl versions earlier than 5.9.5, this is an always - * non-NULL dummy. Also, it cannot be dereferenced. Don't - * use it if you can avoid is and unless you absolutely know - * what you're doing. - * If you always check that PL_parser is non-NULL, you can - * define DPPP_PL_parser_NO_DUMMY to avoid the creation of - * a dummy parser structure. - */ - -#if { VERSION >= 5.9.5 } -# ifdef DPPP_PL_parser_NO_DUMMY -# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ - (croak("panic: PL_parser == NULL in %s:%d", \ - __FILE__, __LINE__), (yy_parser *) NULL))->var) -# else -# ifdef DPPP_PL_parser_NO_DUMMY_WARNING -# define D_PPP_parser_dummy_warning(var) -# else -# define D_PPP_parser_dummy_warning(var) \ - warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__), -# endif -# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ - (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var) -__NEED_DUMMY_VAR__ yy_parser PL_parser; -# endif - -/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */ -/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf - * Do not use this variable unless you know exactly what you're - * doint. It is internal to the perl parser and may change or even - * be removed in the future. As of perl 5.9.5, you have to check - * for (PL_parser != NULL) for this variable to have any effect. - * An always non-NULL PL_parser dummy is provided for earlier - * perl versions. - * If PL_parser is NULL when you try to access this variable, a - * dummy is being accessed instead and a warning is issued unless - * you define DPPP_PL_parser_NO_DUMMY_WARNING. - * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access - * this variable will croak with a panic message. - */ - -# define PL_expect D_PPP_my_PL_parser_var(expect) -# define PL_copline D_PPP_my_PL_parser_var(copline) -# define PL_rsfp D_PPP_my_PL_parser_var(rsfp) -# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters) -# define PL_linestr D_PPP_my_PL_parser_var(linestr) -# define PL_bufptr D_PPP_my_PL_parser_var(bufptr) -# define PL_bufend D_PPP_my_PL_parser_var(bufend) -# define PL_lex_state D_PPP_my_PL_parser_var(lex_state) -# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff) -# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf) - -#else - -/* ensure that PL_parser != NULL and cannot be dereferenced */ -# define PL_parser ((void *) 1) - -#endif - -=xsinit - -#define NEED_PL_signals -#define NEED_PL_parser -#define DPPP_PL_parser_NO_DUMMY_WARNING - -=xsmisc - -U32 get_PL_signals_1(void) -{ - return PL_signals; -} - -extern U32 get_PL_signals_2(void); -extern U32 get_PL_signals_3(void); -int no_dummy_parser_vars(int); -int dummy_parser_warning(void); - -#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END - -#define ppp_PARSERVAR(type, var) STMT_START { \ - type volatile my_ ## var; \ - type volatile *my_p_ ## var; \ - my_ ## var = var; \ - my_p_ ## var = &var; \ - var = my_ ## var; \ - var = *my_p_ ## var; \ - mXPUSHi(&var != NULL); \ - count++; \ - } STMT_END - -#if { VERSION < 5.004 } -# define ppp_rsfp_t FILE * -#else -# define ppp_rsfp_t PerlIO * -#endif - -#if { VERSION < 5.6.0 } -# define ppp_expect_t expectation -#elif { VERSION < 5.9.5 } -# define ppp_expect_t int -#else -# define ppp_expect_t U8 -#endif - -#if { VERSION < 5.9.5 } -# define ppp_lex_state_t U32 -#else -# define ppp_lex_state_t U8 -#endif - -=xsubs - -int -compare_PL_signals() - CODE: - { - U32 ref = get_PL_signals_1(); - RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3(); - } - OUTPUT: - RETVAL - -SV * -PL_sv_undef() - CODE: - RETVAL = newSVsv(&PL_sv_undef); - OUTPUT: - RETVAL - -SV * -PL_sv_yes() - CODE: - RETVAL = newSVsv(&PL_sv_yes); - OUTPUT: - RETVAL - -SV * -PL_sv_no() - CODE: - RETVAL = newSVsv(&PL_sv_no); - OUTPUT: - RETVAL - -int -PL_na(string) - char *string - CODE: - PL_na = strlen(string); - RETVAL = PL_na; - OUTPUT: - RETVAL - -SV * -PL_Sv() - CODE: - PL_Sv = newSVpv("mhx", 0); - RETVAL = PL_Sv; - OUTPUT: - RETVAL - -SV * -PL_tokenbuf() - CODE: - RETVAL = newSViv(PL_tokenbuf[0]); - OUTPUT: - RETVAL - -SV * -PL_parser() - CODE: - RETVAL = newSViv(PL_parser != NULL); - OUTPUT: - RETVAL - -SV * -PL_hexdigit() - CODE: - RETVAL = newSVpv((char *) PL_hexdigit, 0); - OUTPUT: - RETVAL - -SV * -PL_hints() - CODE: - RETVAL = newSViv((IV) PL_hints); - OUTPUT: - RETVAL - -void -PL_ppaddr(string) - char *string - PPCODE: - PUSHMARK(SP); - mXPUSHs(newSVpv(string, 0)); - PUTBACK; - ENTER; - (void)*(PL_ppaddr[OP_UC])(aTHXR); - SPAGAIN; - LEAVE; - XSRETURN(1); - -void -other_variables() - PREINIT: - int count = 0; - PPCODE: - ppp_TESTVAR(PL_DBsignal); - ppp_TESTVAR(PL_DBsingle); - ppp_TESTVAR(PL_DBsub); - ppp_TESTVAR(PL_DBtrace); - ppp_TESTVAR(PL_compiling); - ppp_TESTVAR(PL_curcop); - ppp_TESTVAR(PL_curstash); - ppp_TESTVAR(PL_debstash); - ppp_TESTVAR(PL_defgv); - ppp_TESTVAR(PL_diehook); - ppp_TESTVAR(PL_dirty); - ppp_TESTVAR(PL_dowarn); - ppp_TESTVAR(PL_errgv); - ppp_TESTVAR(PL_laststatval); - ppp_TESTVAR(PL_no_modify); - ppp_TESTVAR(PL_perl_destruct_level); - ppp_TESTVAR(PL_perldb); - ppp_TESTVAR(PL_stack_base); - ppp_TESTVAR(PL_stack_sp); - ppp_TESTVAR(PL_statcache); - ppp_TESTVAR(PL_stdingv); - ppp_TESTVAR(PL_sv_arenaroot); - ppp_TESTVAR(PL_tainted); - ppp_TESTVAR(PL_tainting); - - ppp_PARSERVAR(ppp_expect_t, PL_expect); - ppp_PARSERVAR(line_t, PL_copline); - ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp); - ppp_PARSERVAR(AV *, PL_rsfp_filters); - ppp_PARSERVAR(SV *, PL_linestr); - ppp_PARSERVAR(char *, PL_bufptr); - ppp_PARSERVAR(char *, PL_bufend); - ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state); - ppp_PARSERVAR(SV *, PL_lex_stuff); - - XSRETURN(count); - -int -no_dummy_parser_vars(check) - int check - -int -dummy_parser_warning() - -=tests plan => 49 - -ok(Devel::PPPort::compare_PL_signals()); - -ok(!defined(&Devel::PPPort::PL_sv_undef())); -ok(&Devel::PPPort::PL_sv_yes()); -ok(!&Devel::PPPort::PL_sv_no()); -ok(&Devel::PPPort::PL_na("abcd"), 4); -ok(&Devel::PPPort::PL_Sv(), "mhx"); -ok(defined &Devel::PPPort::PL_tokenbuf()); -ok($] >= 5.009005 || &Devel::PPPort::PL_parser()); -ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/); -ok(defined &Devel::PPPort::PL_hints()); -ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX"); - -for (&Devel::PPPort::other_variables()) { - ok($_ != 0); -} - -{ - my @w; - my $fail = 0; - { - local $SIG{'__WARN__'} = sub { push @w, @_ }; - ok(&Devel::PPPort::dummy_parser_warning()); - } - if ($] >= 5.009005) { - ok(@w >= 0); - for (@w) { - print "# $_"; - unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) { - warn $_; - $fail++; - } - } - } - else { - ok(@w == 0); - } - ok($fail, 0); -} - -ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0)); - -eval { &Devel::PPPort::no_dummy_parser_vars(0) }; - -if ($] < 5.009005) { - ok($@, ''); -} -else { - if ($@) { - print "# $@"; - ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i); - } - else { - ok(1); - } -} diff --git a/ext/Devel/PPPort/parts/inc/version b/ext/Devel/PPPort/parts/inc/version deleted file mode 100644 index ca8d8a6e35..0000000000 --- a/ext/Devel/PPPort/parts/inc/version +++ /dev/null @@ -1,58 +0,0 @@ -################################################################################ -## -## $Revision: 10 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:54 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -PERL_REVISION -PERL_VERSION -PERL_SUBVERSION -PERL_BCDVERSION - -=dontwarn - -PERL_PATCHLEVEL_H_IMPLICIT -_dpppDEC2BCD - -=implementation - -#ifndef PERL_REVISION -# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) -# define PERL_PATCHLEVEL_H_IMPLICIT -# include -# endif -# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) -# include -# endif -# ifndef PERL_REVISION -# define PERL_REVISION (5) - /* Replace: 1 */ -# define PERL_VERSION PATCHLEVEL -# define PERL_SUBVERSION SUBVERSION - /* Replace PERL_PATCHLEVEL with PERL_VERSION */ - /* Replace: 0 */ -# endif -#endif - -#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10)) -#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION)) - -/* It is very unlikely that anyone will try to use this with Perl 6 - (or greater), but who knows. - */ -#if PERL_REVISION != 5 -# error ppport.h only works with Perl version 5 -#endif /* PERL_REVISION != 5 */ diff --git a/ext/Devel/PPPort/parts/inc/warn b/ext/Devel/PPPort/parts/inc/warn deleted file mode 100644 index 76bd881e97..0000000000 --- a/ext/Devel/PPPort/parts/inc/warn +++ /dev/null @@ -1,175 +0,0 @@ -################################################################################ -## -## $Revision: 7 $ -## $Author: mhx $ -## $Date: 2009/01/18 14:10:52 +0100 $ -## -################################################################################ -## -## Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -## Version 2.x, Copyright (C) 2001, Paul Marquess. -## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -## -## This program is free software; you can redistribute it and/or -## modify it under the same terms as Perl itself. -## -################################################################################ - -=provides - -__UNDEFINED__ -ckWARN -warner -Perl_warner -Perl_warner_nocontext - -=implementation - -__UNDEFINED__ WARN_ALL 0 -__UNDEFINED__ WARN_CLOSURE 1 -__UNDEFINED__ WARN_DEPRECATED 2 -__UNDEFINED__ WARN_EXITING 3 -__UNDEFINED__ WARN_GLOB 4 -__UNDEFINED__ WARN_IO 5 -__UNDEFINED__ WARN_CLOSED 6 -__UNDEFINED__ WARN_EXEC 7 -__UNDEFINED__ WARN_LAYER 8 -__UNDEFINED__ WARN_NEWLINE 9 -__UNDEFINED__ WARN_PIPE 10 -__UNDEFINED__ WARN_UNOPENED 11 -__UNDEFINED__ WARN_MISC 12 -__UNDEFINED__ WARN_NUMERIC 13 -__UNDEFINED__ WARN_ONCE 14 -__UNDEFINED__ WARN_OVERFLOW 15 -__UNDEFINED__ WARN_PACK 16 -__UNDEFINED__ WARN_PORTABLE 17 -__UNDEFINED__ WARN_RECURSION 18 -__UNDEFINED__ WARN_REDEFINE 19 -__UNDEFINED__ WARN_REGEXP 20 -__UNDEFINED__ WARN_SEVERE 21 -__UNDEFINED__ WARN_DEBUGGING 22 -__UNDEFINED__ WARN_INPLACE 23 -__UNDEFINED__ WARN_INTERNAL 24 -__UNDEFINED__ WARN_MALLOC 25 -__UNDEFINED__ WARN_SIGNAL 26 -__UNDEFINED__ WARN_SUBSTR 27 -__UNDEFINED__ WARN_SYNTAX 28 -__UNDEFINED__ WARN_AMBIGUOUS 29 -__UNDEFINED__ WARN_BAREWORD 30 -__UNDEFINED__ WARN_DIGIT 31 -__UNDEFINED__ WARN_PARENTHESIS 32 -__UNDEFINED__ WARN_PRECEDENCE 33 -__UNDEFINED__ WARN_PRINTF 34 -__UNDEFINED__ WARN_PROTOTYPE 35 -__UNDEFINED__ WARN_QW 36 -__UNDEFINED__ WARN_RESERVED 37 -__UNDEFINED__ WARN_SEMICOLON 38 -__UNDEFINED__ WARN_TAINT 39 -__UNDEFINED__ WARN_THREADS 40 -__UNDEFINED__ WARN_UNINITIALIZED 41 -__UNDEFINED__ WARN_UNPACK 42 -__UNDEFINED__ WARN_UNTIE 43 -__UNDEFINED__ WARN_UTF8 44 -__UNDEFINED__ WARN_VOID 45 -__UNDEFINED__ WARN_ASSERTIONS 46 - -__UNDEFINED__ packWARN(a) (a) - -#ifndef ckWARN -# ifdef G_WARN_ON -# define ckWARN(a) (PL_dowarn & G_WARN_ON) -# else -# define ckWARN(a) PL_dowarn -# endif -#endif - -#if { VERSION >= 5.004 } && !defined(warner) -#if { NEED warner } - -void -warner(U32 err, const char *pat, ...) -{ - SV *sv; - va_list args; - - PERL_UNUSED_ARG(err); - - va_start(args, pat); - sv = vnewSVpvf(pat, &args); - va_end(args); - sv_2mortal(sv); - warn("%s", SvPV_nolen(sv)); -} - -#define warner Perl_warner - -#define Perl_warner_nocontext Perl_warner - -#endif -#endif - -=xsinit - -#define NEED_warner - -=xsubs - -void -warner() - CODE: -#if { VERSION >= 5.004 } - warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42); -#endif - -void -Perl_warner() - CODE: -#if { VERSION >= 5.004 } - Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42); -#endif - -void -Perl_warner_nocontext() - CODE: -#if { VERSION >= 5.004 } - Perl_warner_nocontext(packWARN(WARN_MISC), "Perl_warner_nocontext %s:%d", "bar", 42); -#endif - -void -ckWARN() - CODE: -#if { VERSION >= 5.004 } - if (ckWARN(WARN_MISC)) - Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42); -#endif - -=tests plan => 5 - -$^W = 0; - -my $warning; - -$SIG{'__WARN__'} = sub { $warning = $_[0] }; - -$warning = ''; -Devel::PPPort::warner(); -ok($] >= 5.004 ? $warning =~ /^warner bar:42/ : $warning eq ''); - -$warning = ''; -Devel::PPPort::Perl_warner(); -ok($] >= 5.004 ? $warning =~ /^Perl_warner bar:42/ : $warning eq ''); - -$warning = ''; -Devel::PPPort::Perl_warner_nocontext(); -ok($] >= 5.004 ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq ''); - -$warning = ''; -Devel::PPPort::ckWARN(); -ok($warning, ''); - -$^W = 1; - -$warning = ''; -Devel::PPPort::ckWARN(); -ok($] >= 5.004 ? $warning =~ /^ckWARN bar:42/ : $warning eq ''); - diff --git a/ext/Devel/PPPort/parts/ppport.fnc b/ext/Devel/PPPort/parts/ppport.fnc deleted file mode 100644 index 567955e3bc..0000000000 --- a/ext/Devel/PPPort/parts/ppport.fnc +++ /dev/null @@ -1,29 +0,0 @@ -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -: -: Perl/Pollution/Portability -: -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -: -: $Revision: 3 $ -: $Author: mhx $ -: $Date: 2009/01/18 14:10:51 +0100 $ -: -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -: -: Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -: Version 2.x, Copyright (C) 2001, Paul Marquess. -: Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -: -: This program is free software; you can redistribute it and/or -: modify it under the same terms as Perl itself. -: -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - -: -: This file lists all API functions/macros that are provided purely -: by Devel::PPPort. It is in the same format as the F that -: ships with the Perl source code. -: - -Am |void |sv_magic_portable|NN SV* sv|NULLOK SV* obj|int how|NULLOK const char* name \ - |I32 namlen diff --git a/ext/Devel/PPPort/parts/ppptools.pl b/ext/Devel/PPPort/parts/ppptools.pl deleted file mode 100644 index 36830eb186..0000000000 --- a/ext/Devel/PPPort/parts/ppptools.pl +++ /dev/null @@ -1,400 +0,0 @@ -################################################################################ -# -# ppptools.pl -- various utility functions -# -################################################################################ -# -# $Revision: 27 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:51 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -sub cat_file -{ - eval { require File::Spec }; - return $@ ? join('/', @_) : File::Spec->catfile(@_); -} - -sub all_files_in_dir -{ - my $dir = shift; - local *DIR; - - opendir DIR, $dir or die "cannot open directory $dir: $!\n"; - my @files = grep { !-d && !/^\./ } readdir DIR; # no dirs or hidden files - closedir DIR; - - return map { cat_file($dir, $_) } @files; -} - -sub parse_todo -{ - my $dir = shift || 'parts/todo'; - local *TODO; - my %todo; - my $todo; - - for $todo (all_files_in_dir($dir)) { - open TODO, $todo or die "cannot open $todo: $!\n"; - my $perl = ; - chomp $perl; - while () { - chomp; - s/#.*//; - s/^\s+//; s/\s+$//; - /^\s*$/ and next; - /^\w+$/ or die "invalid identifier: $_\n"; - exists $todo{$_} and die "duplicate identifier: $_ ($todo{$_} <=> $perl)\n"; - $todo{$_} = $perl; - } - close TODO; - } - - return \%todo; -} - -sub expand_version -{ - my($op, $ver) = @_; - my($r, $v, $s) = parse_version($ver); - $r == 5 or die "only Perl revision 5 is supported\n"; - my $bcdver = sprintf "0x%d%03d%03d", $r, $v, $s; - return "(PERL_BCDVERSION $op $bcdver)"; -} - -sub parse_partspec -{ - my $file = shift; - my $section = 'implementation'; - my $vsec = join '|', qw( provides dontwarn implementation - xsubs xsinit xsmisc xshead xsboot tests ); - my(%data, %options); - local *F; - - open F, $file or die "$file: $!\n"; - while () { - /[ \t]+$/ and warn "$file:$.: warning: trailing whitespace\n"; - if ($section eq 'implementation') { - m!//! && !m!(?:=~|s/).*//! && !m!(?:ht|f)tp://! - and warn "$file:$.: warning: potential C++ comment\n"; - } - /^##/ and next; - if (/^=($vsec)(?:\s+(.*))?/) { - $section = $1; - if (defined $2) { - my $opt = $2; - $options{$section} = eval "{ $opt }"; - $@ and die "$file:$.: invalid options ($opt) in section $section: $@\n"; - } - next; - } - push @{$data{$section}}, $_; - } - close F; - - for (keys %data) { - my @v = @{$data{$_}}; - shift @v while @v && $v[0] =~ /^\s*$/; - pop @v while @v && $v[-1] =~ /^\s*$/; - $data{$_} = join '', @v; - } - - unless (exists $data{provides}) { - $data{provides} = ($file =~ /(\w+)\.?$/)[0]; - } - $data{provides} = [$data{provides} =~ /(\S+)/g]; - - if (exists $data{dontwarn}) { - $data{dontwarn} = [$data{dontwarn} =~ /(\S+)/g]; - } - - my @prov; - my %proto; - - if (exists $data{tests} && (!exists $data{implementation} || $data{implementation} !~ /\S/)) { - $data{implementation} = ''; - } - else { - $data{implementation} =~ /\S/ or die "Empty implementation in $file\n"; - - my $p; - - for $p (@{$data{provides}}) { - if ($p =~ m#^/.*/\w*$#) { - my @tmp = eval "\$data{implementation} =~ ${p}gm"; - $@ and die "invalid regex $p in $file\n"; - @tmp or warn "no matches for regex $p in $file\n"; - push @prov, do { my %h; grep !$h{$_}++, @tmp }; - } - elsif ($p eq '__UNDEFINED__') { - my @tmp = $data{implementation} =~ /^\s*__UNDEFINED__[^\r\n\S]+(\w+)/gm; - @tmp or warn "no __UNDEFINED__ macros in $file\n"; - push @prov, @tmp; - } - else { - push @prov, $p; - } - } - - for (@prov) { - if ($data{implementation} !~ /\b\Q$_\E\b/) { - warn "$file claims to provide $_, but doesn't seem to do so\n"; - next; - } - - # scan for prototypes - my($proto) = $data{implementation} =~ / - ( ^ (?:[\w*]|[^\S\r\n])+ - [\r\n]*? - ^ \b$_\b \s* - \( [^{]* \) - ) - \s* \{ - /xm or next; - - $proto =~ s/^\s+//; - $proto =~ s/\s+$//; - $proto =~ s/\s+/ /g; - - exists $proto{$_} and warn "$file: duplicate prototype for $_\n"; - $proto{$_} = $proto; - } - } - - for $section (qw( implementation xsubs xsinit xsmisc xshead xsboot )) { - if (exists $data{$section}) { - $data{$section} =~ s/\{\s*version\s*(<|>|==|!=|>=|<=)\s*([\d._]+)\s*\}/expand_version($1, $2)/gei; - } - } - - $data{provides} = \@prov; - $data{prototypes} = \%proto; - $data{OPTIONS} = \%options; - - my %prov = map { ($_ => 1) } @prov; - my %dontwarn = exists $data{dontwarn} ? map { ($_ => 1) } @{$data{dontwarn}} : (); - my @maybeprov = do { my %h; - grep { - my($nop) = /^Perl_(.*)/; - not exists $prov{$_} || - exists $dontwarn{$_} || - /^D_PPP_/ || - (defined $nop && exists $prov{$nop} ) || - (defined $nop && exists $dontwarn{$nop}) || - $h{$_}++; - } - $data{implementation} =~ /^\s*#\s*define\s+(\w+)/gm }; - - if (@maybeprov) { - warn "$file seems to provide these macros, but doesn't list them:\n " - . join("\n ", @maybeprov) . "\n"; - } - - return \%data; -} - -sub compare_prototypes -{ - my($p1, $p2) = @_; - for ($p1, $p2) { - s/^\s+//; - s/\s+$//; - s/\s+/ /g; - s/(\w)\s(\W)/$1$2/g; - s/(\W)\s(\w)/$1$2/g; - } - return $p1 cmp $p2; -} - -sub ppcond -{ - my $s = shift; - my @c; - my $p; - - for $p (@$s) { - push @c, map "!($_)", @{$p->{pre}}; - defined $p->{cur} and push @c, "($p->{cur})"; - } - - join " && ", @c; -} - -sub trim_arg -{ - my $in = shift; - my $remove = join '|', qw( NN NULLOK VOL ); - - $in eq '...' and return ($in); - - local $_ = $in; - my $id; - - s/[*()]/ /g; - s/\[[^\]]*\]/ /g; - s/\b(?:auto|const|extern|inline|register|static|volatile|restrict)\b//g; - s/\b(?:$remove)\b//; - s/^\s*//; s/\s*$//; - - if( /^\b(?:struct|union|enum)\s+\w+(?:\s+(\w+))?$/ ) { - defined $1 and $id = $1; - } - else { - if( s/\b(?:char|double|float|int|long|short|signed|unsigned|void)\b//g ) { - /^\s*(\w+)\s*$/ and $id = $1; - } - else { - /^\s*\w+\s+(\w+)\s*$/ and $id = $1; - } - } - - $_ = $in; - - defined $id and s/\b$id\b//; - - # these don't matter at all - s/\b(?:auto|extern|inline|register|static|volatile|restrict)\b//g; - s/\b(?:$remove)\b//; - - s/(?=<\*)\s+(?=\*)//g; - s/\s*(\*+)\s*/ $1 /g; - s/^\s*//; s/\s*$//; - s/\s+/ /g; - - return ($_, $id); -} - -sub parse_embed -{ - my @files = @_; - my @func; - my @pps; - my $file; - local *FILE; - - for $file (@files) { - open FILE, $file or die "$file: $!\n"; - my($line, $l); - - while (defined($line = )) { - while ($line =~ /\\$/ && defined($l = )) { - $line =~ s/\\\s*//; - $line .= $l; - } - next if $line =~ /^\s*:/; - $line =~ s/^\s+|\s+$//gs; - my($dir, $args) = ($line =~ /^\s*#\s*(\w+)(?:\s*(.*?)\s*)?$/); - if (defined $dir and defined $args) { - for ($dir) { - /^ifdef$/ and do { push @pps, { pre => [], cur => "defined($args)" } ; last }; - /^ifndef$/ and do { push @pps, { pre => [], cur => "!defined($args)" } ; last }; - /^if$/ and do { push @pps, { pre => [], cur => $args } ; last }; - /^elif$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = $args; last }; - /^else$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = undef; last }; - /^endif$/ and do { pop @pps ; last }; - /^include$/ and last; - /^define$/ and last; - /^undef$/ and last; - warn "unhandled preprocessor directive: $dir\n"; - } - } - else { - my @e = split /\s*\|\s*/, $line; - if( @e >= 3 ) { - my($flags, $ret, $name, @args) = @e; - for (@args) { - $_ = [trim_arg($_)]; - } - ($ret) = trim_arg($ret); - push @func, { - name => $name, - flags => { map { $_, 1 } $flags =~ /./g }, - ret => $ret, - args => \@args, - cond => ppcond(\@pps), - }; - } - } - } - - close FILE; - } - - return @func; -} - -sub make_prototype -{ - my $f = shift; - my @args = map { "@$_" } @{$f->{args}}; - my $proto; - my $pTHX_ = exists $f->{flags}{n} ? "" : "pTHX_ "; - $proto = "$f->{ret} $f->{name}" . "($pTHX_" . join(', ', @args) . ')'; - return $proto; -} - -sub format_version -{ - my $ver = shift; - - $ver =~ s/$/000000/; - my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; - - $v = int $v; - $s = int $s; - - if ($r < 5 || ($r == 5 && $v < 6)) { - if ($s % 10) { - die "invalid version '$ver'\n"; - } - $s /= 10; - - $ver = sprintf "%d.%03d", $r, $v; - $s > 0 and $ver .= sprintf "_%02d", $s; - - return $ver; - } - - return sprintf "%d.%d.%d", $r, $v, $s; -} - -sub parse_version -{ - my $ver = shift; - - if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { - return ($1, $2, $3); - } - elsif ($ver !~ /^\d+\.[\d_]+$/) { - die "cannot parse version '$ver'\n"; - } - - $ver =~ s/_//g; - $ver =~ s/$/000000/; - - my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; - - $v = int $v; - $s = int $s; - - if ($r < 5 || ($r == 5 && $v < 6)) { - if ($s % 10) { - die "cannot parse version '$ver'\n"; - } - $s /= 10; - } - - return ($r, $v, $s); -} - -1; diff --git a/ext/Devel/PPPort/parts/todo/5004000 b/ext/Devel/PPPort/parts/todo/5004000 deleted file mode 100644 index 1382ea7648..0000000000 --- a/ext/Devel/PPPort/parts/todo/5004000 +++ /dev/null @@ -1,68 +0,0 @@ -5.004000 -GIMME_V # E -G_VOID # E -HEf_SVKEY # E -HeHASH # U -HeKEY # U -HeKLEN # U -HePV # U -HeSVKEY # U -HeSVKEY_force # U -HeSVKEY_set # U -HeVAL # U -SvSetMagicSV # U -SvSetMagicSV_nosteal # U -SvSetSV_nosteal # U -SvTAINTED # U -SvTAINTED_off # U -SvTAINTED_on # U -block_gimme # U -call_list # U -cv_const_sv # U -delimcpy # U -do_open # E (Perl_do_open) -form # U -gv_autoload4 # U -gv_efullname3 # U -gv_fetchmethod_autoload # U -gv_fullname3 # U -hv_delayfree_ent # U -hv_delete_ent # U -hv_exists_ent # U -hv_fetch_ent # U -hv_free_ent # U -hv_iterkeysv # U -hv_ksplit # U -hv_store_ent # U -ibcmp_locale # U -my_failure_exit # U -my_memcmp # U -my_pclose # E (Perl_my_pclose) -my_popen # E (Perl_my_popen) -newSVpvf # U -rsignal # E -rsignal_state # E -save_I16 # U -save_gp # U -share_hek # E -start_subparse # E (Perl_start_subparse) -sv_catpvf # U -sv_catpvf_mg # U -sv_cmp_locale # U -sv_derived_from # U -sv_gets # E (Perl_sv_gets) -sv_magic_portable # U -sv_setpvf # U -sv_setpvf_mg # U -sv_taint # U -sv_tainted # U -sv_untaint # U -sv_vcatpvf # U -sv_vcatpvf_mg # U -sv_vcatpvfn # U -sv_vsetpvf # U -sv_vsetpvf_mg # U -sv_vsetpvfn # U -unsharepvn # U -vnewSVpvf # U -warner # U diff --git a/ext/Devel/PPPort/parts/todo/5004010 b/ext/Devel/PPPort/parts/todo/5004010 deleted file mode 100644 index 8c29866603..0000000000 --- a/ext/Devel/PPPort/parts/todo/5004010 +++ /dev/null @@ -1 +0,0 @@ -5.004010 diff --git a/ext/Devel/PPPort/parts/todo/5004020 b/ext/Devel/PPPort/parts/todo/5004020 deleted file mode 100644 index 4b43fdf8e4..0000000000 --- a/ext/Devel/PPPort/parts/todo/5004020 +++ /dev/null @@ -1 +0,0 @@ -5.004020 diff --git a/ext/Devel/PPPort/parts/todo/5004030 b/ext/Devel/PPPort/parts/todo/5004030 deleted file mode 100644 index e45facbb1f..0000000000 --- a/ext/Devel/PPPort/parts/todo/5004030 +++ /dev/null @@ -1 +0,0 @@ -5.004030 diff --git a/ext/Devel/PPPort/parts/todo/5004040 b/ext/Devel/PPPort/parts/todo/5004040 deleted file mode 100644 index 69ccd5d62c..0000000000 --- a/ext/Devel/PPPort/parts/todo/5004040 +++ /dev/null @@ -1 +0,0 @@ -5.004040 diff --git a/ext/Devel/PPPort/parts/todo/5004050 b/ext/Devel/PPPort/parts/todo/5004050 deleted file mode 100644 index f1c9f8942a..0000000000 --- a/ext/Devel/PPPort/parts/todo/5004050 +++ /dev/null @@ -1,4 +0,0 @@ -5.004050 -do_binmode # U -save_aelem # U -save_helem # U diff --git a/ext/Devel/PPPort/parts/todo/5005000 b/ext/Devel/PPPort/parts/todo/5005000 deleted file mode 100644 index b99f61e20e..0000000000 --- a/ext/Devel/PPPort/parts/todo/5005000 +++ /dev/null @@ -1,27 +0,0 @@ -5.005000 -PL_modglobal # E -cx_dump # U -debop # U -debprofdump # U -fbm_compile # E (Perl_fbm_compile) -fbm_instr # E (Perl_fbm_instr) -get_op_descs # U -get_op_names # U -init_stacks # U -mg_length # U -mg_size # U -newHVhv # U -new_stackinfo # E -regdump # U -regexec_flags # U -regnext # E (Perl_regnext) -runops_debug # U -runops_standard # U -save_iv # U (save_iv) -screaminstr # E (Perl_screaminstr) -sv_iv # U -sv_nv # U -sv_peek # U -sv_pvn # U -sv_pvn_nomg # U -sv_true # U diff --git a/ext/Devel/PPPort/parts/todo/5005010 b/ext/Devel/PPPort/parts/todo/5005010 deleted file mode 100644 index deebff5bf8..0000000000 --- a/ext/Devel/PPPort/parts/todo/5005010 +++ /dev/null @@ -1 +0,0 @@ -5.005010 diff --git a/ext/Devel/PPPort/parts/todo/5005020 b/ext/Devel/PPPort/parts/todo/5005020 deleted file mode 100644 index d19ff2ae09..0000000000 --- a/ext/Devel/PPPort/parts/todo/5005020 +++ /dev/null @@ -1 +0,0 @@ -5.005020 diff --git a/ext/Devel/PPPort/parts/todo/5005030 b/ext/Devel/PPPort/parts/todo/5005030 deleted file mode 100644 index 885afa0d23..0000000000 --- a/ext/Devel/PPPort/parts/todo/5005030 +++ /dev/null @@ -1,4 +0,0 @@ -5.005030 -POPpx # E -get_vtbl # U -save_generic_svref # U diff --git a/ext/Devel/PPPort/parts/todo/5005040 b/ext/Devel/PPPort/parts/todo/5005040 deleted file mode 100644 index 8a165c2033..0000000000 --- a/ext/Devel/PPPort/parts/todo/5005040 +++ /dev/null @@ -1 +0,0 @@ -5.005040 diff --git a/ext/Devel/PPPort/parts/todo/5006000 b/ext/Devel/PPPort/parts/todo/5006000 deleted file mode 100644 index 86f24e2b02..0000000000 --- a/ext/Devel/PPPort/parts/todo/5006000 +++ /dev/null @@ -1,150 +0,0 @@ -5.006000 -SvIOK_UV # U -SvIOK_notUV # U -SvIOK_only_UV # U -SvPOK_only_UTF8 # U -SvPVbyte_nolen # U -SvPVbytex # U -SvPVbytex_force # U -SvPVutf8 # U -SvPVutf8_force # U -SvPVutf8_nolen # U -SvPVutf8x # U -SvPVutf8x_force # U -SvUOK # U -SvUTF8 # U -SvUTF8_off # U -SvUTF8_on # U -av_delete # U -av_exists # U -call_atexit # E -cast_i32 # U (cast_i32) -cast_iv # U (cast_iv) -cast_ulong # U -cast_uv # U (cast_uv) -do_gv_dump # U -do_gvgv_dump # U -do_hv_dump # U -do_magic_dump # U -do_op_dump # U -do_open9 # U -do_pmop_dump # U -do_sv_dump # U -dump_all # U -dump_eval # U -dump_form # U -dump_indent # U -dump_packsubs # U -dump_sub # U -dump_vindent # U -get_context # U -get_ppaddr # E -gv_dump # U -init_i18nl10n # U (perl_init_i18nl10n) -init_i18nl14n # U (perl_init_i18nl14n) -is_uni_alnum # U -is_uni_alnum_lc # U -is_uni_alnumc # U -is_uni_alnumc_lc # U -is_uni_alpha # U -is_uni_alpha_lc # U -is_uni_ascii # U -is_uni_ascii_lc # U -is_uni_cntrl # U -is_uni_cntrl_lc # U -is_uni_digit # U -is_uni_digit_lc # U -is_uni_graph # U -is_uni_graph_lc # U -is_uni_idfirst # U -is_uni_idfirst_lc # U -is_uni_lower # U -is_uni_lower_lc # U -is_uni_print # U -is_uni_print_lc # U -is_uni_punct # U -is_uni_punct_lc # U -is_uni_space # U -is_uni_space_lc # U -is_uni_upper # U -is_uni_upper_lc # U -is_uni_xdigit # U -is_uni_xdigit_lc # U -is_utf8_alnum # U -is_utf8_alnumc # U -is_utf8_alpha # U -is_utf8_ascii # U -is_utf8_char # U -is_utf8_cntrl # U -is_utf8_digit # U -is_utf8_graph # U -is_utf8_idfirst # U -is_utf8_lower # U -is_utf8_mark # U -is_utf8_print # U -is_utf8_punct # U -is_utf8_space # U -is_utf8_upper # U -is_utf8_xdigit # U -magic_dump # U -mess # E (Perl_mess) -my_atof # U -my_fflush_all # U -newANONATTRSUB # U -newATTRSUB # U -newXS # E (Perl_newXS) -newXSproto # E -new_collate # U (perl_new_collate) -new_ctype # U (perl_new_ctype) -new_numeric # U (perl_new_numeric) -op_dump # U -perl_parse # E (perl_parse) -pmop_dump # U -re_intuit_string # U -reginitcolors # U -require_pv # U (perl_require_pv) -safesyscalloc # U -safesysfree # U -safesysmalloc # U -safesysrealloc # U -save_I8 # U -save_alloc # U -save_destructor # E (Perl_save_destructor) -save_destructor_x # E -save_re_context # U -save_vptr # U -scan_bin # U -set_context # U -set_numeric_local # U (perl_set_numeric_local) -set_numeric_radix # U -set_numeric_standard # U (perl_set_numeric_standard) -str_to_version # U -sv_2pvutf8 # U -sv_2pvutf8_nolen # U -sv_force_normal # U -sv_len_utf8 # U -sv_pos_b2u # U -sv_pos_u2b # U -sv_pv # U -sv_pvbyte # U -sv_pvbyten # U -sv_pvbyten_force # U -sv_pvutf8 # U -sv_pvutf8n # U -sv_pvutf8n_force # U -sv_rvweaken # U -sv_utf8_decode # U -sv_utf8_downgrade # U -sv_utf8_encode # U -swash_init # U -tmps_grow # U -to_uni_lower_lc # U -to_uni_title_lc # U -to_uni_upper_lc # U -utf8_distance # U -utf8_hop # U -vcroak # U -vform # U -vmess # U -vwarn # U -vwarner # U diff --git a/ext/Devel/PPPort/parts/todo/5006001 b/ext/Devel/PPPort/parts/todo/5006001 deleted file mode 100644 index 3f4ea792ff..0000000000 --- a/ext/Devel/PPPort/parts/todo/5006001 +++ /dev/null @@ -1,11 +0,0 @@ -5.006001 -SvGAMAGIC # U -apply_attrs_string # U -bytes_to_utf8 # U -gv_efullname4 # U -gv_fullname4 # U -is_utf8_string # U -save_generic_pvref # U -utf16_to_utf8 # E (Perl_utf16_to_utf8) -utf16_to_utf8_reversed # E (Perl_utf16_to_utf8_reversed) -utf8_to_bytes # U diff --git a/ext/Devel/PPPort/parts/todo/5006002 b/ext/Devel/PPPort/parts/todo/5006002 deleted file mode 100644 index dfe09ce2c5..0000000000 --- a/ext/Devel/PPPort/parts/todo/5006002 +++ /dev/null @@ -1 +0,0 @@ -5.006002 diff --git a/ext/Devel/PPPort/parts/todo/5007000 b/ext/Devel/PPPort/parts/todo/5007000 deleted file mode 100644 index 49d08465db..0000000000 --- a/ext/Devel/PPPort/parts/todo/5007000 +++ /dev/null @@ -1 +0,0 @@ -5.007000 diff --git a/ext/Devel/PPPort/parts/todo/5007001 b/ext/Devel/PPPort/parts/todo/5007001 deleted file mode 100644 index f8f9664f8e..0000000000 --- a/ext/Devel/PPPort/parts/todo/5007001 +++ /dev/null @@ -1,19 +0,0 @@ -5.007001 -POPpbytex # E -bytes_from_utf8 # U -despatch_signals # U -do_openn # U -gv_handler # U -is_lvalue_sub # U -my_popen_list # U -save_mortalizesv # U -scan_num # E (Perl_scan_num) -sv_force_normal_flags # U -sv_setref_uv # U -sv_unref_flags # U -sv_utf8_upgrade # E (Perl_sv_utf8_upgrade) -utf8_length # U -utf8_to_uvchr # U -utf8_to_uvuni # U -utf8n_to_uvuni # U -uvuni_to_utf8 # U diff --git a/ext/Devel/PPPort/parts/todo/5007002 b/ext/Devel/PPPort/parts/todo/5007002 deleted file mode 100644 index 2fba735a96..0000000000 --- a/ext/Devel/PPPort/parts/todo/5007002 +++ /dev/null @@ -1,16 +0,0 @@ -5.007002 -calloc # U -getcwd_sv # U -init_tm # U -malloc # U -mfree # U -mini_mktime # U -my_atof2 # U -my_strftime # U -op_null # U -realloc # U -sv_catpvn_flags # U -sv_catsv_flags # U -sv_setsv_flags # U -sv_utf8_upgrade_flags # U -swash_fetch # E (Perl_swash_fetch) diff --git a/ext/Devel/PPPort/parts/todo/5007003 b/ext/Devel/PPPort/parts/todo/5007003 deleted file mode 100644 index 2271d2bcd9..0000000000 --- a/ext/Devel/PPPort/parts/todo/5007003 +++ /dev/null @@ -1,62 +0,0 @@ -5.007003 -PerlIO_clearerr # U (PerlIO_clearerr) -PerlIO_close # U (PerlIO_close) -PerlIO_eof # U (PerlIO_eof) -PerlIO_error # U (PerlIO_error) -PerlIO_fileno # U (PerlIO_fileno) -PerlIO_fill # U (PerlIO_fill) -PerlIO_flush # U (PerlIO_flush) -PerlIO_get_base # U (PerlIO_get_base) -PerlIO_get_bufsiz # U (PerlIO_get_bufsiz) -PerlIO_get_cnt # U (PerlIO_get_cnt) -PerlIO_get_ptr # U (PerlIO_get_ptr) -PerlIO_read # U (PerlIO_read) -PerlIO_seek # U (PerlIO_seek) -PerlIO_set_cnt # U (PerlIO_set_cnt) -PerlIO_set_ptrcnt # U (PerlIO_set_ptrcnt) -PerlIO_setlinebuf # U (PerlIO_setlinebuf) -PerlIO_stderr # U (PerlIO_stderr) -PerlIO_stdin # U (PerlIO_stdin) -PerlIO_stdout # U (PerlIO_stdout) -PerlIO_tell # U (PerlIO_tell) -PerlIO_unread # U (PerlIO_unread) -PerlIO_write # U (PerlIO_write) -SvLOCK # U -SvSHARE # U -SvUNLOCK # U -atfork_lock # U -atfork_unlock # U -custom_op_desc # U -custom_op_name # U -deb # U -debstack # U -debstackptrs # U -gv_fetchmeth_autoload # U -ibcmp_utf8 # U -my_fork # U -my_socketpair # U -pack_cat # U -perl_destruct # E (perl_destruct) -pv_uni_display # U -save_shared_pvref # U -savesharedpv # U -sortsv # U -sv_copypv # U -sv_magicext # U -sv_nolocking # U -sv_nosharing # U -sv_recode_to_utf8 # U -sv_uni_display # U -to_uni_fold # U -to_uni_lower # E (Perl_to_uni_lower) -to_uni_title # E (Perl_to_uni_title) -to_uni_upper # E (Perl_to_uni_upper) -to_utf8_case # U -to_utf8_fold # U -to_utf8_lower # E (Perl_to_utf8_lower) -to_utf8_title # E (Perl_to_utf8_title) -to_utf8_upper # E (Perl_to_utf8_upper) -unpack_str # U -uvchr_to_utf8_flags # U -uvuni_to_utf8_flags # U -vdeb # U diff --git a/ext/Devel/PPPort/parts/todo/5008000 b/ext/Devel/PPPort/parts/todo/5008000 deleted file mode 100644 index a22b04eb81..0000000000 --- a/ext/Devel/PPPort/parts/todo/5008000 +++ /dev/null @@ -1,5 +0,0 @@ -5.008000 -hv_iternext_flags # U -hv_store_flags # U -is_utf8_idcont # U -nothreadhook # U diff --git a/ext/Devel/PPPort/parts/todo/5008001 b/ext/Devel/PPPort/parts/todo/5008001 deleted file mode 100644 index ddc9d09c43..0000000000 --- a/ext/Devel/PPPort/parts/todo/5008001 +++ /dev/null @@ -1,14 +0,0 @@ -5.008001 -SvVOK # U -doing_taint # U -find_runcv # U -is_utf8_string_loc # U -packlist # U -save_bool # U -savestack_grow_cnt # U -seed # U -sv_cat_decode # U -sv_compile_2op # E (Perl_sv_compile_2op) -sv_setpviv # U -sv_setpviv_mg # U -unpackstring # U diff --git a/ext/Devel/PPPort/parts/todo/5008002 b/ext/Devel/PPPort/parts/todo/5008002 deleted file mode 100644 index 63aac525fe..0000000000 --- a/ext/Devel/PPPort/parts/todo/5008002 +++ /dev/null @@ -1 +0,0 @@ -5.008002 diff --git a/ext/Devel/PPPort/parts/todo/5008003 b/ext/Devel/PPPort/parts/todo/5008003 deleted file mode 100644 index 50c6ce1aa1..0000000000 --- a/ext/Devel/PPPort/parts/todo/5008003 +++ /dev/null @@ -1,3 +0,0 @@ -5.008003 -SvIsCOW # U -SvIsCOW_shared_hash # U diff --git a/ext/Devel/PPPort/parts/todo/5008004 b/ext/Devel/PPPort/parts/todo/5008004 deleted file mode 100644 index bb7bcdf66a..0000000000 --- a/ext/Devel/PPPort/parts/todo/5008004 +++ /dev/null @@ -1 +0,0 @@ -5.008004 diff --git a/ext/Devel/PPPort/parts/todo/5008005 b/ext/Devel/PPPort/parts/todo/5008005 deleted file mode 100644 index 7bd2029f4b..0000000000 --- a/ext/Devel/PPPort/parts/todo/5008005 +++ /dev/null @@ -1 +0,0 @@ -5.008005 diff --git a/ext/Devel/PPPort/parts/todo/5008006 b/ext/Devel/PPPort/parts/todo/5008006 deleted file mode 100644 index ba5cad07ed..0000000000 --- a/ext/Devel/PPPort/parts/todo/5008006 +++ /dev/null @@ -1 +0,0 @@ -5.008006 diff --git a/ext/Devel/PPPort/parts/todo/5008007 b/ext/Devel/PPPort/parts/todo/5008007 deleted file mode 100644 index 7d656f0b9e..0000000000 --- a/ext/Devel/PPPort/parts/todo/5008007 +++ /dev/null @@ -1 +0,0 @@ -5.008007 diff --git a/ext/Devel/PPPort/parts/todo/5008008 b/ext/Devel/PPPort/parts/todo/5008008 deleted file mode 100644 index f17b19ff4b..0000000000 --- a/ext/Devel/PPPort/parts/todo/5008008 +++ /dev/null @@ -1 +0,0 @@ -5.008008 diff --git a/ext/Devel/PPPort/parts/todo/5009000 b/ext/Devel/PPPort/parts/todo/5009000 deleted file mode 100644 index 28bc85958e..0000000000 --- a/ext/Devel/PPPort/parts/todo/5009000 +++ /dev/null @@ -1,6 +0,0 @@ -5.009000 -new_version # U -save_set_svflags # U -vcmp # U -vnumify # U -vstringify # U diff --git a/ext/Devel/PPPort/parts/todo/5009001 b/ext/Devel/PPPort/parts/todo/5009001 deleted file mode 100644 index 26d2c4c548..0000000000 --- a/ext/Devel/PPPort/parts/todo/5009001 +++ /dev/null @@ -1,6 +0,0 @@ -5.009001 -hv_clear_placeholders # U -hv_scalar # U -scan_version # E (Perl_scan_version) -sv_2iv_flags # U -sv_2uv_flags # U diff --git a/ext/Devel/PPPort/parts/todo/5009002 b/ext/Devel/PPPort/parts/todo/5009002 deleted file mode 100644 index c6d8a1e183..0000000000 --- a/ext/Devel/PPPort/parts/todo/5009002 +++ /dev/null @@ -1,9 +0,0 @@ -5.009002 -SvPVbyte_force # U -find_rundefsvoffset # U -gv_fetchpvn_flags # U -gv_fetchsv # U -op_refcnt_lock # U -op_refcnt_unlock # U -savesvpv # U -vnormal # U diff --git a/ext/Devel/PPPort/parts/todo/5009003 b/ext/Devel/PPPort/parts/todo/5009003 deleted file mode 100644 index 7be9e0749e..0000000000 --- a/ext/Devel/PPPort/parts/todo/5009003 +++ /dev/null @@ -1,26 +0,0 @@ -5.009003 -av_arylen_p # U -ckwarn # U -ckwarn_d # U -csighandler # E (Perl_csighandler) -dMULTICALL # E -doref # U -gv_const_sv # U -gv_stashpvs # U -hv_eiter_p # U -hv_eiter_set # U -hv_name_set # U -hv_placeholders_get # U -hv_placeholders_p # U -hv_placeholders_set # U -hv_riter_p # U -hv_riter_set # U -is_utf8_string_loclen # U -newGIVENOP # U -newSVhek # U -newSVpvs_share # U -newWHENOP # U -newWHILEOP # E (Perl_newWHILEOP) -savepvs # U -sortsv_flags # U -vverify # U diff --git a/ext/Devel/PPPort/parts/todo/5009004 b/ext/Devel/PPPort/parts/todo/5009004 deleted file mode 100644 index 0d6b7d5051..0000000000 --- a/ext/Devel/PPPort/parts/todo/5009004 +++ /dev/null @@ -1,8 +0,0 @@ -5.009004 -PerlIO_context_layers # U -gv_name_set # U -my_vsnprintf # U -newXS_flags # U -regclass_swash # E (Perl_regclass_swash) -sv_does # U -sv_usepvn_flags # U diff --git a/ext/Devel/PPPort/parts/todo/5009005 b/ext/Devel/PPPort/parts/todo/5009005 deleted file mode 100644 index cf90cd8f80..0000000000 --- a/ext/Devel/PPPort/parts/todo/5009005 +++ /dev/null @@ -1,31 +0,0 @@ -5.009005 -Perl_signbit # U -SvRX # U -SvRXOK # U -av_create_and_push # U -av_create_and_unshift_one # U -get_cvn_flags # U -gv_fetchfile_flags # U -mro_get_linear_isa # U -mro_method_changed_in # U -my_dirfd # U -newSV_type # U -pregcomp # E (Perl_pregcomp) -ptr_table_clear # U -ptr_table_fetch # U -ptr_table_free # U -ptr_table_new # U -ptr_table_split # U -ptr_table_store # U -re_compile # U -re_intuit_start # E (Perl_re_intuit_start) -reg_named_buff_all # U -reg_named_buff_exists # U -reg_named_buff_fetch # U -reg_named_buff_firstkey # U -reg_named_buff_nextkey # U -reg_named_buff_scalar # U -regfree_internal # U -savesharedpvn # U -scan_vstring # E (Perl_scan_vstring) -upg_version # E (Perl_upg_version) diff --git a/ext/Devel/PPPort/parts/todo/5010000 b/ext/Devel/PPPort/parts/todo/5010000 deleted file mode 100644 index 737f374ef0..0000000000 --- a/ext/Devel/PPPort/parts/todo/5010000 +++ /dev/null @@ -1,7 +0,0 @@ -5.010000 -hv_common # U -hv_common_key_len # U -sv_destroyable # U -sys_init # U -sys_init3 # U -sys_term # U diff --git a/ext/Devel/PPPort/parts/todo/5011000 b/ext/Devel/PPPort/parts/todo/5011000 deleted file mode 100644 index 857f62f439..0000000000 --- a/ext/Devel/PPPort/parts/todo/5011000 +++ /dev/null @@ -1,17 +0,0 @@ -5.011000 -HeUTF8 # U -MULTICALL # E -POP_MULTICALL # E -PUSH_MULTICALL # E -SvOOK_offset # U -av_iter_p # U -croak_xs_usage # U -fetch_cop_label # U -gv_fetchmethod_flags # U -hv_assert # U -pad_sv # U -pregfree2 # U -ref # U (Perl_ref) -save_padsv_and_mortalize # U -stashpv_hvname_match # U -sv_insert_flags # U diff --git a/ext/Devel/PPPort/ppport_h.PL b/ext/Devel/PPPort/ppport_h.PL deleted file mode 100644 index e652c352d9..0000000000 --- a/ext/Devel/PPPort/ppport_h.PL +++ /dev/null @@ -1,25 +0,0 @@ -################################################################################ -# -# ppport_h.PL -- generate ppport.h -# -################################################################################ -# -# $Revision: 7 $ -# $Author: mhx $ -# $Date: 2006/06/25 03:41:08 +0200 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -package Devel::PPPort; -require "PPPort.pm"; -rename 'ppport.h', 'ppport.old' if -f 'ppport.h'; -unlink "ppport.old" if WriteFile("ppport.h") && -f 'ppport.h'; diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak deleted file mode 100644 index 9a67665b9a..0000000000 --- a/ext/Devel/PPPort/soak +++ /dev/null @@ -1,606 +0,0 @@ -#!/usr/bin/perl -w -################################################################################ -# -# soak -- Test Perl modules with multiple Perl releases. -# -# Original Author: Paul Marquess -# -################################################################################ -# -# $Revision: 19 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:50 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -require 5.006001; - -use strict; -use warnings; -use ExtUtils::MakeMaker; -use Getopt::Long; -use Pod::Usage; -use File::Find; -use List::Util qw(max); -use Config; - -my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.16 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; - -$| = 1; -my %OPT = ( - verbose => 0, - make => $Config{make} || 'make', - min => '5.000', - color => 1, -); - -GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@ color!)) or pod2usage(2); - -$OPT{mmargs} = [''] unless exists $OPT{mmargs}; -$OPT{min} = parse_version($OPT{min}) - 1e-10; - -sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) } - -my @GoodPerls = map { $_->[0] } - sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] } - grep { $_->[1] >= $OPT{min} } - map { [$_ => perl_version($_)] } - @ARGV ? SearchPerls(@ARGV) : FindPerls(); - -unless (@GoodPerls) { - print "Sorry, got no Perl binaries for testing.\n\n"; - exit 0; -} - -my $maxlen = max(map length, @GoodPerls) + 3; -my $mmalen = max(map length, @{$OPT{mmargs}}); -$maxlen += $mmalen+3 if $mmalen > 0; - -my $rep = Soak::Reporter->new( verbose => $OPT{verbose} - , color => $OPT{color} - , width => $maxlen - ); - -$SIG{__WARN__} = sub { $rep->warn(@_) }; -$SIG{__DIE__} = sub { $rep->die(@_) }; - -# prime the pump, so the first "make realclean" will work. -runit("$^X Makefile.PL") && runit("$OPT{make} realclean") - or $rep->die("Cannot run $^X Makefile.PL && $OPT{make} realclean\n"); - -my $tot = @GoodPerls*@{$OPT{mmargs}}; - -$rep->set(tests => $tot); - -$rep->status(sprintf("Testing %d version%s / %d configuration%s (%d combination%s)...\n", - cs(@GoodPerls), cs(@{$OPT{mmargs}}), cs($tot))); - -for my $perl (@GoodPerls) { - for my $mm (@{$OPT{mmargs}}) { - $rep->set(perl => $perl, config => $mm); - - $rep->test; - - my @warn_mfpl; - my @warn_make; - my @warn_test; - - my $ok = runit("$perl Makefile.PL $mm", \@warn_mfpl) && - runit("$OPT{make}", \@warn_make) && - runit("$OPT{make} test", \@warn_test); - - $rep->warnings(['Makefile.PL' => \@warn_mfpl], - ['make' => \@warn_make], - ['make test' => \@warn_test]); - - if ($ok) { - $rep->passed; - } - else { - $rep->failed; - } - - runit("$OPT{make} realclean"); - } -} - -exit $rep->finish; - -sub runit -{ - # TODO -- portability alert!! - - my($cmd, $warn) = @_; - $rep->vsay("\n Running [$cmd]"); - my $output = `$cmd 2>&1`; - $output = "\n" unless defined $output; - $output =~ s/^/ > /gm; - $rep->say("\n Output:\n$output") if $OPT{verbose} || $?; - if ($?) { - $rep->warn(" Running '$cmd' failed: $?\n"); - return 0; - } - push @$warn, $output =~ /(warning: .*)/ig; - return 1; -} - -sub FindPerls -{ - # TODO -- need to decide how far back we go. - # TODO -- get list of user releases prior to 5.004 - # TODO -- does not work on Windows (at least) - - # find versions of Perl that are available - my @PerlBinaries = qw( - 5.000 - 5.001 - 5.002 - 5.003 - 5.004 5.00401 5.00402 5.00403 5.00404 5.00405 - 5.005 5.00501 5.00502 5.00503 5.00504 - 5.6.0 5.6.1 5.6.2 - 5.7.0 5.7.1 5.7.2 5.7.3 - 5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6 5.8.7 5.8.8 - 5.9.0 5.9.1 5.9.2 5.9.3 - ); - - print "Searching for Perl binaries...\n"; - - # find_perl will send a warning to STDOUT if it can't find - # the requested perl, so need to temporarily silence STDOUT. - tie *STDOUT, 'NoSTDOUT'; - - my $mm = MM->new( { NAME => 'dummy' }); - my @path = $mm->path; - my @GoodPerls; - - for my $perl (@PerlBinaries) { - if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) { - push @GoodPerls, $abs; - } - } - - untie *STDOUT; - - print "\nFound:\n", (map " $_\n", @GoodPerls), "\n"; - - return @GoodPerls; -} - -sub SearchPerls -{ - my @args = @_; - my @perls; - - for my $arg (@args) { - if (-d $arg) { - my @found; - print "Searching for Perl binaries in '$arg'...\n"; - find({ wanted => sub { - $File::Find::name =~ m!perl5[\w._]+$! - and -f $File::Find::name - and -x $File::Find::name - and perl_version($File::Find::name) - and push @found, $File::Find::name; - }, follow => 1 }, $arg); - printf "Found %d Perl binar%s in '%s'.\n\n", cs(@found, 'y', 'ies'), $arg; - push @perls, @found; - } - else { - push @perls, $arg; - } - } - - return @perls; -} - -sub perl_version -{ - my $perl = shift; - my $ver = `$perl -e 'print \$]' 2>&1`; - return $? == 0 && $ver =~ /^\d+\.\d+/ && $ver >= 5 ? $ver : 0; -} - -sub parse_version -{ - my $ver = shift; - - if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { - return $1 + 1e-3*$2 + 1e-6*$3; - } - elsif ($ver =~ /^\d+\.[\d_]+$/) { - $ver =~ s/_//g; - return $ver; - } - - die "cannot parse version '$ver'\n"; -} - -package NoSTDOUT; - -use Tie::Handle; -our @ISA = qw(Tie::Handle); - -sub TIEHANDLE { bless \(my $s = ''), shift } -sub PRINT {} -sub WRITE {} - -package Soak::Reporter; - -use strict; - -sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) } - -sub new -{ - my $class = shift; - bless { - tests => undef, - color => 1, - verbose => 0, - @_, - _cur => 0, - _atbol => 1, - _total => 0, - _good => [], - _bad => [], - }, $class; -} - -sub colored -{ - my $self = shift; - - if ($self->{color}) { - my $c = eval { - require Term::ANSIColor; - Term::ANSIColor::colored(@_); - }; - - if ($@) { - $self->{color} = 0; - } - else { - return $c; - } - } - - return $_[0]; -} - -sub _config -{ - my $self = shift; - return $self->{config} =~ /\S+/ ? " ($self->{config})" : ''; -} - -sub _progress -{ - my $self = shift; - return '' unless defined $self->{tests}; - my $tlen = length $self->{tests}; - my $text = sprintf "[%${tlen}d/%${tlen}d] ", $self->{_cur}, $self->{tests}; - return $self->colored($text, 'bold'); -} - -sub _test -{ - my $self = shift; - return $self->_progress . "Testing " - . $self->colored($self->{perl}, 'blue') - . $self->colored($self->_config, 'green'); -} - -sub _testlen -{ - my $self = shift; - return length("Testing " . $self->{perl} . $self->_config); -} - -sub _dots -{ - my $self = shift; - return '.' x $self->_dotslen; -} - -sub _dotslen -{ - my $self = shift; - return $self->{width} - length($self->{perl} . $self->_config); -} - -sub _sep -{ - my $self = shift; - my $width = shift; - $self->print($self->colored('-'x$width, 'bold'), "\n"); -} - -sub _vsep -{ - goto &_sep if $_[0]->{verbose}; -} - -sub set -{ - my $self = shift; - while (@_) { - my($k, $v) = splice @_, 0, 2; - $self->{$k} = $v; - } -} - -sub test -{ - my $self = shift; - $self->{_cur}++; - $self->_vsep($self->_testlen); - $self->print($self->_test, $self->{verbose} ? "\n" : ' ' . $self->_dots . ' '); - $self->_vsep($self->_testlen); -} - -sub _warnings -{ - my($self, $mode) = @_; - - my $warnings = 0; - my $differ = 0; - - for my $w (@{$self->{_warnings}}) { - if (@{$w->[1]}) { - $warnings += @{$w->[1]}; - $differ++; - } - } - - my $rv = ''; - - if ($warnings) { - if ($mode eq 'summary') { - $rv .= sprintf " (%d warning%s", cs($warnings); - } - else { - $rv .= "\n"; - } - - for my $w (@{$self->{_warnings}}) { - if (@{$w->[1]}) { - if ($mode eq 'detail') { - $rv .= " Warnings during '$w->[0]':\n"; - my $cnt = 1; - for my $msg (@{$w->[1]}) { - $rv .= sprintf " [%d] %s", $cnt++, $msg; - } - $rv .= "\n"; - } - else { - unless ($self->{verbose}) { - $rv .= $differ == 1 ? " during " . $w->[0] - : sprintf(", %d during %s", scalar @{$w->[1]}, $w->[0]); - } - } - } - } - - if ($mode eq 'summary') { - $rv .= ')'; - } - } - - return $rv; -} - -sub _result -{ - my($self, $text, $color) = @_; - my $sum = $self->_warnings('summary'); - my $len = $self->_testlen + $self->_dotslen + length($text) + length($sum) + 2; - - $self->_vsep($len); - $self->print($self->_test, ' ', $self->_dots, ' ') if $self->{verbose} || $self->{_atbol}; - $self->print($self->colored($text, $color)); - $self->print($self->colored($sum, 'red')); - $self->print("\n"); - $self->_vsep($len); - $self->print($self->_warnings('detail')) if $self->{verbose}; - $self->{_total}++; -} - -sub passed -{ - my $self = shift; - $self->_result(@_, 'ok', 'bold green'); - push @{$self->{_good}}, [$self->{perl}, $self->{config}]; -} - -sub failed -{ - my $self = shift; - $self->_result(@_, 'not ok', 'bold red'); - push @{$self->{_bad}}, [$self->{perl}, $self->{config}]; -} - -sub warnings -{ - my $self = shift; - $self->{_warnings} = \@_; -} - -sub _tobol -{ - my $self = shift; - print "\n" unless $self->{_atbol}; - $self->{_atbol} = 1; -} - -sub print -{ - my $self = shift; - my $text = join '', @_; - print $text; - $self->{_atbol} = $text =~ /[\r\n]$/; -} - -sub say -{ - my $self = shift; - $self->_tobol; - $self->print(@_, "\n"); -} - -sub vsay -{ - goto &say if $_[0]->{verbose}; -} - -sub warn -{ - my $self = shift; - $self->say($self->colored(join('', @_), 'red')); -} - -sub die -{ - my $self = shift; - $self->say($self->colored(join('', 'FATAL: ', @_), 'bold red')); - exit -1; -} - -sub status -{ - my($self, $text) = @_; - $self->_tobol; - $self->print($self->colored($text, 'bold'), "\n"); -} - -sub finish -{ - my $self = shift; - - if (@{$self->{_bad}}) { - $self->status("\nFailed with:"); - for my $fail (@{$self->{_bad}}) { - my($perl, $cfg) = @$fail; - $self->set(config => $cfg); - $self->say(" ", $self->colored($perl, 'blue'), $self->colored($self->_config, 'green')); - } - } - - $self->status(sprintf("\nPassed with %d of %d combination%s.\n", - scalar @{$self->{_good}}, cs($self->{_total}))); - - return scalar @{$self->{_bad}}; -} - -__END__ - -=head1 NAME - -soak - Test Perl modules with multiple Perl releases - -=head1 SYNOPSIS - - soak [options] [perl ...] - - --make=program override name of make program ($Config{make}) - --min=version use at least this version of perl - --mmargs=options pass options to Makefile.PL (multiple --mmargs possible) - --verbose be verbose - --nocolor don't use colored output - -=head1 DESCRIPTION - -The F utility can be used to test Perl modules with -multiple Perl releases or build options. It automates the -task of running F and the modules test suite. - -It is not primarily intended for cross-platform checking, -so don't expect it to work on all platforms. - -=head1 EXAMPLES - -To test your favourite module, just change to its root -directory (where the F is located) and run: - - soak - -This will automatically look for Perl binaries installed -on your system. - -Alternatively, you can explicitly pass F a list of -Perl binaries: - - soak perl5.8.6 perl5.9.2 - -Last but not least, you can pass it a list of directories -to recursively search for Perl binaries, for example: - - soak /tmp/perl/install /usr/bin - -All of the above examples will run - - perl Makefile.PL - make - make test - -for your module and report success or failure. - -If your F can take arguments, you may also -want to test different configurations for your module. -You can do so with the I<--mmargs> option: - - soak --mmargs=' ' --mmargs='CCFLAGS=-Wextra' --mmargs='enable-debug' - -This will run - - perl Makefile.PL - make - make test - perl Makefile.PL CCFLAGS=-Wextra - make - make test - perl Makefile.PL enable-debug - make - make test - -for each Perl binary. - -If you have a directory full of different Perl binaries, -but your module isn't expected to work with ancient perls, -you can use the I<--min> option to specify the minimum -version a Perl binary must have to be chosen for testing: - - soak --min=5.8.1 - -Usually, the output of F is rather terse, to give -you a good overview. If you'd like to see more of what's -going on, use the I<--verbose> option: - - soak --verbose - -=head1 COPYRIGHT - -Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz. - -Version 2.x, Copyright (C) 2001, Paul Marquess. - -Version 1.x, Copyright (C) 1999, Kenneth Albanowski. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L. - -=cut - diff --git a/ext/Devel/PPPort/t/MY_CXT.t b/ext/Devel/PPPort/t/MY_CXT.t deleted file mode 100644 index ca2b4a772a..0000000000 --- a/ext/Devel/PPPort/t/MY_CXT.t +++ /dev/null @@ -1,54 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/MY_CXT instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (3) { - load(); - plan(tests => 3); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(&Devel::PPPort::MY_CXT_1()); -ok(&Devel::PPPort::MY_CXT_2()); -ok(&Devel::PPPort::MY_CXT_CLONE()); - diff --git a/ext/Devel/PPPort/t/SvPV.t b/ext/Devel/PPPort/t/SvPV.t deleted file mode 100644 index cd1a3e1f4f..0000000000 --- a/ext/Devel/PPPort/t/SvPV.t +++ /dev/null @@ -1,116 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/SvPV instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (47) { - load(); - plan(tests => 47); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my $mhx = "mhx"; - -ok(&Devel::PPPort::SvPVbyte($mhx), 3); - -my $i = 42; - -ok(&Devel::PPPort::SvPV_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_const($mhx), $i++); -ok(&Devel::PPPort::SvPV_mutable($mhx), $i++); -ok(&Devel::PPPort::SvPV_flags($mhx), $i++); -ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++); - -ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++); -ok(&Devel::PPPort::SvPV_force($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++); - -ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++); -ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++); - -ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++); -ok(&Devel::PPPort::SvPV_nomg($mhx), $i++); -ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++); -ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++); - -$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2); - -$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2); - -$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2); - -$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0); -$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2); -$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0); - -my $str = ""; -my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80); -ok($str, "x"x80); -ok($s2, "x"x80); -ok($before < 81); -ok($after, 81); - -$str = "x"x400; -($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40); -ok($str, "x"x40); -ok($s2, "x"x40); -ok($before > 41); -ok($after, 41); - diff --git a/ext/Devel/PPPort/t/SvREFCNT.t b/ext/Devel/PPPort/t/SvREFCNT.t deleted file mode 100644 index cdaa7500d0..0000000000 --- a/ext/Devel/PPPort/t/SvREFCNT.t +++ /dev/null @@ -1,54 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/SvREFCNT instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (14) { - load(); - plan(tests => 14); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -for (Devel::PPPort::SvREFCNT()) { - ok(defined $_ and $_); -} - diff --git a/ext/Devel/PPPort/t/Sv_set.t b/ext/Devel/PPPort/t/Sv_set.t deleted file mode 100644 index 6753e53bb3..0000000000 --- a/ext/Devel/PPPort/t/Sv_set.t +++ /dev/null @@ -1,71 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/Sv_set instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (5) { - load(); - plan(tests => 5); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my $foo = 5; -ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42); -ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43); -ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44); - -my $bar = []; - -bless $bar, 'foo'; -ok($bar->x(), 'foobar'); - -Devel::PPPort::TestSvSTASH_set($bar, 'bar'); -ok($bar->x(), 'hacker'); - -package foo; - -sub x { 'foobar' } - -package bar; - -sub x { 'hacker' } - diff --git a/ext/Devel/PPPort/t/call.t b/ext/Devel/PPPort/t/call.t deleted file mode 100644 index ffa43ca788..0000000000 --- a/ext/Devel/PPPort/t/call.t +++ /dev/null @@ -1,107 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/call instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (52) { - load(); - plan(tests => 52); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -sub eq_array -{ - my($a, $b) = @_; - join(':', @$a) eq join(':', @$b); -} - -sub f -{ - shift; - unshift @_, 'b'; - pop @_; - @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; -} - -my $obj = bless [], 'Foo'; - -sub Foo::meth -{ - return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo'; - shift; - shift; - unshift @_, 'b'; - pop @_; - @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; -} - -my $test; - -for $test ( - # flags args expected description - [ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ], - [ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ], - [ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ], - [ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ], - [ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ], - [ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ], -) -{ - my ($flags, $args, $expected, $description) = @$test; - print "# --- $description ---\n"; - ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected)); - ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected)); -}; - -ok(&Devel::PPPort::eval_pv('f()', 0), 'y'); -ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y'); - -ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet"); -Devel::PPPort::load_module(0, "less", undef); -ok(defined $::{'less::'}, 1, "Have now loaded less"); - diff --git a/ext/Devel/PPPort/t/cop.t b/ext/Devel/PPPort/t/cop.t deleted file mode 100644 index 1efc43ae4c..0000000000 --- a/ext/Devel/PPPort/t/cop.t +++ /dev/null @@ -1,62 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/cop instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (2) { - load(); - plan(tests => 2); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my $package; -{ - package MyPackage; - $package = &Devel::PPPort::CopSTASHPV(); -} -print "# $package\n"; -ok($package, "MyPackage"); - -my $file = &Devel::PPPort::CopFILE(); -print "# $file\n"; -ok($file =~ /cop/i); - diff --git a/ext/Devel/PPPort/t/exception.t b/ext/Devel/PPPort/t/exception.t deleted file mode 100644 index 3acd5fa445..0000000000 --- a/ext/Devel/PPPort/t/exception.t +++ /dev/null @@ -1,67 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/exception instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (7) { - load(); - plan(tests => 7); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my $rv; - -$Devel::PPPort::exception_caught = undef; - -$rv = eval { &Devel::PPPort::exception(0) }; -ok($@, ''); -ok(defined $rv); -ok($rv, 42); -ok($Devel::PPPort::exception_caught, 0); - -$Devel::PPPort::exception_caught = undef; - -$rv = eval { &Devel::PPPort::exception(1) }; -ok($@, "boo\n"); -ok(not defined $rv); -ok($Devel::PPPort::exception_caught, 1); - diff --git a/ext/Devel/PPPort/t/format.t b/ext/Devel/PPPort/t/format.t deleted file mode 100644 index 66bf3f69e1..0000000000 --- a/ext/Devel/PPPort/t/format.t +++ /dev/null @@ -1,55 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/format instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (1) { - load(); - plan(tests => 1); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my $num = 1.12345678901234567890; - -eval { Devel::PPPort::croak_NVgf($num) }; -ok($@ =~ /^1.1234567890/); - diff --git a/ext/Devel/PPPort/t/grok.t b/ext/Devel/PPPort/t/grok.t deleted file mode 100644 index 6f30c3bab4..0000000000 --- a/ext/Devel/PPPort/t/grok.t +++ /dev/null @@ -1,62 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/grok instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (10) { - load(); - plan(tests => 10); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(&Devel::PPPort::grok_number("42"), 42); -ok(!defined(&Devel::PPPort::grok_number("A"))); -ok(&Devel::PPPort::grok_bin("10000001"), 129); -ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef); -ok(&Devel::PPPort::grok_oct("377"), 255); - -ok(&Devel::PPPort::Perl_grok_number("42"), 42); -ok(!defined(&Devel::PPPort::Perl_grok_number("A"))); -ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129); -ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef); -ok(&Devel::PPPort::Perl_grok_oct("377"), 255); - diff --git a/ext/Devel/PPPort/t/limits.t b/ext/Devel/PPPort/t/limits.t deleted file mode 100644 index 06bb4eb0cf..0000000000 --- a/ext/Devel/PPPort/t/limits.t +++ /dev/null @@ -1,55 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/limits instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (4) { - load(); - plan(tests => 4); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(&Devel::PPPort::iv_size()); -ok(&Devel::PPPort::uv_size()); -ok(&Devel::PPPort::iv_type()); -ok(&Devel::PPPort::uv_type()); - diff --git a/ext/Devel/PPPort/t/mPUSH.t b/ext/Devel/PPPort/t/mPUSH.t deleted file mode 100644 index afe10325ef..0000000000 --- a/ext/Devel/PPPort/t/mPUSH.t +++ /dev/null @@ -1,62 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/mPUSH instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (10) { - load(); - plan(tests => 10); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42"); -ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three"); -ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125"); -ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3"); -ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3"); - -ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42"); -ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three"); -ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125"); -ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3"); -ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3"); - diff --git a/ext/Devel/PPPort/t/magic.t b/ext/Devel/PPPort/t/magic.t deleted file mode 100644 index c782da4911..0000000000 --- a/ext/Devel/PPPort/t/magic.t +++ /dev/null @@ -1,95 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/magic instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (15) { - load(); - plan(tests => 15); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -use Tie::Hash; -my %h; -tie %h, 'Tie::StdHash'; -$h{foo} = 'foo'; -$h{bar} = ''; - -&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); -ok($h{foo}, 'foobar'); - -&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); -ok($h{bar}, 'baz'); - -&Devel::PPPort::sv_catsv_mg($h{foo}, '42'); -ok($h{foo}, 'foobar42'); - -&Devel::PPPort::sv_setiv_mg($h{bar}, 42); -ok($h{bar}, 42); - -&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); -ok(abs($h{PI} - 3.14159) < 0.01); - -&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); -ok($h{mhx}, 'mhx'); - -&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); -ok($h{mhx}, 'Marcus'); - -&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); -ok($h{sv}, 'SV'); - -&Devel::PPPort::sv_setuv_mg($h{sv}, 4711); -ok($h{sv}, 4711); - -&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); -ok($h{sv}, 'Perl'); - -my $ver = eval qq[qv("v1.2.0")]; -ok($[ < 5.009 || $@ eq ''); -ok($@ || Devel::PPPort::SvVSTRING_mg($ver)); -ok(!Devel::PPPort::SvVSTRING_mg(4711)); - -my $foo = 'bar'; -ok(Devel::PPPort::sv_magic_portable($foo)); -ok($foo eq 'bar'); - diff --git a/ext/Devel/PPPort/t/memory.t b/ext/Devel/PPPort/t/memory.t deleted file mode 100644 index 09fb3eed49..0000000000 --- a/ext/Devel/PPPort/t/memory.t +++ /dev/null @@ -1,52 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/memory instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (1) { - load(); - plan(tests => 1); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(Devel::PPPort::checkmem(), 4); - diff --git a/ext/Devel/PPPort/t/misc.t b/ext/Devel/PPPort/t/misc.t deleted file mode 100644 index bbcf4b341e..0000000000 --- a/ext/Devel/PPPort/t/misc.t +++ /dev/null @@ -1,125 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/misc instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (38) { - load(); - plan(tests => 38); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -use vars qw($my_sv @my_av %my_hv); - -ok(&Devel::PPPort::boolSV(1)); -ok(!&Devel::PPPort::boolSV(0)); - -$_ = "Fred"; -ok(&Devel::PPPort::DEFSV(), "Fred"); -ok(&Devel::PPPort::UNDERBAR(), "Fred"); - -if ($] >= 5.009002) { - eval q{ - my $_ = "Tony"; - ok(&Devel::PPPort::DEFSV(), "Fred"); - ok(&Devel::PPPort::UNDERBAR(), "Tony"); - }; -} -else { - ok(1); - ok(1); -} - -my @r = &Devel::PPPort::DEFSV_modify(); - -ok(@r == 3); -ok($r[0], 'Fred'); -ok($r[1], 'DEFSV'); -ok($r[2], 'Fred'); - -ok(&Devel::PPPort::DEFSV(), "Fred"); - -eval { 1 }; -ok(!&Devel::PPPort::ERRSV()); -eval { cannot_call_this_one() }; -ok(&Devel::PPPort::ERRSV()); - -ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0)); -ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0)); -ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1)); - -$my_sv = 1; -ok(&Devel::PPPort::get_sv('my_sv', 0)); -ok(!&Devel::PPPort::get_sv('not_my_sv', 0)); -ok(&Devel::PPPort::get_sv('not_my_sv', 1)); - -@my_av = (1); -ok(&Devel::PPPort::get_av('my_av', 0)); -ok(!&Devel::PPPort::get_av('not_my_av', 0)); -ok(&Devel::PPPort::get_av('not_my_av', 1)); - -%my_hv = (a=>1); -ok(&Devel::PPPort::get_hv('my_hv', 0)); -ok(!&Devel::PPPort::get_hv('not_my_hv', 0)); -ok(&Devel::PPPort::get_hv('not_my_hv', 1)); - -sub my_cv { 1 }; -ok(&Devel::PPPort::get_cv('my_cv', 0)); -ok(!&Devel::PPPort::get_cv('not_my_cv', 0)); -ok(&Devel::PPPort::get_cv('not_my_cv', 1)); - -ok(Devel::PPPort::dXSTARG(42), 43); -ok(Devel::PPPort::dAXMARK(4711), 4710); - -ok(Devel::PPPort::prepush(), 42); - -ok(join(':', Devel::PPPort::xsreturn(0)), 'test1'); -ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); - -ok(Devel::PPPort::PERL_ABS(42), 42); -ok(Devel::PPPort::PERL_ABS(-13), 13); - -ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42'); -ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc'); - -ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo"); - diff --git a/ext/Devel/PPPort/t/newCONSTSUB.t b/ext/Devel/PPPort/t/newCONSTSUB.t deleted file mode 100644 index 58c174aefb..0000000000 --- a/ext/Devel/PPPort/t/newCONSTSUB.t +++ /dev/null @@ -1,59 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/newCONSTSUB instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (3) { - load(); - plan(tests => 3); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -&Devel::PPPort::call_newCONSTSUB_1(); -ok(&Devel::PPPort::test_value_1(), 1); - -&Devel::PPPort::call_newCONSTSUB_2(); -ok(&Devel::PPPort::test_value_2(), 2); - -&Devel::PPPort::call_newCONSTSUB_3(); -ok(&Devel::PPPort::test_value_3(), 3); - diff --git a/ext/Devel/PPPort/t/newRV.t b/ext/Devel/PPPort/t/newRV.t deleted file mode 100644 index 2496546071..0000000000 --- a/ext/Devel/PPPort/t/newRV.t +++ /dev/null @@ -1,53 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/newRV instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (2) { - load(); - plan(tests => 2); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(&Devel::PPPort::newRV_inc_REFCNT, 1); -ok(&Devel::PPPort::newRV_noinc_REFCNT, 1); - diff --git a/ext/Devel/PPPort/t/newSVpv.t b/ext/Devel/PPPort/t/newSVpv.t deleted file mode 100644 index 18031a82ed..0000000000 --- a/ext/Devel/PPPort/t/newSVpv.t +++ /dev/null @@ -1,78 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/newSVpv instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (15) { - load(); - plan(tests => 15); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my @s = &Devel::PPPort::newSVpvn(); -ok(@s == 5); -ok($s[0], "test"); -ok($s[1], "te"); -ok($s[2], ""); -ok(!defined($s[3])); -ok(!defined($s[4])); - -@s = &Devel::PPPort::newSVpvn_flags(); -ok(@s == 5); -ok($s[0], "test"); -ok($s[1], "te"); -ok($s[2], ""); -ok(!defined($s[3])); -ok(!defined($s[4])); - -@s = &Devel::PPPort::newSVpvn_utf8(); -ok(@s == 1); -ok($s[0], "test"); - -if ($] >= 5.008001) { - require utf8; - ok(utf8::is_utf8($s[0])); -} -else { - skip("skip: no is_utf8()", 0); -} - diff --git a/ext/Devel/PPPort/t/podtest.t b/ext/Devel/PPPort/t/podtest.t deleted file mode 100644 index 09b870c899..0000000000 --- a/ext/Devel/PPPort/t/podtest.t +++ /dev/null @@ -1,83 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/podtest instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (0) { - load(); - plan(tests => 0); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my @pods = qw( HACKERS PPPort.pm ppport.h soak devel/regenerate devel/buildperl.pl ); - -my $reason = ''; - -if ($ENV{'SKIP_SLOW_TESTS'}) { - $reason = 'SKIP_SLOW_TESTS'; -} -else { - # Try loading Test::Pod - eval q{ - use Test::Pod; - $Test::Pod::VERSION >= 0.95 - or die "Test::Pod version only $Test::Pod::VERSION"; - import Test::Pod tests => scalar @pods; - }; - $reason = 'Test::Pod >= 0.95 required' if $@; -} - -if ($reason) { - load(); - plan(tests => scalar @pods); -} - -for (@pods) { - print "# checking $_\n"; - if ($reason) { - skip("skip: $reason", 0); - } - else { - pod_file_ok($_); - } -} - diff --git a/ext/Devel/PPPort/t/ppphtest.t b/ext/Devel/PPPort/t/ppphtest.t deleted file mode 100644 index 19fad35316..0000000000 --- a/ext/Devel/PPPort/t/ppphtest.t +++ /dev/null @@ -1,932 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/ppphtest instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (235) { - load(); - plan(tests => 235); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -BEGIN { - if ($ENV{'SKIP_SLOW_TESTS'}) { - for (1 .. 235) { - skip("skip: SKIP_SLOW_TESTS", 0); - } - exit 0; - } -} - -use File::Path qw/rmtree mkpath/; -use Config; - -my $tmp = 'ppptmp'; -my $inc = ''; -my $isVMS = $^O eq 'VMS'; -my $isMAC = $^O eq 'MacOS'; -my $perl = find_perl(); - -rmtree($tmp) if -d $tmp; -mkpath($tmp) or die "mkpath $tmp: $!\n"; -chdir($tmp) or die "chdir $tmp: $!\n"; - -if ($ENV{'PERL_CORE'}) { - if (-d '../../lib') { - if ($isVMS) { - $inc = '"-I../../lib"'; - } - elsif ($isMAC) { - $inc = '-I:::lib'; - } - else { - $inc = '-I../../lib'; - } - unshift @INC, '../../lib'; - } -} -if ($perl =~ m!^\./!) { - $perl = ".$perl"; -} - -END { - chdir('..') if !-d $tmp && -d "../$tmp"; - rmtree($tmp) if -d $tmp; -} - -ok(&Devel::PPPort::WriteFile("ppport.h")); - -sub comment -{ - my $c = shift; - $c =~ s/^/# | /mg; - $c .= "\n" unless $c =~ /[\r\n]$/; - print $c; -} - -sub ppport -{ - my @args = ('ppport.h', @_); - unshift @args, $inc if $inc; - my $run = $perl =~ m/\s/ ? qq("$perl") : $perl; - $run .= ' -MMac::err=unix' if $isMAC; - for (@args) { - $_ = qq("$_") if $isVMS && /^[^"]/; - $run .= " $_"; - } - print "# *** running $run ***\n"; - $run .= ' 2>&1' unless $isMAC; - my @out = `$run`; - my $out = join '', @out; - comment($out); - return wantarray ? @out : $out; -} - -sub matches -{ - my($str, $re, $mod) = @_; - my @n; - eval "\@n = \$str =~ /$re/g$mod;"; - if ($@) { - my $err = $@; - $err =~ s/^/# *** /mg; - print "# *** ERROR ***\n$err\n"; - } - return $@ ? -42 : scalar @n; -} - -sub eq_files -{ - my($f1, $f2) = @_; - return 0 unless -e $f1 && -e $f2; - local *F; - for ($f1, $f2) { - print "# File: $_\n"; - unless (open F, $_) { - print "# couldn't open $_: $!\n"; - return 0; - } - $_ = do { local $/; }; - close F; - comment($_); - } - return $f1 eq $f2; -} - -my @tests; - -for (split /\s*={70,}\s*/, do { local $/; }) { - s/^\s+//; s/\s+$//; - my($c, %f); - ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/; - push @tests, { code => $c, files => \%f }; -} - -my $t; -for $t (@tests) { - print "#\n", ('# ', '-'x70, "\n")x3, "#\n"; - my $f; - for $f (keys %{$t->{files}}) { - my @f = split /\//, $f; - if (@f > 1) { - pop @f; - my $path = join '/', @f; - mkpath($path) or die "mkpath('$path'): $!\n"; - } - my $txt = $t->{files}{$f}; - local *F; - open F, ">$f" or die "open $f: $!\n"; - print F "$txt\n"; - close F; - $txt =~ s/^/# | /mg; - print "# *** writing $f ***\n$txt\n"; - } - - my $code = $t->{code}; - $code =~ s/^/# | /mg; - - print "# *** evaluating test code ***\n$code\n"; - - eval $t->{code}; - if ($@) { - my $err = $@; - $err =~ s/^/# *** /mg; - print "# *** ERROR ***\n$err\n"; - } - ok($@, ''); - - for (keys %{$t->{files}}) { - unlink $_ or die "unlink('$_'): $!\n"; - } -} - -sub find_perl -{ - my $perl = $^X; - - return $perl if $isVMS; - - my $exe = $Config{'_exe'} || ''; - - if ($perl =~ /^perl\Q$exe\E$/i) { - $perl = "perl$exe"; - eval "require File::Spec"; - if ($@) { - $perl = "./$perl"; - } else { - $perl = File::Spec->catfile(File::Spec->curdir(), $perl); - } - } - - if ($perl !~ /\Q$exe\E$/i) { - $perl .= $exe; - } - - warn "find_perl: cannot find $perl from $^X" unless -f $perl; - - return $perl; -} - -__DATA__ - -my $o = ppport(qw(--help)); -ok($o =~ /^Usage:.*ppport\.h/m); -ok($o =~ /--help/m); - -$o = ppport(qw(--version)); -ok($o =~ /^This is.*ppport.*\d+\.\d+(?:_?\d+)?\.$/); - -$o = ppport(qw(--nochanges)); -ok($o =~ /^Scanning.*test\.xs/mi); -ok($o =~ /Analyzing.*test\.xs/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok(matches($o, 'Analyzing', 'm'), 1); -ok($o =~ /Uses Perl_newSViv instead of newSViv/); - -$o = ppport(qw(--quiet --nochanges)); -ok($o =~ /^\s*$/); - ----------------------------- test.xs ------------------------------------------ - -Perl_newSViv(); - -=============================================================================== - -# check if C and C++ comments are filtered correctly - -my $o = ppport(qw(--copy=a)); -ok($o =~ /^Scanning.*MyExt\.xs/mi); -ok($o =~ /Analyzing.*MyExt\.xs/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Uses grok_bin/m); -ok($o !~ /^Uses newSVpv/m); -ok($o =~ /Uses 1 C\+\+ style comment/m); -ok(eq_files('MyExt.xsa', 'MyExt.ra')); - -# check if C++ are left untouched with --cplusplus - -$o = ppport(qw(--copy=b --cplusplus)); -ok($o =~ /^Scanning.*MyExt\.xs/mi); -ok($o =~ /Analyzing.*MyExt\.xs/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Uses grok_bin/m); -ok($o !~ /^Uses newSVpv/m); -ok($o !~ /Uses \d+ C\+\+ style comment/m); -ok(eq_files('MyExt.xsb', 'MyExt.rb')); - -unlink qw(MyExt.xsa MyExt.xsb); - ----------------------------- MyExt.xs ----------------------------------------- - -newSVuv(); - // newSVpv(); - XPUSHs(foo); -/* grok_bin(); */ - ----------------------------- MyExt.ra ----------------------------------------- - -#include "ppport.h" -newSVuv(); - /* newSVpv(); */ - XPUSHs(foo); -/* grok_bin(); */ - ----------------------------- MyExt.rb ----------------------------------------- - -#include "ppport.h" -newSVuv(); - // newSVpv(); - XPUSHs(foo); -/* grok_bin(); */ - -=============================================================================== - -my $o = ppport(qw(--nochanges file1.xs)); -ok($o =~ /^Scanning.*file1\.xs/mi); -ok($o =~ /Analyzing.*file1\.xs/mi); -ok($o !~ /^Scanning.*file2\.xs/mi); -ok($o =~ /^Uses newCONSTSUB/m); -ok($o =~ /^Uses PL_expect/m); -ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); -ok($o =~ /WARNING: PL_expect/m); -ok($o =~ /hint for newCONSTSUB/m); -ok($o =~ /^Analysis completed \(1 warning\)/m); -ok($o =~ /^Looks good/m); - -$o = ppport(qw(--nochanges --nohints file1.xs)); -ok($o =~ /^Scanning.*file1\.xs/mi); -ok($o =~ /Analyzing.*file1\.xs/mi); -ok($o !~ /^Scanning.*file2\.xs/mi); -ok($o =~ /^Uses newCONSTSUB/m); -ok($o =~ /^Uses PL_expect/m); -ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); -ok($o =~ /WARNING: PL_expect/m); -ok($o !~ /hint for newCONSTSUB/m); -ok($o =~ /^Analysis completed \(1 warning\)/m); -ok($o =~ /^Looks good/m); - -$o = ppport(qw(--nochanges --nohints --nodiag file1.xs)); -ok($o =~ /^Scanning.*file1\.xs/mi); -ok($o =~ /Analyzing.*file1\.xs/mi); -ok($o !~ /^Scanning.*file2\.xs/mi); -ok($o !~ /^Uses newCONSTSUB/m); -ok($o !~ /^Uses PL_expect/m); -ok($o !~ /^Uses SvPV_nolen/m); -ok($o =~ /WARNING: PL_expect/m); -ok($o !~ /hint for newCONSTSUB/m); -ok($o =~ /^Analysis completed \(1 warning\)/m); -ok($o =~ /^Looks good/m); - -$o = ppport(qw(--nochanges --quiet file1.xs)); -ok($o =~ /^\s*$/); - -$o = ppport(qw(--nochanges file2.xs)); -ok($o =~ /^Scanning.*file2\.xs/mi); -ok($o =~ /Analyzing.*file2\.xs/mi); -ok($o !~ /^Scanning.*file1\.xs/mi); -ok($o =~ /^Uses mXPUSHp/m); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Looks good/m); -ok($o =~ /^1 potentially required change detected/m); - -$o = ppport(qw(--nochanges --nohints file2.xs)); -ok($o =~ /^Scanning.*file2\.xs/mi); -ok($o =~ /Analyzing.*file2\.xs/mi); -ok($o !~ /^Scanning.*file1\.xs/mi); -ok($o =~ /^Uses mXPUSHp/m); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Looks good/m); -ok($o =~ /^1 potentially required change detected/m); - -$o = ppport(qw(--nochanges --nohints --nodiag file2.xs)); -ok($o =~ /^Scanning.*file2\.xs/mi); -ok($o =~ /Analyzing.*file2\.xs/mi); -ok($o !~ /^Scanning.*file1\.xs/mi); -ok($o !~ /^Uses mXPUSHp/m); -ok($o !~ /^Needs to include.*ppport\.h/m); -ok($o !~ /^Looks good/m); -ok($o =~ /^1 potentially required change detected/m); - -$o = ppport(qw(--nochanges --quiet file2.xs)); -ok($o =~ /^\s*$/); - ----------------------------- file1.xs ----------------------------------------- - -#define NEED_newCONSTSUB -#define NEED_sv_2pv_flags -#define NEED_PL_parser -#include "ppport.h" - -newCONSTSUB(); -SvPV_nolen(); -PL_expect = 0; - ----------------------------- file2.xs ----------------------------------------- - -mXPUSHp(foo); - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /^Scanning.*FooBar\.xs/mi); -ok($o =~ /Analyzing.*FooBar\.xs/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok($o !~ /^Looks good/m); -ok($o =~ /^Uses grok_bin/m); - ----------------------------- FooBar.xs ---------------------------------------- - -newSViv(); -XPUSHs(foo); -grok_bin(); - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /^Scanning.*First\.xs/mi); -ok($o =~ /Analyzing.*First\.xs/mi); -ok($o =~ /^Scanning.*second\.h/mi); -ok($o =~ /Analyzing.*second\.h/mi); -ok($o =~ /^Scanning.*sub.*third\.c/mi); -ok($o =~ /Analyzing.*sub.*third\.c/mi); -ok($o !~ /^Scanning.*foobar/mi); -ok(matches($o, '^Scanning', 'm'), 3); - ----------------------------- First.xs ----------------------------------------- - -one - ----------------------------- foobar.xyz --------------------------------------- - -two - ----------------------------- second.h ----------------------------------------- - -three - ----------------------------- sub/third.c -------------------------------------- - -four - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i); - ----------------------------- test.xs ------------------------------------------ - -#define NEED_foobar - -=============================================================================== - -# And now some complex "real-world" example - -my $o = ppport(qw(--copy=f)); -for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) { - ok($o =~ /^Scanning.*\Q$_\E/mi); - ok($o =~ /Analyzing.*\Q$_\E/i); -} -ok(matches($o, '^Scanning', 'm'), 6); - -ok(matches($o, '^Writing copy of', 'm'), 5); -ok(!-e "mod5.cf"); - -for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) { - ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); - ok(-e "${_}f"); - ok(eq_files("${_}f", "${_}r")); - unlink "${_}f"; -} - ----------------------------- main.xs ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_newCONSTSUB -#define NEED_grok_hex_GLOBAL -#include "ppport.h" - -newCONSTSUB(); -grok_hex(); -Perl_grok_bin(aTHX_ foo, bar); - -/* some comment */ - -perl_eval_pv(); -grok_bin(); -Perl_grok_bin(bar, sv_no); - ----------------------------- mod1.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_grok_bin_GLOBAL -#define NEED_newCONSTSUB -#include "ppport.h" - -newCONSTSUB(); -grok_bin(); -{ - Perl_croak ("foo"); - Perl_sv_catpvf(); /* I know it's wrong ;-) */ -} - ----------------------------- mod2.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_eval_pv -#include "ppport.h" - -newSViv(); - -/* - eval_pv(); -*/ - ----------------------------- mod3.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -grok_oct(); -eval_pv(); - ----------------------------- mod4.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -START_MY_CXT; - ----------------------------- mod5.c ------------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include "ppport.h" -call_pv(); - ----------------------------- main.xsr ----------------------------------------- - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_eval_pv_GLOBAL -#define NEED_grok_hex -#define NEED_newCONSTSUB_GLOBAL -#include "ppport.h" - -newCONSTSUB(); -grok_hex(); -grok_bin(foo, bar); - -/* some comment */ - -eval_pv(); -grok_bin(); -grok_bin(bar, PL_sv_no); - ----------------------------- mod1.cr ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define NEED_grok_bin_GLOBAL -#include "ppport.h" - -newCONSTSUB(); -grok_bin(); -{ - Perl_croak (aTHX_ "foo"); - Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */ -} - ----------------------------- mod2.cr ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - - -newSViv(); - -/* - eval_pv(); -*/ - ----------------------------- mod3.cr ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#define NEED_grok_oct -#include "ppport.h" - -grok_oct(); -eval_pv(); - ----------------------------- mod4.cr ------------------------------------------ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include "ppport.h" - -START_MY_CXT; - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /Uses grok_hex/m); -ok($o !~ /Looks good/m); - -$o = ppport(qw(--nochanges --compat-version=5.8.0)); -ok($o !~ /Uses grok_hex/m); -ok($o =~ /Looks good/m); - ----------------------------- FooBar.xs ---------------------------------------- - -grok_hex(); - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); - -$o = ppport(qw(--nochanges --compat-version=5.5.3)); -ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); - -$o = ppport(qw(--nochanges --compat-version=5.005_03)); -ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); - -$o = ppport(qw(--nochanges --compat-version=5.6.0)); -ok($o !~ /Uses SvPVutf8_force/m); - -$o = ppport(qw(--nochanges --compat-version=5.006)); -ok($o !~ /Uses SvPVutf8_force/m); - -$o = ppport(qw(--nochanges --compat-version=5.999.999)); -ok($o !~ /Uses SvPVutf8_force/m); - -$o = ppport(qw(--nochanges --compat-version=6.0.0)); -ok($o =~ /Only Perl 5 is supported/m); - -$o = ppport(qw(--nochanges --compat-version=5.1000.999)); -ok($o =~ /Invalid version number: 5.1000.999/m); - -$o = ppport(qw(--nochanges --compat-version=5.999.1000)); -ok($o =~ /Invalid version number: 5.999.1000/m); - ----------------------------- FooBar.xs ---------------------------------------- - -SvPVutf8_force(); - -=============================================================================== - -my $o = ppport(qw(--nochanges)); -ok($o !~ /potentially required change/); -ok(matches($o, '^Looks good', 'm'), 2); - ----------------------------- FooBar.xs ---------------------------------------- - -#define NEED_grok_numeric_radix -#define NEED_grok_number -#include "ppport.h" - -GROK_NUMERIC_RADIX(); -grok_number(); - ----------------------------- foo.c -------------------------------------------- - -#include "ppport.h" - -call_pv(); - -=============================================================================== - -# check --api-info option - -my $o = ppport(qw(--api-info=INT2PTR)); -my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; -ok(scalar keys %found, 1); -ok(exists $found{INT2PTR}); -ok(matches($o, '^Supported at least starting from perl-5\.6\.0\.', 'm'), 1); -ok(matches($o, '^Support by .*ppport.* provided back to perl-5\.003\.', 'm'), 1); - -$o = ppport(qw(--api-info=Zero)); -%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; -ok(scalar keys %found, 1); -ok(exists $found{Zero}); -ok(matches($o, '^No portability information available\.', 'm'), 1); - -$o = ppport(qw(--api-info=/Zero/)); -%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; -ok(scalar keys %found, 2); -ok(exists $found{Zero}); -ok(exists $found{ZeroD}); - -=============================================================================== - -# check --list-provided option - -my @o = ppport(qw(--list-provided)); -my %p; -my $fail = 0; -for (@o) { - my($name, $flags) = /^(\w+)(?:\s+\[(\w+(?:,\s+\w+)*)\])?$/ or $fail++; - exists $p{$name} and $fail++; - $p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : ''; -} -ok(@o > 100); -ok($fail, 0); - -ok(exists $p{call_pv}); -ok(not ref $p{call_pv}); - -ok(exists $p{grok_bin}); -ok(ref $p{grok_bin}, 'HASH'); -ok(scalar keys %{$p{grok_bin}}, 2); -ok($p{grok_bin}{explicit}); -ok($p{grok_bin}{depend}); - -ok(exists $p{gv_stashpvn}); -ok(ref $p{gv_stashpvn}, 'HASH'); -ok(scalar keys %{$p{gv_stashpvn}}, 2); -ok($p{gv_stashpvn}{depend}); -ok($p{gv_stashpvn}{hint}); - -ok(exists $p{sv_catpvf_mg}); -ok(ref $p{sv_catpvf_mg}, 'HASH'); -ok(scalar keys %{$p{sv_catpvf_mg}}, 2); -ok($p{sv_catpvf_mg}{explicit}); -ok($p{sv_catpvf_mg}{depend}); - -ok(exists $p{PL_signals}); -ok(ref $p{PL_signals}, 'HASH'); -ok(scalar keys %{$p{PL_signals}}, 1); -ok($p{PL_signals}{explicit}); - -=============================================================================== - -# check --list-unsupported option - -my @o = ppport(qw(--list-unsupported)); -my %p; -my $fail = 0; -for (@o) { - my($name, $ver) = /^(\w+)\s*\.+\s*([\d._]+)$/ or $fail++; - exists $p{$name} and $fail++; - $p{$name} = $ver; -} -ok(@o > 100); -ok($fail, 0); - -ok(exists $p{utf8_distance}); -ok($p{utf8_distance}, '5.6.0'); - -ok(exists $p{save_generic_svref}); -ok($p{save_generic_svref}, '5.005_03'); - -=============================================================================== - -# check --nofilter option - -my $o = ppport(qw(--nochanges)); -ok($o =~ /^Scanning.*foo\.cpp/mi); -ok($o =~ /Analyzing.*foo\.cpp/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok(matches($o, 'Analyzing', 'm'), 1); - -$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL)); -ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m); -ok(matches($o, '^\|\s+foo\.o', 'mi'), 1); -ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1); -ok($o =~ /^Scanning.*foo\.cpp/mi); -ok($o =~ /Analyzing.*foo\.cpp/mi); -ok(matches($o, '^Scanning', 'm'), 1); -ok(matches($o, 'Analyzing', 'm'), 1); - -$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL)); -ok($o =~ /^Scanning.*foo\.cpp/mi); -ok($o =~ /Analyzing.*foo\.cpp/mi); -ok($o =~ /^Scanning.*foo\.o/mi); -ok($o =~ /Analyzing.*foo\.o/mi); -ok($o =~ /^Scanning.*Makefile/mi); -ok($o =~ /Analyzing.*Makefile/mi); -ok(matches($o, '^Scanning', 'm'), 3); -ok(matches($o, 'Analyzing', 'm'), 3); - ----------------------------- foo.cpp ------------------------------------------ - -newSViv(); - ----------------------------- foo.o -------------------------------------------- - -newSViv(); - ----------------------------- Makefile.PL -------------------------------------- - -newSViv(); - -=============================================================================== - -# check if explicit variables are handled propery - -my $o = ppport(qw(--copy=a)); -ok($o =~ /^Needs to include.*ppport\.h/m); -ok($o =~ /^Uses PL_signals/m); -ok($o =~ /^File needs PL_signals, adding static request/m); -ok(eq_files('MyExt.xsa', 'MyExt.ra')); - -unlink qw(MyExt.xsa); - ----------------------------- MyExt.xs ----------------------------------------- - -PL_signals = 123; -if (PL_signals == 42) - foo(); - ----------------------------- MyExt.ra ----------------------------------------- - -#define NEED_PL_signals -#include "ppport.h" -PL_signals = 123; -if (PL_signals == 42) - foo(); - -=============================================================================== - -my $o = ppport(qw(--nochanges file.xs)); -ok($o =~ /^Uses PL_copline/m); -ok($o =~ /WARNING: PL_copline/m); -ok($o =~ /^Uses SvUOK/m); -ok($o =~ /WARNING: Uses SvUOK, which may not be portable/m); -ok($o =~ /^Analysis completed \(2 warnings\)/m); -ok($o =~ /^Looks good/m); - -$o = ppport(qw(--nochanges --compat-version=5.8.0 file.xs)); -ok($o =~ /^Uses PL_copline/m); -ok($o =~ /WARNING: PL_copline/m); -ok($o !~ /WARNING: Uses SvUOK, which may not be portable/m); -ok($o =~ /^Analysis completed \(1 warning\)/m); -ok($o =~ /^Looks good/m); - ----------------------------- file.xs ----------------------------------------- - -#define NEED_PL_parser -#include "ppport.h" -SvUOK -PL_copline - -=============================================================================== - -my $o = ppport(qw(--copy=f)); - -for (qw(file.xs)) { - ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); - ok(-e "${_}f"); - ok(eq_files("${_}f", "${_}r")); - unlink "${_}f"; -} - ----------------------------- file.xs ----------------------------------------- - -a_string = "sv_undef" -a_char = 'sv_yes' -#define SOMETHING defgv -/* C-comment: sv_tainted */ -# -# This is just a big XS comment using sv_no -# -/* The following, is NOT an XS comment! */ -# define SOMETHING_ELSE defgv + \ - sv_undef - ----------------------------- file.xsr ----------------------------------------- - -#include "ppport.h" -a_string = "sv_undef" -a_char = 'sv_yes' -#define SOMETHING PL_defgv -/* C-comment: sv_tainted */ -# -# This is just a big XS comment using sv_no -# -/* The following, is NOT an XS comment! */ -# define SOMETHING_ELSE PL_defgv + \ - PL_sv_undef - -=============================================================================== - -my $o = ppport(qw(--copy=f)); - -for (qw(file.xs)) { - ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); - ok(-e "${_}f"); - ok(eq_files("${_}f", "${_}r")); - unlink "${_}f"; -} - ----------------------------- file.xs ----------------------------------------- - -#define NEED_sv_2pv_flags -#define NEED_vnewSVpvf -#define NEED_warner -#include "ppport.h" -Perl_croak_nocontext("foo"); -Perl_croak("bar"); -croak("foo"); -croak_nocontext("foo"); -Perl_warner_nocontext("foo"); -Perl_warner("foo"); -warner_nocontext("foo"); -warner("foo"); - ----------------------------- file.xsr ----------------------------------------- - -#define NEED_sv_2pv_flags -#define NEED_vnewSVpvf -#define NEED_warner -#include "ppport.h" -Perl_croak_nocontext("foo"); -Perl_croak(aTHX_ "bar"); -croak("foo"); -croak_nocontext("foo"); -Perl_warner_nocontext("foo"); -Perl_warner(aTHX_ "foo"); -warner_nocontext("foo"); -warner("foo"); - diff --git a/ext/Devel/PPPort/t/pv_tools.t b/ext/Devel/PPPort/t/pv_tools.t deleted file mode 100644 index 65164b0d87..0000000000 --- a/ext/Devel/PPPort/t/pv_tools.t +++ /dev/null @@ -1,74 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/pv_tools instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (13) { - load(); - plan(tests => 13); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my $uni = &Devel::PPPort::pv_escape_can_unicode(); - -# sanity check -ok($uni ? $] >= 5.006 : $] < 5.008); - -my @r; - -@r = &Devel::PPPort::pv_pretty(); -ok($r[0], $r[1]); -ok($r[0], "foobarbaz"); -ok($r[2], $r[3]); -ok($r[2], ''); -ok($r[4], $r[5]); -ok($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303'); -ok($r[6], $r[7]); -ok($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...'); - -@r = &Devel::PPPort::pv_display(); -ok($r[0], $r[1]); -ok($r[0], '"foob\0rbaz"\0'); -ok($r[2], $r[3]); -ok($r[2] eq '"pv_di"...\0' || - $r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :( - diff --git a/ext/Devel/PPPort/t/pvs.t b/ext/Devel/PPPort/t/pvs.t deleted file mode 100644 index 4cfcb0fe83..0000000000 --- a/ext/Devel/PPPort/t/pvs.t +++ /dev/null @@ -1,68 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/pvs instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (8) { - load(); - plan(tests => 8); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my $x = 'foo'; - -ok(Devel::PPPort::newSVpvs(), "newSVpvs"); -ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); - -Devel::PPPort::sv_catpvs($x); -ok($x, "foosv_catpvs"); - -Devel::PPPort::sv_setpvs($x); -ok($x, "sv_setpvs"); - -my %h = ('hv_fetchs' => 42); -Devel::PPPort::hv_stores(\%h, 4711); -ok(scalar keys %h, 2); -ok(exists $h{'hv_stores'}); -ok($h{'hv_stores'}, 4711); -ok(Devel::PPPort::hv_fetchs(\%h), 42); - diff --git a/ext/Devel/PPPort/t/shared_pv.t b/ext/Devel/PPPort/t/shared_pv.t deleted file mode 100644 index 3e7ed54fc7..0000000000 --- a/ext/Devel/PPPort/t/shared_pv.t +++ /dev/null @@ -1,52 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/shared_pv instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (1) { - load(); - plan(tests => 1); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(&Devel::PPPort::newSVpvn_share(), 6); - diff --git a/ext/Devel/PPPort/t/snprintf.t b/ext/Devel/PPPort/t/snprintf.t deleted file mode 100644 index f9b4a8828d..0000000000 --- a/ext/Devel/PPPort/t/snprintf.t +++ /dev/null @@ -1,54 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/snprintf instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (2) { - load(); - plan(tests => 2); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my($l, $s) = Devel::PPPort::my_snprintf(); -ok($l, 8); -ok($s, "foobar42"); - diff --git a/ext/Devel/PPPort/t/sprintf.t b/ext/Devel/PPPort/t/sprintf.t deleted file mode 100644 index 5e3f3124d8..0000000000 --- a/ext/Devel/PPPort/t/sprintf.t +++ /dev/null @@ -1,54 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/sprintf instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (2) { - load(); - plan(tests => 2); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my($l, $s) = Devel::PPPort::my_sprintf(); -ok($l, 8); -ok($s, "foobar42"); - diff --git a/ext/Devel/PPPort/t/strlfuncs.t b/ext/Devel/PPPort/t/strlfuncs.t deleted file mode 100644 index d058944229..0000000000 --- a/ext/Devel/PPPort/t/strlfuncs.t +++ /dev/null @@ -1,65 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/strlfuncs instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (13) { - load(); - plan(tests => 13); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -my @e = (3, 'foo', - 6, 'foobar', - 9, 'foobarb', - 10, '1234567', - 4, '1234', - 16, '1234567', - ); -my @r = Devel::PPPort::my_strlfunc(); - -ok(@e == @r); - -for (0 .. $#e) { - ok($r[$_], $e[$_]); -} - diff --git a/ext/Devel/PPPort/t/sv_xpvf.t b/ext/Devel/PPPort/t/sv_xpvf.t deleted file mode 100644 index 1aada0a591..0000000000 --- a/ext/Devel/PPPort/t/sv_xpvf.t +++ /dev/null @@ -1,78 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/sv_xpvf instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (9) { - load(); - plan(tests => 9); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -use Tie::Hash; -my %h; -tie %h, 'Tie::StdHash'; -$h{foo} = 'foo-'; -$h{bar} = ''; - -ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d'); -ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d'); -ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d'); - -&Devel::PPPort::sv_catpvf_mg($h{foo}); -ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-'); - -&Devel::PPPort::Perl_sv_catpvf_mg($h{foo}); -ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-'); - -&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo}); -ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-'); - -&Devel::PPPort::sv_setpvf_mg($h{bar}); -ok($h{bar}, $] >= 5.004 ? 'mhx-42' : ''); - -&Devel::PPPort::Perl_sv_setpvf_mg($h{bar}); -ok($h{bar}, $] >= 5.004 ? 'foo-43' : ''); - -&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar}); -ok($h{bar}, $] >= 5.004 ? 'bar-44' : ''); - diff --git a/ext/Devel/PPPort/t/testutil.pl b/ext/Devel/PPPort/t/testutil.pl deleted file mode 100644 index 4fc7d667a6..0000000000 --- a/ext/Devel/PPPort/t/testutil.pl +++ /dev/null @@ -1,48 +0,0 @@ -{ - my $__ntest; - my $__total; - - sub plan { - @_ == 2 or die "usage: plan(tests => count)"; - my $what = shift; - $what eq 'tests' or die "cannot plan anything but tests"; - $__total = shift; - defined $__total && $__total > 0 or die "need a positive number of tests"; - print "1..$__total\n"; - } - - sub skip { - my $reason = shift; - ++$__ntest; - print "ok $__ntest # skip: $reason\n" - } - - sub ok ($;$$) { - local($\,$,); - my $ok = 0; - my $result = shift; - if (@_ == 0) { - $ok = $result; - } else { - $expected = shift; - if (!defined $expected) { - $ok = !defined $result; - } elsif (!defined $result) { - $ok = 0; - } elsif (ref($expected) eq 'Regexp') { - die "using regular expression objects is not backwards compatible"; - } else { - $ok = $result eq $expected; - } - } - ++$__ntest; - if ($ok) { - print "ok $__ntest\n" - } - else { - print "not ok $__ntest\n" - } - } -} - -1; diff --git a/ext/Devel/PPPort/t/threads.t b/ext/Devel/PPPort/t/threads.t deleted file mode 100644 index ccfb863418..0000000000 --- a/ext/Devel/PPPort/t/threads.t +++ /dev/null @@ -1,54 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/threads instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (2) { - load(); - plan(tests => 2); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(&Devel::PPPort::no_THX_arg("42"), 43); -eval { &Devel::PPPort::with_THX_arg("yes\n"); }; -ok($@ =~ /^yes/); - diff --git a/ext/Devel/PPPort/t/uv.t b/ext/Devel/PPPort/t/uv.t deleted file mode 100644 index 1ebeff9d23..0000000000 --- a/ext/Devel/PPPort/t/uv.t +++ /dev/null @@ -1,61 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/uv instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (10) { - load(); - plan(tests => 10); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(&Devel::PPPort::sv_setuv(42), 42); -ok(&Devel::PPPort::newSVuv(123), 123); -ok(&Devel::PPPort::sv_2uv("4711"), 4711); -ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559); -ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559); -ok(&Devel::PPPort::SvUVx(1735928559), 1735928559); -ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef); -ok(&Devel::PPPort::XSRETURN_UV(), 42); -ok(&Devel::PPPort::PUSHu(), 42); -ok(&Devel::PPPort::XPUSHu(), 43); - diff --git a/ext/Devel/PPPort/t/variables.t b/ext/Devel/PPPort/t/variables.t deleted file mode 100644 index 58d690e621..0000000000 --- a/ext/Devel/PPPort/t/variables.t +++ /dev/null @@ -1,107 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/variables instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (49) { - load(); - plan(tests => 49); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -ok(Devel::PPPort::compare_PL_signals()); - -ok(!defined(&Devel::PPPort::PL_sv_undef())); -ok(&Devel::PPPort::PL_sv_yes()); -ok(!&Devel::PPPort::PL_sv_no()); -ok(&Devel::PPPort::PL_na("abcd"), 4); -ok(&Devel::PPPort::PL_Sv(), "mhx"); -ok(defined &Devel::PPPort::PL_tokenbuf()); -ok($] >= 5.009005 || &Devel::PPPort::PL_parser()); -ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/); -ok(defined &Devel::PPPort::PL_hints()); -ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX"); - -for (&Devel::PPPort::other_variables()) { - ok($_ != 0); -} - -{ - my @w; - my $fail = 0; - { - local $SIG{'__WARN__'} = sub { push @w, @_ }; - ok(&Devel::PPPort::dummy_parser_warning()); - } - if ($] >= 5.009005) { - ok(@w >= 0); - for (@w) { - print "# $_"; - unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) { - warn $_; - $fail++; - } - } - } - else { - ok(@w == 0); - } - ok($fail, 0); -} - -ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0)); - -eval { &Devel::PPPort::no_dummy_parser_vars(0) }; - -if ($] < 5.009005) { - ok($@, ''); -} -else { - if ($@) { - print "# $@"; - ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i); - } - else { - ok(1); - } -} - diff --git a/ext/Devel/PPPort/t/warn.t b/ext/Devel/PPPort/t/warn.t deleted file mode 100644 index fcd8ab3694..0000000000 --- a/ext/Devel/PPPort/t/warn.t +++ /dev/null @@ -1,78 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! !!!!! -# -# Edit mktests.PL and/or parts/inc/warn instead. -# -# This file was automatically generated from the definition files in the -# parts/inc/ subdirectory by mktests.PL. To learn more about how all this -# works, please read the F file that came with this distribution. -# -################################################################################ - -BEGIN { - if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext'; - require Config; import Config; - use vars '%Config'; - if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { - print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; - exit 0; - } - } - else { - unshift @INC, 't'; - } - - sub load { - eval "use Test"; - require 'testutil.pl' if $@; - } - - if (5) { - load(); - plan(tests => 5); - } -} - -use Devel::PPPort; -use strict; -$^W = 1; - -package Devel::PPPort; -use vars '@ISA'; -require DynaLoader; -@ISA = qw(DynaLoader); -bootstrap Devel::PPPort; - -package main; - -$^W = 0; - -my $warning; - -$SIG{'__WARN__'} = sub { $warning = $_[0] }; - -$warning = ''; -Devel::PPPort::warner(); -ok($] >= 5.004 ? $warning =~ /^warner bar:42/ : $warning eq ''); - -$warning = ''; -Devel::PPPort::Perl_warner(); -ok($] >= 5.004 ? $warning =~ /^Perl_warner bar:42/ : $warning eq ''); - -$warning = ''; -Devel::PPPort::Perl_warner_nocontext(); -ok($] >= 5.004 ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq ''); - -$warning = ''; -Devel::PPPort::ckWARN(); -ok($warning, ''); - -$^W = 1; - -$warning = ''; -Devel::PPPort::ckWARN(); -ok($] >= 5.004 ? $warning =~ /^ckWARN bar:42/ : $warning eq ''); - diff --git a/ext/Devel/PPPort/typemap b/ext/Devel/PPPort/typemap deleted file mode 100644 index f2118a8166..0000000000 --- a/ext/Devel/PPPort/typemap +++ /dev/null @@ -1,35 +0,0 @@ -################################################################################ -# -# typemap -- XS type mappings not present in early perls -# -################################################################################ -# -# $Revision: 8 $ -# $Author: mhx $ -# $Date: 2009/01/18 14:10:48 +0100 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -UV T_UV -NV T_NV - -INPUT -T_UV - $var = ($type)SvUV($arg) -T_NV - $var = ($type)SvNV($arg) - -OUTPUT -T_UV - sv_setuv($arg, (UV)$var); -T_NV - sv_setnv($arg, (NV)$var); diff --git a/mkppport b/mkppport index be41fde353..4636d3e563 100644 --- a/mkppport +++ b/mkppport @@ -56,7 +56,7 @@ unshift @INC, File::Spec->catdir($absroot, 'lib'); # Change to Devel::PPPort directory, as it needs the stuff # from the parts/ directory -chdir File::Spec->catdir($rootdir, 'ext', 'Devel', 'PPPort'); +chdir File::Spec->catdir($rootdir, 'ext', 'Devel-PPPort'); # Capture and remove temporary files my @unlink; @@ -134,7 +134,7 @@ sub readlist #---------------------------------------------- sub run { - my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 3, 'lib'), @_); + my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 2, 'lib'), @_); my $run = $perl =~ m/\s/ ? qq("$perl") : $perl; for (@args) { $_ = qq("$_") if $^O eq 'VMS' && /^[^"]/; -- cgit v1.2.1