summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/perl
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/usr.bin/perl')
-rw-r--r--gnu/usr.bin/perl/emacs/e2ctags.pl20
-rw-r--r--gnu/usr.bin/perl/ext/B/defsubs_h.PL76
-rw-r--r--gnu/usr.bin/perl/lib/Carp/Heavy.pm255
-rw-r--r--gnu/usr.bin/perl/pod/perlcompile.pod185
-rw-r--r--gnu/usr.bin/perl/pod/podchecker.PL54
-rw-r--r--gnu/usr.bin/perl/pod/podselect.PL23
-rw-r--r--gnu/usr.bin/perl/pp.sym50
-rw-r--r--gnu/usr.bin/perl/warnings.pl758
-rw-r--r--gnu/usr.bin/perl/win32/genmk95.pl2
9 files changed, 687 insertions, 736 deletions
diff --git a/gnu/usr.bin/perl/emacs/e2ctags.pl b/gnu/usr.bin/perl/emacs/e2ctags.pl
index 34e3e14b54d..ef7a8d8539a 100644
--- a/gnu/usr.bin/perl/emacs/e2ctags.pl
+++ b/gnu/usr.bin/perl/emacs/e2ctags.pl
@@ -16,7 +16,6 @@ use strict;
my $filename;
my ($tag,$line_no,$line);
my %tags = ();
-my %filetags = ();
my %files = ();
my @lines = ();
@@ -35,17 +34,21 @@ while (<>) {
next if /struct/;
if (/\x01/) {
($tag,$line_no) = /\x7F(\w+)\x01(\d+)/;
+ next unless $tag;
+ ##Take only the first entry per tag
+ next if defined($tags{$tag});
+ $tags{$tag}{FILE} = $filename;
+ $tags{$tag}{LINE_NO} = $line_no;
}
else {
tr/(//d;
($tag,$line_no) = /(\w+)\s*\x7F(\d+),/;
+ next unless $tag;
+ ##Take only the first entry per tag
+ next if defined($tags{$tag});
+ $tags{$tag}{FILE} = $filename;
+ $tags{$tag}{LINE_NO} = $line_no;
}
- next unless $tag;
- ##Take only the first entry per tag
- next if defined($tags{$tag});
- $tags{$tag}{FILE} = $filename;
- $tags{$tag}{LINE_NO} = $line_no;
- push @{$filetags{$filename}}, $tag;
}
foreach $filename (keys %files) {
@@ -53,7 +56,8 @@ foreach $filename (keys %files) {
@lines = <FILE>;
close FILE;
chomp @lines;
- foreach $tag ( @{$filetags{$filename}} ) {
+ foreach $tag ( keys %tags ) {
+ next unless $filename eq $tags{$tag}{FILE};
$line = $lines[$tags{$tag}{LINE_NO}-1];
if (length($line) >= 50) {
$line = substr($line,0,50);
diff --git a/gnu/usr.bin/perl/ext/B/defsubs_h.PL b/gnu/usr.bin/perl/ext/B/defsubs_h.PL
index 684ca26fb07..80ef936fcec 100644
--- a/gnu/usr.bin/perl/ext/B/defsubs_h.PL
+++ b/gnu/usr.bin/perl/ext/B/defsubs_h.PL
@@ -1,86 +1,24 @@
# Do not remove the following line; MakeMaker relies on it to identify
# this file as a template for defsubs.h
# Extracting defsubs.h (with variable substitutions)
-#!perl -w
-use File::Spec;
-my (undef, $headerpath) = @ARGV;
+#!perl
my ($out) = __FILE__ =~ /(^.*)\.PL/i;
$out =~ s/_h$/.h/;
-unlink $out if -l $out;
open(OUT,">$out") || die "Cannot open $file:$!";
print "Extracting $out...\n";
-print OUT <<"END";
-/*
- !!! Don't modify this file - it's autogenerated from $0 !!!
- */
-END
-
-foreach my $const (qw(
- CVf_ANON
- CVf_CLONE
- CVf_CLONED
- CVf_CONST
- CVf_LVALUE
- CVf_METHOD
- CVf_NODEBUG
- CVf_UNIQUE
- CVf_WEAKOUTSIDE
- GVf_IMPORTED_AV
- GVf_IMPORTED_CV
- GVf_IMPORTED_HV
- GVf_IMPORTED_SV
+foreach my $const (qw(AVf_REAL
HEf_SVKEY
- SVTYPEMASK
- SVf_FAKE
- SVf_IOK
- SVf_IVisUV
- SVf_NOK
- SVf_POK
- SVf_READONLY
- SVf_ROK
- SVp_IOK
- SVp_NOK
- SVp_POK
- SVpad_OUR
- SVs_RMG
- SVs_SMG
- SVt_PVGV
- SVt_PVHV
- PAD_FAKELEX_ANON
- PAD_FAKELEX_MULTI
- ))
+ SVf_IOK SVf_IVisUV SVf_NOK SVf_POK
+ SVf_ROK SVp_IOK SVp_POK ))
{
doconst($const);
}
-
-if ($] < 5.009) {
- # This is only present in 5.10, but it's useful to B::Deparse to be able
- # to import a dummy value from B
- doconst(OPpPAD_STATE);
-}
-
-if ($] >= 5.009) {
- # Constant not present in 5.8.x
- doconst(CVf_ISXSUB);
-} else {
- # Constant not present after 5.8.x
- doconst(AVf_REAL);
-}
-
-if ($] < 5.011) {
- # Constant not present after 5.10.x
- doconst(CVf_LOCKED);
-}
-
-foreach my $tuple (['op.h'],['cop.h'],['regexp.h','RXf_'])
+foreach my $file (qw(op.h cop.h))
{
- my $file = $tuple->[0];
- my $pfx = $tuple->[1] || '';
- my $path = File::Spec->catfile($headerpath, $file);
- open(OPH,"$path") || die "Cannot open $path:$!";
+ open(OPH,"../../$file") || die "Cannot open ../../$file:$!";
while (<OPH>)
{
- doconst($1) if (/#define\s+($pfx\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/);
+ doconst($1) if (/#define\s+(\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/);
}
close(OPH);
}
diff --git a/gnu/usr.bin/perl/lib/Carp/Heavy.pm b/gnu/usr.bin/perl/lib/Carp/Heavy.pm
index 38f95d8a5aa..5e3de49418b 100644
--- a/gnu/usr.bin/perl/lib/Carp/Heavy.pm
+++ b/gnu/usr.bin/perl/lib/Carp/Heavy.pm
@@ -1,10 +1,253 @@
package Carp;
-# On one line so MakeMaker will see it.
-use Carp; our $VERSION = $Carp::VERSION;
+=head1 NAME
-1;
+Carp::Heavy - Carp guts
+
+=head1 SYNOPIS
+
+(internal use only)
+
+=head1 DESCRIPTION
+
+No user-serviceable parts inside.
+
+=cut
+
+# This package is heavily used. Be small. Be fast. Be good.
+
+# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
+# _almost_ complete understanding of the package. Corrections and
+# comments are welcome.
+
+# longmess() crawls all the way up the stack reporting on all the function
+# calls made. The error string, $error, is originally constructed from the
+# arguments passed into longmess() via confess(), cluck() or shortmess().
+# This gets appended with the stack trace messages which are generated for
+# each function call on the stack.
+
+sub longmess_heavy {
+ return @_ if ref $_[0];
+ my $error = join '', @_;
+ my $mess = "";
+ my $i = 1 + $CarpLevel;
+ my ($pack,$file,$line,$sub,$hargs,$eval,$require);
+ my (@a);
+ #
+ # crawl up the stack....
+ #
+ while (do { { package DB; @a = caller($i++) } } ) {
+ # get copies of the variables returned from caller()
+ ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
+ #
+ # if the $error error string is newline terminated then it
+ # is copied into $mess. Otherwise, $mess gets set (at the end of
+ # the 'else {' section below) to one of two things. The first time
+ # through, it is set to the "$error at $file line $line" message.
+ # $error is then set to 'called' which triggers subsequent loop
+ # iterations to append $sub to $mess before appending the "$error
+ # at $file line $line" which now actually reads "called at $file line
+ # $line". Thus, the stack trace message is constructed:
+ #
+ # first time: $mess = $error at $file line $line
+ # subsequent times: $mess .= $sub $error at $file line $line
+ # ^^^^^^
+ # "called"
+ if ($error =~ m/\n$/) {
+ $mess .= $error;
+ } else {
+ # Build a string, $sub, which names the sub-routine called.
+ # This may also be "require ...", "eval '...' or "eval {...}"
+ if (defined $eval) {
+ if ($require) {
+ $sub = "require $eval";
+ } else {
+ $eval =~ s/([\\\'])/\\$1/g;
+ if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
+ substr($eval,$MaxEvalLen) = '...';
+ }
+ $sub = "eval '$eval'";
+ }
+ } elsif ($sub eq '(eval)') {
+ $sub = 'eval {...}';
+ }
+ # if there are any arguments in the sub-routine call, format
+ # them according to the format variables defined earlier in
+ # this file and join them onto the $sub sub-routine string
+ if ($hargs) {
+ # we may trash some of the args so we take a copy
+ @a = @DB::args; # must get local copy of args
+ # don't print any more than $MaxArgNums
+ if ($MaxArgNums and @a > $MaxArgNums) {
+ # cap the length of $#a and set the last element to '...'
+ $#a = $MaxArgNums;
+ $a[$#a] = "...";
+ }
+ for (@a) {
+ # set args to the string "undef" if undefined
+ $_ = "undef", next unless defined $_;
+ if (ref $_) {
+ # force reference to string representation
+ $_ .= '';
+ s/'/\\'/g;
+ }
+ else {
+ s/'/\\'/g;
+ # terminate the string early with '...' if too long
+ substr($_,$MaxArgLen) = '...'
+ if $MaxArgLen and $MaxArgLen < length;
+ }
+ # 'quote' arg unless it looks like a number
+ $_ = "'$_'" unless /^-?[\d.]+$/;
+ # print high-end chars as 'M-<char>'
+ s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+ # print remaining control chars as ^<char>
+ s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+ }
+ # append ('all', 'the', 'arguments') to the $sub string
+ $sub .= '(' . join(', ', @a) . ')';
+ }
+ # here's where the error message, $mess, gets constructed
+ $mess .= "\t$sub " if $error eq "called";
+ $mess .= "$error at $file line $line";
+ if (defined &Thread::tid) {
+ my $tid = Thread->self->tid;
+ $mess .= " thread $tid" if $tid;
+ }
+ $mess .= "\n";
+ }
+ # we don't need to print the actual error message again so we can
+ # change this to "called" so that the string "$error at $file line
+ # $line" makes sense as "called at $file line $line".
+ $error = "called";
+ }
+ # this kludge circumvents die's incorrect handling of NUL
+ my $msg = \($mess || $error);
+ $$msg =~ tr/\0//d;
+ $$msg;
+}
+
+
+# ancestors() returns the complete set of ancestors of a module
+
+sub ancestors($$);
-# Most of the machinery of Carp used to be there.
-# It has been moved in Carp.pm now, but this placeholder remains for
-# the benefit of modules that like to preload Carp::Heavy directly.
+sub ancestors($$){
+ my( $pack, $href ) = @_;
+ if( @{"${pack}::ISA"} ){
+ my $risa = \@{"${pack}::ISA"};
+ my %tree = ();
+ @tree{@$risa} = ();
+ foreach my $mod ( @$risa ){
+ # visit ancestors - if not already in the gallery
+ if( ! defined( $$href{$mod} ) ){
+ my @ancs = ancestors( $mod, $href );
+ @tree{@ancs} = ();
+ }
+ }
+ return ( keys( %tree ) );
+ } else {
+ return ();
+ }
+}
+
+
+# shortmess() is called by carp() and croak() to skip all the way up to
+# the top-level caller's package and report the error from there. confess()
+# and cluck() generate a full stack trace so they call longmess() to
+# generate that. In verbose mode shortmess() calls longmess() so
+# you always get a stack trace
+
+sub shortmess_heavy { # Short-circuit &longmess if called via multiple packages
+ goto &longmess_heavy if $Verbose;
+ return @_ if ref $_[0];
+ my $error = join '', @_;
+ my ($prevpack) = caller(1);
+ my $extra = $CarpLevel;
+
+ my @Clans = ( $prevpack );
+ my $i = 2;
+ my ($pack,$file,$line);
+ # when reporting an error, we want to report it from the context of the
+ # calling package. So what is the calling package? Within a module,
+ # there may be many calls between methods and perhaps between sub-classes
+ # and super-classes, but the user isn't interested in what happens
+ # inside the package. We start by building a hash array which keeps
+ # track of all the packages to which the calling package belongs. We
+ # do this by examining its @ISA variable. Any call from a base class
+ # method (one of our caller's @ISA packages) can be ignored
+ my %isa;
+
+ # merge all the caller's @ISA packages and ancestors into %isa.
+ my @pars = ancestors( $prevpack, \%isa );
+ @isa{@pars} = () if @pars;
+ $isa{$prevpack} = 1;
+
+ # now we crawl up the calling stack and look at all the packages in
+ # there. For each package, we look to see if it has an @ISA and then
+ # we see if our caller features in that list. That would imply that
+ # our caller is a derived class of that package and its calls can also
+ # be ignored
+CALLER:
+ while (($pack,$file,$line) = caller($i++)) {
+
+ # Chances are, the caller's caller (or its caller...) is already
+ # in the gallery - if so, ignore this caller.
+ next if exists( $isa{$pack} );
+
+ # no: collect this module's ancestors.
+ my @i = ancestors( $pack, \%isa );
+ my %i;
+ if( @i ){
+ @i{@i} = ();
+ # check whether our representative of one of the clans is
+ # in this family tree.
+ foreach my $cl (@Clans){
+ if( exists( $i{$cl} ) ){
+ # yes: merge all of the family tree into %isa
+ @isa{@i,$pack} = ();
+ # and here's where we do some more ignoring...
+ # if the package in question is one of our caller's
+ # base or derived packages then we can ignore it (skip it)
+ # and go onto the next.
+ next CALLER if exists( $isa{$pack} );
+ last;
+ }
+ }
+ }
+
+ # Hey! We've found a package that isn't one of our caller's
+ # clan....but wait, $extra refers to the number of 'extra' levels
+ # we should skip up. If $extra > 0 then this is a false alarm.
+ # We must merge the package into the %isa hash (so we can ignore it
+ # if it pops up again), decrement $extra, and continue.
+ if ($extra-- > 0) {
+ push( @Clans, $pack );
+ @isa{@i,$pack} = ();
+ }
+ else {
+ # OK! We've got a candidate package. Time to construct the
+ # relevant error message and return it. die() doesn't like
+ # to be given NUL characters (which $msg may contain) so we
+ # remove them first.
+ my $msg;
+ $msg = "$error at $file line $line";
+ if (defined &Thread::tid) {
+ my $tid = Thread->self->tid;
+ $mess .= " thread $tid" if $tid;
+ }
+ $msg .= "\n";
+ $msg =~ tr/\0//d;
+ return $msg;
+ }
+ }
+
+ # uh-oh! It looks like we crawled all the way up the stack and
+ # never found a candidate package. Oh well, let's call longmess
+ # to generate a full stack trace. We use the magical form of 'goto'
+ # so that this shortmess() function doesn't appear on the stack
+ # to further confuse longmess() about it's calling package.
+ goto &longmess_heavy;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/pod/perlcompile.pod b/gnu/usr.bin/perl/pod/perlcompile.pod
index 505ce68384f..697cb80d409 100644
--- a/gnu/usr.bin/perl/pod/perlcompile.pod
+++ b/gnu/usr.bin/perl/pod/perlcompile.pod
@@ -9,16 +9,17 @@ internal form (a parse tree) which is then optimized before being
run. Since version 5.005, Perl has shipped with a module
capable of inspecting the optimized parse tree (C<B>), and this has
been used to write many useful utilities, including a module that lets
-you turn your Perl into C source code that can be compiled into a
+you turn your Perl into C source code that can be compiled into an
native executable.
The C<B> module provides access to the parse tree, and other modules
("back ends") do things with the tree. Some write it out as
-semi-human-readable text. Another traverses the parse tree to build a
-cross-reference of which subroutines, formats, and variables are used
-where. Another checks your code for dubious constructs. Yet another back
-end dumps the parse tree back out as Perl source, acting as a source code
-beautifier or deobfuscator.
+bytecode, C source code, or a semi-human-readable text. Another
+traverses the parse tree to build a cross-reference of which
+subroutines, formats, and variables are used where. Another checks
+your code for dubious constructs. Yet another back end dumps the
+parse tree back out as Perl source, acting as a source code beautifier
+or deobfuscator.
Because its original purpose was to be a way to produce C code
corresponding to a Perl program, and in turn a native executable, the
@@ -36,7 +37,8 @@ what problems there are, and how to work around them.
The compiler back ends are in the C<B::> hierarchy, and the front-end
(the module that you, the user of the compiler, will sometimes
-interact with) is the O module.
+interact with) is the O module. Some back ends (e.g., C<B::C>) have
+programs (e.g., I<perlcc>) to hide the modules' complexity.
Here are the important back ends to know about, with their status
expressed as a number from 0 (outline for later implementation) to
@@ -44,6 +46,30 @@ expressed as a number from 0 (outline for later implementation) to
=over 4
+=item B::Bytecode
+
+Stores the parse tree in a machine-independent format, suitable
+for later reloading through the ByteLoader module. Status: 5 (some
+things work, some things don't, some things are untested).
+
+=item B::C
+
+Creates a C source file containing code to rebuild the parse tree
+and resume the interpreter. Status: 6 (many things work adequately,
+including programs using Tk).
+
+=item B::CC
+
+Creates a C source file corresponding to the run time code path in
+the parse tree. This is the closest to a Perl-to-C translator there
+is, but the code it generates is almost incomprehensible because it
+translates the parse tree into a giant switch structure that
+manipulates Perl structures. Eventual goal is to reduce (given
+sufficient type information in the Perl program) some of the
+Perl data structure manipulations into manipulations of C-level
+ints, floats, etc. Status: 5 (some things work, including
+uncomplicated Tk examples).
+
=item B::Lint
Complains if it finds dubious constructs in your source code. Status:
@@ -134,7 +160,7 @@ I<myperlprogram> to the file I<report>:
=head2 The Decompiling Back End
The Deparse back end turns your Perl source back into Perl source. It
-can reformat along the way, making it useful as a deobfuscator. The
+can reformat along the way, making it useful as a de-obfuscator. The
most basic way to use it is:
$ perl -MO=Deparse myperlprogram
@@ -157,6 +183,9 @@ one-liners:
rename $was, $_ unless $was eq $_;
}
+(this is the I<rename> program that comes in the I<eg/> directory
+of the Perl source distribution).
+
The decompiler has several options for the code it generates. For
instance, you can set the size of each indent from 4 (as above) to
2 with:
@@ -190,7 +219,57 @@ To disable context checks and undefined subroutines:
See L<B::Lint> for information on the options.
-=head1 Module List for the Compiler Suite
+=head2 The Simple C Back End
+
+This module saves the internal compiled state of your Perl program
+to a C source file, which can be turned into a native executable
+for that particular platform using a C compiler. The resulting
+program links against the Perl interpreter library, so it
+will not save you disk space (unless you build Perl with a shared
+library) or program size. It may, however, save you startup time.
+
+The C<perlcc> tool generates such executables by default.
+
+ perlcc myperlprogram.pl
+
+=head2 The Bytecode Back End
+
+This back end is only useful if you also have a way to load and
+execute the bytecode that it produces. The ByteLoader module provides
+this functionality.
+
+To turn a Perl program into executable byte code, you can use C<perlcc>
+with the C<-b> switch:
+
+ perlcc -b myperlprogram.pl
+
+The byte code is machine independent, so once you have a compiled
+module or program, it is as portable as Perl source (assuming that
+the user of the module or program has a modern-enough Perl interpreter
+to decode the byte code).
+
+See B<B::Bytecode> for information on options to control the
+optimization and nature of the code generated by the Bytecode module.
+
+=head2 The Optimized C Back End
+
+The optimized C back end will turn your Perl program's run time
+code-path into an equivalent (but optimized) C program that manipulates
+the Perl data structures directly. The program will still link against
+the Perl interpreter library, to allow for eval(), C<s///e>,
+C<require>, etc.
+
+The C<perlcc> tool generates such executables when using the -opt
+switch. To compile a Perl program (ending in C<.pl>
+or C<.p>):
+
+ perlcc -opt myperlprogram.pl
+
+To produce a shared library from a Perl module (ending in C<.pm>):
+
+ perlcc -opt Myperlmodule.pm
+
+For more information, see L<perlcc> and L<B::CC>.
=over 4
@@ -211,13 +290,53 @@ called something like this:
This is like saying C<use O 'Deparse'> in your Perl program.
-=item B::Concise
+=item B::Asmdata
+
+This module is used by the B::Assembler module, which is in turn used
+by the B::Bytecode module, which stores a parse-tree as
+bytecode for later loading. It's not a back end itself, but rather a
+component of a back end.
+
+=item B::Assembler
+
+This module turns a parse-tree into data suitable for storing
+and later decoding back into a parse-tree. It's not a back end
+itself, but rather a component of a back end. It's used by the
+I<assemble> program that produces bytecode.
+
+=item B::Bblock
+
+This module is used by the B::CC back end. It walks "basic blocks".
+A basic block is a series of operations which is known to execute from
+start to finish, with no possiblity of branching or halting.
+
+=item B::Bytecode
+
+This module is a back end that generates bytecode from a
+program's parse tree. This bytecode is written to a file, from where
+it can later be reconstructed back into a parse tree. The goal is to
+do the expensive program compilation once, save the interpreter's
+state into a file, and then restore the state from the file when the
+program is to be executed. See L</"The Bytecode Back End">
+for details about usage.
-This module prints a concise (but complete) version of the Perl parse
-tree. Its output is more customizable than the one of B::Terse or
-B::Debug (and it can emulate them). This module useful for people who
-are writing their own back end, or who are learning about the Perl
-internals. It's not useful to the average programmer.
+=item B::C
+
+This module writes out C code corresponding to the parse tree and
+other interpreter internal structures. You compile the corresponding
+C file, and get an executable file that will restore the internal
+structures and the Perl interpreter will begin running the
+program. See L</"The Simple C Back End"> for details about usage.
+
+=item B::CC
+
+This module writes out C code corresponding to your program's
+operations. Unlike the B::C module, which merely stores the
+interpreter and its state in a C program, the B::CC module makes a
+C program that does not involve the interpreter. As a consequence,
+programs translated into C by B::CC can execute faster than normal
+interpreted programs. See L</"The Optimized C Back End"> for
+details about usage.
=item B::Debug
@@ -233,6 +352,12 @@ It is useful in debugging and deconstructing other people's code,
also as a pretty-printer for your own source. See
L</"The Decompiling Back End"> for details about usage.
+=item B::Disassembler
+
+This module turns bytecode back into a parse tree. It's not a back
+end itself, but rather a component of a back end. It's used by the
+I<disassemble> program that comes with the bytecode.
+
=item B::Lint
This module inspects the compiled form of your source code for things
@@ -244,17 +369,30 @@ can identify. See L</"The Lint Back End"> for details about usage.
=item B::Showlex
This module prints out the my() variables used in a function or a
-file. To get a list of the my() variables used in the subroutine
+file. To gt a list of the my() variables used in the subroutine
mysub() defined in the file myperlprogram:
$ perl -MO=Showlex,mysub myperlprogram
-To get a list of the my() variables used in the file myperlprogram:
+To gt a list of the my() variables used in the file myperlprogram:
$ perl -MO=Showlex myperlprogram
[BROKEN]
+=item B::Stackobj
+
+This module is used by the B::CC module. It's not a back end itself,
+but rather a component of a back end.
+
+=item B::Stash
+
+This module is used by the L<perlcc> program, which compiles a module
+into an executable. B::Stash prints the symbol tables in use by a
+program, and is used to prevent B::CC from producing C code for the
+B::* and O modules. It's not a back end itself, but rather a
+component of a back end.
+
=item B::Terse
This module prints the contents of the parse tree, but without as much
@@ -276,6 +414,19 @@ usage.
=head1 KNOWN PROBLEMS
+The simple C backend currently only saves typeglobs with alphanumeric
+names.
+
+The optimized C backend outputs code for more modules than it should
+(e.g., DirHandle). It also has little hope of properly handling
+C<goto LABEL> outside the running subroutine (C<goto &sub> is ok).
+C<goto LABEL> currently does not work at all in this backend.
+It also creates a huge initialization function that gives
+C compilers headaches. Splitting the initialization function gives
+better results. Other problems include: unsigned math does not
+work correctly; some opcodes are handled incorrectly by default
+opcode handling mechanism.
+
BEGIN{} blocks are executed while compiling your code. Any external
state that is initialized in BEGIN{}, such as opening files, initiating
database connections etc., do not behave properly. To work around
diff --git a/gnu/usr.bin/perl/pod/podchecker.PL b/gnu/usr.bin/perl/pod/podchecker.PL
index 75c316d26ed..a7f96434ca6 100644
--- a/gnu/usr.bin/perl/pod/podchecker.PL
+++ b/gnu/usr.bin/perl/pod/podchecker.PL
@@ -39,7 +39,7 @@ print OUT <<'!NO!SUBS!';
#############################################################################
# podchecker -- command to invoke the podchecker function in Pod::Checker
#
-# Copyright (c) 1998-2000 by Bradford Appleton. All rights reserved.
+# Copyright (c) 1998-1999 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
@@ -70,9 +70,7 @@ Print the manual page and exit.
=item B<-warnings> B<-nowarnings>
-Turn on/off printing of warnings. Repeating B<-warnings> increases the
-warning level, i.e. more warnings are printed. Currently increasing to
-level two causes flagging of unescaped "E<lt>,E<gt>" characters.
+Turn on/off printing of warnings.
=item I<file>
@@ -87,8 +85,6 @@ syntax errors in the POD documentation and will print any errors
it find to STDERR. At the end, it will print a status message
indicating the number of errors found.
-Directories are ignored, an appropriate warning message is printed.
-
B<podchecker> invokes the B<podchecker()> function exported by B<Pod::Checker>
Please see L<Pod::Checker/podchecker()> for more details.
@@ -105,7 +101,7 @@ the given POD files has syntax errors.
The status 2 indicates that at least one of the specified
files does not contain I<any> POD commands.
-Status 1 overrides status 2. If you want unambiguous
+Status 1 overrides status 2. If you want unambigouus
results, call B<podchecker> with one single argument only.
=head1 SEE ALSO
@@ -114,10 +110,8 @@ L<Pod::Parser> and L<Pod::Checker>
=head1 AUTHORS
-Please report bugs using L<http://rt.cpan.org>.
-
Brad Appleton E<lt>bradapp@enteract.comE<gt>,
-Marek Rouchal E<lt>marekr@cpan.orgE<gt>
+Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>
Based on code for B<Pod::Text::pod2text(1)> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
@@ -130,50 +124,32 @@ use Pod::Usage;
use Getopt::Long;
## Define options
-my %options;
+my %options = (
+ "help" => 0,
+ "man" => 0,
+ "warnings" => 1,
+);
## Parse options
-GetOptions(\%options, qw(help man warnings+ nowarnings)) || pod2usage(2);
+GetOptions(\%options, "help", "man", "warnings!") || pod2usage(2);
pod2usage(1) if ($options{help});
pod2usage(-verbose => 2) if ($options{man});
-if($options{nowarnings}) {
- $options{warnings} = 0;
-}
-elsif(!defined $options{warnings}) {
- $options{warnings} = 1; # default is warnings on
-}
-
## Dont default to STDIN if connected to a terminal
pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
## Invoke podchecker()
my $status = 0;
-@ARGV = qw(-) unless(@ARGV);
-for my $podfile (@ARGV) {
- if($podfile eq '-') {
- $podfile = '<&STDIN';
- }
- elsif(-d $podfile) {
- warn "podchecker: Warning: Ignoring directory '$podfile'\n";
- next;
- }
- my $errors =
- podchecker($podfile, undef, '-warnings' => $options{warnings});
- if($errors > 0) {
+@ARGV = ("<&STDIN") unless(@ARGV);
+for (@ARGV) {
+ my $s = podchecker($_, undef, '-warnings' => $options{warnings});
+ if($s > 0) {
# errors occurred
$status = 1;
- printf STDERR ("%s has %d pod syntax %s.\n",
- $podfile, $errors,
- ($errors == 1) ? 'error' : 'errors');
}
- elsif($errors < 0) {
+ elsif($s < 0) {
# no pod found
$status = 2 unless($status);
- print STDERR "$podfile does not contain any pod commands.\n";
- }
- else {
- print STDERR "$podfile pod syntax OK.\n";
}
}
exit $status;
diff --git a/gnu/usr.bin/perl/pod/podselect.PL b/gnu/usr.bin/perl/pod/podselect.PL
index 7fadd7366cb..f2ba80a73b5 100644
--- a/gnu/usr.bin/perl/pod/podselect.PL
+++ b/gnu/usr.bin/perl/pod/podselect.PL
@@ -15,8 +15,9 @@ use Cwd;
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir(dirname($0));
-$file = basename($0, '.PL');
-$file .= '.com' if $^O eq 'VMS';
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
+$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
@@ -38,14 +39,14 @@ print OUT <<'!NO!SUBS!';
#############################################################################
# podselect -- command to invoke the podselect function in Pod::Select
#
-# Copyright (c) 1996-2000 by Bradford Appleton. All rights reserved.
+# Copyright (c) 1996-1999 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
use strict;
-#use diagnostics;
+use diagnostics;
=head1 NAME
@@ -98,8 +99,6 @@ L<Pod::Parser> and L<Pod::Select>
=head1 AUTHOR
-Please report bugs using L<http://rt.cpan.org>.
-
Brad Appleton E<lt>bradapp@enteract.comE<gt>
Based on code for B<Pod::Text::pod2text(1)> written by
@@ -113,13 +112,13 @@ use Getopt::Long;
## Define options
my %options = (
- 'help' => 0,
- 'man' => 0,
- 'sections' => [],
+ "help" => 0,
+ "man" => 0,
+ "sections" => [],
);
## Parse options
-GetOptions(\%options, 'help', 'man', 'sections|select=s@') || pod2usage(2);
+GetOptions(\%options, "help", "man", "sections|select=s@") || pod2usage(2);
pod2usage(1) if ($options{help});
pod2usage(-verbose => 2) if ($options{man});
@@ -127,8 +126,8 @@ pod2usage(-verbose => 2) if ($options{man});
pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
## Invoke podselect().
-if (@{ $options{'sections'} } > 0) {
- podselect({ -sections => $options{'sections'} }, @ARGV);
+if (@{ $options{"sections"} } > 0) {
+ podselect({ -sections => $options{"sections"} }, @ARGV);
}
else {
podselect(@ARGV);
diff --git a/gnu/usr.bin/perl/pp.sym b/gnu/usr.bin/perl/pp.sym
index 9d4d7540682..0e6c056611a 100644
--- a/gnu/usr.bin/perl/pp.sym
+++ b/gnu/usr.bin/perl/pp.sym
@@ -1,18 +1,14 @@
-# -*- buffer-read-only: t -*-
#
-# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file is built by opcode.pl from its data. Any changes made here
# will be lost!
#
Perl_ck_anoncode
Perl_ck_bitop
-Perl_ck_chdir
Perl_ck_concat
Perl_ck_defined
Perl_ck_delete
-Perl_ck_die
-Perl_ck_each
Perl_ck_eof
Perl_ck_eval
Perl_ck_exec
@@ -20,34 +16,32 @@ Perl_ck_exists
Perl_ck_exit
Perl_ck_ftst
Perl_ck_fun
+Perl_ck_fun_locale
Perl_ck_glob
Perl_ck_grep
Perl_ck_index
Perl_ck_join
+Perl_ck_lengthconst
Perl_ck_lfun
Perl_ck_listiob
Perl_ck_match
Perl_ck_method
Perl_ck_null
Perl_ck_open
-Perl_ck_readline
Perl_ck_repeat
Perl_ck_require
-Perl_ck_return
Perl_ck_rfun
Perl_ck_rvconst
Perl_ck_sassign
+Perl_ck_scmp
Perl_ck_select
Perl_ck_shift
-Perl_ck_smartmatch
Perl_ck_sort
Perl_ck_spair
Perl_ck_split
Perl_ck_subr
-Perl_ck_substr
Perl_ck_svconst
Perl_ck_trunc
-Perl_ck_unpack
Perl_pp_null
Perl_pp_stub
Perl_pp_scalar
@@ -142,7 +136,6 @@ Perl_pp_negate
Perl_pp_i_negate
Perl_pp_not
Perl_pp_complement
-Perl_pp_smartmatch
Perl_pp_atan2
Perl_pp_sin
Perl_pp_cos
@@ -174,9 +167,6 @@ Perl_pp_rv2av
Perl_pp_aelemfast
Perl_pp_aelem
Perl_pp_aslice
-Perl_pp_aeach
-Perl_pp_akeys
-Perl_pp_avalues
Perl_pp_each
Perl_pp_values
Perl_pp_keys
@@ -185,7 +175,6 @@ Perl_pp_exists
Perl_pp_rv2hv
Perl_pp_helem
Perl_pp_hslice
-Perl_pp_boolkeys
Perl_pp_unpack
Perl_pp_pack
Perl_pp_split
@@ -211,11 +200,9 @@ Perl_pp_flop
Perl_pp_and
Perl_pp_or
Perl_pp_xor
-Perl_pp_dor
Perl_pp_cond_expr
Perl_pp_andassign
Perl_pp_orassign
-Perl_pp_dorassign
Perl_pp_method
Perl_pp_entersub
Perl_pp_leavesub
@@ -242,13 +229,6 @@ Perl_pp_redo
Perl_pp_dump
Perl_pp_goto
Perl_pp_exit
-Perl_pp_method_named
-Perl_pp_entergiven
-Perl_pp_leavegiven
-Perl_pp_enterwhen
-Perl_pp_leavewhen
-Perl_pp_break
-Perl_pp_continue
Perl_pp_open
Perl_pp_close
Perl_pp_pipe_op
@@ -268,11 +248,12 @@ Perl_pp_enterwrite
Perl_pp_leavewrite
Perl_pp_prtf
Perl_pp_print
-Perl_pp_say
Perl_pp_sysopen
Perl_pp_sysseek
Perl_pp_sysread
Perl_pp_syswrite
+Perl_pp_send
+Perl_pp_recv
Perl_pp_eof
Perl_pp_tell
Perl_pp_seek
@@ -280,8 +261,6 @@ Perl_pp_truncate
Perl_pp_fcntl
Perl_pp_ioctl
Perl_pp_flock
-Perl_pp_send
-Perl_pp_recv
Perl_pp_socket
Perl_pp_sockpair
Perl_pp_bind
@@ -302,23 +281,23 @@ Perl_pp_fteread
Perl_pp_ftewrite
Perl_pp_fteexec
Perl_pp_ftis
+Perl_pp_fteowned
+Perl_pp_ftrowned
+Perl_pp_ftzero
Perl_pp_ftsize
Perl_pp_ftmtime
Perl_pp_ftatime
Perl_pp_ftctime
-Perl_pp_ftrowned
-Perl_pp_fteowned
-Perl_pp_ftzero
Perl_pp_ftsock
Perl_pp_ftchr
Perl_pp_ftblk
Perl_pp_ftfile
Perl_pp_ftdir
Perl_pp_ftpipe
+Perl_pp_ftlink
Perl_pp_ftsuid
Perl_pp_ftsgid
Perl_pp_ftsvtx
-Perl_pp_ftlink
Perl_pp_fttty
Perl_pp_fttext
Perl_pp_ftbinary
@@ -365,12 +344,11 @@ Perl_pp_msgget
Perl_pp_msgctl
Perl_pp_msgsnd
Perl_pp_msgrcv
-Perl_pp_semop
Perl_pp_semget
Perl_pp_semctl
+Perl_pp_semop
Perl_pp_require
Perl_pp_dofile
-Perl_pp_hintseval
Perl_pp_entereval
Perl_pp_leaveeval
Perl_pp_entertry
@@ -408,6 +386,6 @@ Perl_pp_egrent
Perl_pp_getlogin
Perl_pp_syscall
Perl_pp_lock
-Perl_pp_once
-
-# ex: set ro:
+Perl_pp_threadsv
+Perl_pp_setstate
+Perl_pp_method_named
diff --git a/gnu/usr.bin/perl/warnings.pl b/gnu/usr.bin/perl/warnings.pl
index 514ccd7ef5d..61602d5608a 100644
--- a/gnu/usr.bin/perl/warnings.pl
+++ b/gnu/usr.bin/perl/warnings.pl
@@ -1,23 +1,7 @@
#!/usr/bin/perl
-#
-# Regenerate (overwriting only if changed):
-#
-# lib/warnings.pm
-# warnings.h
-#
-# from information hardcoded into this script (the $tree hash), plus the
-# template for warnings.pm in the DATA section.
-#
-# With an argument of 'tree', just dump the contents of $tree and exits.
-# Also accepts the standard regen_lib -q and -v args.
-#
-# This script is normally invoked from regen.pl.
-
-$VERSION = '1.02_03';
BEGIN {
- require 'regen_lib.pl';
- push @INC, './lib';
+ push @INC, './lib';
}
use strict ;
@@ -26,62 +10,58 @@ sub DEFAULT_OFF () { 2 }
my $tree = {
-'all' => [ 5.008, {
- 'io' => [ 5.008, {
- 'pipe' => [ 5.008, DEFAULT_OFF],
- 'unopened' => [ 5.008, DEFAULT_OFF],
- 'closed' => [ 5.008, DEFAULT_OFF],
- 'newline' => [ 5.008, DEFAULT_OFF],
- 'exec' => [ 5.008, DEFAULT_OFF],
- 'layer' => [ 5.008, DEFAULT_OFF],
- }],
- 'syntax' => [ 5.008, {
- 'ambiguous' => [ 5.008, DEFAULT_OFF],
- 'semicolon' => [ 5.008, DEFAULT_OFF],
- 'precedence' => [ 5.008, DEFAULT_OFF],
- 'bareword' => [ 5.008, DEFAULT_OFF],
- 'reserved' => [ 5.008, DEFAULT_OFF],
- 'digit' => [ 5.008, DEFAULT_OFF],
- 'parenthesis' => [ 5.008, DEFAULT_OFF],
- 'printf' => [ 5.008, DEFAULT_OFF],
- 'prototype' => [ 5.008, DEFAULT_OFF],
- 'qw' => [ 5.008, DEFAULT_OFF],
- 'illegalproto' => [ 5.011, DEFAULT_OFF],
- }],
- 'severe' => [ 5.008, {
- 'inplace' => [ 5.008, DEFAULT_ON],
- 'internal' => [ 5.008, DEFAULT_ON],
- 'debugging' => [ 5.008, DEFAULT_ON],
- 'malloc' => [ 5.008, DEFAULT_ON],
- }],
- 'deprecated' => [ 5.008, DEFAULT_OFF],
- 'void' => [ 5.008, DEFAULT_OFF],
- 'recursion' => [ 5.008, DEFAULT_OFF],
- 'redefine' => [ 5.008, DEFAULT_OFF],
- 'numeric' => [ 5.008, DEFAULT_OFF],
- 'uninitialized' => [ 5.008, DEFAULT_OFF],
- 'once' => [ 5.008, DEFAULT_OFF],
- 'misc' => [ 5.008, DEFAULT_OFF],
- 'regexp' => [ 5.008, DEFAULT_OFF],
- 'glob' => [ 5.008, DEFAULT_OFF],
- 'untie' => [ 5.008, DEFAULT_OFF],
- 'substr' => [ 5.008, DEFAULT_OFF],
- 'taint' => [ 5.008, DEFAULT_OFF],
- 'signal' => [ 5.008, DEFAULT_OFF],
- 'closure' => [ 5.008, DEFAULT_OFF],
- 'overflow' => [ 5.008, DEFAULT_OFF],
- 'portable' => [ 5.008, DEFAULT_OFF],
- 'utf8' => [ 5.008, DEFAULT_OFF],
- 'exiting' => [ 5.008, DEFAULT_OFF],
- 'pack' => [ 5.008, DEFAULT_OFF],
- 'unpack' => [ 5.008, DEFAULT_OFF],
- 'threads' => [ 5.008, DEFAULT_OFF],
- 'imprecision' => [ 5.011, DEFAULT_OFF],
-
- #'default' => [ 5.008, DEFAULT_ON ],
- }],
+'all' => {
+ 'io' => { 'pipe' => DEFAULT_OFF,
+ 'unopened' => DEFAULT_OFF,
+ 'closed' => DEFAULT_OFF,
+ 'newline' => DEFAULT_OFF,
+ 'exec' => DEFAULT_OFF,
+ },
+ 'syntax' => { 'ambiguous' => DEFAULT_OFF,
+ 'semicolon' => DEFAULT_OFF,
+ 'precedence' => DEFAULT_OFF,
+ 'bareword' => DEFAULT_OFF,
+ 'reserved' => DEFAULT_OFF,
+ 'digit' => DEFAULT_OFF,
+ 'parenthesis' => DEFAULT_OFF,
+ 'deprecated' => DEFAULT_OFF,
+ 'printf' => DEFAULT_OFF,
+ 'prototype' => DEFAULT_OFF,
+ 'qw' => DEFAULT_OFF,
+ },
+ 'severe' => { 'inplace' => DEFAULT_ON,
+ 'internal' => DEFAULT_ON,
+ 'debugging' => DEFAULT_ON,
+ 'malloc' => DEFAULT_ON,
+ },
+ 'void' => DEFAULT_OFF,
+ 'recursion' => DEFAULT_OFF,
+ 'redefine' => DEFAULT_OFF,
+ 'numeric' => DEFAULT_OFF,
+ 'uninitialized' => DEFAULT_OFF,
+ 'once' => DEFAULT_OFF,
+ 'misc' => DEFAULT_OFF,
+ 'regexp' => DEFAULT_OFF,
+ 'glob' => DEFAULT_OFF,
+ 'y2k' => DEFAULT_OFF,
+ 'chmod' => DEFAULT_OFF,
+ 'umask' => DEFAULT_OFF,
+ 'untie' => DEFAULT_OFF,
+ 'substr' => DEFAULT_OFF,
+ 'taint' => DEFAULT_OFF,
+ 'signal' => DEFAULT_OFF,
+ 'closure' => DEFAULT_OFF,
+ 'overflow' => DEFAULT_OFF,
+ 'portable' => DEFAULT_OFF,
+ 'utf8' => DEFAULT_OFF,
+ 'exiting' => DEFAULT_OFF,
+ 'pack' => DEFAULT_OFF,
+ 'unpack' => DEFAULT_OFF,
+ #'default' => DEFAULT_ON,
+ }
} ;
+
###########################################################################
sub tab {
my($l, $t) = @_;
@@ -93,49 +73,8 @@ sub tab {
my %list ;
my %Value ;
-my %ValueToName ;
-my %NameToValue ;
my $index ;
-my %v_list = () ;
-
-sub valueWalk
-{
- my $tre = shift ;
- my @list = () ;
- my ($k, $v) ;
-
- foreach $k (sort keys %$tre) {
- $v = $tre->{$k};
- die "duplicate key $k\n" if defined $list{$k} ;
- die "Value associated with key '$k' is not an ARRAY reference"
- if !ref $v || ref $v ne 'ARRAY' ;
-
- my ($ver, $rest) = @{ $v } ;
- push @{ $v_list{$ver} }, $k;
-
- if (ref $rest)
- { valueWalk ($rest) }
-
- }
-
-}
-
-sub orderValues
-{
- my $index = 0;
- foreach my $ver ( sort { $a <=> $b } keys %v_list ) {
- foreach my $name (@{ $v_list{$ver} } ) {
- $ValueToName{ $index } = [ uc $name, $ver ] ;
- $NameToValue{ uc $name } = $index ++ ;
- }
- }
-
- return $index ;
-}
-
-###########################################################################
-
sub walk
{
my $tre = shift ;
@@ -145,17 +84,10 @@ sub walk
foreach $k (sort keys %$tre) {
$v = $tre->{$k};
die "duplicate key $k\n" if defined $list{$k} ;
- #$Value{$index} = uc $k ;
- die "Can't find key '$k'"
- if ! defined $NameToValue{uc $k} ;
- push @{ $list{$k} }, $NameToValue{uc $k} ;
- die "Value associated with key '$k' is not an ARRAY reference"
- if !ref $v || ref $v ne 'ARRAY' ;
-
- my ($ver, $rest) = @{ $v } ;
- if (ref $rest)
- { push (@{ $list{$k} }, walk ($rest)) }
-
+ $Value{$index} = uc $k ;
+ push @{ $list{$k} }, $index ++ ;
+ if (ref $v)
+ { push (@{ $list{$k} }, walk ($v)) }
push @list, @{ $list{$k} } ;
}
@@ -172,7 +104,7 @@ sub mkRange
for ($i = 1 ; $i < @a; ++ $i) {
- $out[$i] = ".."
+ $out[$i] = ".."
if $a[$i] == $a[$i - 1] + 1 && $a[$i] + 1 == $a[$i + 1] ;
}
@@ -187,33 +119,20 @@ sub printTree
{
my $tre = shift ;
my $prefix = shift ;
+ my $indent = shift ;
my ($k, $v) ;
my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
- my @keys = sort keys %$tre ;
- while ($k = shift @keys) {
+ $prefix .= " " x $indent ;
+ foreach $k (sort keys %$tre) {
$v = $tre->{$k};
- die "Value associated with key '$k' is not an ARRAY reference"
- if !ref $v || ref $v ne 'ARRAY' ;
-
- my $offset ;
- if ($tre ne $tree) {
- print $prefix . "|\n" ;
- print $prefix . "+- $k" ;
- $offset = ' ' x ($max + 4) ;
- }
- else {
- print $prefix . "$k" ;
- $offset = ' ' x ($max + 1) ;
- }
-
- my ($ver, $rest) = @{ $v } ;
- if (ref $rest)
- {
- my $bar = @keys ? "|" : " ";
- print " -" . "-" x ($max - length $k ) . "+\n" ;
- printTree ($rest, $prefix . $bar . $offset )
+ print $prefix . "|\n" ;
+ print $prefix . "+- $k" ;
+ if (ref $v)
+ {
+ print " " . "-" x ($max - length $k ) . "+\n" ;
+ printTree ($v, $prefix . "|" , $max + $indent - 1)
}
else
{ print "\n" }
@@ -223,9 +142,9 @@ sub printTree
###########################################################################
-sub mkHexOct
+sub mkHex
{
- my ($f, $max, @a) = @_ ;
+ my ($max, @a) = @_ ;
my $mask = "\x00" x $max ;
my $string = "" ;
@@ -233,43 +152,30 @@ sub mkHexOct
vec($mask, $_, 1) = 1 ;
}
+ #$string = unpack("H$max", $mask) ;
+ #$string =~ s/(..)/\x$1/g;
foreach (unpack("C*", $mask)) {
- if ($f eq 'x') {
- $string .= '\x' . sprintf("%2.2x", $_)
- }
- else {
- $string .= '\\' . sprintf("%o", $_)
- }
+ $string .= '\x' . sprintf("%2.2x", $_) ;
}
return $string ;
}
-sub mkHex
-{
- my($max, @a) = @_;
- return mkHexOct("x", $max, @a);
-}
-
-sub mkOct
-{
- my($max, @a) = @_;
- return mkHexOct("o", $max, @a);
-}
-
###########################################################################
if (@ARGV && $ARGV[0] eq "tree")
{
- printTree($tree, " ") ;
+ #print " all -+\n" ;
+ printTree($tree, " ", 4) ;
exit ;
}
-my $warn = safer_open("warnings.h-new");
-my $pm = safer_open("lib/warnings.pm-new");
+#unlink "warnings.h";
+#unlink "lib/warnings.pm";
+open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n";
+open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n";
-print $warn <<'EOM' ;
-/* -*- buffer-read-only: t -*-
- !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+print WARN <<'EOM' ;
+/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by warnings.pl
Any changes made here will be lost!
*/
@@ -287,180 +193,144 @@ print $warn <<'EOM' ;
#define G_WARN_ONCE 8 /* set if 'once' ever enabled */
#define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
-#define pWARN_STD NULL
-#define pWARN_ALL (((STRLEN*)0)+1) /* use warnings 'all' */
-#define pWARN_NONE (((STRLEN*)0)+2) /* no warnings 'all' */
+#define pWARN_STD Nullsv
+#define pWARN_ALL (Nullsv+1) /* use warnings 'all' */
+#define pWARN_NONE (Nullsv+2) /* no warnings 'all' */
#define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \
(x) == pWARN_NONE)
-/* if PL_warnhook is set to this value, then warnings die */
-#define PERL_WARNHOOK_FATAL (&PL_sv_placeholder)
+#define ckDEAD(x) \
+ ( ! specialWARN(PL_curcop->cop_warnings) && \
+ IsSet(SvPVX(PL_curcop->cop_warnings), 2*x+1))
+
+#define ckWARN(x) \
+ ( (PL_curcop->cop_warnings != pWARN_STD && \
+ PL_curcop->cop_warnings != pWARN_NONE && \
+ (PL_curcop->cop_warnings == pWARN_ALL || \
+ IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) ) \
+ || (PL_curcop->cop_warnings == pWARN_STD && PL_dowarn & G_WARN_ON) )
+
+#define ckWARN2(x,y) \
+ ( (PL_curcop->cop_warnings != pWARN_STD && \
+ PL_curcop->cop_warnings != pWARN_NONE && \
+ (PL_curcop->cop_warnings == pWARN_ALL || \
+ IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) || \
+ IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) \
+ || (PL_curcop->cop_warnings == pWARN_STD && PL_dowarn & G_WARN_ON) )
+
+#define ckWARN_d(x) \
+ (PL_curcop->cop_warnings == pWARN_STD || \
+ PL_curcop->cop_warnings == pWARN_ALL || \
+ (PL_curcop->cop_warnings != pWARN_NONE && \
+ IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) )
+
+#define ckWARN2_d(x,y) \
+ (PL_curcop->cop_warnings == pWARN_STD || \
+ PL_curcop->cop_warnings == pWARN_ALL || \
+ (PL_curcop->cop_warnings != pWARN_NONE && \
+ (IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) || \
+ IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) )
+
+
+#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
+#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
+#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
+#define isWARN_on(c,x) (IsSet(SvPVX(c), 2*(x)))
+
EOM
my $offset = 0 ;
$index = $offset ;
#@{ $list{"all"} } = walk ($tree) ;
-valueWalk ($tree) ;
-my $index = orderValues();
-
-die <<EOM if $index > 255 ;
-Too many warnings categories -- max is 255
- rewrite packWARN* & unpackWARN* macros
-EOM
-
walk ($tree) ;
+
$index *= 2 ;
my $warn_size = int($index / 8) + ($index % 8 != 0) ;
my $k ;
-my $last_ver = 0;
-foreach $k (sort { $a <=> $b } keys %ValueToName) {
- my ($name, $version) = @{ $ValueToName{$k} };
- print $warn "\n/* Warnings Categories added in Perl $version */\n\n"
- if $last_ver != $version ;
- print $warn tab(5, "#define WARN_$name"), "$k\n" ;
- $last_ver = $version ;
+foreach $k (sort { $a <=> $b } keys %Value) {
+ print WARN tab(5, "#define WARN_$Value{$k}"), "$k\n" ;
}
-print $warn "\n" ;
+print WARN "\n" ;
-print $warn tab(5, '#define WARNsize'), "$warn_size\n" ;
+print WARN tab(5, '#define WARNsize'), "$warn_size\n" ;
#print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ;
-print $warn tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
-print $warn tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
-
-print $warn <<'EOM';
-
-#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
-#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
-#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
-#define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
-#define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
-
-#define DUP_WARNINGS(p) \
- (specialWARN(p) ? (STRLEN*)(p) \
- : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \
- char))
-
-#define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w))
-#define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2))
-#define ckWARN3(w1,w2,w3) Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3))
-#define ckWARN4(w1,w2,w3,w4) Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4))
+print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
+print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
-#define ckWARN_d(w) Perl_ckwarn_d(aTHX_ packWARN(w))
-#define ckWARN2_d(w1,w2) Perl_ckwarn_d(aTHX_ packWARN2(w1,w2))
-#define ckWARN3_d(w1,w2,w3) Perl_ckwarn_d(aTHX_ packWARN3(w1,w2,w3))
-#define ckWARN4_d(w1,w2,w3,w4) Perl_ckwarn_d(aTHX_ packWARN4(w1,w2,w3,w4))
-
-#define WARNshift 8
-
-#define packWARN(a) (a )
-#define packWARN2(a,b) ((a) | ((b)<<8) )
-#define packWARN3(a,b,c) ((a) | ((b)<<8) | ((c)<<16) )
-#define packWARN4(a,b,c,d) ((a) | ((b)<<8) | ((c)<<16) | ((d) <<24))
-
-#define unpackWARN1(x) ((x) & 0xFF)
-#define unpackWARN2(x) (((x) >>8) & 0xFF)
-#define unpackWARN3(x) (((x) >>16) & 0xFF)
-#define unpackWARN4(x) (((x) >>24) & 0xFF)
-
-#define ckDEAD(x) \
- ( ! specialWARN(PL_curcop->cop_warnings) && \
- ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \
- isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \
- isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \
- isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \
- isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
+print WARN <<'EOM';
/* end of file warnings.h */
-/* ex: set ro: */
+
EOM
-safer_close $warn;
-rename_if_different("warnings.h-new", "warnings.h");
+close WARN ;
while (<DATA>) {
last if /^KEYWORDS$/ ;
- print $pm $_ ;
+ print PM $_ ;
}
#$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
-$last_ver = 0;
-print $pm "our %Offsets = (\n" ;
-foreach my $k (sort { $a <=> $b } keys %ValueToName) {
- my ($name, $version) = @{ $ValueToName{$k} };
- $name = lc $name;
+#my %Keys = map {lc $Value{$_}, $_} keys %Value ;
+
+print PM "%Offsets = (\n" ;
+foreach my $k (sort { $a <=> $b } keys %Value) {
+ my $v = lc $Value{$k} ;
$k *= 2 ;
- if ( $last_ver != $version ) {
- print $pm "\n";
- print $pm tab(4, " # Warnings Categories added in Perl $version");
- print $pm "\n\n";
- }
- print $pm tab(4, " '$name'"), "=> $k,\n" ;
- $last_ver = $version;
+ print PM tab(4, " '$v'"), "=> $k,\n" ;
}
-print $pm " );\n\n" ;
+print PM " );\n\n" ;
-print $pm "our %Bits = (\n" ;
+print PM "%Bits = (\n" ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
my @list = sort { $a <=> $b } @$v ;
- print $pm tab(4, " '$k'"), '=> "',
- # mkHex($warn_size, @list),
- mkHex($warn_size, map $_ * 2 , @list),
+ print PM tab(4, " '$k'"), '=> "',
+ # mkHex($warn_size, @list),
+ mkHex($warn_size, map $_ * 2 , @list),
'", # [', mkRange(@list), "]\n" ;
}
-print $pm " );\n\n" ;
+print PM " );\n\n" ;
-print $pm "our %DeadBits = (\n" ;
+print PM "%DeadBits = (\n" ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
my @list = sort { $a <=> $b } @$v ;
- print $pm tab(4, " '$k'"), '=> "',
- # mkHex($warn_size, @list),
- mkHex($warn_size, map $_ * 2 + 1 , @list),
+ print PM tab(4, " '$k'"), '=> "',
+ # mkHex($warn_size, @list),
+ mkHex($warn_size, map $_ * 2 + 1 , @list),
'", # [', mkRange(@list), "]\n" ;
}
-print $pm " );\n\n" ;
-print $pm '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
-print $pm '$LAST_BIT = ' . "$index ;\n" ;
-print $pm '$BYTES = ' . "$warn_size ;\n" ;
+print PM " );\n\n" ;
+print PM '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
+print PM '$LAST_BIT = ' . "$index ;\n" ;
+print PM '$BYTES = ' . "$warn_size ;\n" ;
while (<DATA>) {
- print $pm $_ ;
+ print PM $_ ;
}
-print $pm "# ex: set ro:\n";
-safer_close $pm;
-rename_if_different("lib/warnings.pm-new", "lib/warnings.pm");
+close PM ;
__END__
-# -*- buffer-read-only: t -*-
-# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+
# This file was created by warnings.pl
# Any changes made here will be lost.
#
package warnings;
-our $VERSION = '1.09';
-
-# Verify that we're called correctly so that warnings will work.
-# see also strict.pm.
-unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
- my (undef, $f, $l) = caller;
- die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
-}
-
=head1 NAME
warnings - Perl pragma to control optional warnings
@@ -482,347 +352,141 @@ warnings - Perl pragma to control optional warnings
warnings::warn("void", "some warning");
}
- if (warnings::enabled($object)) {
- warnings::warn($object, "some warning");
- }
-
- warnings::warnif("some warning");
- warnings::warnif("void", "some warning");
- warnings::warnif($object, "some warning");
-
=head1 DESCRIPTION
-The C<warnings> pragma is a replacement for the command line flag C<-w>,
-but the pragma is limited to the enclosing block, while the flag is global.
-See L<perllexwarn> for more information.
-
If no import list is supplied, all possible warnings are either enabled
or disabled.
-A number of functions are provided to assist module authors.
+A number of functions are provided to assist module authors.
=over 4
=item use warnings::register
-Creates a new warnings category with the same name as the package where
-the call to the pragma is used.
-
-=item warnings::enabled()
-
-Use the warnings category with the same name as the current package.
-
-Return TRUE if that warnings category is enabled in the calling module.
-Otherwise returns FALSE.
-
-=item warnings::enabled($category)
-
-Return TRUE if the warnings category, C<$category>, is enabled in the
-calling module.
-Otherwise returns FALSE.
-
-=item warnings::enabled($object)
-
-Use the name of the class for the object reference, C<$object>, as the
-warnings category.
-
-Return TRUE if that warnings category is enabled in the first scope
-where the object is used.
-Otherwise returns FALSE.
-
-=item warnings::fatal_enabled()
-
-Return TRUE if the warnings category with the same name as the current
-package has been set to FATAL in the calling module.
-Otherwise returns FALSE.
-
-=item warnings::fatal_enabled($category)
-
-Return TRUE if the warnings category C<$category> has been set to FATAL in
-the calling module.
-Otherwise returns FALSE.
-
-=item warnings::fatal_enabled($object)
-
-Use the name of the class for the object reference, C<$object>, as the
-warnings category.
-
-Return TRUE if that warnings category has been set to FATAL in the first
-scope where the object is used.
-Otherwise returns FALSE.
-
-=item warnings::warn($message)
-
-Print C<$message> to STDERR.
-
-Use the warnings category with the same name as the current package.
-
-If that warnings category has been set to "FATAL" in the calling module
-then die. Otherwise return.
+Creates a new warnings category which has the same name as the module
+where the call to the pragma is used.
-=item warnings::warn($category, $message)
+=item warnings::enabled([$category])
-Print C<$message> to STDERR.
+Returns TRUE if the warnings category C<$category> is enabled in the
+calling module. Otherwise returns FALSE.
-If the warnings category, C<$category>, has been set to "FATAL" in the
-calling module then die. Otherwise return.
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
-=item warnings::warn($object, $message)
+=item warnings::warn([$category,] $message)
-Print C<$message> to STDERR.
+If the calling module has I<not> set C<$category> to "FATAL", print
+C<$message> to STDERR.
+If the calling module has set C<$category> to "FATAL", print C<$message>
+STDERR then die.
-Use the name of the class for the object reference, C<$object>, as the
-warnings category.
-
-If that warnings category has been set to "FATAL" in the scope where C<$object>
-is first used then die. Otherwise return.
-
-
-=item warnings::warnif($message)
-
-Equivalent to:
-
- if (warnings::enabled())
- { warnings::warn($message) }
-
-=item warnings::warnif($category, $message)
-
-Equivalent to:
-
- if (warnings::enabled($category))
- { warnings::warn($category, $message) }
-
-=item warnings::warnif($object, $message)
-
-Equivalent to:
-
- if (warnings::enabled($object))
- { warnings::warn($object, $message) }
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
=back
-See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
+See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
=cut
+use Carp ;
+
KEYWORDS
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
-sub Croaker
-{
- require Carp; # this initializes %CarpInternal
- local $Carp::CarpInternal{'warnings'};
- delete $Carp::CarpInternal{'warnings'};
- Carp::croak(@_);
-}
-
-sub bits
-{
- # called from B::Deparse.pm
-
- push @_, 'all' unless @_;
-
- my $mask;
+sub bits {
+ my $mask ;
my $catmask ;
my $fatal = 0 ;
- my $no_fatal = 0 ;
-
- foreach my $word ( @_ ) {
- if ($word eq 'FATAL') {
+ foreach my $word (@_) {
+ if ($word eq 'FATAL') {
$fatal = 1;
- $no_fatal = 0;
- }
- elsif ($word eq 'NONFATAL') {
- $fatal = 0;
- $no_fatal = 1;
}
elsif ($catmask = $Bits{$word}) {
$mask |= $catmask ;
$mask |= $DeadBits{$word} if $fatal ;
- $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
}
else
- { Croaker("Unknown warnings category '$word'")}
+ { croak("unknown warnings category '$word'")}
}
return $mask ;
}
-sub import
-{
+sub import {
shift;
-
- my $catmask ;
- my $fatal = 0 ;
- my $no_fatal = 0 ;
-
- my $mask = ${^WARNING_BITS} ;
-
- if (vec($mask, $Offsets{'all'}, 1)) {
- $mask |= $Bits{'all'} ;
- $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
- }
-
- push @_, 'all' unless @_;
-
- foreach my $word ( @_ ) {
- if ($word eq 'FATAL') {
- $fatal = 1;
- $no_fatal = 0;
- }
- elsif ($word eq 'NONFATAL') {
- $fatal = 0;
- $no_fatal = 1;
- }
- elsif ($catmask = $Bits{$word}) {
- $mask |= $catmask ;
- $mask |= $DeadBits{$word} if $fatal ;
- $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
- }
- else
- { Croaker("Unknown warnings category '$word'")}
- }
-
- ${^WARNING_BITS} = $mask ;
+ ${^WARNING_BITS} |= bits(@_ ? @_ : 'all') ;
}
-sub unimport
-{
+sub unimport {
shift;
-
- my $catmask ;
my $mask = ${^WARNING_BITS} ;
-
if (vec($mask, $Offsets{'all'}, 1)) {
- $mask |= $Bits{'all'} ;
+ $mask = $Bits{'all'} ;
$mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
}
-
- push @_, 'all' unless @_;
-
- foreach my $word ( @_ ) {
- if ($word eq 'FATAL') {
- next;
- }
- elsif ($catmask = $Bits{$word}) {
- $mask &= ~($catmask | $DeadBits{$word} | $All);
- }
- else
- { Croaker("Unknown warnings category '$word'")}
- }
-
- ${^WARNING_BITS} = $mask ;
+ ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
}
-my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
-
-sub __chk
+sub enabled
{
+ croak("Usage: warnings::enabled([category])")
+ unless @_ == 1 || @_ == 0 ;
+ local $Carp::CarpLevel = 1 ;
my $category ;
my $offset ;
- my $isobj = 0 ;
+ my $callers_bitmask = (caller(1))[9] ;
+ return 0 unless defined $callers_bitmask ;
+
if (@_) {
# check the category supplied.
$category = shift ;
- if (my $type = ref $category) {
- Croaker("not an object")
- if exists $builtin_type{$type};
- $category = $type;
- $isobj = 1 ;
- }
$offset = $Offsets{$category};
- Croaker("Unknown warnings category '$category'")
+ croak("unknown warnings category '$category'")
unless defined $offset;
}
else {
- $category = (caller(1))[0] ;
+ $category = (caller(0))[0] ;
$offset = $Offsets{$category};
- Croaker("package '$category' not registered for warnings")
+ croak("package '$category' not registered for warnings")
unless defined $offset ;
}
- my $this_pkg = (caller(1))[0] ;
- my $i = 2 ;
- my $pkg ;
-
- if ($isobj) {
- while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
- last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
- }
- $i -= 2 ;
- }
- else {
- $i = _error_loc(); # see where Carp will allocate the error
- }
-
- my $callers_bitmask = (caller($i))[9] ;
- return ($callers_bitmask, $offset, $i) ;
-}
-
-sub _error_loc {
- require Carp;
- goto &Carp::short_error_loc; # don't introduce another stack frame
-}
-
-sub enabled
-{
- Croaker("Usage: warnings::enabled([category])")
- unless @_ == 1 || @_ == 0 ;
-
- my ($callers_bitmask, $offset, $i) = __chk(@_) ;
-
- return 0 unless defined $callers_bitmask ;
return vec($callers_bitmask, $offset, 1) ||
vec($callers_bitmask, $Offsets{'all'}, 1) ;
}
-sub fatal_enabled
-{
- Croaker("Usage: warnings::fatal_enabled([category])")
- unless @_ == 1 || @_ == 0 ;
-
- my ($callers_bitmask, $offset, $i) = __chk(@_) ;
-
- return 0 unless defined $callers_bitmask;
- return vec($callers_bitmask, $offset + 1, 1) ||
- vec($callers_bitmask, $Offsets{'all'} + 1, 1) ;
-}
sub warn
{
- Croaker("Usage: warnings::warn([category,] 'message')")
- unless @_ == 2 || @_ == 1 ;
-
- my $message = pop ;
- my ($callers_bitmask, $offset, $i) = __chk(@_) ;
- require Carp;
- Carp::croak($message)
- if vec($callers_bitmask, $offset+1, 1) ||
- vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
- Carp::carp($message) ;
-}
-
-sub warnif
-{
- Croaker("Usage: warnings::warnif([category,] 'message')")
+ croak("Usage: warnings::warn([category,] 'message')")
unless @_ == 2 || @_ == 1 ;
+ local $Carp::CarpLevel = 1 ;
+ my $category ;
+ my $offset ;
+ my $callers_bitmask = (caller(1))[9] ;
- my $message = pop ;
- my ($callers_bitmask, $offset, $i) = __chk(@_) ;
-
- return
- unless defined $callers_bitmask &&
- (vec($callers_bitmask, $offset, 1) ||
- vec($callers_bitmask, $Offsets{'all'}, 1)) ;
+ if (@_ == 2) {
+ $category = shift ;
+ $offset = $Offsets{$category};
+ croak("unknown warnings category '$category'")
+ unless defined $offset ;
+ }
+ else {
+ $category = (caller(0))[0] ;
+ $offset = $Offsets{$category};
+ croak("package '$category' not registered for warnings")
+ unless defined $offset ;
+ }
- require Carp;
- Carp::croak($message)
+ my $message = shift ;
+ croak($message)
if vec($callers_bitmask, $offset+1, 1) ||
vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
-
- Carp::carp($message) ;
+ carp($message) ;
}
1;
diff --git a/gnu/usr.bin/perl/win32/genmk95.pl b/gnu/usr.bin/perl/win32/genmk95.pl
index cf31457ab10..8fe4f86dbfc 100644
--- a/gnu/usr.bin/perl/win32/genmk95.pl
+++ b/gnu/usr.bin/perl/win32/genmk95.pl
@@ -64,7 +64,6 @@ while (<$in>)
if (/^(.*?)(&&|\|\|)(.*)$/) # two commands separated by && or ||
{
my ($one, $sep, $two) = ($1, $2, $3);
- $one =~ s/^\t(?:-(?!-))?\@?(.*?)$/\t$1/; # no -,@ in group recipes
LINE_CONT:
if ($two =~ /\\\s*$/)
{
@@ -78,7 +77,6 @@ LINE_CONT:
next;
}
# fall through - no need for special handling
- s/^\t(?:-(?!-))?\@?(.*?)$/\t$1/; # no -,@ in group recipes
print $out "$_\n";
}
print $out "]\n" if ($inrec);
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-27 07:18:41 +0000