[ 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 <rjk@linguist.Thayer.dartmouth.edu>
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 <spoon@cpan.org>
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 <schwern@pobox.com>
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 <ilya@Math.Berkeley.EDU>
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..)
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
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);
}
$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);
}
features of DynaLoader are not implemented in XSLoader, like for
example the dl_load_flags is not honored by XSLoader.
+=head2 Migration from C<DynaLoader>
+
+A typical module using L<DynaLoader|DynaLoader> 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<require DynaLoader> by C<use XSLoader>, remove
+C<DynaLoader> from @ISA, change C<bootstrap> by C<XSLoader::load>. Do not
+forget to quote the name of your package on the C<XSLoader::load> line,
+and add comma (C<,>) before the arguments ($VERSION above).
+
+Of course, if @ISA contained only C<DynaLoader>, there is no need to have the
+@ISA assignment at all; moreover, if instead of C<our> 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<bootstrap> 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<use XSLoader> by C<require>, so the compiler does not know that a function
+XSLoader::load() is present.
+
+This boilerplate uses the low-overhead C<XSLoader> if present; if used with
+an antic Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>.
+
+=head1 Order of initialization: early load()
+
+I<Skip this section if the XSUB functions are supposed to be called from other
+modules only; read it only if you call your XSUBs from the code in your module,
+or have a C<BOOT:> section in your XS file (see L<perlxs/"The BOOT: Keyword">).
+What is described here is equally applicable to L<DynaLoader|DynaLoader>
+interface.>
+
+A sufficiently complicated module using XS would have both Perl code (defined
+in F<YourPackage.pm>) and XS code (defined in F<YourPackage.xs>). 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<BOOT:> 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<BOOT:> 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<BOOT:> section and Perl code is
+more complicated than this (e.g., the C<BOOT:> section makes calls to Perl
+functions which make calls to XSUBs with prototypes), get rid of the C<BOOT:>
+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<make install>
+would put the DLL). If not found, the search for the DLL is transparently
+delegated to C<DynaLoader>, 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<make install>.
+
=head1 AUTHOR
Ilya Zakharevich: extraction from DynaLoader.
--- /dev/null
+#!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 (<DATA>) {
+ 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
+<FH> # readline
+SKIP (set by optimizer) $x .= <F> # 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
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
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);
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;/;
&& 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;
+ }
+
}
+
}
}
}
This is a quick reference to Perl's regular expressions.
For full information see L<perlre> and L<perlop>, as well
-as the L<references|/"SEE ALSO"> section in this document.
+as the L</"SEE ALSO"> 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.
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<successfully> match
+ If 'pattern' is an empty string, the last I<successfully> matched
regex is used. Delimiters other than '/' may be used for both this
operator and the following ones.
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<reset|perlfunc/reset>.
-=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)
[...] 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
\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</Titlecase>.
+
This one works differently from normal strings:
\b An assertion, not backspace, except in a character class
[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
^ 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<longest> leftmost.
+Quantifiers are greedy by default -- match the B<longest> 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
(?<!...) Zero-width negative lookbehind assertion
(?>...) Grab what we can, prohibit backtracking
(?{ code }) Embedded code, return value becomes $^R
(?(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)
$+ 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<opening> paren.
+Captured groups are numbered according to their I<opening> 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
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</Titlecase>.
+
+=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.
and
Jeffrey Goff
for useful advice.
+
+=cut
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;
use Config;
-print "1..181\n";
+print "1..185\n";
my $test = 1;
sub test (&) {
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" };
+
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
$Text::Wrap::columns = 80;
use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload);
use File::Compare;
+use File::Path;
sub usage {
warn "@_\n" if @_;
# 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.
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;
}
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;
__END__
END
-my ($email,$author);
+my ($email,$author,$licence);
eval {
my $username;
$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 = <<EOT if $opt_C;
#
while ($name, $struct) = each %structs;
}
+# Prefix the default licence with hash symbols.
+# Is this just cargo cult - it seems that the first thing that happens to this
+# block is that all the hashes are then s///g out.
+my $licence_hash = $licence;
+$licence_hash =~ s/^/#/gm;
+
my $pod = <<"END" unless $opt_P;
## Below is stub documentation for your module. You'd better edit it!
#
#
#=head1 COPYRIGHT AND LICENSE
#
-#Copyright ${\(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.
+$licence_hash
#
#=cut
END
# the contents of the Makefile that is written.
WriteMakefile(
NAME => '$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
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";
}
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'
#########################
warn "Writing $ext$modpname/MANIFEST\n";
open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
-my @files = grep { -f } (<*>, <t/*>, <$fallbackdirname/*>);
+my @files = grep { -f } (<*>, <t/*>, <$fallbackdirname/*>, <$modpmdir/*>);
if (!@files) {
eval {opendir(D,'.');};
unless ($@) { @files = readdir(D); closedir(D); }
https://perl5.git.perl.org / perl5.git / commitdiff