Report for Devel-Cover-0.87
Back
From: metabase:user:d2c9f356-b46f-11df-9a90-20a83c0b7757
Subject: FAIL Devel-Cover-0.87 v5.14.2 SunOS/Solaris
Date: 2012-05-22T09:19:21Z
This distribution has been tested as part of the CPAN Testers
project, supporting the Perl programming language. See
http://wiki.cpantesters.org/ for more information or email
questions to cpan-testers-discuss@perl.org
--
Dear Paul Johnson,
This is a computer-generated report for Devel-Cover-0.87
on perl 5.14.2, created by CPAN-Reporter-1.2006.
Thank you for uploading your work to CPAN. However, there was a problem
testing your distribution.
If you think this report is invalid, please consult the CPAN Testers Wiki
for suggestions on how to avoid getting FAIL reports for missing library
or binary dependencies, unsupported operating systems, and so on:
http://wiki.cpantesters.org/wiki/CPANAuthorNotes
Sections of this report:
* Tester comments
* Program output
* Prerequisites
* Environment and other context
------------------------------
TESTER COMMENTS
------------------------------
Additional comments from tester:
this report is from an automated smoke testing program
and was not reviewed by a human for accuracy
------------------------------
PROGRAM OUTPUT
------------------------------
Output from '/usr/local/bin/make test':
PERL_DL_NONLAZY=1 /export/home/cpant2/perl5/bin/perl5.14.2 "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*/*.t
t/e2e/aalias.t .............. ok
t/e2e/aalias1.t ............. ok
t/e2e/abranch_return_sub.t .. ok
t/e2e/acond_and.t ........... ok
t/e2e/acond_branch.t ........ ok
t/e2e/acond_or.t ............ ok
t/e2e/acond_xor.t ........... ok
t/e2e/acop.t ................ ok
t/e2e/adefault_param.t ...... ok
t/e2e/adeparse.t ............ ok
t/e2e/adestroy.t ............ ok
t/e2e/adynamic_subs.t ....... ok
t/e2e/aeval1.t .............. ok
t/e2e/aeval2.t .............. ok
t/e2e/aeval3.t .............. ok
t/e2e/aeval_nested.t ........ ok
t/e2e/aexec.t ............... ok
t/e2e/aexec_die.t ........... ok
t/e2e/afork.t ............... ok
t/e2e/aif.t ................. ok
t/e2e/ainc_sub.t ............ ok
t/e2e/amodule1.t ............ ok
t/e2e/amodule2.t ............ ok
t/e2e/amodule_ignore.t ...... ok
t/e2e/amodule_import.t ...... ok
t/e2e/amodule_relative.t .... ok
t/e2e/amoose_basic.t ........ ok
t/e2e/aoverload_bool.t ...... ok
t/e2e/aoverloaded.t ......... ok
t/e2e/apod.t ................ ok
t/e2e/apod_nocp.t ........... ok
t/e2e/arequire.t ............ ok
t/e2e/askip.t ............... ok
t/e2e/asort.t ............... ok
t/e2e/aspecial_blocks.t ..... ok
t/e2e/astatement.t .......... ok
t/e2e/asubs_only.t .......... ok
t/e2e/at0.t ................. ok
t/e2e/at1.t ................. ok
# Test 1 got:
+------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+------+-----------------------------------------------------------------------------------+
| Elt|Got | Elt|Expected |
+------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+------+-----------------------------------------------------------------------------------+
| 3|'- ------ ------ ------ ------ ------\n' | 3|'- ------ ------ ------ ------ ------\n' |
| 4|'File stmt bran cond sub total\n' | 4|'File stmt bran cond sub total\n' |
| 5|'- ------ ------ ------ ------ ------\n' | 5|'- ------ ------ ------ ------ ------\n' |
* 6|'...home/cpant2/perl5/lib/5.14.2/B/Debug.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 7|'...me/cpant2/perl5/lib/5.14.2/B/Deparse.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 8|'.../cpant2/perl5/lib/5.14.2/Digest/base.pm 0.0 0.0 n/a 0.0 0.0\n' * | |
* 9|'...ome/cpant2/perl5/lib/5.14.2/Exporter.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 10|'...ant2/perl5/lib/5.14.2/Exporter/Heavy.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 11|'...pant2/perl5/lib/5.14.2/File/Basename.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 12|'...me/cpant2/perl5/lib/5.14.2/File/Find.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 13|'...me/cpant2/perl5/lib/5.14.2/File/Path.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 14|'...ome/cpant2/perl5/lib/5.14.2/Pod/Find.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 15|'...t2/perl5/lib/5.14.2/Pod/InputObjects.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 16|'...e/cpant2/perl5/lib/5.14.2/Pod/Parser.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 17|'...rt/home/cpant2/perl5/lib/5.14.2/base.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 18|'...rt/home/cpant2/perl5/lib/5.14.2/blib.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 19|'...ome/cpant2/perl5/lib/5.14.2/constant.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 20|'...home/cpant2/perl5/lib/5.14.2/feature.pm 0.0 0.0 n/a 0.0 0.0\n' * | |
* 21|'...rl5/lib/5.14.2/i86pc-solaris-64int/B.pm 2.4 0.0 0.0 4.3 1.9\n' * | |
* 22|'...ib/5.14.2/i86pc-solaris-64int/Config.pm 0.0 0.0 n/a 0.0 0.0\n' * | |
* 23|'...5/lib/5.14.2/i86pc-solaris-64int/Cwd.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 24|'....14.2/i86pc-solaris-64int/DynaLoader.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 25|'...lib/5.14.2/i86pc-solaris-64int/Errno.pm 47.8 12.5 n/a 44.4 40.0\n' * | |
* 26|'...lib/5.14.2/i86pc-solaris-64int/Fcntl.pm 100.0 n/a n/a 100.0 100.0\n' * | |
* 27|'...5.14.2/i86pc-solaris-64int/File/Glob.pm 0.0 0.0 n/a 0.0 0.0\n' * | |
* 28|'...2/i86pc-solaris-64int/File/Spec/Unix.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 29|'...14.2/i86pc-solaris-64int/Scalar/Util.pm 0.0 0.0 n/a 0.0 0.0\n' * | |
* 30|'....14.2/i86pc-solaris-64int/attributes.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 31|'...l5/lib/5.14.2/i86pc-solaris-64int/re.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 32|'...ome/cpant2/perl5/lib/5.14.2/overload.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 33|'.../home/cpant2/perl5/lib/5.14.2/strict.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 34|'...rt/home/cpant2/perl5/lib/5.14.2/vars.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 35|'...ome/cpant2/perl5/lib/5.14.2/warnings.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 36|'...2/perl5/lib/5.14.2/warnings/register.pm 0.0 n/a n/a 0.0 0.0\n' * | |
* 37|'...ant2/perl5/lib/site_perl/5.14.2/Carp.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 38|'...5/lib/site_perl/5.14.2/Devel/Symdump.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 39|'...ant2/perl5/lib/site_perl/5.14.2/JSON.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 40|'...l5/lib/site_perl/5.14.2/Pod/Coverage.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
* 41|'...erl/5.14.2/Pod/Coverage/CountParents.pm 0.0 0.0 n/a 0.0 0.0\n' * | |
* 42|'...l5/lib/site_perl/5.14.2/common/sense.pm 0.0 n/a n/a 0.0 0.0\n' * | |
* 43|'...l/5.14.2/i86pc-solaris-64int/JSON/XS.pm 0.0 n/a n/a 0.0 0.0\n' * | |
* 44|'.../5.14.2/i86pc-solaris-64int/XSLoader.pm 0.0 0.0 0.0 0.0 0.0\n' * | |
| 45|'tests/t2 93.8 50.0 n/a 100.0 84.0\n' | 6|'tests/t2 93.8 50.0 n/a 100.0 84.0\n' |
* 46|'Total 0.6 0.1 0.0 1.1 0.4\n' * 7|'Total 93.8 50.0 n/a 100.0 84.0\n' *
| 47|'- ------ ------ ------ ------ ------\n' | 8|'- ------ ------ ------ ------ ------\n' |
| 48|'\n' | 9|'\n' |
| 49|'\n' | 10|'\n' |
+------+---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+------+-----------------------------------------------------------------------------------+
| 53|'Start: \n' | 14|'Start: \n' |
| 54|'Finish: \n' | 15|'Finish: \n' |
| 55|'\n' | 16|'\n' |
* 56|'/export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm\n' * | |
* 57|'\n' * | |
* 58|'line err stmt bran cond sub code\n' * | |
* 59|'1 package B::Debug;\n' * | |
* 60|'2 \n' * | |
* 61|'3 our $VERSION = \'1.17\';\n' * | |
* 62|'4 \n' * | |
* 63|'5 use strict;\n' * | |
* 64|'6 require 5.006;\n' * | |
* 65|'7 use B qw(peekop class walkoptree walkoptree_exec\n' * | |
* 66|'8 main_start main_root cstring sv_undef SVf_NOK SVf_IOK);\n' * | |
* 67|'9 use Config;\n' * | |
* 68|'10 my (@optype, @specialsv_name);\n' * | |
* 69|'11 require B;\n' * | |
* 70|'12 if ($] < 5.009) {\n' * | |
* 71|'13 require B::Asmdata;\n' * | |
* 72|'14 B::Asmdata->import (qw(@optype @specialsv_name));\n' * | |
* 73|'15 } else {\n' * | |
* 74|'16 B->import (qw(@optype @specialsv_name));\n' * | |
* 75|'17 }\n' * | |
* 76|'18 \n' * | |
* 77|'19 if ($] < 5.006002) {\n' * | |
* 78|'20 eval q|sub B::GV::SAFENAME {\n' * | |
* 79|'21 my $name = (shift())->NAME;\n' * | |
* 80|'22 # The regex below corresponds to the isCONTROLVAR macro from toke.c\n' * | |
* 81|'23 $name =~ s/^([\\cA-\\cZ\\c\\\\c[\\c]\\c?\\c_\\c^])/"^".chr(64 ^ ord($1))/e;\n' * | |
* 82|'24 return $name;\n' * | |
* 83|'25 }|;\n' * | |
* 84|'26 }\n' * | |
* 85|'27 \n' * | |
* 86|'28 my ($have_B_Flags, $have_B_Flags_extra);\n' * | |
* 87|'29 if (!$ENV{PERL_CORE}){ # avoid CORE test crashes\n' * | |
* 88|'30 eval { require B::Flags and $have_B_Flags++ };\n' * | |
* 89|'31 $have_B_Flags_extra++ if $have_B_Flags and $B::Flags::VERSION gt \'0.03\';\n' * | |
* 90|'32 }\n' * | |
* 91|'33 my %done_gv;\n' * | |
* 92|'34 \n' * | |
* 93|'35 sub _printop {\n' * | |
* 94|'36 *** 0 0 my $op = shift;\n' * | |
* 95|'37 *** 0 0 my $addr = ${$op} ? $op->ppaddr : \'\';\n' * | |
* 96|' *** 0 \n' * | |
* 97|'38 *** 0 0 $addr =~ s/^PL_ppaddr// if $addr;\n' * | |
* 98|'39 *** 0 0 return sprintf "0x%08x %6s %s", ${$op}, ${$op} ? class($op) : \'\', $addr;\n' * | |
* 99|' *** 0 \n' * | |
* 100|' *** 0 \n' * | |
* 101|'40 }\n' * | |
* 102|'41 \n' * | |
* 103|'42 sub B::OP::debug {\n' * | |
* 104|'43 *** 0 0 my ($op) = @_;\n' * | |
* 105|'44 *** 0 printf <<\'EOT\', class($op), $$op, _printop($op), _printop($op->next), _printop($op->sibling), $op->targ, $op->type, $op->name;\n' * | |
* 106|'45 %s (0x%lx)\n' * | |
* 107|'46 op_ppaddr %s\n' * | |
* 108|'47 op_next %s\n' * | |
* 109|'48 op_sibling %s\n' * | |
* 110|'49 op_targ %d\n' * | |
* 111|'50 op_type %d %s\n' * | |
* 112|'51 EOT\n' * | |
* 113|'52 *** 0 0 if ($] > 5.009) {\n' * | |
* 114|'53 *** 0 printf <<\'EOT\', $op->opt;\n' * | |
* 115|'54 op_opt %d\n' * | |
* 116|'55 EOT\n' * | |
* 117|'56 } else {\n' * | |
* 118|'57 *** 0 printf <<\'EOT\', $op->seq;\n' * | |
* 119|'58 op_seq %d\n' * | |
* 120|'59 EOT\n' * | |
* 121|'60 }\n' * | |
* 122|'61 *** 0 0 if ($have_B_Flags) {\n' * | |
* 123|'62 *** 0 printf <<\'EOT\', $op->flags, $op->flagspv, $op->private, $op->privatepv;\n' * | |
* 124|'63 op_flags %d %s\n' * | |
* 125|'64 op_private %d %s\n' * | |
* 126|'65 EOT\n' * | |
* 127|'66 } else {\n' * | |
* 128|'67 *** 0 printf <<\'EOT\', $op->flags, $op->private;\n' * | |
* 129|'68 op_flags %d\n' * | |
* 130|'69 op_private %d\n' * | |
* 131|'70 EOT\n' * | |
* 132|'71 }\n' * | |
* 133|'72 }\n' * | |
* 134|'73 \n' * | |
* 135|'74 sub B::UNOP::debug {\n' * | |
* 136|'75 *** 0 0 my ($op) = @_;\n' * | |
* 137|'76 *** 0 $op->B::OP::debug();\n' * | |
* 138|'77 *** 0 printf "\\top_first\\t%s\\n", _printop($op->first);\n' * | |
* 139|'78 }\n' * | |
* 140|'79 \n' * | |
* 141|'80 sub B::BINOP::debug {\n' * | |
* 142|'81 *** 0 0 my ($op) = @_;\n' * | |
* 143|'82 *** 0 $op->B::UNOP::debug();\n' * | |
* 144|'83 *** 0 printf "\\top_last \\t%s\\n", _printop($op->last);\n' * | |
* 145|'84 }\n' * | |
* 146|'85 \n' * | |
* 147|'86 sub B::LOOP::debug {\n' * | |
* 148|'87 *** 0 0 my ($op) = @_;\n' * | |
* 149|'88 *** 0 $op->B::BINOP::debug();\n' * | |
* 150|'89 *** 0 printf <<\'EOT\', _printop($op->redoop), _printop($op->nextop), _printop($op->lastop);\n' * | |
* 151|'90 op_redoop %s\n' * | |
* 152|'91 op_nextop %s\n' * | |
* 153|'92 op_lastop %s\n' * | |
* 154|'93 EOT\n' * | |
* 155|'94 }\n' * | |
* 156|'95 \n' * | |
* 157|'96 sub B::LOGOP::debug {\n' * | |
* 158|'97 *** 0 0 my ($op) = @_;\n' * | |
* 159|'98 *** 0 $op->B::UNOP::debug();\n' * | |
* 160|'99 *** 0 printf "\\top_other\\t%s\\n", _printop($op->other);\n' * | |
* 161|'100 }\n' * | |
* 162|'101 \n' * | |
* 163|'102 sub B::LISTOP::debug {\n' * | |
* 164|'103 *** 0 0 my ($op) = @_;\n' * | |
* 165|'104 *** 0 $op->B::BINOP::debug();\n' * | |
* 166|'105 *** 0 printf "\\top_children\\t%d\\n", $op->children;\n' * | |
* 167|'106 }\n' * | |
* 168|'107 \n' * | |
* 169|'108 sub B::PMOP::debug {\n' * | |
* 170|'109 *** 0 0 my ($op) = @_;\n' * | |
* 171|'110 *** 0 $op->B::LISTOP::debug();\n' * | |
* 172|'111 *** 0 0 printf "\\top_pmreplroot\\t0x%x\\n", $] < 5.008 ? ${$op->pmreplroot} : $op->pmreplroot;\n' * | |
* 173|' *** 0 \n' * | |
* 174|'112 *** 0 printf "\\top_pmreplstart\\t0x%x\\n", ${$op->pmreplstart};\n' * | |
* 175|' *** 0 \n' * | |
* 176|'113 *** 0 0 printf "\\top_pmnext\\t0x%x\\n", ${$op->pmnext} if $] < 5.009005;\n' * | |
* 177|' *** 0 \n' * | |
* 178|'114 *** 0 0 if ($Config{\'useithreads\'}) {\n' * | |
* 179|'115 *** 0 printf "\\top_pmstashpv\\t%s\\n", cstring($op->pmstashpv);\n' * | |
* 180|'116 *** 0 printf "\\top_pmoffset\\t%d\\n", $op->pmoffset;\n' * | |
* 181|'117 } else {\n' * | |
* 182|'118 *** 0 printf "\\top_pmstash\\t%s\\n", cstring($op->pmstash);\n' * | |
* 183|'119 }\n' * | |
* 184|'120 *** 0 printf "\\top_precomp\\t%s\\n", cstring($op->precomp);\n' * | |
* 185|'121 *** 0 printf "\\top_pmflags\\t0x%x\\n", $op->pmflags;\n' * | |
* 186|'122 *** 0 0 printf "\\top_reflags\\t0x%x\\n", $op->reflags if $] >= 5.009;\n' * | |
* 187|'123 *** 0 0 printf "\\top_pmpermflags\\t0x%x\\n", $op->pmpermflags if $] < 5.009;\n' * | |
* 188|'124 *** 0 0 printf "\\top_pmdynflags\\t0x%x\\n", $op->pmdynflags if $] < 5.009;\n' * | |
* 189|'125 *** 0 0 $op->pmreplroot->debug if $] < 5.008;\n' * | |
* 190|'126 }\n' * | |
* 191|'127 \n' * | |
* 192|'128 sub B::COP::debug {\n' * | |
* 193|'129 *** 0 0 my ($op) = @_;\n' * | |
* 194|'130 *** 0 $op->B::OP::debug();\n' * | |
* 195|'131 *** 0 0 my $warnings = ref $op->warnings ? ${$op->warnings} : 0;\n' * | |
* 196|' *** 0 \n' * | |
* 197|'132 *** 0 printf <<\'EOT\', $op->label, $op->stashpv, $op->file, $op->cop_seq, $op->arybase, $op->line, $warnings;\n' * | |
* 198|'133 cop_label "%s"\n' * | |
* 199|'134 cop_stashpv "%s"\n' * | |
* 200|'135 cop_file "%s"\n' * | |
* 201|'136 cop_seq %d\n' * | |
* 202|'137 cop_arybase %d\n' * | |
* 203|'138 cop_line %d\n' * | |
* 204|'139 cop_warnings 0x%x\n' * | |
* 205|'140 EOT\n' * | |
* 206|'141 *** 0 0 0 if ($] > 5.008 and $] < 5.011) {\n' * | |
* 207|'142 *** 0 0 my $cop_io = class($op->io) eq \'SPECIAL\' ? \'\' : $op->io->as_string;\n' * | |
* 208|'143 *** 0 printf(" cop_io %s\\n", cstring($cop_io));\n' * | |
* 209|'144 }\n' * | |
* 210|'145 }\n' * | |
* 211|'146 \n' * | |
* 212|'147 sub B::SVOP::debug {\n' * | |
* 213|'148 *** 0 0 my ($op) = @_;\n' * | |
* 214|'149 *** 0 $op->B::OP::debug();\n' * | |
* 215|'150 *** 0 printf "\\top_sv\\t\\t0x%x\\n", ${$op->sv};\n' * | |
* 216|' *** 0 \n' * | |
* 217|'151 *** 0 $op->sv->debug;\n' * | |
* 218|'152 }\n' * | |
* 219|'153 \n' * | |
* 220|'154 sub B::PVOP::debug {\n' * | |
* 221|'155 *** 0 0 my ($op) = @_;\n' * | |
* 222|'156 *** 0 $op->B::OP::debug();\n' * | |
* 223|'157 *** 0 printf "\\top_pv\\t\\t%s\\n", cstring($op->pv);\n' * | |
* 224|'158 }\n' * | |
* 225|'159 \n' * | |
* 226|'160 sub B::PADOP::debug {\n' * | |
* 227|'161 *** 0 0 my ($op) = @_;\n' * | |
* 228|'162 *** 0 $op->B::OP::debug();\n' * | |
* 229|'163 *** 0 printf "\\top_padix\\t%ld\\n", $op->padix;\n' * | |
* 230|'164 }\n' * | |
* 231|'165 \n' * | |
* 232|'166 sub B::NULL::debug {\n' * | |
* 233|'167 *** 0 0 my ($sv) = @_;\n' * | |
* 234|'168 *** 0 0 if ($$sv == ${sv_undef()}) {\n' * | |
* 235|' *** 0 \n' * | |
* 236|'169 *** 0 print "&sv_undef\\n";\n' * | |
* 237|'170 } else {\n' * | |
* 238|'171 *** 0 printf "NULL (0x%x)\\n", $$sv;\n' * | |
* 239|'172 }\n' * | |
* 240|'173 }\n' * | |
* 241|'174 \n' * | |
* 242|'175 sub B::SV::debug {\n' * | |
* 243|'176 *** 0 0 my ($sv) = @_;\n' * | |
* 244|'177 *** 0 0 if (!$$sv) {\n' * | |
* 245|'178 *** 0 print class($sv), " = NULL\\n";\n' * | |
* 246|'179 *** 0 return;\n' * | |
* 247|'180 }\n' * | |
* 248|'181 *** 0 printf <<\'EOT\', class($sv), $$sv, $sv->REFCNT;\n' * | |
* 249|'182 %s (0x%x)\n' * | |
* 250|'183 REFCNT %d\n' * | |
* 251|'184 FLAGS 0x%x\n' * | |
* 252|'185 EOT\n' * | |
* 253|'186 *** 0 printf "\\tFLAGS\\t\\t0x%x", $sv->FLAGS;\n' * | |
* 254|'187 *** 0 0 if ($have_B_Flags) {\n' * | |
* 255|'188 *** 0 0 printf "\\t%s", $have_B_Flags_extra ? $sv->flagspv(0) : $sv->flagspv;\n' * | |
* 256|'189 }\n' * | |
* 257|'190 *** 0 print "\\n";\n' * | |
* 258|'191 }\n' * | |
* 259|'192 \n' * | |
* 260|'193 sub B::RV::debug {\n' * | |
* 261|'194 *** 0 0 my ($rv) = @_;\n' * | |
* 262|'195 *** 0 B::SV::debug($rv);\n' * | |
* 263|'196 *** 0 printf <<\'EOT\', ${$rv->RV};\n' * | |
* 264|'197 RV 0x%x\n' * | |
* 265|'198 *** 0 EOT\n' * | |
* 266|'199 *** 0 $rv->RV->debug;\n' * | |
* 267|'200 }\n' * | |
* 268|'201 \n' * | |
* 269|'202 sub B::PV::debug {\n' * | |
* 270|'203 *** 0 0 my ($sv) = @_;\n' * | |
* 271|'204 *** 0 $sv->B::SV::debug();\n' * | |
* 272|'205 *** 0 my $pv = $sv->PV();\n' * | |
* 273|'206 *** 0 printf <<\'EOT\', cstring($pv), length($pv);\n' * | |
* 274|'207 xpv_pv %s\n' * | |
* 275|'208 xpv_cur %d\n' * | |
* 276|'209 EOT\n' * | |
* 277|'210 }\n' * | |
* 278|'211 \n' * | |
* 279|'212 sub B::IV::debug {\n' * | |
* 280|'213 *** 0 0 my ($sv) = @_;\n' * | |
* 281|'214 *** 0 $sv->B::SV::debug();\n' * | |
* 282|'215 *** 0 0 printf "\\txiv_iv\\t\\t%d\\n", $sv->IV if $sv->FLAGS & SVf_IOK;\n' * | |
* 283|'216 }\n' * | |
* 284|'217 \n' * | |
* 285|'218 sub B::NV::debug {\n' * | |
* 286|'219 *** 0 0 my ($sv) = @_;\n' * | |
* 287|'220 *** 0 $sv->B::IV::debug();\n' * | |
* 288|'221 *** 0 0 printf "\\txnv_nv\\t\\t%s\\n", $sv->NV if $sv->FLAGS & SVf_NOK;\n' * | |
* 289|'222 }\n' * | |
* 290|'223 \n' * | |
* 291|'224 sub B::PVIV::debug {\n' * | |
* 292|'225 *** 0 0 my ($sv) = @_;\n' * | |
* 293|'226 *** 0 $sv->B::PV::debug();\n' * | |
* 294|'227 *** 0 0 printf "\\txiv_iv\\t\\t%d\\n", $sv->IV if $sv->FLAGS & SVf_IOK;\n' * | |
* 295|'228 }\n' * | |
* 296|'229 \n' * | |
* 297|'230 sub B::PVNV::debug {\n' * | |
* 298|'231 *** 0 0 my ($sv) = @_;\n' * | |
* 299|'232 *** 0 $sv->B::PVIV::debug();\n' * | |
* 300|'233 *** 0 0 printf "\\txnv_nv\\t\\t%s\\n", $sv->NV if $sv->FLAGS & SVf_NOK;\n' * | |
* 301|'234 }\n' * | |
* 302|'235 \n' * | |
* 303|'236 sub B::PVLV::debug {\n' * | |
* 304|'237 *** 0 0 my ($sv) = @_;\n' * | |
* 305|'238 *** 0 $sv->B::PVNV::debug();\n' * | |
* 306|'239 *** 0 printf "\\txlv_targoff\\t%d\\n", $sv->TARGOFF;\n' * | |
* 307|'240 *** 0 printf "\\txlv_targlen\\t%u\\n", $sv->TARGLEN;\n' * | |
* 308|'241 *** 0 printf "\\txlv_type\\t%s\\n", cstring(chr($sv->TYPE));\n' * | |
* 309|'242 }\n' * | |
* 310|'243 \n' * | |
* 311|'244 sub B::BM::debug {\n' * | |
* 312|'245 *** 0 0 my ($sv) = @_;\n' * | |
* 313|'246 *** 0 $sv->B::PVNV::debug();\n' * | |
* 314|'247 *** 0 printf "\\txbm_useful\\t%d\\n", $sv->USEFUL;\n' * | |
* 315|'248 *** 0 printf "\\txbm_previous\\t%u\\n", $sv->PREVIOUS;\n' * | |
* 316|'249 *** 0 printf "\\txbm_rare\\t%s\\n", cstring(chr($sv->RARE));\n' * | |
* 317|'250 }\n' * | |
* 318|'251 \n' * | |
* 319|'252 sub B::CV::debug {\n' * | |
* 320|'253 *** 0 0 my ($sv) = @_;\n' * | |
* 321|'254 *** 0 $sv->B::PVNV::debug();\n' * | |
* 322|'255 *** 0 my ($stash) = $sv->STASH;\n' * | |
* 323|'256 *** 0 my ($start) = $sv->START;\n' * | |
* 324|'257 *** 0 my ($root) = $sv->ROOT;\n' * | |
* 325|'258 *** 0 my ($padlist) = $sv->PADLIST;\n' * | |
* 326|'259 *** 0 my ($file) = $sv->FILE;\n' * | |
* 327|'260 *** 0 my ($gv) = $sv->GV;\n' * | |
* 328|'261 *** 0 printf <<\'EOT\', $$stash, $$start, $$root, $$gv, $file, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};\n' * | |
* 329|'262 STASH 0x%x\n' * | |
* 330|'263 START 0x%x\n' * | |
* 331|'264 ROOT 0x%x\n' * | |
* 332|'265 GV 0x%x\n' * | |
* 333|'266 FILE %s\n' * | |
* 334|'267 DEPTH %d\n' * | |
* 335|'268 PADLIST 0x%x\n' * | |
* 336|'269 OUTSIDE 0x%x\n' * | |
* 337|'270 *** 0 EOT\n' * | |
* 338|'271 *** 0 0 printf("\\tOUTSIDE_SEQ\\t%d\\n", , $sv->OUTSIDE_SEQ) if $] > 5.007;\n' * | |
* 339|'272 *** 0 0 if ($have_B_Flags) {\n' * | |
* 340|'273 *** 0 0 my $SVt_PVCV = $] < 5.010 ? 12 : 13;\n' * | |
* 341|'274 *** 0 0 printf("\\tCvFLAGS\\t0x%x\\t%s\\n", $sv->CvFLAGS,\n' * | |
* 342|'275 $have_B_Flags_extra ? $sv->flagspv($SVt_PVCV) : $sv->flagspv);\n' * | |
* 343|'276 } else {\n' * | |
* 344|'277 *** 0 printf("\\tCvFLAGS\\t0x%x\\n", $sv->CvFLAGS);\n' * | |
* 345|'278 }\n' * | |
* 346|'279 *** 0 0 $start->debug if $start;\n' * | |
* 347|'280 *** 0 0 $root->debug if $root;\n' * | |
* 348|'281 *** 0 0 $gv->debug if $gv;\n' * | |
* 349|'282 *** 0 0 $padlist->debug if $padlist;\n' * | |
* 350|'283 }\n' * | |
* 351|'284 \n' * | |
* 352|'285 sub B::AV::debug {\n' * | |
* 353|'286 *** 0 0 my ($av) = @_;\n' * | |
* 354|'287 *** 0 $av->B::SV::debug;\n' * | |
* 355|'288 # tied arrays may leave out FETCHSIZE\n' * | |
* 356|'289 *** 0 my (@array) = eval { $av->ARRAY; };\n' * | |
* 357|' *** 0 \n' * | |
* 358|'290 *** 0 print "\\tARRAY\\t\\t(", join(", ", map("0x" . $$_, @array)), ")\\n";\n' * | |
* 359|'291 *** 0 my $fill = eval { scalar(@array) };\n' * | |
* 360|' *** 0 \n' * | |
* 361|'292 *** 0 0 if ($Config{\'useithreads\'}) {\n' * | |
* 362|'293 *** 0 printf <<\'EOT\', $fill, $av->MAX, $av->OFF;\n' * | |
* 363|'294 FILL %d\n' * | |
* 364|'295 MAX %d\n' * | |
* 365|'296 OFF %d\n' * | |
* 366|'297 EOT\n' * | |
* 367|'298 } else {\n' * | |
* 368|'299 *** 0 printf <<\'EOT\', $fill, $av->MAX;\n' * | |
* 369|'300 FILL %d\n' * | |
* 370|'301 MAX %d\n' * | |
* 371|'302 EOT\n' * | |
* 372|'303 }\n' * | |
* 373|'304 *** 0 0 if ($] < 5.009) {\n' * | |
* 374|'305 *** 0 0 if ($have_B_Flags) {\n' * | |
* 375|'306 *** 0 0 printf("\\tAvFLAGS\\t0x%x\\t%s\\n", $av->AvFLAGS,\n' * | |
* 376|'307 $have_B_Flags_extra ? $av->flagspv(10) : $av->flagspv);\n' * | |
* 377|'308 } else {\n' * | |
* 378|'309 *** 0 printf("\\tAvFLAGS\\t0x%x\\n", $av->AvFLAGS);\n' * | |
* 379|'310 }\n' * | |
* 380|'311 }\n' * | |
* 381|'312 }\n' * | |
* 382|'313 \n' * | |
* 383|'314 sub B::GV::debug {\n' * | |
* 384|'315 *** 0 0 my ($gv) = @_;\n' * | |
* 385|'316 *** 0 0 if ($done_gv{$$gv}++) {\n' * | |
* 386|'317 *** 0 printf "GV %s::%s\\n", $gv->STASH->NAME, $gv->SAFENAME;\n' * | |
* 387|'318 *** 0 return;\n' * | |
* 388|'319 }\n' * | |
* 389|'320 *** 0 my $sv = $gv->SV;\n' * | |
* 390|'321 *** 0 my $av = $gv->AV;\n' * | |
* 391|'322 *** 0 my $cv = $gv->CV;\n' * | |
* 392|'323 *** 0 $gv->B::SV::debug;\n' * | |
* 393|'324 *** 0 printf <<\'EOT\', $gv->SAFENAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS;\n' * | |
* 394|'325 NAME %s\n' * | |
* 395|'326 STASH %s (0x%x)\n' * | |
* 396|'327 SV 0x%x\n' * | |
* 397|'328 GvREFCNT %d\n' * | |
* 398|'329 FORM 0x%x\n' * | |
* 399|'330 AV 0x%x\n' * | |
* 400|'331 HV 0x%x\n' * | |
* 401|'332 EGV 0x%x\n' * | |
* 402|'333 CV 0x%x\n' * | |
* 403|'334 CVGEN %d\n' * | |
* 404|'335 LINE %d\n' * | |
* 405|'336 FILE %s\n' * | |
* 406|'337 *** 0 EOT\n' * | |
* 407|' *** 0 \n' * | |
* 408|'338 *** 0 0 if ($have_B_Flags) {\n' * | |
* 409|'339 *** 0 0 my $SVt_PVGV = $] < 5.010 ? 13 : 9;\n' * | |
* 410|'340 *** 0 0 printf("\\tGvFLAGS\\t0x%x\\t%s\\n", $gv->GvFLAGS,\n' * | |
* 411|'341 $have_B_Flags_extra ? $gv->flagspv($SVt_PVGV) : $gv->flagspv);\n' * | |
* 412|'342 } else {\n' * | |
* 413|'343 *** 0 printf("\\tGvFLAGS\\t0x%x\\n", $gv->GvFLAGS);\n' * | |
* 414|'344 }\n' * | |
* 415|'345 *** 0 0 $sv->debug if $sv;\n' * | |
* 416|'346 *** 0 0 $av->debug if $av;\n' * | |
* 417|'347 *** 0 0 $cv->debug if $cv;\n' * | |
* 418|'348 }\n' * | |
* 419|'349 \n' * | |
* 420|'350 sub B::SPECIAL::debug {\n' * | |
* 421|'351 *** 0 0 my $sv = shift;\n' * | |
* 422|'352 *** 0 0 my $i = ref $sv ? $$sv : 0;\n' * | |
* 423|'353 *** 0 0 print exists $specialsv_name[$i] ? $specialsv_name[$i] : "", "\\n";\n' * | |
* 424|'354 }\n' * | |
* 425|'355 \n' * | |
* 426|'356 sub compile {\n' * | |
* 427|'357 *** 0 0 my $order = shift;\n' * | |
* 428|'358 *** 0 B::clearsym();\n' * | |
* 429|'359 *** 0 0 0 if ($order && $order eq "exec") {\n' * | |
* 430|'360 *** 0 0 return sub { walkoptree_exec(main_start, "debug") }\n' * | |
* 431|'361 *** 0 } else {\n' * | |
* 432|'362 *** 0 0 return sub { walkoptree(main_root, "debug") }\n' * | |
* 433|'363 *** 0 }\n' * | |
* 434|'364 }\n' * | |
* 435|'365 \n' * | |
* 436|'366 1;\n' * | |
* 437|'367 \n' * | |
* 438|'368 __END__\n' * | |
* 439|'\n' * | |
* 440|'\n' * | |
* 441|'Branches\n' * | |
* 442|'-\n' * | |
* 443|'\n' * | |
* 444|'line err % true false branch\n' * | |
* 445|'- --- ------ ------ ------ ------\n' * | |
* 446|'37 *** 0 0 0 ${$op;} ? :\n' * | |
* 447|'38 *** 0 0 0 if $addr\n' * | |
* 448|'39 *** 0 0 0 ${$op;} ? :\n' * | |
* 449|'52 *** 0 0 0 if ($] > 5.009) { }\n' * | |
* 450|'61 *** 0 0 0 if ($have_B_Flags) { }\n' * | |
* 451|'111 *** 0 0 0 $] < 5.008 ? :\n' * | |
* 452|'113 *** 0 0 0 if $] < 5.009005\n' * | |
* 453|'114 *** 0 0 0 if ($Config{\'useithreads\'}) { }\n' * | |
* 454|'122 *** 0 0 0 if $] >= 5.009\n' * | |
* 455|'123 *** 0 0 0 if $] < 5.009\n' * | |
* 456|'124 *** 0 0 0 if $] < 5.009\n' * | |
* 457|'125 *** 0 0 0 if $] < 5.008\n' * | |
* 458|'131 *** 0 0 0 ref $op->warnings ? :\n' * | |
* 459|'141 *** 0 0 0 if ($] > 5.008 and $] < 5.011)\n' * | |
* 460|'142 *** 0 0 0 class($op->io) eq \'SPECIAL\' ? :\n' * | |
* 461|'168 *** 0 0 0 if ($$sv == ${sv_undef();}) { }\n' * | |
* 462|'177 *** 0 0 0 unless ($$sv)\n' * | |
* 463|'187 *** 0 0 0 if ($have_B_Flags)\n' * | |
* 464|'188 *** 0 0 0 $have_B_Flags_extra ? :\n' * | |
* 465|'215 *** 0 0 0 if $sv->FLAGS & 256\n' * | |
* 466|'221 *** 0 0 0 if $sv->FLAGS & 512\n' * | |
* 467|'227 *** 0 0 0 if $sv->FLAGS & 256\n' * | |
* 468|'233 *** 0 0 0 if $sv->FLAGS & 512\n' * | |
* 469|'271 *** 0 0 0 if $] > 5.007\n' * | |
* 470|'272 *** 0 0 0 if ($have_B_Flags) { }\n' * | |
* 471|'273 *** 0 0 0 $] < 5.01 ? :\n' * | |
* 472|'274 *** 0 0 0 $have_B_Flags_extra ? :\n' * | |
* 473|'279 *** 0 0 0 if $start\n' * | |
* 474|'280 *** 0 0 0 if $root\n' * | |
* 475|'281 *** 0 0 0 if $gv\n' * | |
* 476|'282 *** 0 0 0 if $padlist\n' * | |
* 477|'292 *** 0 0 0 if ($Config{\'useithreads\'}) { }\n' * | |
* 478|'304 *** 0 0 0 if ($] < 5.009)\n' * | |
* 479|'305 *** 0 0 0 if ($have_B_Flags) { }\n' * | |
* 480|'306 *** 0 0 0 $have_B_Flags_extra ? :\n' * | |
* 481|'316 *** 0 0 0 if ($done_gv{$$gv}++)\n' * | |
* 482|'338 *** 0 0 0 if ($have_B_Flags) { }\n' * | |
* 483|'339 *** 0 0 0 $] < 5.01 ? :\n' * | |
* 484|'340 *** 0 0 0 $have_B_Flags_extra ? :\n' * | |
* 485|'345 *** 0 0 0 if $sv\n' * | |
* 486|'346 *** 0 0 0 if $av\n' * | |
* 487|'347 *** 0 0 0 if $cv\n' * | |
* 488|'352 *** 0 0 0 ref $sv ? :\n' * | |
* 489|'353 *** 0 0 0 exists $specialsv_name[$i] ? :\n' * | |
* 490|'359 *** 0 0 0 if ($order and $order eq \'exec\') { }\n' * | |
* 491|'\n' * | |
* 492|'\n' * | |
* 493|'Conditions\n' * | |
* 494|'-\n' * | |
* 495|'\n' * | |
* 496|'and 3 conditions\n' * | |
* 497|'\n' * | |
* 498|'line err % !l l&&!r l&&r expr\n' * | |
* 499|'- --- ------ ------ ------ ------ ----\n' * | |
* 500|'141 *** 0 0 0 0 $] > 5.008 and $] < 5.011\n' * | |
* 501|'359 *** 0 0 0 0 $order and $order eq \'exec\'\n' * | |
* 502|'\n' * | |
* 503|'\n' * | |
* 504|'Uncovered Subroutines\n' * | |
* 505|'-\n' * | |
* 506|'\n' * | |
* 507|'Subroutine Count Location \n' * | |
* 508|'- ----- ---------------------------------------------------\n' * | |
* 509|'__ANON__ 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:360\n' * | |
* 510|'__ANON__ 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:362\n' * | |
* 511|'_printop 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:36 \n' * | |
* 512|'compile 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:357\n' * | |
* 513|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:103\n' * | |
* 514|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:109\n' * | |
* 515|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:129\n' * | |
* 516|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:148\n' * | |
* 517|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:155\n' * | |
* 518|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:161\n' * | |
* 519|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:167\n' * | |
* 520|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:176\n' * | |
* 521|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:194\n' * | |
* 522|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:203\n' * | |
* 523|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:213\n' * | |
* 524|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:219\n' * | |
* 525|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:225\n' * | |
* 526|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:231\n' * | |
* 527|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:237\n' * | |
* 528|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:245\n' * | |
* 529|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:253\n' * | |
* 530|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:286\n' * | |
* 531|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:315\n' * | |
* 532|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:351\n' * | |
* 533|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:43 \n' * | |
* 534|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:75 \n' * | |
* 535|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:81 \n' * | |
* 536|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:87 \n' * | |
* 537|'debug 0 /export/home/cpant2/perl5/lib/5.14.2/B/Debug.pm:97 \n' * | |
* 538|'\n' * | |
* 539|'\n' * | |
* 540|'/export/home/cpant2/perl5/lib/5.14.2/B/Deparse.pm\n' * | |
* 541|'\n' * | |
* 542|'line err stmt bran cond sub code\n' * | |
* 543|'1 # B::Deparse.pm\n' * | |
* 544|'2 # \n' * | |
* 545|'3 # All rights reserved.\n' * | |
* 546|'4 # This module is free software; you can redistribute and/or modify\n' * | |
* 547|'5 # it under the same terms as Perl itself.\n' * | |
* 548|'6 \n' * | |
* 549|'7 # This is based on the module of the same name by Malcolm Beattie,\n' * | |
* 550|'8 # but essentially none of his code remains.\n' * | |
* 551|'9 \n' * | |
* 552|'10 package B::Deparse;\n' * | |
* 553|'11 use Carp;\n' * | |
* 554|'12 use B qw(class main_root main_start main_cv svref_2object opnumber perlstring\n' * | |
* 555|'13 OPf_WANT OPf_WANT_VOID OPf_WANT_SCALAR OPf_WANT_LIST\n' * | |
* 556|'14 OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL OPf_MOD\n' * | |
* 557|'15 OPpLVAL_INTRO OPpOUR_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE\n' * | |
* 558|'16 OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY\n' * | |
* 559|'17 OPpCONST_ARYBASE OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER\n' * | |
* 560|'18 OPpSORT_REVERSE\n' * | |
* 561|'19 SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG\n' * | |
* 562|'20 CVf_METHOD CVf_LVALUE\n' * | |
* 563|'21 PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE\n' * | |
* 564|'22 PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED),\n' * | |
* 565|'23 ($] < 5.008004 ? () : \'OPpSORT_INPLACE\'),\n' * | |
* 566|'24 ($] < 5.008006 ? () : qw(OPpSORT_DESCEND OPpITER_REVERSED)),\n' * | |
* 567|'25 ($] < 5.008009 ? () : qw(OPpCONST_NOVER OPpPAD_STATE)),\n' * | |
* 568|'26 ($] < 5.009 ? \'PMf_SKIPWHITE\' : qw(RXf_SKIPWHITE)),\n' * | |
* 569|'27 ($] < 5.011 ? \'CVf_LOCKED\' : \'OPpREVERSE_INPLACE\'),\n' * | |
* 570|'28 ($] < 5.013 ? () : \'PMf_NONDESTRUCT\');\n' * | |
* 571|'29 $VERSION = "1.04";\n' * | |
* 572|'30 use strict;\n' * | |
* 573|'31 use vars qw/$AUTOLOAD/;\n' * | |
* 574|'32 use warnings ();\n' * | |
* 575|'33 \n' * | |
* 576|'34 BEGIN {\n' * | |
* 577|'35 # Easiest way to keep this code portable between version looks to\n' * | |
* 578|'36 # be to fake up a dummy constant that will never actually be true.\n' * | |
* 579|'37 foreach (qw(OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED OPpCONST_NOVER\n' * | |
* 580|'38 OPpPAD_STATE RXf_SKIPWHITE CVf_LOCKED OPpREVERSE_INPLACE\n' * | |
* 581|'39 PMf_NONDESTRUCT)) {\n' * | |
* 582|'40 no strict \'refs\';\n' * | |
* 583|'41 *{$_} = sub () {0} unless *{$_}{CODE};\n' * | |
* 584|'42 }\n' * | |
* 585|'43 }\n' * | |
* 586|'44 \n' * | |
* 587|'45 # Changes between 0.50 and 0.51:\n' * | |
* 588|'46 # - fixed nulled leave with live enter in sort { }\n' * | |
* 589|'47 # - fixed reference constants (\\"str")\n' * | |
* 590|'48 # - handle empty programs gracefully\n' * | |
* 591|'49 # - handle infinite loops (for (;;) {}, while (1) {})\n' * | |
* 592|'50 # - differentiate between `for my $x ...\' and `my $x; for $x ...\'\n' * | |
* 593|'51 # - various minor cleanups\n' * | |
* 594|'52 # - moved globals into an object\n' * | |
* 595|'53 # - added `-u\', like B::C\n' * | |
* 596|'54 # - package declarations using cop_stash\n' * | |
* 597|'55 # - subs, formats and code sorted by cop_seq\n' * | |
* 598|'56 # Changes between 0.51 and 0.52:\n' * | |
* 599|'57 # - added pp_threadsv (special variables under USE_5005THREADS)\n' * | |
* 600|'58 # - added documentation\n' * | |
* 601|'59 # Changes between 0.52 and 0.53:\n' * | |
* 602|'60 # - many changes adding precedence contexts and associativity\n' * | |
* 603|'61 # - added `-p\' and `-s\' output style options\n' * | |
* 604|'62 # - various other minor fixes\n' * | |
* 605|'63 # Changes between 0.53 and 0.54:\n' * | |
* 606|'64 # - added support for new `for (1..100)\' optimization,\n' * | |
* 607|'65 # thanks to Gisle Aas\n' * | |
* 608|'66 # Changes between 0.54 and 0.55:\n' * | |
* 609|'67 # - added support for new qr// construct\n' * | |
* 610|'68 # - added support for new pp_regcreset OP\n' * | |
* 611|'69 # Changes between 0.55 and 0.56:\n' * | |
* 612|'70 # - tested on base/*.t, cmd/*.t, comp/*.t, io/*.t\n' * | |
* 613|'71 # - fixed $# on non-lexicals broken in last big rewrite\n' * | |
* 614|'72 # - added temporary fix for change in opcode of OP_STRINGIFY\n' * | |
* 615|'73 # - fixed problem in 0.54\'s for() patch in `for (@ary)\'\n' * | |
* 616|'74 # - fixed precedence in conditional of ?:\n' * | |
* 617|'75 # - tweaked list paren elimination in `my($x) = @_\'\n' * | |
* 618|'76 # - made continue-block detection trickier wrt. null ops\n' * | |
* 619|'77 # - fixed various prototype problems in pp_entersub\n' * | |
* 620|'78 # - added support for sub prototypes that never get GVs\n' * | |
* 621|'79 # - added unquoting for special filehandle first arg in truncate\n' * | |
* 622|'80 # - print doubled rv2gv (a bug) as `*{*GV}\' instead of illegal `**GV\'\n' * | |
* 623|'81 # - added semicolons at the ends of blocks\n' * | |
* 624|'82 # - added -l `#line\' declaration option -- fixes cmd/subval.t 27,28\n' * | |
* 625|'83 # Changes between 0.56 and 0.561:\n' * | |
* 626|'84 # - fixed multiply-declared my var in pp_truncate (thanks to Sarathy)\n' * | |
* 627|'85 # - used new B.pm symbolic constants (done by Nick Ing-Simmons)\n' * | |
* 628|'86 # Changes between 0.561 and 0.57:\n' * | |
* 629|'87 # - stylistic changes to symbolic constant stuff\n' * | |
* 630|'88 # - handled scope in s///e replacement code\n' * | |
* 631|'89 # - added unquote option for expanding "" into concats, etc.\n' * | |
* 632|'90 # - split method and proto parts of pp_entersub into separate functions\n' * | |
* 633|'91 # - various minor cleanups\n' * | |
* 634|'92 # Changes after 0.57:\n' * | |
* 635|'93 # - added parens in \\&foo (patch by Albert Dvornik)\n' * | |
* 636|'94 # Changes between 0.57 and 0.58:\n' * | |
* 637|'95 # - fixed `0\' statements that weren\'t being printed\n' * | |
* 638|'96 # - added methods for use from other programs\n' * | |
* 639|'97 # (based on patches from James Duncan and Hugo van der Sanden)\n' * | |
* 640|'98 # - added -si and -sT to control indenting (also based on a patch from Hugo)\n' * | |
* 641|'99 # - added -sv to print something else instead of \'???\'\n' * | |
* 642|'100 # - preliminary version of utf8 tr/// handling\n' * | |
* 643|'101 # Changes after 0.58:\n' * | |
* 644|'102 # - uses of $op->ppaddr changed to new $op->name (done by Sarathy)\n' * | |
* 645|'103 # - added support for Hugo\'s new OP_SETSTATE (like nextstate)\n' * | |
* 646|'104 # Changes between 0.58 and 0.59\n' * | |
* 647|'105 # - added support for Chip\'s OP_METHOD_NAMED\n' * | |
* 648|'106 # - added support for Ilya\'s OPpTARGET_MY optimization\n' * | |
* 649|'107 # - elided arrows before `()\' subscripts when possible\n' * | |
* 650|'108 # Changes between 0.59 and 0.60\n' * | |
* 651|'109 # - support for method attributes was added\n' * | |
* 652|'110 # - some warnings fixed\n' * | |
* 653|'111 # - separate recognition of constant subs\n' * | |
* 654|'112 # - rewrote continue block handling, now recognizing for loops\n' * | |
* 655|'113 # - added more control of expanding control structures\n' * | |
* 656|'114 # Changes between 0.60 and 0.61 (mostly by Robin Houston)\n' * | |
* 657|'115 # - many bug-fixes\n' * | |
* 658|'116 # - support for pragmas and \'use\'\n' * | |
* 659|'117 # - support for the little-used $[ variable\n' * | |
* 660|'118 # - support for __DATA__ sections\n' * | |
* 661|'119 # - UTF8 support\n' * | |
* 662|'120 # - BEGIN, CHECK, INIT and END blocks\n' * | |
* 663|'121 # - scoping of subroutine declarations fixed\n' * | |
* 664|'122 # - compile-time output from the input program can be suppressed, so that the\n' * | |
* 665|'123 # output is just the deparsed code. (a change to O.pm in fact)\n' * | |
* 666|'124 # - our() declarations\n' * | |
* 667|'125 # - *all* the known bugs are now listed in the BUGS section\n' * | |
* 668|'126 # - comprehensive test mechanism (TEST -deparse)\n' * | |
* 669|'127 # Changes between 0.62 and 0.63 (mostly by Rafael Garcia-Suarez)\n' * | |
* 670|'128 # - bug-fixes\n' * | |
* 671|'129 # - new switch -P\n' * | |
* 672|'130 # - support for command-line switches (-l, -0, etc.)\n' * | |
* 673|'131 # Changes between 0.63 and 0.64\n' * | |
* 674|'132 # - support for //, CHECK blocks, and assertions\n' * | |
* 675|'133 # - improved handling of foreach loops and lexicals\n' * | |
* 676|'134 # - option to use Data::Dumper for constants\n' * | |
* 677|'135 # - more bug fixes\n' * | |
* 678|'136 # - discovered lots more bugs not yet fixed\n' * | |
* 679|'137 #\n' * | |
* 680|'138 # ...\n' * | |
* 681|'139 #\n' * | |
* 682|'140 # Changes between 0.72 and 0.73\n' * | |
* 683|'141 # - support new switch constructs\n' * | |
* 684|'142 \n' * | |
* 685|'143 # Todo:\n' * | |
* 686|'144 # (See also BUGS section at the end of this file)\n' * | |
* 687|'145 #\n' * | |
* 688|'146 # - finish tr/// changes\n' * | |
* 689|'147 # - add option for even more parens (generalize \\&foo change)\n' * | |
* 690|'148 # - left/right context\n' * | |
* 691|'149 # - copy comments (look at real text with $^P?)\n' * | |
* 692|'150 # - avoid semis in one-statement blocks\n' * | |
* 693|'151 # - associativity of &&=, ||=, ?:\n' * | |
* 694|'152 # - \',\' => \'=>\' (auto-unquote?)\n' * | |
* 695|'153 # - break long lines ("\\r" as discretionary break?)\n' * | |
* 696|'154 # - configurable syntax highlighting: ANSI color, HTML, TeX, etc.\n' * | |
* 697|'155 # - more style options: brace style, hex vs. octal, quotes, ...\n' * | |
* 698|'156 # - print big ints as hex/octal instead of decimal (heuristic?)\n' * | |
* 699|'157 # - handle `my $x if 0\'?\n' * | |
* 700|'158 # - version using op_next instead of op_first/sibling?\n' * | |
* 701|'159 # - avoid string copies (pass arrays, one big join?)\n' * | |
* 702|'160 # - here-docs?\n' * | |
* 703|'161 \n' * | |
* 704|'162 # Current test.deparse failures\n' * | |
* 705|'163 # comp/hints 6 - location of BEGIN blocks wrt. block openings\n' * | |
* 706|'164 # run/switchI 1 - missing -I switches entirely\n' * | |
* 707|'165 # perl -Ifoo -e \'print @INC\'\n' * | |
* 708|'166 # op/caller 2 - warning mask propagates backwards before warnings::register\n' * | |
* 709|'167 # \'use warnings; BEGIN {${^WARNING_BITS} eq "U"x12;} use warnings::register\'\n' * | |
* 710|'168 # op/getpid 2 - can\'t assign to shared my() declaration (threads only)\n' * | |
* 711|'169 # \'my $x : shared = 5\'\n' * | |
* 712|'170 # op/override 7 - parens on overridden require change v-string interpretation\n' * | |
* 713|'171 # \'BEGIN{*CORE::GLOBAL::require=sub {}} require v5.6\'\n' * | |
* 714|'172 # c.f. \'BEGIN { *f = sub {0} }; f 2\'\n' * | |
* 715|'173 # op/pat 774 - losing Unicode-ness of Latin1-only strings\n' * | |
* 716|'174 # \'use charnames ":short"; $x="\\N{latin:a with acute}"\'\n' * | |
* 717|'175 # op/recurse 12 - missing parens on recursive call makes it look like method\n' * | |
* 718|'176 # \'sub f { f($x) }\'\n' * | |
* 719|'177 # op/subst 90 - inconsistent handling of utf8 under "use utf8"\n' * | |
* 720|'178 # op/taint 29 - "use re \'taint\'" deparsed in the wrong place wrt. block open\n' * | |
* 721|'179 # op/tiehandle compile - "use strict" deparsed in the wrong place\n' * | |
* 722|'180 # uni/tr_ several\n' * | |
* 723|'181 # ext/B/t/xref 11 - line numbers when we add newlines to one-line subs\n' * | |
* 724|'182 # ext/Data/Dumper/t/dumper compile\n' * | |
* 725|'183 # ext/DB_file/several\n' * | |
* 726|'184 # ext/Encode/several\n' * | |
* 727|'185 # ext/Ernno/Errno warnings\n' * | |
* 728|'186 # ext/IO/lib/IO/t/io_sel 23\n' * | |
* 729|'187 # ext/PerlIO/t/encoding compile\n' * | |
* 730|'188 # ext/POSIX/t/posix 6\n' * | |
* 731|'189 # ext/Socket/Socket 8\n' * | |
* 732|'190 # ext/Storable/t/croak compile\n' * | |
* 733|'191 # lib/Attribute/Handlers/t/multi compile\n' * | |
* 734|'192 # lib/bignum/ several\n' * | |
* 735|'193 # lib/charnames 35\n' * | |
* 736|'194 # lib/constant 32\n' * | |
* 737|'195 # lib/English 40\n' * | |
* 738|'196 # lib/ExtUtils/t/bytes 4\n' * | |
* 739|'197 # lib/File/DosGlob compile\n' * | |
* 740|'198 # lib/Filter/Simple/t/data 1\n' * | |
* 741|'199 # lib/Math/BigInt/t/constant 1\n' * | |
* 742|'200 # lib/Net/t/config Deparse-warning\n' * | |
* 743|'201 # lib/overload compile\n' * | |
* 744|'202 # lib/Switch/ several\n' * | |
* 745|'203 # lib/Symbol 4\n' * | |
* 746|'204 # lib/Test/Simple several\n' * | |
* 747|'205 # lib/Term/Complete\n' * | |
* 748|'206 # lib/Tie/File/t/29_downcopy 5\n' * | |
* 749|'207 # lib/vars 22\n' * | |
* 750|'208 \n' * | |
* 751|'209 # Object fields (were globals):\n' * | |
* 752|'210 #\n' * | |
* 753|'211 # avoid_local:\n' * | |
* 754|'212 # (local($a), local($b)) and local($a, $b) have the same internal\n' * | |
* 755|'213 # representation but the short form looks better. We notice we can\n' * | |
* 756|'214 # use a large-scale local when checking the list, but need to prevent\n' * | |
* 757|'215 # individual locals too. This hash holds the addresses of OPs that\n' * | |
* 758|'216 # have already had their local-ness accounted for. The same thing\n' * | |
* 759|'217 # is done with my().\n' * | |
* 760|'218 #\n' * | |
* 761|'219 # curcv:\n' * | |
* 762|'220 # CV for current sub (or main program) being deparsed\n' * | |
* 763|'221 #\n' * | |
* 764|'222 # curcvlex:\n' * | |
* 765|'223 # Cached hash of lexical variables for curcv: keys are names,\n' * | |
* 766|'224 # each value is an array of pairs, indicating the cop_seq of scopes\n' * | |
* 767|'225 # in which a var of that name is valid.\n' * | |
* 768|'226 #\n' * | |
* 769|'227 # curcop:\n' * | |
* 770|'228 # COP for statement being deparsed\n' * | |
* 771|'229 #\n' * | |
* 772|'230 # curstash:\n' * | |
* 773|'231 # name of the current package for deparsed code\n' * | |
* 774|'232 #\n' * | |
* 775|'233 # subs_todo:\n' * | |
* 776|'234 # array of [cop_seq, CV, is_format?] for subs and formats we still\n' * | |
* 777|'235 # want to deparse\n' * | |
* 778|'236 #\n' * | |
* 779|'237 # protos_todo:\n' * | |
* 780|'238 # as above, but [name, prototype] for subs that never got a GV\n' * | |
* 781|'239 #\n' * | |
* 782|'240 # subs_done, forms_done:\n' * | |
* 783|'241 # keys are addresses of GVs for subs and formats we\'ve already\n' * | |
* 784|'242 # deparsed (or at least put into subs_todo)\n' * | |
* 785|'243 #\n' * | |
* 786|'244 # subs_declared\n' * | |
* 787|'245 # keys are names of subs for which we\'ve printed declarations.\n' * | |
* 788|'246 # That means we can omit parentheses from the arguments.\n' * | |
* 789|'247 #\n' * | |
* 790|'248 # subs_deparsed\n' * | |
* 791|'249 # Keeps track of fully qualified names of all deparsed subs.\n' * | |
* 792|'250 #\n' * | |
* 793|'251 # parens: -p\n' * | |
* 794|'252 # linenums: -l\n' * | |
* 795|'253 # unquote: -q\n' * | |
* 796|'254 # cuddle: ` \' or `\\n\', depending on -sC\n' * | |
* 797|'255 # indent_size: -si\n' * | |
* 798|'256 # use_tabs: -sT\n' * | |
* 799|'257 # ex_const: -sv\n' * | |
* 800|'258 \n' * | |
* 801|'259 # A little explanation of how precedence contexts and associativity\n' * | |
* 802|'260 # work:\n' * | |
* 803|'261 #\n' * | |
* 804|'262 # deparse() calls each per-op subroutine with an argument $cx (short\n' * | |
* 805|'263 # for context, but not the same as the cx* in the perl core), which is\n' * | |
* 806|'264 # a number describing the op\'s parents in terms of precedence, whether\n' * | |
* 807|'265 # they\'re inside an expression or at statement level, etc. (see\n' * | |
* 808|'266 # chart below). When ops with children call deparse on them, they pass\n' * | |
* 809|'267 # along their precedence. Fractional values are used to implement\n' * | |
* 810|'268 # associativity (`($x + $y) + $z\' => `$x + $y + $y\') and related\n' * | |
* 811|'269 # parentheses hacks. The major disadvantage of this scheme is that\n' * | |
* 812|'270 # it doesn\'t know about right sides and left sides, so say if you\n' * | |
* 813|'271 # assign a listop to a variable, it can\'t tell it\'s allowed to leave\n' * | |
* 814|'272 # the parens off the listop.\n' * | |
* 815|'273 \n' * | |
* 816|'274 # Precedences:\n' * | |
* 817|'275 # 26 [TODO] inside interpolation context ("")\n' * | |
* 818|'276 # 25 left terms and list operators (leftward)\n' * | |
* 819|'277 # 24 left ->\n' * | |
* 820|'278 # 23 nonassoc ++ -\n' * | |
* 821|'279 # 22 right **\n' * | |
* 822|'280 # 21 right ! ~ \\ and unary + and -\n' * | |
* 823|'281 # 20 left =~ !~\n' * | |
* 824|'282 # 19 left * / % x\n' * | |
* 825|'283 # 18 left + - .\n' * | |
* 826|'284 # 17 left << >>\n' * | |
* 827|'285 # 16 nonassoc named unary operators\n' * | |
* 828|'286 # 15 nonassoc < > <= >= lt gt le ge\n' * | |
* 829|'287 # 14 nonassoc == != <=> eq ne cmp\n' * | |
* 830|'288 # 13 left &\n' * | |
* 831|'289 # 12 left | ^\n' * | |
* 832|'290 # 11 left &&\n' * | |
* 833|'291 # 10 left ||\n' * | |
* 834|'292 # 9 nonassoc .. ...\n' * | |
* 835|'293 # 8 right ?:\n' * | |
* 836|'294 # 7 right = += -= *= etc.\n' * | |
* 837|'295 # 6 left , =>\n' * | |
* 838|'296 # 5 nonassoc list operators (rightward)\n' * | |
* 839|'297 # 4 right not\n' * | |
* 840|'298 # 3 left and\n' * | |
* 841|'299 # 2 left or xor\n' * | |
* 842|'300 # 1 statement modifiers\n' * | |
* 843|'301 # 0.5 statements, but still print scopes as do { ... }\n' * | |
* 844|'302 # 0 statement level\n' * | |
* 845|'303 \n' * | |
* 846|'304 # Nonprinting characters with special meaning:\n' * | |
* 847|'305 # \\cS - steal parens (see maybe_parens_unop)\n' * | |
* 848|'306 # \\n - newline and indent\n' * | |
* 849|'307 # \\t - increase indent\n' * | |
* 850|'308 # \\b - decrease indent (`outdent\')\n' * | |
* 851|'309 # \\f - flush left (no indent)\n' * | |
* 852|'310 # \\cK - kill following semicolon, if any\n' * | |
* 853|'311 \n' * | |
* 854|'312 sub null {\n' * | |
* 855|'313 *** 0 0 my $op = shift;\n' * | |
* 856|'314 *** 0 return class($op) eq "NULL";\n' * | |
* 857|'315 }\n' * | |
* 858|'316 \n' * | |
* 859|'317 sub todo {\n' * | |
* 860|'318 *** 0 0 my $self = shift;\n' * | |
* 861|'319 *** 0 my($cv, $is_form) = @_;\n' * | |
* 862|'320 *** 0 0 0 return unless ($cv->FILE eq $0 || exists $self->{files}{$cv->FILE});\n' * | |
* 863|'321 *** 0 my $seq;\n' * | |
* 864|'322 *** 0 0 0 if ($cv->OUTSIDE_SEQ) {\n' * | |
* 865|' *** 0 \n' * | |
* 866|'323 *** 0 $seq = $cv->OUTSIDE_SEQ;\n' * | |
* 867|'324 } elsif (!null($cv->START) and is_state($cv->START)) {\n' * | |
* 868|'325 *** 0 $seq = $cv->START->cop_seq;\n' * | |
* 869|'326 } else {\n' * | |
* 870|'327 *** 0 $seq = 0;\n' * | |
* 871|'328 }\n' * | |
* 872|'329 *** 0 push @{$self->{\'subs_todo\'}}, [$seq, $cv, $is_form];\n' * | |
* 873|' *** 0 \n' * | |
* 874|'330 *** 0 0 0 unless ($is_form || class($cv->STASH) eq \'SPECIAL\') {\n' * | |
* 875|'331 *** 0 $self->{\'subs_deparsed\'}{$cv->STASH->NAME."::".$cv->GV->NAME} = 1;\n' * | |
* 876|'332 }\n' * | |
* 877|'333 }\n' * | |
* 878|'334 \n' * | |
* 879|'335 sub next_todo {\n' * | |
* 880|'336 *** 0 0 my $self = shift;\n' * | |
* 881|'337 *** 0 my $ent = shift @{$self->{\'subs_todo\'}};\n' * | |
* 882|' *** 0 \n' * | |
* 883|'338 *** 0 my $cv = $ent->[1];\n' * | |
* 884|'339 *** 0 my $gv = $cv->GV;\n' * | |
* 885|'340 *** 0 my $name = $self->gv_name($gv);\n' * | |
* 886|'341 *** 0 0 if ($ent->[2]) {\n' * | |
* 887|'342 *** 0 return "format $name =\\n"\n' * | |
* 888|'343 . $self->deparse_format($ent->[1]). "\\n";\n' * | |
* 889|'344 } else {\n' * | |
* 890|'345 *** 0 $self->{\'subs_declared\'}{$name} = 1;\n' * | |
* 891|'346 *** 0 0 if ($name eq "BEGIN") {\n' * | |
* 892|'347 *** 0 my $use_dec = $self->begin_is_use($cv);\n' * | |
* 893|'348 *** 0 0 0 if (defined ($use_dec) and $self->{\'expand\'} < 5) {\n' * | |
* 894|'349 *** 0 0 return () if 0 == length($use_dec);\n' * | |
* 895|'350 *** 0 return $use_dec;\n' * | |
* 896|'351 }\n' * | |
* 897|'352 }\n' * | |
* 898|'353 *** 0 my $l = \'\';\n' * | |
* 899|'354 *** 0 0 if ($self->{\'linenums\'}) {\n' * | |
* 900|'355 *** 0 my $line = $gv->LINE;\n' * | |
* 901|'356 *** 0 my $file = $gv->FILE;\n' * | |
* 902|'357 *** 0 $l = "\\n\\f#line $line \\"$file\\"\\n";\n' * | |
* 903|'358 }\n' * | |
* 904|'359 *** 0 my $p = \'\';\n' * | |
* 905|'360 *** 0 0 if (class($cv->STASH) ne "SPECIAL") {\n' * | |
* 906|'361 *** 0 my $stash = $cv->STASH->NAME;\n' * | |
* 907|'362 *** 0 0 if ($stash ne $self->{\'curstash\'}) {\n' * | |
* 908|'363 *** 0 $p = "package $stash;\\n";\n' * | |
* 909|'364 *** 0 0 $name = "$self->{\'curstash\'}::$name" unless $name =~ /::/;\n' * | |
* 910|'365 *** 0 $self->{\'curstash\'} = $stash;\n' * | |
* 911|'366 }\n' * | |
* 912|'367 *** 0 $name =~ s/^\\Q$stash\\E::(?!\\z|.*::)//;\n' * | |
* 913|'368 }\n' * | |
* 914|'369 *** 0 return "${p}${l}sub $name " . $self->deparse_sub($cv);\n' * | |
* 915|'370 }\n' * | |
* 916|'371 }\n' * | |
* 917|'372 \n' * | |
* 918|'373 # Return a "use" declaration for this BEGIN block, if appropriate\n' * | |
* 919|'374 sub begin_is_use {\n' * | |
* 920|'375 *** 0 0 my ($self, $cv) = @_;\n' * | |
* 921|'376 *** 0 my $root = $cv->ROOT;\n' * | |
* 922|'377 *** 0 local @$self{qw\'curcv curcvlex\'} = ($cv);\n' * | |
* 923|'378 #require B::Debug;\n' * | |
* 924|'379 #B::walkoptree($cv->ROOT, "debug");\n' * | |
* 925|'380 *** 0 my $lineseq = $root->first;\n' * | |
* 926|'381 *** 0 0 return if $lineseq->name ne "lineseq";\n' * | |
* 927|'382 \n' * | |
* 928|'383 *** 0 my $req_op = $lineseq->first->sibling;\n' * | |
* 929|'384 *** 0 0 return if $req_op->name ne "require";\n' * | |
* 930|'385 \n' * | |
* 931|'386 *** 0 my $module;\n' * | |
* 932|'387 *** 0 0 if ($req_op->first->private & OPpCONST_BARE) {\n' * | |
* 933|'388 # Actually it should always be a bareword\n' * | |
* 934|'389 *** 0 $module = $self->const_sv($req_op->first)->PV;\n' * | |
* 935|'390 *** 0 $module =~ s[/][::]g;\n' * | |
* 936|'391 *** 0 $module =~ s/.pm$//;\n' * | |
* 937|'392 }\n' * | |
* 938|'393 else {\n' * | |
* 939|'394 *** 0 $module = $self->const($self->const_sv($req_op->first), 6);\n' * | |
* 940|'395 }\n' * | |
* 941|'396 \n' * | |
* 942|'397 *** 0 my $version;\n' * | |
* 943|'398 *** 0 my $version_op = $req_op->sibling;\n' * | |
* 944|'399 *** 0 0 return if class($version_op) eq "NULL";\n' * | |
* 945|'400 *** 0 0 if ($version_op->name eq "lineseq") {\n' * | |
* 946|'401 # We have a version parameter; skip nextstate & pushmark\n' * | |
* 947|'402 *** 0 my $constop = $version_op->first->next->next;\n' * | |
* 948|'403 \n' * | |
* 949|'404 *** 0 0 return unless $self->const_sv($constop)->PV eq $module;\n' * | |
* 950|'405 *** 0 $constop = $constop->sibling;\n' * | |
* 951|'406 *** 0 $version = $self->const_sv($constop);\n' * | |
* 952|'407 *** 0 0 if (class($version) eq "IV") {\n' * | |
* 953|' *** 0 \n' * | |
* 954|' *** 0 \n' * | |
* 955|'408 *** 0 $version = $version->int_value;\n' * | |
* 956|'409 } elsif (class($version) eq "NV") {\n' * | |
* 957|'410 *** 0 $version = $version->NV;\n' * | |
* 958|'411 } elsif (class($version) ne "PVMG") {\n' * | |
* 959|'412 # Includes PVIV and PVNV\n' * | |
* 960|'413 *** 0 $version = $version->PV;\n' * | |
* 961|'414 } else {\n' * | |
* 962|'415 # version specified as a v-string\n' * | |
* 963|'416 *** 0 $version = \'v\'.join \'.\', map ord, split //, $version->PV;\n' * | |
* 964|'417 }\n' * | |
* 965|'418 *** 0 $constop = $constop->sibling;\n' * | |
* 966|'419 *** 0 0 return if $constop->name ne "method_named";\n' * | |
* 967|'420 *** 0 0 return if $self->const_sv($constop)->PV ne "VERSION";\n' * | |
* 968|'421 }\n' * | |
* 969|'422 \n' * | |
* 970|'423 *** 0 $lineseq = $version_op->sibling;\n' * | |
* 971|'424 *** 0 0 return if $lineseq->name ne "lineseq";\n' * | |
* 972|'425 *** 0 my $entersub = $lineseq->first->sibling;\n' * | |
* 973|'426 *** 0 0 if ($entersub->name eq "stub") {\n' * | |
* 974|'427 *** 0 0 return "use $module $version ();\\n" if defined $version;\n' * | |
* 975|'428 *** 0 return "use $module ();\\n";\n' * | |
* 976|'429 }\n' * | |
* 977|'430 *** 0 0 return if $entersub->name ne "entersub";\n' * | |
* 978|'431 \n' * | |
* 979|'432 # See if there are import arguments\n' * | |
* 980|'433 *** 0 my $args = \'\';\n' * | |
* 981|'434 \n' * | |
* 982|'435 *** 0 my $svop = $entersub->first->sibling; # Skip over pushmark\n' * | |
* 983|'436 *** 0 0 return unless $self->const_sv($svop)->PV eq $module;\n' * | |
* 984|'437 \n' * | |
* 985|'438 # Pull out the arguments\n' * | |
* 986|'439 *** 0 for ($svop=$svop->sibling; $svop->name ne "method_named";\n' * | |
* 987|'440 $svop = $svop->sibling) {\n' * | |
* 988|'441 *** 0 0 $args .= ", " if length($args);\n' * | |
* 989|'442 *** 0 $args .= $self->deparse($svop, 6);\n' * | |
* 990|'443 }\n' * | |
* 991|'444 \n' * | |
* 992|'445 *** 0 my $use = \'use\';\n' * | |
* 993|'446 *** 0 my $method_named = $svop;\n' * | |
* 994|'447 *** 0 0 return if $method_named->name ne "method_named";\n' * | |
* 995|'448 *** 0 my $method_name = $self->const_sv($method_named)->PV;\n' * | |
* 996|'449 \n' * | |
* 997|'450 *** 0 0 if ($method_name eq "unimport") {\n' * | |
* 998|'451 *** 0 $use = \'no\';\n' * | |
* 999|'452 }\n' * | |
* 1000|'453 \n' * | |
* 1001|'454 # Certain pragmas are dealt with using hint bits,\n' * | |
* 1002|'455 # so we ignore them here\n' * | |
* 1003|'456 *** 0 0 0 if ($module eq \'strict\' || $module eq \'integer\'\n' * | |
* 1004|' *** 0 \n' * | |
* 1005|' *** 0 \n' * | |
* 1006|' *** 0 \n' * | |
* 1007|'457 || $module eq \'bytes\' || $module eq \'warnings\'\n' * | |
* 1008|'458 || $module eq \'feature\') {\n' * | |
* 1009|'459 *** 0 return "";\n' * | |
* 1010|'460 }\n' * | |
* 1011|'461 \n' * | |
* 1012|'462 *** 0 0 0 if (defined $version && length $args) {\n' * | |
* 1013|' *** 0 \n' * | |
* 1014|' *** 0 \n' * | |
* 1015|'463 *** 0 return "$use $module $version ($args);\\n";\n' * | |
* 1016|'464 } elsif (defined $version) {\n' * | |
* 1017|'465 *** 0 return "$use $module $version;\\n";\n' * | |
* 1018|'466 } elsif (length $args) {\n' * | |
* 1019|'467 *** 0 return "$use $module ($args);\\n";\n' * | |
* 1020|'468 } else {\n' * | |
* 1021|'469 *** 0 return "$use $module;\\n";\n' * | |
* 1022|'470 }\n' * | |
* 1023|'471 }\n' * | |
* 1024|'472 \n' * | |
* 1025|'473 sub stash_subs {\n' * | |
* 1026|'474 *** 0 0 my ($self, $pack) = @_;\n' * | |
* 1027|'475 *** 0 my (@ret, $stash);\n' * | |
* 1028|'476 *** 0 0 if (!defined $pack) {\n' * | |
* 1029|'477 *** 0 $pack = \'\';\n' * | |
* 1030|'478 *** 0 $stash = \\%::;\n' * | |
* 1031|'479 }\n' * | |
* 1032|'480 else {\n' * | |
* 1033|'481 *** 0 $pack =~ s/(::)?$/::/;\n' * | |
* 1034|'482 no strict \'refs\';\n' * | |
* 1035|'483 *** 0 $stash = \\%{"main::$pack"};\n' * | |
* 1036|' *** 0 \n' * | |
* 1037|'484 }\n' * | |
* 1038|'485 *** 0 my %stash = svref_2object($stash)->ARRAY;\n' * | |
* 1039|'486 *** 0 while (my ($key, $val) = each %stash) {\n' * | |
* 1040|'487 *** 0 my $class = class($val);\n' * | |
* 1041|'488 *** 0 0 0 if ($class eq "PV") {\n' * | |
* 1042|' *** 0 \n' * | |
* 1043|' *** 0 \n' * | |
* 1044|'489 # Just a prototype. As an ugly but fairly effective way\n' * | |
* 1045|'490 # to find out if it belongs here is to see if the AUTOLOAD\n' * | |
* 1046|'491 # (if any) for the stash was defined in one of our files.\n' * | |
* 1047|'492 *** 0 my $A = $stash{"AUTOLOAD"};\n' * | |
* 1048|'493 *** 0 0 0 if (defined ($A) && class($A) eq "GV" && defined($A->CV)\n' * | |
* 1049|' *** 0 \n' * | |
* 1050|' *** 0 \n' * | |
* 1051|'494 && class($A->CV) eq "CV") {\n' * | |
* 1052|'495 *** 0 my $AF = $A->FILE;\n' * | |
* 1053|'496 *** 0 0 0 next unless $AF eq $0 || exists $self->{\'files\'}{$AF};\n' * | |
* 1054|'497 }\n' * | |
* 1055|'498 *** 0 push @{$self->{\'protos_todo\'}}, [$pack . $key, $val->PV];\n' * | |
* 1056|' *** 0 \n' * | |
* 1057|'499 } elsif ($class eq "IV" && !($val->FLAGS & SVf_ROK)) {\n' * | |
* 1058|'500 # Just a name. As above.\n' * | |
* 1059|'501 # But skip proxy constant subroutines, as some form of perl-space\n' * | |
* 1060|'502 # visible code must have created them, be it a use statement, or\n' * | |
* 1061|'503 # some direct symbol-table manipulation code that we will Deparse\n' * | |
* 1062|'504 *** 0 my $A = $stash{"AUTOLOAD"};\n' * | |
* 1063|'505 *** 0 0 0 if (defined ($A) && class($A) eq "GV" && defined($A->CV)\n' * | |
* 1064|' *** 0 \n' * | |
* 1065|' *** 0 \n' * | |
* 1066|'506 && class($A->CV) eq "CV") {\n' * | |
* 1067|'507 *** 0 my $AF = $A->FILE;\n' * | |
* 1068|'508 *** 0 0 0 next unless $AF eq $0 || exists $self->{\'files\'}{$AF};\n' * | |
* 1069|'509 }\n' * | |
* 1070|'510 *** 0 push @{$self->{\'protos_todo\'}}, [$pack . $key, undef];\n' * | |
* 1071|' *** 0 \n' * | |
* 1072|'511 } elsif ($class eq "GV") {\n' * | |
* 1073|'512 *** 0 0 if (class(my $cv = $val->CV) ne "SPECIAL") {\n' * | |
* 1074|'513 *** 0 0 next if $self->{\'subs_done\'}{$$val}++;\n' * | |
* 1075|'514 *** 0 0 next if $$val != ${$cv->GV}; # Ignore imposters\n' * | |
* 1076|' *** 0 \n' * | |
* 1077|'515 *** 0 $self->todo($cv, 0);\n' * | |
* 1078|'516 }\n' * | |
* 1079|'517 *** 0 0 if (class(my $cv = $val->FORM) ne "SPECIAL") {\n' * | |
* 1080|'518 *** 0 0 next if $self->{\'forms_done\'}{$$val}++;\n' * | |
* 1081|'519 *** 0 0 next if $$val != ${$cv->GV}; # Ignore imposters\n' * | |
* 1082|' *** 0 \n' * | |
* 1083|'520 *** 0 $self->todo($cv, 1);\n' * | |
* 1084|'521 }\n' * | |
* 1085|'522 *** 0 0 0 if (class($val->HV) ne "SPECIAL" && $key =~ /::$/) {\n' * | |
* 1086|'523 *** 0 0 0 $self->stash_subs($pack . $key)\n' * | |
* 1087|'524 unless $pack eq \'\' && $key eq \'main::\';\n' * | |
* 1088|'525 # avoid infinite recursion\n' * | |
* 1089|'526 }\n' * | |
* 1090|'527 }\n' * | |
* 1091|'528 }\n' * | |
* 1092|'529 }\n' * | |
* 1093|'530 \n' * | |
* 1094|'531 sub print_protos {\n' * | |
* 1095|'532 *** 0 0 my $self = shift;\n' * | |
* 1096|'533 *** 0 my $ar;\n' * | |
* 1097|'534 *** 0 my @ret;\n' * | |
* 1098|'535 *** 0 foreach $ar (@{$self->{\'protos_todo\'}}) {\n' * | |
* 1099|' *** 0 \n' * | |
* 1100|'536 *** 0 0 my $proto = (defined $ar->[1] ? " (". $ar->[1] . ")" : "");\n' * | |
* 1101|'537 *** 0 push @ret, "sub " . $ar->[0] . "$proto;\\n";\n' * | |
* 1102|'538 }\n' * | |
* 1103|'539 *** 0 delete $self->{\'protos_todo\'};\n' * | |
* 1104|'540 *** 0 return @ret;\n' * | |
* 1105|'541 }\n' * | |
* 1106|'542 \n' * | |
* 1107|'543 sub style_opts {\n' * | |
* 1108|'544 *** 0 0 my $self = shift;\n' * | |
* 1109|'545 *** 0 my $opts = shift;\n' * | |
* 1110|'546 *** 0 my $opt;\n' * | |
* 1111|'547 *** 0 while (length($opt = substr($opts, 0, 1))) {\n' * | |
* 1112|'548 *** 0 0 if ($opt eq "C") {\n' * | |
* 1113|' *** 0 \n' * | |
* 1114|' *** 0 \n' * | |
* 1115|' *** 0 \n' * | |
* 1116|'549 *** 0 $self->{\'cuddle\'} = " ";\n' * | |
* 1117|'550 *** 0 $opts = substr($opts, 1);\n' * | |
* 1118|'551 } elsif ($opt eq "i") {\n' * | |
* 1119|'552 *** 0 $opts =~ s/^i(\\d+)//;\n' * | |
* 1120|'553 *** 0 $self->{\'indent_size\'} = $1;\n' * | |
* 1121|'554 } elsif ($opt eq "T") {\n' * | |
* 1122|'555 *** 0 $self->{\'use_tabs\'} = 1;\n' * | |
* 1123|'556 *** 0 $opts = substr($opts, 1);\n' * | |
* 1124|'557 } elsif ($opt eq "v") {\n' * | |
* 1125|'558 *** 0 $opts =~ s/^v([^.]*)(.|$)//;\n' * | |
* 1126|'559 *** 0 $self->{\'ex_const\'} = $1;\n' * | |
* 1127|'560 }\n' * | |
* 1128|'561 }\n' * | |
* 1129|'562 }\n' * | |
* 1130|'563 \n' * | |
* 1131|'564 sub new {\n' * | |
* 1132|'565 *** 0 0 my $class = shift;\n' * | |
* 1133|'566 *** 0 my $self = bless {}, $class;\n' * | |
* 1134|'567 *** 0 $self->{\'cuddle\'} = "\\n";\n' * | |
* 1135|'568 *** 0 $self->{\'curcop\'} = undef;\n' * | |
* 1136|'569 *** 0 $self->{\'curstash\'} = "main";\n' * | |
* 1137|'570 *** 0 $self->{\'ex_const\'} = "\'???\'";\n' * | |
* 1138|'571 *** 0 $self->{\'expand\'} = 0;\n' * | |
* 1139|'572 *** 0 $self->{\'files\'} = {};\n' * | |
* 1140|'573 *** 0 $self->{\'indent_size\'} = 4;\n' * | |
* 1141|'574 *** 0 $self->{\'linenums\'} = 0;\n' * | |
* 1142|'575 *** 0 $self->{\'parens\'} = 0;\n' * | |
* 1143|'576 *** 0 $self->{\'subs_todo\'} = [];\n' * | |
* 1144|'577 *** 0 $self->{\'unquote\'} = 0;\n' * | |
* 1145|'578 *** 0 $self->{\'use_dumper\'} = 0;\n' * | |
* 1146|'579 *** 0 $self->{\'use_tabs\'} = 0;\n' * | |
* 1147|'580 \n' * | |
* 1148|'581 *** 0 $self->{\'ambient_arybase\'} = 0;\n' * | |
* 1149|'582 *** 0 $self->{\'ambient_warnings\'} = undef; # Assume no lexical warnings\n' * | |
* 1150|'583 *** 0 $self->{\'ambient_hints\'} = 0;\n' * | |
* 1151|'584 *** 0 $self->{\'ambient_hinthash\'} = undef;\n' * | |
* 1152|'585 *** 0 $self->init();\n' * | |
* 1153|'586 \n' * | |
* 1154|'587 *** 0 while (my $arg = shift @_) {\n' * | |
* 1155|'588 *** 0 0 if ($arg eq "-d") {\n' * | |
* 1156|' *** 0 \n' * | |
* 1157|' *** 0 \n' * | |
* 1158|' *** 0 \n' * | |
* 1159|' *** 0 \n' * | |
* 1160|' *** 0 \n' * | |
* 1161|' *** 0 \n' * | |
* 1162|' *** 0 \n' * | |
* 1163|'589 *** 0 $self->{\'use_dumper\'} = 1;\n' * | |
* 1164|'590 *** 0 require Data::Dumper;\n' * | |
* 1165|'591 } elsif ($arg =~ /^-f(.*)/) {\n' * | |
* 1166|'592 *** 0 $self->{\'files\'}{$1} = 1;\n' * | |
* 1167|'593 } elsif ($arg eq "-l") {\n' * | |
* 1168|'594 *** 0 $self->{\'linenums\'} = 1;\n' * | |
* 1169|'595 } elsif ($arg eq "-p") {\n' * | |
* 1170|'596 *** 0 $self->{\'parens\'} = 1;\n' * | |
* 1171|'597 } elsif ($arg eq "-P") {\n' * | |
* 1172|'598 *** 0 $self->{\'noproto\'} = 1;\n' * | |
* 1173|'599 } elsif ($arg eq "-q") {\n' * | |
* 1174|'600 *** 0 $self->{\'unquote\'} = 1;\n' * | |
* 1175|'601 } elsif (substr($arg, 0, 2) eq "-s") {\n' * | |
* 1176|'602 *** 0 $self->style_opts(substr $arg, 2);\n' * | |
* 1177|'603 } elsif ($arg =~ /^-x(\\d)$/) {\n' * | |
* 1178|'604 *** 0 $self->{\'expand\'} = $1;\n' * | |
* 1179|'605 }\n' * | |
* 1180|'606 }\n' * | |
* 1181|'607 *** 0 return $self;\n' * | |
* 1182|'608 }\n' * | |
* 1183|'609 \n' * | |
* 1184|'610 {\n' * | |
* 1185|'611 # Mask out the bits that L<warnings::register> uses\n' * | |
* 1186|'612 my $WARN_MASK;\n' * | |
* 1187|'613 BEGIN {\n' * | |
* 1188|'614 $WARN_MASK = $warnings::Bits{all} | $warnings::DeadBits{all};\n' * | |
* 1189|'615 }\n' * | |
* 1190|'616 sub WARN_MASK () {\n' * | |
* 1191|'617 *** 0 0 return $WARN_MASK;\n' * | |
* 1192|'618 }\n' * | |
* 1193|'619 }\n' * | |
* 1194|'620 \n' * | |
* 1195|'621 # Initialise the contextual information, either from\n' * | |
* 1196|'622 # defaults provided with the ambient_pragmas method,\n' * | |
* 1197|'623 # or from perl\'s own defaults otherwise.\n' * | |
* 1198|'624 sub init {\n' * | |
* 1199|'625 *** 0 0 my $self = shift;\n' * | |
* 1200|'626 \n' * | |
* 1201|'627 *** 0 $self->{\'arybase\'} = $self->{\'ambient_arybase\'};\n' * | |
* 1202|'628 *** 0 0 $self->{\'warnings\'} = defined ($self->{\'ambient_warnings\'})\n' * | |
* 1203|'629 ? $self->{\'ambient_warnings\'} & WARN_MASK\n' * | |
* 1204|'630 : undef;\n' * | |
* 1205|'631 *** 0 $self->{\'hints\'} = $self->{\'ambient_hints\'};\n' * | |
* 1206|'632 *** 0 0 $self->{\'hints\'} &= 0xFF if $] < 5.009;\n' * | |
* 1207|'633 *** 0 $self->{\'hinthash\'} = $self->{\'ambient_hinthash\'};\n' * | |
* 1208|'634 \n' * | |
* 1209|'635 # also a convenient place to clear out subs_declared\n' * | |
* 1210|'636 *** 0 delete $self->{\'subs_declared\'};\n' * | |
* 1211|'637 }\n' * | |
* 1212|'638 \n' * | |
* 1213|'639 sub compile {\n' * | |
* 1214|'640 *** 0 0 my(@args) = @_;\n' * | |
* 1215|'641 return sub {\n' * | |
* 1216|'642 *** 0 0 my $self = B::Deparse->new(@args);\n' * | |
* 1217|'643 # First deparse command-line args\n' * | |
* 1218|'644 *** 0 0 if (defined $^I) { # deparse -i\n' * | |
* 1219|'645 *** 0 print q(BEGIN { $^I = ).perlstring($^I).qq(; }\\n);\n' * | |
* 1220|'646 }\n' * | |
* 1221|'647 *** 0 0 if ($^W) { # deparse -w\n' * | |
* 1222|'648 *** 0 print qq(BEGIN { \\$^W = $^W; }\\n);\n' * | |
* 1223|'649 }\n' * | |
* 1224|'650 *** 0 0 0 if ($/ ne "\\n" or defined $O::savebackslash) { # deparse -l and -0\n' * | |
* 1225|'651 *** 0 0 my $fs = perlstring($/) || \'undef\';\n' * | |
* 1226|'652 *** 0 0 my $bs = perlstring($O::savebackslash) || \'undef\';\n' * | |
* 1227|'653 *** 0 print qq(BEGIN { \\$/ = $fs; \\$\\\\ = $bs; }\\n);\n' * | |
* 1228|'654 }\n' * | |
* 1229|'655 *** 0 0 my @BEGINs = B::begin_av->isa("B::AV") ? B::begin_av->ARRAY : ();\n' * | |
* 1230|'656 *** 0 0 my @UNITCHECKs = B::unitcheck_av->isa("B::AV")\n' * | |
* 1231|'657 ? B::unitcheck_av->ARRAY\n' * | |
* 1232|'658 : ();\n' * | |
* 1233|'659 *** 0 0 my @CHECKs = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();\n' * | |
* 1234|'660 *** 0 0 my @INITs = B::init_av->isa("B::AV") ? B::init_av->ARRAY : ();\n' * | |
* 1235|'661 *** 0 0 my @ENDs = B::end_av->isa("B::AV") ? B::end_av->ARRAY : ();\n' * | |
* 1236|'662 *** 0 for my $block (@BEGINs, @UNITCHECKs, @CHECKs, @INITs, @ENDs) {\n' * | |
* 1237|'663 *** 0 $self->todo($block, 0);\n' * | |
* 1238|'664 }\n' * | |
* 1239|'665 *** 0 $self->stash_subs();\n' * | |
* 1240|'666 local($SIG{"__DIE__"}) =\n' * | |
* 1241|'667 sub {\n' * | |
* 1242|'668 *** 0 0 if ($self->{\'curcop\'}) {\n' * | |
* 1243|'669 *** 0 my $cop = $self->{\'curcop\'};\n' * | |
* 1244|'670 *** 0 my($line, $file) = ($cop->line, $cop->file);\n' * | |
* 1245|'671 *** 0 print STDERR "While deparsing $file near line $line,\\n";\n' * | |
* 1246|'672 }\n' * | |
* 1247|'673 *** 0 };\n' * | |
* 1248|'674 *** 0 $self->{\'curcv\'} = main_cv;\n' * | |
* 1249|'675 *** 0 $self->{\'curcvlex\'} = undef;\n' * | |
* 1250|'676 *** 0 print $self->print_protos;\n' * | |
* 1251|'677 *** 0 @{$self->{\'subs_todo\'}} =\n' * | |
* 1252|' *** 0 \n' * | |
* 1253|'678 *** 0 sort {$a->[0] <=> $b->[0]} @{$self->{\'subs_todo\'}};\n' * | |
* 1254|' *** 0 \n' * | |
* 1255|'679 *** 0 0 print $self->indent($self->deparse_root(main_root)), "\\n"\n' * | |
* 1256|'680 unless null main_root;\n' * | |
* 1257|'681 *** 0 my @text;\n' * | |
* 1258|'682 *** 0 while (scalar(@{$self->{\'subs_todo\'}})) {\n' * | |
* 1259|' *** 0 \n' * | |
* 1260|'683 *** 0 push @text, $self->next_todo;\n' * | |
* 1261|'684 }\n' * | |
* 1262|'685 *** 0 0 print $self->indent(join("", @text)), "\\n" if @text;\n' * | |
* 1263|'686 \n' * | |
* 1264|'687 # Print __DATA__ section, if necessary\n' * | |
* 1265|'688 no strict \'refs\';\n' * | |
* 1266|'689 *** 0 0 my $laststash = defined $self->{\'curcop\'}\n' * | |
* 1267|'690 ? $self->{\'curcop\'}->stash->NAME : $self->{\'curstash\'};\n' * | |
* 1268|'691 *** 0 0 if (defined *{$laststash."::DATA"}{IO}) {\n' * | |
* 1269|' *** 0 \n' * | |
* 1270|'692 *** 0 0 print "package $laststash;\\n"\n' * | |
* 1271|'693 unless $laststash eq $self->{\'curstash\'};\n' * | |
* 1272|'694 *** 0 print "__DATA__\\n";\n' * | |
* 1273|'695 *** 0 print readline(*{$laststash."::DATA"});\n' * | |
* 1274|' *** 0 \n' * | |
* 1275|'696 }\n' * | |
* 1276|'697 }\n' * | |
* 1277|'698 *** 0 }\n' * | |
* 1278|'699 \n' * | |
* 1279|'700 sub coderef2text {\n' * | |
* 1280|'701 *** 0 0 my $self = shift;\n' * | |
* 1281|'702 *** 0 my $sub = shift;\n' * | |
* 1282|'703 *** 0 0 croak "Usage: ->coderef2text(CODEREF)" unless UNIVERSAL::isa($sub, "CODE");\n' * | |
* 1283|'704 \n' * | |
* 1284|'705 *** 0 $self->init();\n' * | |
* 1285|'706 *** 0 return $self->indent($self->deparse_sub(svref_2object($sub)));\n' * | |
* 1286|'707 }\n' * | |
* 1287|'708 \n' * | |
* 1288|'709 sub ambient_pragmas {\n' * | |
* 1289|'710 *** 0 0 my $self = shift;\n' * | |
* 1290|'711 *** 0 my ($arybase, $hint_bits, $warning_bits, $hinthash) = (0, 0);\n' * | |
* 1291|'712 \n' * | |
* 1292|'713 *** 0 while (@_ > 1) {\n' * | |
* 1293|'714 *** 0 my $name = shift();\n' * | |
* 1294|'715 *** 0 my $val = shift();\n' * | |
* 1295|'716 \n' * | |
* 1296|'717 *** 0 0 0 if ($name eq \'strict\') {\n' * | |
* 1297|' *** 0 0 \n' * | |
* 1298|' *** 0 \n' * | |
* 1299|' *** 0 \n' * | |
* 1300|' *** 0 \n' * | |
* 1301|' *** 0 \n' * | |
* 1302|' *** 0 \n' * | |
* 1303|' *** 0 \n' * | |
* 1304|'718 *** 0 require strict;\n' * | |
* 1305|'719 \n' * | |
* 1306|'720 *** 0 0 if ($val eq \'none\') {\n' * | |
* 1307|'721 *** 0 $hint_bits &= ~strict::bits(qw/refs subs vars/);\n' * | |
* 1308|'722 *** 0 next();\n' * | |
* 1309|'723 }\n' * | |
* 1310|'724 \n' * | |
* 1311|'725 *** 0 my @names;\n' * | |
* 1312|'726 *** 0 0 if ($val eq "all") {\n' * | |
* 1313|' *** 0 \n' * | |
* 1314|'727 *** 0 @names = qw/refs subs vars/;\n' * | |
* 1315|'728 }\n' * | |
* 1316|'729 elsif (ref $val) {\n' * | |
* 1317|'730 *** 0 @names = @$val;\n' * | |
* 1318|'731 }\n' * | |
* 1319|'732 else {\n' * | |
* 1320|'733 *** 0 @names = split\' \', $val;\n' * | |
* 1321|'734 }\n' * | |
* 1322|'735 *** 0 $hint_bits |= strict::bits(@names);\n' * | |
* 1323|'736 }\n' * | |
* 1324|'737 \n' * | |
* 1325|'738 elsif ($name eq \'$[\') {\n' * | |
* 1326|'739 *** 0 $arybase = $val;\n' * | |
* 1327|'740 }\n' * | |
* 1328|'741 \n' * | |
* 1329|'742 elsif ($name eq \'integer\'\n' * | |
* 1330|'743 || $name eq \'bytes\'\n' * | |
* 1331|'744 || $name eq \'utf8\') {\n' * | |
* 1332|'745 *** 0 require "$name.pm";\n' * | |
* 1333|'746 *** 0 0 if ($val) {\n' * | |
* 1334|'747 *** 0 $hint_bits |= ${$::{"${name}::"}{"hint_bits"}};\n' * | |
* 1335|' *** 0 \n' * | |
* 1336|'748 }\n' * | |
* 1337|'749 else {\n' * | |
* 1338|'750 *** 0 $hint_bits &= ~${$::{"${name}::"}{"hint_bits"}};\n' * | |
* 1339|' *** 0 \n' * | |
* 1340|'751 }\n' * | |
* 1341|'752 }\n' * | |
* 1342|'753 \n' * | |
* 1343|'754 elsif ($name eq \'re\') {\n' * | |
* 1344|'755 *** 0 require re;\n' * | |
* 1345|'756 *** 0 0 if ($val eq \'none\') {\n' * | |
* 1346|'757 *** 0 $hint_bits &= ~re::bits(qw/taint eval/);\n' * | |
* 1347|'758 *** 0 next();\n' * | |
* 1348|'759 }\n' * | |
* 1349|'760 \n' * | |
* 1350|'761 *** 0 my @names;\n' * | |
* 1351|'762 *** 0 0 if ($val eq \'all\') {\n' * | |
* 1352|' *** 0 \n' * | |
* 1353|'763 *** 0 @names = qw/taint eval/;\n' * | |
* 1354|'764 }\n' * | |
* 1355|'765 elsif (ref $val) {\n' * | |
* 1356|'766 *** 0 @names = @$val;\n' * | |
* 1357|'767 }\n' * | |
* 1358|'768 else {\n' * | |
* 1359|'769 *** 0 @names = split\' \',$val;\n' * | |
* 1360|'770 }\n' * | |
* 1361|'771 *** 0 $hint_bits |= re::bits(@names);\n' * | |
* 1362|'772 }\n' * | |
* 1363|'773 \n' * | |
* 1364|'774 elsif ($name eq \'warnings\') {\n' * | |
* 1365|'775 *** 0 0 if ($val eq \'none\') {\n' * | |
* 1366|'776 *** 0 $warning_bits = $warnings::NONE;\n' * | |
* 1367|'777 *** 0 next();\n' * | |
* 1368|'778 }\n' * | |
* 1369|'779 \n' * | |
* 1370|'780 *** 0 my @names;\n' * | |
* 1371|'781 *** 0 0 if (ref $val) {\n' * | |
* 1372|'782 *** 0 @names = @$val;\n' * | |
* 1373|'783 }\n' * | |
* 1374|'784 else {\n' * | |
* 1375|'785 *** 0 @names = split/\\s+/, $val;\n' * | |
* 1376|'786 }\n' * | |
* 1377|'787 \n' * | |
* 1378|'788 *** 0 0 $warning_bits = $warnings::NONE if !defined ($warning_bits);\n' * | |
* 1379|'789 *** 0 $warning_bits |= warnings::bits(@names);\n' * | |
* 1380|'790 }\n' * | |
* 1381|'791 \n' * | |
* 1382|'792 elsif ($name eq \'warning_bits\') {\n' * | |
* 1383|'793 *** 0 $warning_bits = $val;\n' * | |
* 1384|'794 }\n' * | |
* 1385|'795 \n' * | |
* 1386|'796 elsif ($name eq \'hint_bits\') {\n' * | |
* 1387|'797 *** 0 $hint_bits = $val;\n' * | |
* 1388|'798 }\n' * | |
* 1389|'799 \n' * | |
* 1390|'800 elsif ($name eq \'%^H\') {\n' * | |
* 1391|'801 *** 0 $hinthash = $val;\n' * | |
* 1392|'802 }\n' * | |
* 1393|'803 \n' * | |
* 1394|'804 else {\n' * | |
* 1395|'805 *** 0 croak "Unknown pragma type: $name";\n' * | |
* 1396|'806 }\n' * | |
* 1397|'807 }\n' * | |
* 1398|'808 *** 0 0 if (@_) {\n' * | |
* 1399|'809 *** 0 croak "The ambient_pragmas method expects an even number of args";\n' * | |
* 1400|'810 }\n' * | |
* 1401|'811 \n' * | |
* 1402|'812 *** 0 $self->{\'ambient_arybase\'} = $arybase;\n' * | |
* 1403|'813 *** 0 $self->{\'ambient_warnings\'} = $warning_bits;\n' * | |
* 1404|'814 *** 0 $self->{\'ambient_hints\'} = $hint_bits;\n' * | |
* 1405|'815 *** 0 $self->{\'ambient_hinthash\'} = $hinthash;\n' * | |
* 1406|'816 }\n' * | |
* 1407|'817 \n' * | |
* 1408|'818 # This method is the inner loop, so try to keep it simple\n' * | |
* 1409|'819 sub deparse {\n' * | |
* 1410|'820 *** 0 0 my $self = shift;\n' * | |
* 1411|'821 *** 0 my($op, $cx) = @_;\n' * | |
* 1412|'822 \n' * | |
* 1413|'823 *** 0 0 0 Carp::confess("Null op in deparse") if !defined($op)\n' * | |
* 1414|'824 || class($op) eq "NULL";\n' * | |
* 1415|'825 *** 0 my $meth = "pp_" . $op->name;\n' * | |
* 1416|'826 *** 0 return $self->$meth($op, $cx);\n' * | |
* 1417|'827 }\n' * | |
* 1418|'828 \n' * | |
* 1419|'829 sub indent {\n' * | |
* 1420|'830 *** 0 0 my $self = shift;\n' * | |
* 1421|'831 *** 0 my $txt = shift;\n' * | |
* 1422|'832 *** 0 my @lines = split(/\\n/, $txt);\n' * | |
* 1423|'833 *** 0 my $leader = "";\n' * | |
* 1424|'834 *** 0 my $level = 0;\n' * | |
* 1425|'835 *** 0 my $line;\n' * | |
* 1426|'836 *** 0 for $line (@lines) {\n' * | |
* 1427|'837 *** 0 my $cmd = substr($line, 0, 1);\n' * | |
* 1428|'838 *** 0 0 0 if ($cmd eq "\\t" or $cmd eq "\\b") {\n' * | |
* 1429|'839 *** 0 0 $level += ($cmd eq "\\t" ? 1 : -1) * $self->{\'indent_size\'};\n' * | |
* 1430|'840 *** 0 0 if ($self->{\'use_tabs\'}) {\n' * | |
* 1431|'841 *** 0 $leader = "\\t" x ($level / 8) . " " x ($level % 8);\n' * | |
* 1432|'842 } else {\n' * | |
* 1433|'843 *** 0 $leader = " " x $level;\n' * | |
* 1434|'844 }\n' * | |
* 1435|'845 *** 0 $line = substr($line, 1);\n' * | |
* 1436|'846 }\n' * | |
* 1437|'847 *** 0 0 if (substr($line, 0, 1) eq "\\f") {\n' * | |
* 1438|'848 *** 0 $line = substr($line, 1); # no indent\n' * | |
* 1439|'849 } else {\n' * | |
* 1440|'850 *** 0 $line = $leader . $line;\n' * | |
* 1441|'851 }\n' * | |
* 1442|'852 *** 0 $line =~ s/\\cK;?//g;\n' * | |
* 1443|'853 }\n' * | |
* 1444|'854 *** 0 return join("\\n", @lines);\n' * | |
* 1445|'855 }\n' * | |
* 1446|'856 \n' * | |
* 1447|'857 sub deparse_sub {\n' * | |
* 1448|'858 *** 0 0 my $self = shift;\n' * | |
* 1449|'859 *** 0 my $cv = shift;\n' * | |
* 1450|'860 *** 0 my $proto = "";\n' * | |
* 1451|'861 *** 0 0 0 Carp::confess("NULL in deparse_sub") if !defined($cv) || $cv->isa("B::NULL");\n' * | |
* 1452|'862 *** 0 0 Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");\n' * | |
* 1453|'863 *** 0 local $self->{\'curcop\'} = $self->{\'curcop\'};\n' * | |
* 1454|'864 *** 0 0 if ($cv->FLAGS & SVf_POK) {\n' * | |
* 1455|'865 *** 0 $proto = "(". $cv->PV . ") ";\n' * | |
* 1456|'866 }\n' * | |
* 1457|'867 *** 0 0 if ($cv->CvFLAGS & (CVf_METHOD|CVf_LOCKED|CVf_LVALUE)) {\n' * | |
* 1458|'868 *** 0 $proto .= ": ";\n' * | |
* 1459|'869 *** 0 0 $proto .= "lvalue " if $cv->CvFLAGS & CVf_LVALUE;\n' * | |
* 1460|'870 *** 0 0 $proto .= "locked " if $cv->CvFLAGS & CVf_LOCKED;\n' * | |
* 1461|'871 *** 0 0 $proto .= "method " if $cv->CvFLAGS & CVf_METHOD;\n' * | |
* 1462|'872 }\n' * | |
* 1463|'873 \n' * | |
* 1464|'874 *** 0 local($self->{\'curcv\'}) = $cv;\n' * | |
* 1465|'875 *** 0 local($self->{\'curcvlex\'});\n' * | |
* 1466|'876 *** 0 local(@$self{qw\'curstash warnings hints hinthash\'})\n' * | |
* 1467|'877 = @$self{qw\'curstash warnings hints hinthash\'};\n' * | |
* 1468|'878 *** 0 my $body;\n' * | |
* 1469|'879 *** 0 0 if (not null $cv->ROOT) {\n' * | |
* 1470|'880 *** 0 my $lineseq = $cv->ROOT->first;\n' * | |
* 1471|'881 *** 0 0 if ($lineseq->name eq "lineseq") {\n' * | |
* 1472|'882 *** 0 my @ops;\n' * | |
* 1473|'883 *** 0 for(my$o=$lineseq->first; $$o; $o=$o->sibling) {\n' * | |
* 1474|'884 *** 0 push @ops, $o;\n' * | |
* 1475|'885 }\n' * | |
* 1476|'886 *** 0 $body = $self->lineseq(undef, @ops).";";\n' * | |
* 1477|'887 *** 0 my $scope_en = $self->find_scope_en($lineseq);\n' * | |
* 1478|'888 *** 0 0 if (defined $scope_en) {\n' * | |
* 1479|'889 *** 0 my $subs = join"", $self->seq_subs($scope_en);\n' * | |
* 1480|'890 *** 0 0 $body .= ";\\n$subs" if length($subs);\n' * | |
* 1481|'891 }\n' * | |
* 1482|'892 }\n' * | |
* 1483|'893 else {\n' * | |
* 1484|'894 *** 0 $body = $self->deparse($cv->ROOT->first, 0);\n' * | |
* 1485|'895 }\n' * | |
* 1486|'896 }\n' * | |
* 1487|'897 else {\n' * | |
* 1488|'898 *** 0 my $sv = $cv->const_sv;\n' * | |
* 1489|'899 *** 0 0 if ($$sv) {\n' * | |
* 1490|'900 # uh-oh. inlinable sub... format it differently\n' * | |
* 1491|'901 *** 0 return $proto . "{ " . $self->const($sv, 0) . " }\\n";\n' * | |
* 1492|'902 } else { # XSUB? (or just a declaration)\n' * | |
* 1493|'903 *** 0 return "$proto;\\n";\n' * | |
* 1494|'904 }\n' * | |
* 1495|'905 }\n' * | |
* 1496|'906 *** 0 return $proto ."{\\n\\t$body\\n\\b}" ."\\n";\n' * | |
* 1497|'907 }\n' * | |
* 1498|'908 \n' * | |
* 1499|'909 sub deparse_format {\n' * | |
* 1500|'910 *** 0 0 my $self = shift;\n' * | |
* 1501|'911 *** 0 my $form = shift;\n' * | |
* 1502|'912 *** 0 my @text;\n' * | |
* 1503|'913 *** 0 local($self->{\'curcv\'}) = $form;\n' * | |
* 1504|'914 *** 0 local($self->{\'curcvlex\'});\n' * | |
* 1505|'915 *** 0 local($self->{\'in_format\'}) = 1;\n' * | |
* 1506|'916 *** 0 local(@$self{qw\'curstash warnings hints hinthash\'})\n' * | |
* 1507|'917 = @$self{qw\'curstash warnings hints hinthash\'};\n' * | |
* 1508|'918 *** 0 my $op = $form->ROOT;\n' * | |
* 1509|'919 *** 0 my $kid;\n' * | |
* 1510|'920 *** 0 0 0 return "\\f." if $op->first->name eq \'stub\'\n' * | |
* 1511|'921 || $op->first->name eq \'nextstate\';\n' * | |
* 1512|'922 *** 0 $op = $op->first->first; # skip leavewrite, lineseq\n' * | |
* 1513|'923 *** 0 while (not null $op) {\n' * | |
* 1514|'924 *** 0 $op = $op->sibling; # skip nextstate\n' * | |
* 1515|'925 *** 0 my @exprs;\n' * | |
* 1516|'926 *** 0 $kid = $op->first->sibling; # skip pushmark\n' * | |
* 1517|'927 *** 0 push @text, "\\f".$self->const_sv($kid)->PV;\n' * | |
* 1518|'928 *** 0 $kid = $kid->sibling;\n' * | |
* 1519|'929 *** 0 for (; not null $kid; $kid = $kid->sibling) {\n' * | |
* 1520|'930 *** 0 push @exprs, $self->deparse($kid, 0);\n' * | |
* 1521|'931 }\n' * | |
* 1522|'932 *** 0 0 push @text, "\\f".join(", ", @exprs)."\\n" if @exprs;\n' * | |
* 1523|'933 *** 0 $op = $op->sibling;\n' * | |
* 1524|'934 }\n' * | |
* 1525|'935 *** 0 return join("", @text) . "\\f.";\n' * | |
* 1526|'936 }\n' * | |
* 1527|'937 \n' * | |
* 1528|'938 sub is_scope {\n' * | |
* 1529|'939 *** 0 0 my $op = shift;\n' * | |
* 1530|'940 *** 0 0 return $op->name eq "leave" || $op->name eq "scope"\n' * | |
* 1531|'941 || $op->name eq "lineseq"\n' * | |
* 1532|'942 || ($op->name eq "null" && class($op) eq "UNOP"\n' * | |
* 1533|'943 && (is_scope($op->first) || $op->first->name eq "enter"));\n' * | |
* 1534|'944 }\n' * | |
* 1535|'945 \n' * | |
* 1536|'946 sub is_state {\n' * | |
* 1537|'947 *** 0 0 my $name = $_[0]->name;\n' * | |
* 1538|'948 *** 0 0 return $name eq "nextstate" || $name eq "dbstate" || $name eq "setstate";\n' * | |
* 1539|'949 }\n' * | |
* 1540|'950 \n' * | |
* 1541|'951 sub is_miniwhile { # check for one-line loop (`foo() while $y--\')\n' * | |
* 1542|'952 *** 0 0 my $op = shift;\n' * | |
* 1543|'953 *** 0 0 return (!null($op) and null($op->sibling)\n' * | |
* 1544|'954 and $op->name eq "null" and class($op) eq "UNOP"\n' * | |
* 1545|'955 and (($op->first->name =~ /^(and|or)$/\n' * | |
* 1546|'956 and $op->first->first->sibling->name eq "lineseq")\n' * | |
* 1547|'957 or ($op->first->name eq "lineseq"\n' * | |
* 1548|'958 and not null $op->first->first->sibling\n' * | |
* 1549|'959 and $op->first->first->sibling->name eq "unstack")\n' * | |
* 1550|'960 ));\n' * | |
* 1551|'961 }\n' * | |
* 1552|'962 \n' * | |
* 1553|'963 # Check if the op and its sibling are the initialization and the rest of a\n' * | |
* 1554|'964 # for (..;..;..) { ... } loop\n' * | |
* 1555|'965 sub is_for_loop {\n' * | |
* 1556|'966 *** 0 0 my $op = shift;\n' * | |
* 1557|'967 # This OP might be almost anything, though it won\'t be a\n' * | |
* 1558|'968 # nextstate. (It\'s the initialization, so in the canonical case it\n' * | |
* 1559|'969 # will be an sassign.) The sibling is (old style) a lineseq whose\n' * | |
* 1560|'970 # first child is a nextstate and whose second is a leaveloop, or\n' * | |
* 1561|'971 # (new style) an unstack whose sibling is a leaveloop.\n' * | |
* 1562|'972 *** 0 my $lseq = $op->sibling;\n' * | |
* 1563|'973 *** 0 0 0 return 0 unless !is_state($op) and !null($lseq);\n' * | |
* 1564|'974 *** 0 0 0 if ($lseq->name eq "lineseq") {\n' * | |
* 1565|' *** 0 \n' * | |
* 1566|'975 *** 0 0 0 if ($lseq->first && !null($lseq->first) && is_state($lseq->first)\n' * | |
* 1567|' *** 0 \n' * | |
* 1568|' *** 0 \n' * | |
* 1569|'976 && (my $sib = $lseq->first->sibling)) {\n' * | |
* 1570|'977 *** 0 0 return (!null($sib) && $sib->name eq "leaveloop");\n' * | |
* 1571|'978 }\n' * | |
* 1572|'979 } elsif ($lseq->name eq "unstack" && ($lseq->flags & OPf_SPECIAL)) {\n' * | |
* 1573|'980 *** 0 my $sib = $lseq->sibling;\n' * | |
* 1574|'981 *** 0 0 return $sib && !null($sib) && $sib->name eq "leaveloop";\n' * | |
* 1575|'982 }\n' * | |
* 1576|'983 *** 0 return 0;\n' * | |
* 1577|'984 }\n' * | |
* 1578|'985 \n' * | |
* 1579|'986 sub is_scalar {\n' * | |
* 1580|'987 *** 0 0 my $op = shift;\n' * | |
* 1581|'988 *** 0 0 return ($op->name eq "rv2sv" or\n' * | |
* 1582|'989 $op->name eq "padsv" or\n' * | |
* 1583|'990 $op->name eq "gv" or # only in array/hash constructs\n' * | |
* 1584|'991 $op->flags & OPf_KIDS && !null($op->first)\n' * | |
* 1585|'992 && $op->first->name eq "gvsv");\n' * | |
* 1586|'993 }\n' * | |
* 1587|'994 \n' * | |
* 1588|'995 sub maybe_parens {\n' * | |
* 1589|'996 *** 0 0 my $self = shift;\n' * | |
* 1590|'997 *** 0 my($text, $cx, $prec) = @_;\n' * | |
* 1591|'998 *** 0 0 0 if ($prec < $cx # unary ops nest just fine\n' * | |
* 1592|' *** 0 \n' * | |
* 1593|' *** 0 \n' * | |
* 1594|' *** 0 \n' * | |
* 1595|' *** 0 \n' * | |
* 1596|'999 or $prec == $cx and $cx != 4 and $cx != 16 and $cx != 21\n' * | |
* 1597|'1000 or $self->{\'parens\'})\n' * | |
* 1598|'1001 {\n' * | |
* 1599|'1002 *** 0 $text = "($text)";\n' * | |
* 1600|'1003 # In a unop, let parent reuse our parens; see maybe_parens_unop\n' * | |
* 1601|'1004 *** 0 0 $text = "\\cS" . $text if $cx == 16;\n' * | |
* 1602|'1005 *** 0 return $text;\n' * | |
* 1603|'1006 } else {\n' * | |
* 1604|'1007 *** 0 return $text;\n' * | |
* 1605|'1008 }\n' * | |
* 1606|'1009 }\n' * | |
* 1607|'1010 \n' * | |
* 1608|'1011 # same as above, but get around the `if it looks like a function\' rule\n' * | |
* 1609|'1012 sub maybe_parens_unop {\n' * | |
* 1610|'1013 *** 0 0 my $self = shift;\n' * | |
* 1611|'1014 *** 0 my($name, $kid, $cx) = @_;\n' * | |
* 1612|'1015 *** 0 0 0 if ($cx > 16 or $self->{\'parens\'}) {\n' * | |
* 1613|'1016 *** 0 $kid = $self->deparse($kid, 1);\n' * | |
* 1614|'1017 *** 0 0 0 if ($name eq "umask" && $kid =~ /^\\d+$/) {\n' * | |
* 1615|'1018 *** 0 $kid = sprintf("%#o", $kid);\n' * | |
* 1616|'1019 }\n' * | |
* 1617|'1020 *** 0 return "$name($kid)";\n' * | |
* 1618|'1021 } else {\n' * | |
* 1619|'1022 *** 0 $kid = $self->deparse($kid, 16);\n' * | |
* 1620|'1023 *** 0 0 0 if ($name eq "umask" && $kid =~ /^\\d+$/) {\n' * | |
* 1621|'1024 *** 0 $kid = sprintf("%#o", $kid);\n' * | |
* 1622|'1025 }\n' * | |
* 1623|'1026 *** 0 0 if (substr($kid, 0, 1) eq "\\cS") {\n' * | |
* 1624|' *** 0 \n' * | |
* 1625|'1027 # use kid\'s parens\n' * | |
* 1626|'1028 *** 0 return $name . substr($kid, 1);\n' * | |
* 1627|'1029 } elsif (substr($kid, 0, 1) eq "(") {\n' * | |
* 1628|'1030 # avoid looks-like-a-function trap with extra parens\n' * | |
* 1629|'1031 # (`+\' can lead to ambiguities)\n' * | |
* 1630|'1032 *** 0 return "$name(" . $kid . ")";\n' * | |
* 1631|'1033 } else {\n' * | |
* 1632|'1034 *** 0 return "$name $kid";\n' * | |
* 1633|'1035 }\n' * | |
* 1634|'1036 }\n' * | |
* 1635|'1037 }\n' * | |
* 1636|'1038 \n' * | |
* 1637|'1039 sub maybe_parens_func {\n' * | |
* 1638|'1040 *** 0 0 my $self = shift;\n' * | |
* 1639|'1041 *** 0 my($func, $text, $cx, $prec) = @_;\n' * | |
* 1640|'1042 *** 0 0 0 if ($prec <= $cx or substr($text, 0, 1) eq "(" or $self->{\'parens\'}) {\n' * | |
* 1641|' *** 0 \n' * | |
* 1642|'1043 *** 0 return "$func($text)";\n' * | |
* 1643|'1044 } else {\n' * | |
* 1644|'1045 *** 0 return "$func $text";\n' * | |
* 1645|'1046 }\n' * | |
* 1646|'1047 }\n' * | |
* 1647|'1048 \n' * | |
* 1648|'1049 sub maybe_local {\n' * | |
* 1649|'1050 *** 0 0 my $self = shift;\n' * | |
* 1650|'1051 *** 0 my($op, $cx, $text) = @_;\n' * | |
* 1651|'1052 *** 0 0 my $our_intro = ($op->name =~ /^(gv|rv2)[ash]v$/) ? OPpOUR_INTRO : 0;\n' * | |
* 1652|'1053 *** 0 0 0 if ($op->private & (OPpLVAL_INTRO|$our_intro)\n' * | |
* 1653|'1054 and not $self->{\'avoid_local\'}{$$op}) {\n' * | |
* 1654|'1055 *** 0 0 my $our_local = ($op->private & OPpLVAL_INTRO) ? "local" : "our";\n' * | |
* 1655|'1056 *** 0 0 if( $our_local eq \'our\' ) {\n' * | |
* 1656|'1057 *** 0 0 0 if ( $text !~ /^\\W(\\w+::)*\\w+\\z/\n' * | |
* 1657|' *** 0 \n' * | |
* 1658|'1058 and !utf8::decode($text) || $text !~ /^\\W(\\w+::)*\\w+\\z/\n' * | |
* 1659|'1059 ) {\n' * | |
* 1660|'1060 *** 0 die "Unexpected our($text)\\n";\n' * | |
* 1661|'1061 }\n' * | |
* 1662|'1062 *** 0 $text =~ s/(\\w+::)+//;\n' * | |
* 1663|'1063 }\n' * | |
* 1664|'1064 *** 0 0 if (want_scalar($op)) {\n' * | |
* 1665|'1065 *** 0 return "$our_local $text";\n' * | |
* 1666|'1066 } else {\n' * | |
* 1667|'1067 *** 0 return $self->maybe_parens_func("$our_local", $text, $cx, 16);\n' * | |
* 1668|'1068 }\n' * | |
* 1669|'1069 } else {\n' * | |
* 1670|'1070 *** 0 return $text;\n' * | |
* 1671|'1071 }\n' * | |
* 1672|'1072 }\n' * | |
* 1673|'1073 \n' * | |
* 1674|'1074 sub maybe_targmy {\n' * | |
* 1675|'1075 *** 0 0 my $self = shift;\n' * | |
* 1676|'1076 *** 0 my($op, $cx, $func, @args) = @_;\n' * | |
* 1677|'1077 *** 0 0 if ($op->private & OPpTARGET_MY) {\n' * | |
* 1678|'1078 *** 0 my $var = $self->padname($op->targ);\n' * | |
* 1679|'1079 *** 0 my $val = $func->($self, $op, 7, @args);\n' * | |
* 1680|'1080 *** 0 return $self->maybe_parens("$var = $val", $cx, 7);\n' * | |
* 1681|'1081 } else {\n' * | |
* 1682|'1082 *** 0 return $func->($self, $op, $cx, @args);\n' * | |
* 1683|'1083 }\n' * | |
* 1684|'1084 }\n' * | |
* 1685|'1085 \n' * | |
* 1686|'1086 sub padname_sv {\n' * | |
* 1687|'1087 *** 0 0 my $self = shift;\n' * | |
* 1688|'1088 *** 0 my $targ = shift;\n' * | |
* 1689|'1089 *** 0 return $self->{\'curcv\'}->PADLIST->ARRAYelt(0)->ARRAYelt($targ);\n' * | |
* 1690|'1090 }\n' * | |
* 1691|'1091 \n' * | |
* 1692|'1092 sub maybe_my {\n' * | |
* 1693|'1093 *** 0 0 my $self = shift;\n' * | |
* 1694|'1094 *** 0 my($op, $cx, $text) = @_;\n' * | |
* 1695|'1095 *** 0 0 0 if ($op->private & OPpLVAL_INTRO and not $self->{\'avoid_local\'}{$$op}) {\n' * | |
* 1696|'1096 *** 0 0 my $my = $op->private & OPpPAD_STATE ? "state" : "my";\n' * | |
* 1697|'1097 *** 0 0 if (want_scalar($op)) {\n' * | |
* 1698|'1098 *** 0 return "$my $text";\n' * | |
* 1699|'1099 } else {\n' * | |
* 1700|'1100 *** 0 return $self->maybe_parens_func($my, $text, $cx, 16);\n' * | |
* 1701|'1101 }\n' * | |
* 1702|'1102 } else {\n' * | |
* 1703|'1103 *** 0 return $text;\n' * | |
* 1704|'1104 }\n' * | |
* 1705|'1105 }\n' * | |
* 1706|'1106 \n' * | |
* 1707|'1107 # The following OPs don\'t have functions:\n' * | |
* 1708|'1108 \n' * | |
* 1709|'1109 # pp_padany - does not exist after parsing\n' * | |
* 1710|'1110 \n' * | |
* 1711|'1111 sub AUTOLOAD {\n' * | |
* 1712|'1112 *** 0 0 0 if ($AUTOLOAD =~ s/^.*::pp_//) {\n' * | |
* 1713|'1113 *** 0 warn "unexpected OP_".uc $AUTOLOAD;\n' * | |
* 1714|'1114 *** 0 return "XXX";\n' * | |
* 1715|'1115 } else {\n' * | |
* 1716|'1116 *** 0 die "Undefined subroutine $AUTOLOAD called";\n' * | |
* 1717|'1117 }\n' * | |
* 1718|'1118 }\n' * | |
* 1719|'1119 \n' * | |
* 1720|'1120 *** 0 0 sub DESTROY {} # Do not AUTOLOAD\n' * | |
* 1721|'1121 \n' * | |
* 1722|'1122 # $root should be the op which represents the root of whatever\n' * | |
* 1723|'1123 # we\'re sequencing here. If it\'s undefined, then we don\'t append\n' * | |
* 1724|'1124 # any subroutine declarations to the deparsed ops, otherwise we\n' * | |
* 1725|'1125 # append appropriate declarations.\n' * | |
* 1726|'1126 sub lineseq {\n' * | |
* 1727|'1127 *** 0 0 my($self, $root, @ops) = @_;\n' * | |
* 1728|'1128 *** 0 my($expr, @exprs);\n' * | |
* 1729|'1129 \n' * | |
* 1730|'1130 *** 0 my $out_cop = $self->{\'curcop\'};\n' * | |
* 1731|'1131 *** 0 0 my $out_seq = defined($out_cop) ? $out_cop->cop_seq : undef;\n' * | |
* 1732|'1132 *** 0 my $limit_seq;\n' * | |
* 1733|'1133 *** 0 0 if (defined $root) {\n' * | |
* 1734|'1134 *** 0 $limit_seq = $out_seq;\n' * | |
* 1735|'1135 *** 0 my $nseq;\n' * | |
* 1736|'1136 *** 0 0 $nseq = $self->find_scope_st($root->sibling) if ${$root->sibling};\n' * | |
* 1737|' *** 0 \n' * | |
* 1738|'1137 *** 0 0 0 $limit_seq = $nseq if !defined($limit_seq)\n' * | |
* 1739|' *** 0 \n' * | |
* 1740|'1138 or defined($nseq) && $nseq < $limit_seq;\n' * | |
* 1741|'1139 }\n' * | |
* 1742|'1140 *** 0 0 0 $limit_seq = $self->{\'limit_seq\'}\n' * | |
* 1743|' *** 0 \n' * | |
* 1744|'1141 if defined($self->{\'limit_seq\'})\n' * | |
* 1745|'1142 && (!defined($limit_seq) || $self->{\'limit_seq\'} < $limit_seq);\n' * | |
* 1746|'1143 *** 0 local $self->{\'limit_seq\'} = $limit_seq;\n' * | |
* 1747|'1144 \n' * | |
* 1748|'1145 $self->walk_lineseq($root, \\@ops,\n' * | |
* 1749|'1146 *** 0 0 sub { push @exprs, $_[0]} );\n' * | |
* 1750|' *** 0 \n' * | |
* 1751|'1147 \n' * | |
* 1752|'1148 *** 0 my $body = join(";\\n", grep {length} @exprs);\n' * | |
* 1753|' *** 0 \n' * | |
* 1754|'1149 *** 0 my $subs = "";\n' * | |
* 1755|'1150 *** 0 0 0 if (defined $root && defined $limit_seq && !$self->{\'in_format\'}) {\n' * | |
* 1756|' *** 0 \n' * | |
* 1757|'1151 *** 0 $subs = join "\\n", $self->seq_subs($limit_seq);\n' * | |
* 1758|'1152 }\n' * | |
* 1759|'1153 *** 0 return join(";\\n", grep {length} $body, $subs);\n' * | |
* 1760|' *** 0 \n' * | |
* 1761|'1154 }\n' * | |
* 1762|'1155 \n' * | |
* 1763|'1156 sub scopeop {\n' * | |
* 1764|'1157 *** 0 0 my($real_block, $self, $op, $cx) = @_;\n' * | |
* 1765|'1158 *** 0 my $kid;\n' * | |
* 1766|'1159 *** 0 my @kids;\n' * | |
* 1767|'1160 \n' * | |
* 1768|'1161 *** 0 0 local(@$self{qw\'curstash warnings hints hinthash\'})\n' * | |
* 1769|'1162 = @$self{qw\'curstash warnings hints hinthash\'} if $real_block;\n' * | |
* 1770|'1163 *** 0 0 if ($real_block) {\n' * | |
* 1771|'1164 *** 0 $kid = $op->first->sibling; # skip enter\n' * | |
* 1772|'1165 *** 0 0 if (is_miniwhile($kid)) {\n' * | |
* 1773|'1166 *** 0 my $top = $kid->first;\n' * | |
* 1774|'1167 *** 0 my $name = $top->name;\n' * | |
* 1775|'1168 *** 0 0 if ($name eq "and") {\n' * | |
* 1776|' *** 0 \n' * | |
* 1777|'1169 *** 0 $name = "while";\n' * | |
* 1778|'1170 } elsif ($name eq "or") {\n' * | |
* 1779|'1171 *** 0 $name = "until";\n' * | |
* 1780|'1172 } else { # no conditional -> while 1 or until 0\n' * | |
* 1781|'1173 *** 0 return $self->deparse($top->first, 1) . " while 1";\n' * | |
* 1782|'1174 }\n' * | |
* 1783|'1175 *** 0 my $cond = $top->first;\n' * | |
* 1784|'1176 *** 0 my $body = $cond->sibling->first; # skip lineseq\n' * | |
* 1785|'1177 *** 0 $cond = $self->deparse($cond, 1);\n' * | |
* 1786|'1178 *** 0 $body = $self->deparse($body, 1);\n' * | |
* 1787|'1179 *** 0 return "$body $name $cond";\n' * | |
* 1788|'1180 }\n' * | |
* 1789|'1181 } else {\n' * | |
* 1790|'1182 *** 0 $kid = $op->first;\n' * | |
* 1791|'1183 }\n' * | |
* 1792|'1184 *** 0 for (; !null($kid); $kid = $kid->sibling) {\n' * | |
* 1793|'1185 *** 0 push @kids, $kid;\n' * | |
* 1794|'1186 }\n' * | |
* 1795|'1187 *** 0 0 if ($cx > 0) { # inside an expression, (a do {} while for lineseq)\n' * | |
* 1796|'1188 *** 0 return "do {\\n\\t" . $self->lineseq($op, @kids) . "\\n\\b}";\n' * | |
* 1797|'1189 } else {\n' * | |
* 1798|'1190 *** 0 my $lineseq = $self->lineseq($op, @kids);\n' * | |
* 1799|'1191 *** 0 0 return (length ($lineseq) ? "$lineseq;" : "");\n' * | |
* 1800|'1192 }\n' * | |
* 1801|'1193 }\n' * | |
* 1802|'1194 \n' * | |
* 1803|'1195 *** 0 0 sub pp_scope { scopeop(0, @_); }\n' * | |
* 1804|'1196 *** 0 0 sub pp_lineseq { scopeop(0, @_); }\n' * | |
* 1805|'1197 *** 0 0 sub pp_leave { scopeop(1, @_); }\n' * | |
* 1806|'1198 \n' * | |
* 1807|'1199 # This is a special case of scopeop and lineseq, for the case of the\n' * | |
* 1808|'1200 # main_root. The difference is that we print the output statements as\n' * | |
* 1809|'1201 # soon as we get them, for the sake of impatient users.\n' * | |
* 1810|'1202 sub deparse_root {\n' * | |
* 1811|'1203 *** 0 0 my $self = shift;\n' * | |
* 1812|'1204 *** 0 my($op) = @_;\n' * | |
* 1813|'1205 *** 0 local(@$self{qw\'curstash warnings hints hinthash\'})\n' * | |
* 1814|'1206 = @$self{qw\'curstash warnings hints hinthash\'};\n' * | |
* 1815|'1207 *** 0 my @kids;\n' * | |
* 1816|'1208 *** 0 0 return if null $op->first; # Can happen, e.g., for Bytecode without -k\n' * | |
* 1817|'1209 *** 0 for (my $kid = $op->first->sibling; !null($kid); $kid = $kid->sibling) {\n' * | |
* 1818|'1210 *** 0 push @kids, $kid;\n' * | |
* 1819|'1211 }\n' * | |
* 1820|'1212 $self->walk_lineseq($op, \\@kids,\n' * | |
* 1821|'1213 *** 0 0 sub { print $self->indent($_[0].\';\');\n' * | |
* 1822|'1214 *** 0 0 print "\\n" unless $_[1] == $#kids;\n' * | |
* 1823|'1215 *** 0 });\n' * | |
* 1824|'1216 }\n' * | |
* 1825|'1217 \n' * | |
* 1826|'1218 sub walk_lineseq {\n' * | |
* 1827|'1219 *** 0 0 my ($self, $op, $kids, $callback) = @_;\n' * | |
* 1828|'1220 *** 0 my @kids = @$kids;\n' * | |
* 1829|'1221 *** 0 for (my $i = 0; $i < @kids; $i++) {\n' * | |
* 1830|'1222 *** 0 my $expr = "";\n' * | |
* 1831|'1223 *** 0 0 if (is_state $kids[$i]) {\n' * | |
* 1832|'1224 *** 0 $expr = $self->deparse($kids[$i++], 0);\n' * | |
* 1833|'1225 *** 0 0 if ($i > $#kids) {\n' * | |
* 1834|'1226 *** 0 $callback->($expr, $i);\n' * | |
* 1835|'1227 *** 0 last;\n' * | |
* 1836|'1228 }\n' * | |
* 1837|'1229 }\n' * | |
* 1838|'1230 *** 0 0 if (is_for_loop($kids[$i])) {\n' * | |
* 1839|'1231 *** 0 0 $callback->($expr . $self->for_loop($kids[$i], 0),\n' * | |
* 1840|'1232 $i += $kids[$i]->sibling->name eq "unstack" ? 2 : 1);\n' * | |
* 1841|'1233 *** 0 next;\n' * | |
* 1842|'1234 }\n' * | |
* 1843|'1235 *** 0 $expr .= $self->deparse($kids[$i], (@kids != 1)/2);\n' * | |
* 1844|'1236 *** 0 $expr =~ s/;\\n?\\z//;\n' * | |
* 1845|'1237 *** 0 $callback->($expr, $i);\n' * | |
* 1846|'1238 }\n' * | |
* 1847|'1239 }\n' * | |
* 1848|'1240 \n' * | |
* 1849|'1241 # The BEGIN {} is used here because otherwise this code isn\'t executed\n' * | |
* 1850|'1242 # when you run B::Deparse on itself.\n' * | |
* 1851|'1243 my %globalnames;\n' * | |
* 1852|'1244 BEGIN { map($globalnames{$_}++, "SIG", "STDIN", "STDOUT", "STDERR", "INC",\n' * | |
* 1853|'1245 "ENV", "ARGV", "ARGVOUT", "_"); }\n' * | |
* 1854|'1246 \n' * | |
* 1855|'1247 sub gv_name {\n' * | |
* 1856|'1248 *** 0 0 my $self = shift;\n' * | |
* 1857|'1249 *** 0 my $gv = shift;\n' * | |
* 1858|'1250 *** 0 0 Carp::confess() unless ref($gv) eq "B::GV";\n' * | |
* 1859|'1251 *** 0 my $stash = $gv->STASH->NAME;\n' * | |
* 1860|'1252 *** 0 my $name = $gv->SAFENAME;\n' * | |
* 1861|'1253 *** 0 0 0 if ($stash eq \'main\' && $name =~ /^::/) {\n' * | |
* 1862|' *** 0 0 \n' * | |
* 1863|' *** 0 \n' * | |
* 1864|' *** 0 \n' * | |
* 1865|' *** 0 \n' * | |
* 1866|' *** 0 \n' * | |
* 1867|' *** 0 \n' * | |
* 1868|'1254 *** 0 $stash = \'::\';\n' * | |
* 1869|'1255 }\n' * | |
* 1870|'1256 elsif (($stash eq \'main\' && $globalnames{$name})\n' * | |
* 1871|'1257 or ($stash eq $self->{\'curstash\'} && !$globalnames{$name}\n' * | |
* 1872|'1258 && ($stash eq \'main\' || $name !~ /::/))\n' * | |
* 1873|'1259 or $name =~ /^[^A-Za-z_:]/)\n' * | |
* 1874|'1260 {\n' * | |
* 1875|'1261 *** 0 $stash = "";\n' * | |
* 1876|'1262 } else {\n' * | |
* 1877|'1263 *** 0 $stash = $stash . "::";\n' * | |
* 1878|'1264 }\n' * | |
* 1879|'1265 *** 0 0 if ($name =~ /^(\\^..|{)/) {\n' * | |
* 1880|'1266 *** 0 $name = "{$name}"; # ${^WARNING_BITS}, etc and ${\n' * | |
* 1881|'1267 }\n' * | |
* 1882|'1268 *** 0 return $stash . $name;\n' * | |
* 1883|'1269 }\n' * | |
* 1884|'1270 \n' * | |
* 1885|'1271 # Return the name to use for a stash variable.\n' * | |
* 1886|'1272 # If a lexical with the same name is in scope, it may need to be\n' * | |
* 1887|'1273 # fully-qualified.\n' * | |
* 1888|'1274 sub stash_variable {\n' * | |
* 1889|'1275 *** 0 0 my ($self, $prefix, $name) = @_;\n' * | |
* 1890|'1276 \n' * | |
* 1891|'1277 *** 0 0 return "$prefix$name" if $name =~ /::/;\n' * | |
* 1892|'1278 \n' * | |
* 1893|'1279 *** 0 0 0 unless ($prefix eq \'$\' || $prefix eq \'@\' || #\'\n' * | |
* 1894|' *** 0 \n' * | |
* 1895|' *** 0 \n' * | |
* 1896|'1280 $prefix eq \'%\' || $prefix eq \'$#\') {\n' * | |
* 1897|'1281 *** 0 return "$prefix$name";\n' * | |
* 1898|'1282 }\n' * | |
* 1899|'1283 \n' * | |
* 1900|'1284 *** 0 0 my $v = ($prefix eq \'$#\' ? \'@\' : $prefix) . $name;\n' * | |
* 1901|'1285 *** 0 0 return $prefix .$self->{\'curstash\'}.\'::\'. $name if $self->lex_in_scope($v);\n' * | |
* 1902|'1286 *** 0 return "$prefix$name";\n' * | |
* 1903|'1287 }\n' * | |
* 1904|'1288 \n' * | |
* 1905|'1289 sub lex_in_scope {\n' * | |
* 1906|'1290 *** 0 0 my ($self, $name) = @_;\n' * | |
* 1907|'1291 *** 0 0 $self->populate_curcvlex() if !defined $self->{\'curcvlex\'};\n'
[Output truncated after 1000K]
------------------------------
PREREQUISITES
------------------------------
Prerequisite modules loaded:
requires:
Module Need Have
------------------- ---- ----
Digest::MD5 0 2.51
Storable 0 2.30
Test::More 0 0.98
Test::Warn 0 0.24
build_requires:
Module Need Have
------------------- ---- ----
ExtUtils::MakeMaker 0 6.62
configure_requires:
Module Need Have
------------------- ---- ----
ExtUtils::MakeMaker 0 6.62
------------------------------
ENVIRONMENT AND OTHER CONTEXT
------------------------------
Environment variables:
AUTOMATED_TESTING = 1
LANG = C
LD_LIBRARY_PATH = /usr/local/lib:
PATH = /export/home/cpant2/perl5/bin:/usr/local/bin:/usr/bin
PERL5LIB =
PERL5OPT =
PERL5_CPANPLUS_IS_RUNNING = 15274
PERL5_CPAN_IS_RUNNING = 15274
PERL5_CPAN_IS_RUNNING_IN_RECURSION = 2161,15274
PERL_CR_SMOKER_CURRENT = Devel-Cover-0.87
PERL_EXTUTILS_AUTOINSTALL = --defaultdeps
PERL_MM_USE_DEFAULT = 1
SHELL = /usr/bin/bash
TERM = xterm
Perl special variables (and OS-specific diagnostics, for MSWin32):
$^X = /export/home/cpant2/perl5/bin/perl5.14.2
$UID/$EUID = 101 / 101
$GID = 1 1
$EGID = 1 1
Perl module toolchain versions installed:
Module Have
------------------- --------
CPAN 1.9800
CPAN::Meta 2.120921
Cwd 3.36
ExtUtils::CBuilder 0.280205
ExtUtils::Command 1.17
ExtUtils::Install 1.56
ExtUtils::MakeMaker 6.62
ExtUtils::Manifest 1.60
ExtUtils::ParseXS 3.15
File::Spec 3.33
JSON 2.53
JSON::PP 2.27200
Module::Build 0.40
Module::Signature n/a
Parse::CPAN::Meta 1.4404
Test::Harness 3.23
Test::More 0.98
YAML 0.81
YAML::Syck 1.20
version 0.99
--
Summary of my perl5 (revision 5 version 14 subversion 2) configuration:
Platform:
osname=solaris, osvers=2.10, archname=i86pc-solaris-64int
uname='sunos vmrz0046 5.10 generic_141445-09 i86pc i386 i86pc solaris '
config_args='-Dcc=gcc -Dprefix=~/perl5 -Duse64bitint -Dusedevel -d'
hint=recommended, useposix=true, d_sigaction=define
useithreads=undef, usemultiplicity=undef
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=define, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='gcc', ccflags ='-DPTR_IS_LONG -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -DPERL_USE_SAFE_PUTENV',
optimize='-O',
cppflags='-DPTR_IS_LONG -fno-strict-aliasing -pipe -I/usr/local/include'
ccversion='', gccversion='3.4.6', gccosandvers='solaris2.10'
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='gcc', ldflags =' -L/usr/local/lib '
libpth=/usr/local/lib /usr/lib /usr/ccs/lib
libs=-lsocket -lnsl -lgdbm -ldl -lm -lc
perllibs=-lsocket -lnsl -ldl -lm -lc
libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'
Characteristics of this binary (from libperl):
Compile-time options: PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP
PERL_PRESERVE_IVUV PERL_USE_DEVEL
PERL_USE_SAFE_PUTENV USE_64_BIT_INT USE_LARGE_FILES
USE_PERLIO USE_PERL_ATOF
Built under solaris
Compiled at Sep 30 2011 11:41:59
%ENV:
PERL5LIB=""
PERL5OPT=""
PERL5_CPANPLUS_IS_RUNNING="15274"
PERL5_CPAN_IS_RUNNING="15274"
PERL5_CPAN_IS_RUNNING_IN_RECURSION="2161,15274"
PERL_CR_SMOKER_CURRENT="Devel-Cover-0.87"
PERL_EXTUTILS_AUTOINSTALL="--defaultdeps"
PERL_MM_USE_DEFAULT="1"
@INC:
/export/home/cpant2/perl5/lib/site_perl/5.14.2/i86pc-solaris-64int
/export/home/cpant2/perl5/lib/site_perl/5.14.2
/export/home/cpant2/perl5/lib/5.14.2/i86pc-solaris-64int
/export/home/cpant2/perl5/lib/5.14.2
/export/home/cpant2/perl5/lib/site_perl
.