From: Jarkko Hietaniemi Date: Tue, 12 Aug 2003 08:58:28 +0000 (+0000) Subject: Integrate: X-Git-Tag: perl-5.8.1~205 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/d211ebfa58aa937ca8abda3d2fe1e714da81bdfc Integrate: [ 20620] Subject: [PATCH] [@20616] perlreref.pod incorrectly describes \c From: merlyn@stonehenge.com (Randal L. Schwartz) Date: 11 Aug 2003 09:45:29 -0700 Message-ID: <86isp4kus6.fsf@blue.stonehenge.com> Subject: [PATCH] perlreref.pod tweaks From: Ronald J Kimball Date: Mon, 11 Aug 2003 13:19:51 -0400 Message-ID: <20030811171951.GA332851@linguist.thayer.dartmouth.edu> Plus a note about {,n} not being a quantifier. [ 20621] perldelta tweaks. [ 20622] [perl #23274] B::Deparse wasn't handling correctly builtins that have two filehandles in their prototypes (pipe, socketpair, accept) when non-bareword prototypes were used. [ 20623] Add a new regression test for Safe : tests that all ops can be trapped by a Safe compartement (except for the ones that can't.) [ 20625] Subject: Re: [PATCH] perlreref.pod tweaks From: Iain Truskett Date: Tue, 12 Aug 2003 13:59:27 +1000 Message-ID: <20030812035927.GJ7914@gytha.anu.edu.au> plus explain "Titlecase". [ 20626] head2-ify many of the head1s, will probably make this look better in HTML. [ 20627] Gotta Get'em Cases Right. [ 20628] Too enthusiastic head2-ing. [ 20629] =head2 ALL CAPS [ 20630] Fix for [perl #23287] segfault in untie. (Well, at least no more coredump.) [ 20631] A new try from Dave Mitchell for [perl #23265]. [ 20632] The Debian people have expressed a wish for the boilerplate being specific about the Perl version; patch from Nicholas Clark. [ 20633] Subject: [PATCH h2xs] produce Foo-Bar/lib/Foo/Bar.pm From: Michael G Schwern Date: Sat, 9 Aug 2003 15:03:02 -0700 Message-ID: <20030809220301.GE24919@windhund.schwern.org> (plus one extra catfile() in h2xs.t) [ 20634] Subject: [PATCH 5.8.1 @19053] XSLoader revisted From: Ilya Zakharevich Date: Mon, 21 Apr 2003 22:44:37 -0700 Message-ID: <20030422054437.GA8297@math.berkeley.edu> (the XSLoader doc hunk; the h2xs looks like a behavioural change) [ 20635] Advertise neo-h2xs. p4raw-link: @20635 on //depot/maint-5.8/perl: 03048e76084a87b7af1a556483f7ebf08a44e280 p4raw-link: @20634 on //depot/perl: d7f44de216e72597099819403690905e87b0a15f p4raw-link: @20633 on //depot/perl: 4a6602376e46f7ce9ede73b10063d105a533f05a p4raw-link: @20632 on //depot/perl: a42b7cd7ba47cae246abc5cd8f9dc7ba948aaa55 p4raw-link: @20631 on //depot/perl: 9d1ce744c6b1f6545853185bcc1688e9343cccff p4raw-link: @20630 on //depot/perl: b7056d9c698177a62c525b2c6e1f5368fe56e6c5 p4raw-link: @20629 on //depot/perl: 1501d360ba47d9f9487869f06b91da936bb3c6e7 p4raw-link: @20628 on //depot/perl: 40506b5d304221b2909f8fc369d184f7caedc902 p4raw-link: @20627 on //depot/perl: d3b55b48172934cab9a64a8de5d1bdd25b115c5c p4raw-link: @20626 on //depot/perl: a5365663f59d38ce50a53f9b46b25daa36d5ab17 p4raw-link: @20625 on //depot/perl: 47e8a552181f4e4d9a6075d02dfd1f5863b44bf7 p4raw-link: @20623 on //depot/perl: 6c52f3eb45c9b0bdbcd8209f58fd8ec7fbae4aa8 p4raw-link: @20622 on //depot/perl: b72c97e8d47870b635328f30b227f57d2bb55515 p4raw-link: @20621 on //depot/maint-5.8/perl: 47cd5e5e1f0206edd7bfaa844df56d4b74643f1e p4raw-link: @20620 on //depot/perl: 6d014f17427cba892ebb4fb2b45f28cc737c7c9e p4raw-id: //depot/maint-5.8/perl@20636 p4raw-branched: from //depot/perl@20635 'branch in' ext/Safe/t/safeops.t p4raw-integrated: from //depot/perl@20635 'copy in' lib/h2xs.t (@15429..) pp_sys.c (@19910..) ext/DynaLoader/XSLoader_pm.PL (@19948..) utils/h2xs.PL (@20176..) t/op/tie.t (@20199..) pod/perlreref.pod (@20620..) 'merge in' ext/B/B/Deparse.pm (@20287..) MANIFEST (@20593..) pad.c t/op/closure.t (@20602..) --- diff --git a/MANIFEST b/MANIFEST index fb1ae5e..2989611 100644 --- a/MANIFEST +++ b/MANIFEST @@ -600,6 +600,7 @@ ext/re/t/re.t see if re pragma works ext/Safe/t/safe1.t See if Safe works ext/Safe/t/safe2.t See if Safe works ext/Safe/t/safe3.t See if Safe works +ext/Safe/t/safeops.t Tests that all ops can be trapped by Safe ext/SDBM_File/Makefile.PL SDBM extension makefile writer ext/SDBM_File/sdbm/biblio SDBM kit ext/SDBM_File/sdbm/CHANGES SDBM kit diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 723a519..6fd1e9a 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -2126,8 +2126,9 @@ sub listop { return $name if null $kid; my $first; $name = "socketpair" if $name eq "sockpair"; - if (defined prototype("CORE::$name") - && prototype("CORE::$name") =~ /^;?\*/ + my $proto = prototype("CORE::$name"); + if (defined $proto + && $proto =~ /^;?\*/ && $kid->name eq "rv2gv") { $first = $self->deparse($kid->first, 6); } @@ -2140,6 +2141,10 @@ sub listop { $first = "+$first" if not $parens and substr($first, 0, 1) eq "("; push @exprs, $first; $kid = $kid->sibling; + if ($proto =~ /^\*\*/ && $kid->name eq "rv2gv") { + push @exprs, $self->deparse($kid->first, 6); + $kid = $kid->sibling; + } for (; !null($kid); $kid = $kid->sibling) { push @exprs, $self->deparse($kid, 6); } diff --git a/ext/DynaLoader/XSLoader_pm.PL b/ext/DynaLoader/XSLoader_pm.PL index 9e6d42b..9f3aaed 100644 --- a/ext/DynaLoader/XSLoader_pm.PL +++ b/ext/DynaLoader/XSLoader_pm.PL @@ -160,6 +160,164 @@ For more complicated interface see L. Many (most) features of DynaLoader are not implemented in XSLoader, like for example the dl_load_flags is not honored by XSLoader. +=head2 Migration from C + +A typical module using L starts like this: + + package YourPackage; + require DynaLoader; + + our @ISA = qw( OnePackage OtherPackage DynaLoader ); + our $VERSION = '0.01'; + bootstrap YourPackage $VERSION; + +Change this to + + package YourPackage; + use XSLoader; + + our @ISA = qw( OnePackage OtherPackage ); + our $VERSION = '0.01'; + XSLoader::load 'YourPackage', $VERSION; + +In other words: replace C by C, remove +C from @ISA, change C by C. Do not +forget to quote the name of your package on the C line, +and add comma (C<,>) before the arguments ($VERSION above). + +Of course, if @ISA contained only C, there is no need to have the +@ISA assignment at all; moreover, if instead of C one uses +backward-compatible + + use vars qw($VERSION @ISA); + +one can remove this reference to @ISA together with the @ISA assignment + +If no $VERSION was specified on the C line, the last line becomes + + XSLoader::load 'YourPackage'; + +=head2 Backward compatible boilerplate + +If you want to have your cake and eat it too, you need a more complicated +boilerplate. + + package YourPackage; + use vars qw($VERSION @ISA); + + @ISA = qw( OnePackage OtherPackage ); + $VERSION = '0.01'; + eval { + require XSLoader; + XSLoader::load('YourPackage', $VERSION); + 1; + } or do { + require DynaLoader; + push @ISA, 'DynaLoader'; + bootstrap YourPackage $VERSION; + }; + +The parentheses about XSLoader::load() arguments are needed since we replaced +C by C, so the compiler does not know that a function +XSLoader::load() is present. + +This boilerplate uses the low-overhead C if present; if used with +an antic Perl which has no C, it falls back to using C. + +=head1 Order of initialization: early load() + +I section in your XS file (see L). +What is described here is equally applicable to L +interface.> + +A sufficiently complicated module using XS would have both Perl code (defined +in F) and XS code (defined in F). If this +Perl code makes calls into this XS code, and/or this XS code makes calls to +the Perl code, one should be careful with the order of initialization. + +The call to XSLoader::load() (or bootstrap()) has three side effects: + +=over + +=item * + +if $VERSION was specified, a sanity check is done to insure that the versions +of the F<.pm> and the (compiled) F<.xs> parts are compatible; + +=item * + +The XSUBs are made accessible from Perl; + +=item * + +If the C section was present in F<.xs> file, the code there is called. + +=back + +Consequently, if the code in F<.pm> file makes calls to these XSUBs, it is +convenient to have XSUBs installed before the Perl code is defined; for +example, this makes prototypes for XSUBs visible to this Perl code. +Alternatively, if the C section makes calls to Perl functions (or +uses Perl variables) defined in F<.pm> file, they must be defined prior to +the call to XSLoader::load() (or bootstrap()). + +The first situation being much more frequent, it makes sense to rewrite the +boilerplate as + + package YourPackage; + use XSLoader; + use vars qw($VERSION @ISA); + + BEGIN { + @ISA = qw( OnePackage OtherPackage ); + $VERSION = '0.01'; + + # Put Perl code used in the BOOT: section here + + XSLoader::load 'YourPackage', $VERSION; + } + + # Put Perl code making calls into XSUBs here + +=head2 The most hairy case + +If the interdependence of your C section and Perl code is +more complicated than this (e.g., the C section makes calls to Perl +functions which make calls to XSUBs with prototypes), get rid of the C +section altogether. Replace it with a function onBOOT(), and call it like +this: + + package YourPackage; + use XSLoader; + use vars qw($VERSION @ISA); + + BEGIN { + @ISA = qw( OnePackage OtherPackage ); + $VERSION = '0.01'; + XSLoader::load 'YourPackage', $VERSION; + } + + # Put Perl code used in onBOOT() function here; calls to XSUBs are + # prototype-checked. + + onBOOT; + + # Put Perl initialization code assuming that XS is initialized here + +=head1 LIMITATIONS + +To reduce the overhead as much as possible, only one possible location +is checked to find the extension DLL (this location is where C +would put the DLL). If not found, the search for the DLL is transparently +delegated to C, which looks for the DLL along the @INC list. + +In particular, this is applicable to the structure of @INC used for testing +not-yet-installed extensions. This means that the overhead of running +uninstalled extension may be much more than running the same extension after +C. + =head1 AUTHOR Ilya Zakharevich: extraction from DynaLoader. diff --git a/ext/Safe/t/safeops.t b/ext/Safe/t/safeops.t new file mode 100644 index 0000000..285e978 --- /dev/null +++ b/ext/Safe/t/safeops.t @@ -0,0 +1,415 @@ +#!perl +# Tests that all ops can be trapped by a Safe compartment + +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't' if -d 't'; + @INC = '../lib'; + } + else { + # this won't work outside of the core, so exit + print "1..0\n"; exit 0; + } +} +use Config; +BEGIN { + if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') { + print "1..0\n"; exit 0; + } +} + +use strict; +use Test::More tests => 354; +use Safe; + +# Read the op names and descriptions directly from opcode.pl +my @op; +my @opname; +open my $fh, '<', '../opcode.pl' or die "Can't open opcode.pl: $!"; +while (<$fh>) { + last if /^__END__/; +} +while (<$fh>) { + chomp; + next if !$_ or /^#/; + my ($op, $opname) = split /\t+/; + push @op, $op; + push @opname, $opname; +} +close $fh; + +sub testop { + my ($op, $opname, $code) = @_; + pass("$op : skipped") and return if $code =~ /^SKIP/; + my $c = new Safe; + $c->deny_only($op); + $c->reval($code); + like($@, qr/'\Q$opname\E' trapped by operation mask/, $op); +} + +my $i = 0; +while () { + testop $op[$i], $opname[$i], $_; + ++$i; +} + +# lists op examples, in the same order than opcode.pl +# things that begin with SKIP are skipped, for various reasons (notably +# optree modified by the optimizer -- Safe checks are done before the +# optimizer modifies the optree) + +__DATA__ +SKIP # null +SKIP # stub +scalar $x # scalar +print @x # pushmark +wantarray # wantarray +42 # const +SKIP (set by optimizer) $x # gvsv +SKIP *x # gv +*x{SCALAR} # gelem +SKIP my $x # padsv +SKIP my @x # padav +SKIP my %x # padhv +SKIP (not implemented) # padany +SKIP split /foo/ # pushre +*x # rv2gv +$x # rv2sv +$#x # av2arylen +f() # rv2cv +sub { } # anoncode +prototype 'foo' # prototype +\($x,$y) # refgen +SKIP \$x # srefgen +ref # ref +bless # bless +qx/ls/ # backtick +<*.c> # glob + # readline +SKIP (set by optimizer) $x .= # rcatline +SKIP (internal) # regcmaybe +SKIP (internal) # regcreset +SKIP (internal) # regcomp +/foo/ # match +qr/foo/ # qr +s/foo/bar/ # subst +SKIP (set by optimizer) # substcont +y:z:t: # trans +$x = $y # sassign +@x = @y # aassign +chop @foo # chop +chop # schop +chomp @foo # chomp +chomp # schomp +defined # defined +undef # undef +study # study +pos # pos +++$i # preinc +SKIP (set by optimizer) # i_preinc +--$i # predec +SKIP (set by optimizer) # i_predec +$i++ # postinc +SKIP (set by optimizer) # i_postinc +$i-- # postdec +SKIP (set by optimizer) # i_postdec +$x ** $y # pow +$x * $y # multiply +SKIP (set by optimizer) # i_multiply +$x / $y # divide +SKIP (set by optimizer) # i_divide +$x % $y # modulo +SKIP (set by optimizer) # i_modulo +$x x $y # repeat +$x + $y # add +SKIP (set by optimizer) # i_add +$x - $y # subtract +SKIP (set by optimizer) # i_subtract +$x . $y # concat +"$x" # stringify +$x << 1 # left_shift +$x >> 1 # right_shift +$x < $y # lt +SKIP (set by optimizer) # i_lt +$x > $y # gt +SKIP (set by optimizer) # i_gt +$i <= $y # le +SKIP (set by optimizer) # i_le +$i >= $y # ge +SKIP (set by optimizer) # i_ge +$x == $y # eq +SKIP (set by optimizer) # i_eq +$x != $y # ne +SKIP (set by optimizer) # i_ne +$i <=> $y # ncmp +SKIP (set by optimizer) # i_ncmp +$x lt $y # slt +$x gt $y # sgt +$x le $y # sle +$x ge $y # sge +$x eq $y # seq +$x ne $y # sne +$x cmp $y # scmp +$x & $y # bit_and +$x ^ $y # bit_xor +$x | $y # bit_or +-$x # negate +SKIP (set by optimizer) # i_negate +!$x # not +~$x # complement +atan2 1 # atan2 +sin 1 # sin +cos 1 # cos +rand # rand +srand # srand +exp 1 # exp +log 1 # log +sqrt 1 # sqrt +int # int +hex # hex +oct # oct +abs # abs +length # length +substr $x, 1 # substr +vec # vec +index # index +rindex # rindex +sprintf '%s', 'foo' # sprintf +formline # formline +ord # ord +chr # chr +crypt 'foo','bar' # crypt +ucfirst # ucfirst +lcfirst # lcfirst +uc # uc +lc # lc +quotemeta # quotemeta +@a # rv2av +SKIP (set by optimizer) # aelemfast +$a[1] # aelem +@a[1,2] # aslice +each %h # each +values %h # values +keys %h # keys +delete $h{Key} # delete +exists $h{Key} # exists +%h # rv2hv +$h{kEy} # helem +@h{kEy} # hslice +unpack # unpack +pack # pack +split /foo/ # split +join $a, @b # join +@x = (1,2) # list +SKIP @x[1,2] # lslice +[1,2] # anonlist +{ a => 1 } # anonhash +splice @x, 1, 2, 3 # splice +push @x, $x # push +pop @x # pop +shift @x # shift +unshift @x # unshift +sort @x # sort +reverse @x # reverse +grep { $_ eq 'foo' } @x # grepstart +SKIP grep { $_ eq 'foo' } @x # grepwhile +map $_ + 1, @foo # mapstart +SKIP (set by optimizer) # mapwhile +SKIP # range +1..2 # flip +1..2 # flop +$x && $y # and +$x || $y # or +$x xor $y # xor +$x ? 1 : 0 # cond_expr +$x &&= $y # andassign +$x ||= $y # orassign +Foo->$x() # method +f() # entersub +sub f{} f() # leavesub +sub f:lvalue{return $x} f() # leavesublv +caller # caller +warn # warn +die # die +reset # reset +SKIP # lineseq +SKIP # nextstate +SKIP (needs debugger) # dbstate +while(0){} # unstack +SKIP # enter +SKIP # leave +SKIP # scope +SKIP # enteriter +SKIP # iter +SKIP # enterloop +SKIP # leaveloop +return # return +last # last +next # next +redo THIS # redo +dump # dump +goto THERE # goto +exit 0 # exit +open FOO # open +close FOO # close +pipe FOO,BAR # pipe_op +fileno FOO # fileno +umask 0755, 'foo' # umask +binmode FOO # binmode +tie # tie +untie # untie +tied # tied +dbmopen # dbmopen +dbmclose # dbmclose +SKIP (set by optimizer) # sselect +select FOO # select +getc FOO # getc +read FOO # read +write # enterwrite +SKIP # leavewrite +printf # prtf +print # print +sysopen # sysopen +sysseek # sysseek +sysread # sysread +syswrite # syswrite +send # send +recv # recv +eof FOO # eof +tell # tell +seek FH, $pos, $whence # seek +truncate FOO, 42 # truncate +fcntl # fcntl +ioctl # ioctl +flock FOO, 1 # flock +socket # socket +socketpair # sockpair +bind # bind +connect # connect +listen # listen +accept # accept +shutdown # shutdown +getsockopt # gsockopt +setsockopt # ssockopt +getsockname # getsockname +getpeername # getpeername +lstat FOO # lstat +stat FOO # stat +-R # ftrread +-W # ftrwrite +-X # ftrexec +-r # fteread +-w # ftewrite +-x # fteexec +-e # ftis +SKIP -O # fteowned +SKIP -o # ftrowned +-z # ftzero +-s # ftsize +-M # ftmtime +-A # ftatime +-C # ftctime +-S # ftsock +-c # ftchr +-b # ftblk +-f # ftfile +-d # ftdir +-p # ftpipe +-l # ftlink +-u # ftsuid +-g # ftsgid +-k # ftsvtx +-t # fttty +-T # fttext +-B # ftbinary +chdir '/' # chdir +chown # chown +chroot # chroot +unlink 'foo' # unlink +chmod 511, 'foo' # chmod +utime # utime +rename 'foo', 'bar' # rename +link 'foo', 'bar' # link +symlink 'foo', 'bar' # symlink +readlink 'foo' # readlink +mkdir 'foo' # mkdir +rmdir 'foo' # rmdir +opendir DIR # open_dir +readdir DIR # readdir +telldir DIR # telldir +seekdir DIR, $pos # seekdir +rewinddir DIR # rewinddir +closedir DIR # closedir +fork # fork +wait # wait +waitpid # waitpid +system # system +exec # exec +kill # kill +getppid # getppid +getpgrp # getpgrp +setpgrp # setpgrp +getpriority # getpriority +setpriority # setpriority +time # time +times # tms +localtime # localtime +gmtime # gmtime +alarm # alarm +sleep 1 # sleep +shmget # shmget +shmctl # shmctl +shmread # shmread +shmwrite # shmwrite +msgget # msgget +msgctl # msgctl +msgsnd # msgsnd +msgrcv # msgrcv +semget # semget +semctl # semctl +semop # semop +use strict # require +do 'file' # dofile +eval "1+1" # entereval +eval "1+1" # leaveeval +SKIP eval { 1+1 } # entertry +SKIP eval { 1+1 } # leavetry +gethostbyname 'foo' # ghbyname +gethostbyaddr 'foo' # ghbyaddr +gethostent # ghostent +getnetbyname 'foo' # gnbyname +getnetbyaddr 'foo' # gnbyaddr +getnetent # gnetent +getprotobyname 'foo' # gpbyname +getprotobynumber 42 # gpbynumber +getprotoent # gprotoent +getservbyname 'name', 'proto' # gsbyname +getservbyport 'a', 'b' # gsbyport +getservent # gservent +sethostent # shostent +setnetent # snetent +setprotoent # sprotoent +setservent # sservent +endhostent # ehostent +endnetent # enetent +endprotoent # eprotoent +endservent # eservent +getpwnam # gpwnam +getpwuid # gpwuid +getpwent # gpwent +setpwent # spwent +endpwent # epwent +getgrnam # ggrnam +getgrgid # ggrgid +getgrent # ggrent +setgrent # sgrent +endgrent # egrent +getlogin # getlogin +syscall # syscall +SKIP # lock +SKIP # threadsv +SKIP # setstate +$x->y() # method_named +$x // $y # dor +$x //= $y # dorassign +SKIP (no way) # custom diff --git a/lib/h2xs.t b/lib/h2xs.t index 5acc0b2..2a5e14b 100644 --- a/lib/h2xs.t +++ b/lib/h2xs.t @@ -58,74 +58,74 @@ If you intend this module to be compatible with earlier perl versions, please specify a minimum perl version with the -b option. Writing $name/ppport.h -Writing $name/$name.pm +Writing $name/lib/$name.pm Writing $name/$name.xs Writing $name/fallback/const-c.inc Writing $name/fallback/const-xs.inc Writing $name/Makefile.PL Writing $name/README -Writing $name/t/1.t +Writing $name/t/$name.t Writing $name/Changes Writing $name/MANIFEST EOXSFILES "-f -n $name -b $thisversion", $], <<"EOXSFILES", Writing $name/ppport.h -Writing $name/$name.pm +Writing $name/lib/$name.pm Writing $name/$name.xs Writing $name/fallback/const-c.inc Writing $name/fallback/const-xs.inc Writing $name/Makefile.PL Writing $name/README -Writing $name/t/1.t +Writing $name/t/$name.t Writing $name/Changes Writing $name/MANIFEST EOXSFILES "-f -n $name -b 5.6.1", "5.006001", <<"EOXSFILES", Writing $name/ppport.h -Writing $name/$name.pm +Writing $name/lib/$name.pm Writing $name/$name.xs Writing $name/fallback/const-c.inc Writing $name/fallback/const-xs.inc Writing $name/Makefile.PL Writing $name/README -Writing $name/t/1.t +Writing $name/t/$name.t Writing $name/Changes Writing $name/MANIFEST EOXSFILES "-f -n $name -b 5.5.3", "5.00503", <<"EOXSFILES", Writing $name/ppport.h -Writing $name/$name.pm +Writing $name/lib/$name.pm Writing $name/$name.xs Writing $name/fallback/const-c.inc Writing $name/fallback/const-xs.inc Writing $name/Makefile.PL Writing $name/README -Writing $name/t/1.t +Writing $name/t/$name.t Writing $name/Changes Writing $name/MANIFEST EOXSFILES "\"-X\" -f -n $name -b $thisversion", $], <<"EONOXSFILES", -Writing $name/$name.pm +Writing $name/lib/$name.pm Writing $name/Makefile.PL Writing $name/README -Writing $name/t/1.t +Writing $name/t/$name.t Writing $name/Changes Writing $name/MANIFEST EONOXSFILES "-f -n $name $header -b $thisversion", $], <<"EOXSFILES", Writing $name/ppport.h -Writing $name/$name.pm +Writing $name/lib/$name.pm Writing $name/$name.xs Writing $name/fallback/const-c.inc Writing $name/fallback/const-xs.inc Writing $name/Makefile.PL Writing $name/README -Writing $name/t/1.t +Writing $name/t/$name.t Writing $name/Changes Writing $name/MANIFEST EOXSFILES @@ -134,7 +134,7 @@ EOXSFILES my $total_tests = 3; # opening, closing and deleting the header file. for (my $i = $#tests; $i > 0; $i-=3) { # 1 test for running it, 1 test for the expected result, and 1 for each file - # plus 1 to open and 1 to check for the use in $name.pm and Makefile.PL + # plus 1 to open and 1 to check for the use in lib/$name.pm and Makefile.PL # And 1 more for our check for "bonus" files, 2 more for ExtUtil::Manifest. # use the () to force list context and hence count the number of matches. $total_tests += 9 + (() = $tests[$i] =~ /(Writing)/sg); @@ -199,7 +199,7 @@ while (my ($args, $version, $expectation) = splice @tests, 0, 3) { pop @INC; chdir ($up) or die "chdir $up failed: $!"; - foreach my $leaf ("$name.pm", 'Makefile.PL') { + foreach my $leaf (File::Spec->catfile('lib', "$name.pm"), 'Makefile.PL') { my $file = File::Spec->catfile($name, $leaf); if (ok (open (FILE, $file), "open $file")) { my $match = qr/use $version;/; diff --git a/pad.c b/pad.c index 1b415b1..3f26d1a 100644 --- a/pad.c +++ b/pad.c @@ -253,11 +253,19 @@ Perl_pad_undef(pTHX_ CV* cv) && CvOUTSIDE(innercv) == cv) { assert(CvWEAKOUTSIDE(innercv)); - CvWEAKOUTSIDE_off(innercv); - CvOUTSIDE(innercv) = outercv; - CvOUTSIDE_SEQ(innercv) = seq; - SvREFCNT_inc(outercv); + /* don't relink to grandfather if he's being freed */ + if (outercv && SvREFCNT(outercv)) { + CvWEAKOUTSIDE_off(innercv); + CvOUTSIDE(innercv) = outercv; + CvOUTSIDE_SEQ(innercv) = seq; + SvREFCNT_inc(outercv); + } + else { + CvOUTSIDE(innercv) = Nullcv; + } + } + } } } diff --git a/pod/perlreref.pod b/pod/perlreref.pod index 08cd227..fc38b13 100644 --- a/pod/perlreref.pod +++ b/pod/perlreref.pod @@ -6,15 +6,21 @@ perlreref - Perl Regular Expressions Reference This is a quick reference to Perl's regular expressions. For full information see L and L, as well -as the L section in this document. +as the L section in this document. -=head1 OPERATORS +=head2 OPERATORS =~ determines to which variable the regex is applied. In its absence, $_ is used. $var =~ /foo/; + !~ determines to which variable the regex is applied, + and negates the result of the match; it returns + false if the match succeeds, and true if it fails. + + $var !~ /foo/; + m/pattern/igmsoxc searches a string for a pattern match, applying the given options. @@ -24,9 +30,9 @@ as the L section in this document. s match as a Single line - . matches \n o compile pattern Once x eXtended legibility - free whitespace and comments - c don't reset pos on fails when using /g + c don't reset pos on failed matches when using /g - If 'pattern' is an empty string, the last I match + If 'pattern' is an empty string, the last I matched regex is used. Delimiters other than '/' may be used for both this operator and the following ones. @@ -44,11 +50,11 @@ as the L section in this document. as a double quoted string unless a single-quote (') is the delimiter. ?pattern? is like m/pattern/ but matches only once. No alternate - delimiters can be used. Must be reset with 'reset'. + delimiters can be used. Must be reset with L. -=head1 SYNTAX +=head2 SYNTAX - \ Escapes the character(s) immediately following it + \ Escapes the character immediately following it . Matches any single character except a newline (unless /s is used) ^ Matches at the beginning of the string (or line, if /m is used) $ Matches at the end of the string (or line, if /m is used) @@ -59,7 +65,7 @@ as the L section in this document. [...] Matches any one of the characters contained within the brackets (...) Groups subexpressions for capturing to $1, $2... (?:...) Groups subexpressions without capturing (cluster) - | Matches either the expression preceding or following it + | Matches either the subexpression preceding or following it \1, \2 ... The text from the Nth group =head2 ESCAPE SEQUENCES @@ -78,13 +84,15 @@ These work as in normal strings. \cx Control-x \N{name} A named character - \l Lowercase until next character - \u Uppercase until next character + \l Lowercase next character + \u Titlecase next character \L Lowercase until \E \U Uppercase until \E \Q Disable pattern metacharacters until \E \E End case modification +For Titlecase, see L. + This one works differently from normal strings: \b An assertion, not backspace, except in a character class @@ -94,17 +102,17 @@ This one works differently from normal strings: [amy] Match 'a', 'm' or 'y' [f-j] Dash specifies "range" [f-j-] Dash escaped or at start or end means 'dash' - [^f-j] Caret indicates "match char any _except_ these" + [^f-j] Caret indicates "match any character _except_ these" The following work within or without a character class: \d A digit, same as [0-9] \D A nondigit, same as [^0-9] - \w A word character (alphanumeric), same as [a-zA-Z_0-9] - \W A non-word character, [^a-zA-Z_0-9] + \w A word character (alphanumeric), same as [a-zA-Z0-9_] + \W A non-word character, [^a-zA-Z0-9_] \s A whitespace character, same as [ \t\n\r\f] \S A non-whitespace character, [^ \t\n\r\f] - \C Match a byte (with Unicode. '.' matches char) + \C Match a byte (with Unicode, '.' matches char) \pP Match P-named (Unicode) property \p{...} Match Unicode property with long name \PP Match non-P @@ -142,34 +150,34 @@ All are zero-width assertions. ^ Match string start (or line, if /m is used) $ Match string end (or line, if /m is used) or before newline \b Match word boundary (between \w and \W) - \B Match except at word boundary + \B Match except at word boundary (between \w and \w or \W and \W) \A Match string start (regardless of /m) - \Z Match string end (preceding optional newline) + \Z Match string end (before optional newline) \z Match absolute string end \G Match where previous m//g left off - \c Suppresses resetting of search position when used with /g. - Without \c, search pattern is reset to the beginning of the string =head2 QUANTIFIERS -Quantifiers are greedy by default --- match the B leftmost. +Quantifiers are greedy by default -- match the B leftmost. Maximal Minimal Allowed range ------- ------- ------------- {n,m} {n,m}? Must occur at least n times but no more than m times {n,} {n,}? Must occur at least n times - {n} {n}? Must match exactly n times + {n} {n}? Must occur exactly n times * *? 0 or more times (same as {0,}) + +? 1 or more times (same as {1,}) ? ?? 0 or 1 time (same as {0,1}) +There is no quantifier {,n} -- that gets understood as a literal string. + =head2 EXTENDED CONSTRUCTS (?#text) A comment - (?imxs-imsx:...) Enable/disable option (as per m//) + (?imxs-imsx:...) Enable/disable option (as per m// modifiers) (?=...) Zero-width positive lookahead assertion (?!...) Zero-width negative lookahead assertion - (?<...) Zero-width positive lookbehind assertion + (?<=...) Zero-width positive lookbehind assertion (?...) Grab what we can, prohibit backtracking (?{ code }) Embedded code, return value becomes $^R @@ -177,7 +185,7 @@ Quantifiers are greedy by default --- match the B leftmost. (?(cond)yes|no) cond being integer corresponding to capturing parens (?(cond)yes) or a lookaround/eval zero-width assertion -=head1 VARIABLES +=head2 VARIABLES $_ Default variable for operators to use $* Enable multiline matching (deprecated; not in 5.9.0 or later) @@ -195,17 +203,18 @@ See also L. $+ Last parenthesized pattern match $^N Holds the most recently closed capture $^R Holds the result of the last (?{...}) expr - @- Offsets of starts of groups. [0] holds start of whole match - @+ Offsets of ends of groups. [0] holds end of whole match + @- Offsets of starts of groups. $-[0] holds start of whole match + @+ Offsets of ends of groups. $+[0] holds end of whole match -Capture groups are numbered according to their I paren. +Captured groups are numbered according to their I paren. -=head1 FUNCTIONS +=head2 FUNCTIONS lc Lowercase a string lcfirst Lowercase first char of a string uc Uppercase a string ucfirst Titlecase first char of a string + pos Return or set current match position quotemeta Quote metacharacters reset Reset ?pattern? status @@ -213,6 +222,16 @@ Capture groups are numbered according to their I paren. split Use regex to split a string into parts +The first four of these are like the escape sequences C<\L>, C<\l>, +C<\U>, and C<\u>. For Titlecase, see L. + +=head2 TERMINOLOGY + +=head3 Titlecase + +Unicode concept which most often is equal to uppercase, but for +certain characters like the German "sharp s" there is a difference. + =head1 AUTHOR Iain Truskett. @@ -283,3 +302,5 @@ Jim Cromie, and Jeffrey Goff for useful advice. + +=cut diff --git a/pp_sys.c b/pp_sys.c index b240b62..910fb14 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -860,7 +860,7 @@ PP(pp_untie) if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv))) RETPUSHYES; - if ((mg = SvTIED_mg(sv, how))) { + if ((mg = SvTIED_mg(sv, how)) && mg->mg_obj) { SV *obj = SvRV(mg->mg_obj); GV *gv; CV *cv = NULL; diff --git a/t/op/closure.t b/t/op/closure.t index 6a81a44..54a20d2 100755 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -13,7 +13,7 @@ BEGIN { use Config; -print "1..181\n"; +print "1..185\n"; my $test = 1; sub test (&) { @@ -604,3 +604,34 @@ sub linger { linger(\$watch); test { $watch eq '12' } } + +require "./test.pl"; + +curr_test(182); + +SKIP: { skip("tests not in maint because change #19637 not applied", 3) } + +$test= 185; + +# bugid #23265 - this used to coredump during destruction of PL_maincv +# and its children + +my $got = runperl( + prog => q[ + print + sub {$_[0]->(@_)} -> ( + sub { + $_[1] + ? $_[0]->($_[0], $_[1] - 1) . sub {"x"}->() + : "y" + }, + 2 + ) + , "\n" + ; + + ], + stderr => 1 +); +test { $got eq "yxx\n" }; + diff --git a/t/op/tie.t b/t/op/tie.t index a3b4be2..d73cce1 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -360,3 +360,10 @@ $s=~ s/\(0x\w+\)//g; print $s, "\n"; EXPECT SCALAR SCALAR SCALAR SCALAR +######## +# [perl #23287] segfault in untie +sub TIESCALAR { bless $_[1], $_[0] } +my $var; +tie $var, 'main', \$var; +untie $var; +EXPECT diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 6e1f297..e444d5e 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -504,6 +504,7 @@ $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload); use File::Compare; +use File::Path; sub usage { warn "@_\n" if @_; @@ -912,7 +913,6 @@ if( @path_h ){ # Save current directory so that C::Scan can use it my $cwd = File::Spec->rel2abs( File::Spec->curdir ); -my ($ext, $nested, @modparts, $modfname, $modpname); # As Ilya suggested, use a name that contains - and then it can't clash with # the names of any packages. A directory 'fallback' will clash with any # new pragmata down the fallback:: tree, but that seems unlikely. @@ -920,35 +920,21 @@ my $constscfname = 'const-c.inc'; my $constsxsfname = 'const-xs.inc'; my $fallbackdirname = 'fallback'; -$ext = chdir 'ext' ? 'ext/' : ''; - -if( $module =~ /::/ ){ - $nested = 1; - @modparts = split(/::/,$module); - $modfname = $modparts[-1]; - $modpname = join('/',@modparts); -} -else { - $nested = 0; - @modparts = (); - $modfname = $modpname = $module; -} - - +my $ext = chdir 'ext' ? 'ext/' : ''; + +my @modparts = split(/::/,$module); +my $modpname = join('-', @modparts); +my $modfname = pop @modparts; +my $modpmdir = join '/', 'lib', @modparts; +my $modpmname = join '/', $modpmdir, $modfname.'.pm'; + if ($opt_O) { warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname; } else { die "Won't overwrite existing $ext$modpname\n" if -e $modpname; } -if( $nested ){ - my $modpath = ""; - foreach (@modparts){ - -d "$modpath$_" || mkdir("$modpath$_", 0777); - $modpath .= "$_/"; - } -} --d "$modpname" || mkdir($modpname, 0777); +-d "$modpname" || mkpath([$modpname], 0, 0775); chdir($modpname) || die "Can't chdir $ext$modpname: $!\n"; my %types_seen; @@ -1080,10 +1066,11 @@ if( ! $opt_X ){ # use XS, unless it was disabled } my @const_names = sort keys %const_names; -open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n"; +-d $modpmdir || mkpath([$modpmdir], 0, 0775); +open(PM, ">$modpmname") || die "Can't create $ext$modpname/$modpmname: $!\n"; $" = "\n\t"; -warn "Writing $ext$modpname/$modfname.pm\n"; +warn "Writing $ext$modpname/$modpmname\n"; print PM <<"END"; package $module; @@ -1232,7 +1219,7 @@ print PM <<"END"; __END__ END -my ($email,$author); +my ($email,$author,$licence); eval { my $username; @@ -1248,6 +1235,14 @@ eval { $author ||= "A. U. Thor"; $email ||= 'a.u.thor@a.galaxy.far.far.away'; +$licence = sprintf << "DEFAULT", $^V; +Copyright (C) ${\(1900 + (localtime) [5])} by $author + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version %vd or, +at your option, any later version of Perl 5 you may have available. +DEFAULT + my $revhist = ''; $revhist = < '$module', - VERSION_FROM => '$modfname.pm', # finds \$VERSION + VERSION_FROM => '$modpmname', # finds \$VERSION PREREQ_PM => {$prereq_pm}, # e.g., Module::Name => 1.1 (\$] >= 5.005 ? ## Add these new keywords supported since 5.005 - (ABSTRACT_FROM => '$modfname.pm', # retrieve abstract from module + (ABSTRACT_FROM => '$modpmname', # retrieve abstract from module AUTHOR => '$author <$email>') : ()), END if (!$opt_X) { # print C stuff, unless XS is disabled @@ -2048,16 +2046,13 @@ COPYRIGHT AND LICENCE Put the correct copyright and licence information here. -Copyright (C) $thisyear $author - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +$licence _RMEND_ close(RM) || die "Can't close $ext$modpname/README: $!\n"; my $testdir = "t"; -my $testfile = "$testdir/1.t"; +my $testfile = "$testdir/$modpname.t"; unless (-d "$testdir") { mkdir "$testdir" or die "Cannot mkdir $testdir: $!\n"; } @@ -2068,7 +2063,7 @@ open EX, ">$testfile" or die "Can't create $ext$modpname/$testfile: $!\n"; print EX <<_END_; # Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl 1.t' +# `make test'. After `make install' it should work as `perl $modpname.t' ######################### @@ -2182,7 +2177,7 @@ EOP warn "Writing $ext$modpname/MANIFEST\n"; open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!"; -my @files = grep { -f } (<*>, , <$fallbackdirname/*>); +my @files = grep { -f } (<*>, , <$fallbackdirname/*>, <$modpmdir/*>); if (!@files) { eval {opendir(D,'.');}; unless ($@) { @files = readdir(D); closedir(D); }