summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/utils
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/utils')
-rw-r--r--contrib/perl5/utils/h2ph.PL102
-rw-r--r--contrib/perl5/utils/h2xs.PL16
-rw-r--r--contrib/perl5/utils/perlbug.PL34
-rw-r--r--contrib/perl5/utils/perldoc.PL13
4 files changed, 141 insertions, 24 deletions
diff --git a/contrib/perl5/utils/h2ph.PL b/contrib/perl5/utils/h2ph.PL
index 066f2c9..6011d98 100644
--- a/contrib/perl5/utils/h2ph.PL
+++ b/contrib/perl5/utils/h2ph.PL
@@ -63,6 +63,8 @@ $inif = 0;
@ARGV = ('-') unless @ARGV;
+build_preamble_if_necessary();
+
while (defined ($file = next_file())) {
if (-l $file and -d $file) {
link_if_possible($file) if ($opt_l);
@@ -97,6 +99,8 @@ while (defined ($file = next_file())) {
open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
}
+
+ print OUT "require '_h2ph_pre.ph';\n\n";
while (<IN>) {
chop;
while (/\\$/) {
@@ -105,6 +109,7 @@ while (defined ($file = next_file())) {
chop;
}
print OUT "# $_\n" if $opt_D;
+
if (s:/\*:\200:g) {
s:\*/:\201:g;
s/\200[^\201]*\201//g; # delete single line comments
@@ -158,6 +163,7 @@ while (defined ($file = next_file())) {
$args = reindent($args);
if ($t ne '') {
$new =~ s/(['\\])/\\$1/g; #']);
+
if ($opt_h) {
print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n";
$eval_index++;
@@ -165,6 +171,9 @@ while (defined ($file = next_file())) {
print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
}
} else {
+ # Shunt around such directives as `#define FOO FOO':
+ next if " \&$name" eq $new;
+
print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n";
}
}
@@ -230,10 +239,12 @@ while (defined ($file = next_file())) {
print OUT $t,"}\n";
} elsif(/^undef\s+(\w+)/) {
print OUT $t, "undef(&$1) if defined(&$1);\n";
+ } elsif(/^error\s+(".*")/) {
+ print OUT $t, "die($1);\n";
} elsif(/^error\s+(.*)/) {
- print OUT $t, "die(\"$1\");\n";
+ print OUT $t, "die(\"", quotemeta($1), "\");\n";
} elsif(/^warning\s+(.*)/) {
- print OUT $t, "warn(\"$1\");\n";
+ print OUT $t, "warn(\"", quotemeta($1), "\");\n";
} elsif(/^ident\s+(.*)/) {
print OUT $t, "# $1\n";
}
@@ -512,6 +523,71 @@ sub inc_dirs
}
+# Create "_h2ph_pre.ph", if it doesn't exist or was built by a different
+# version of h2ph.
+sub build_preamble_if_necessary
+{
+ # Increment $VERSION every time this function is modified:
+ my $VERSION = 1;
+ my $preamble = "$Dest_dir/_h2ph_pre.ph";
+
+ # Can we skip building the preamble file?
+ if (-r $preamble) {
+ # Extract version number from first line of preamble:
+ open PREAMBLE, $preamble or die "Cannot open $preamble: $!";
+ my $line = <PREAMBLE>;
+ $line =~ /(\b\d+\b)/;
+ close PREAMBLE or die "Cannot close $preamble: $!";
+
+ # Don't build preamble if a compatible preamble exists:
+ return if $1 == $VERSION;
+ }
+
+ my (%define) = _extract_cc_defines();
+
+ open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!";
+ print PREAMBLE "# This file was created by h2ph version $VERSION\n";
+
+ foreach (sort keys %define) {
+ if ($opt_D) {
+ print PREAMBLE "# $_=$define{$_}\n";
+ }
+
+ if ($define{$_} =~ /^\d+$/) {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { $define{$_} } }\n\n";
+ } else {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { \"",
+ quotemeta($define{$_}), "\" } }\n\n";
+ }
+ }
+ close PREAMBLE or die "Cannot close $preamble: $!";
+}
+
+
+# %Config contains information on macros that are pre-defined by the
+# system's compiler. We need this information to make the .ph files
+# function with perl as the .h files do with cc.
+sub _extract_cc_defines
+{
+ my %define;
+ my $allsymbols = join " ", @Config{ccsymbols, cppsymbols, cppccsymbols};
+
+ # Split compiler pre-definitions into `key=value' pairs:
+ foreach (split /\s+/, $allsymbols) {
+ /(.*?)=(.*)/;
+ $define{$1} = $2;
+
+ if ($opt_D) {
+ print STDERR "$_: $1 -> $2\n";
+ }
+ }
+
+ return %define;
+}
+
+
1;
##############################################################################
@@ -590,6 +666,10 @@ However, the B<.ph> files almost double in size when built using B<-h>.
Include the code from the B<.h> file as a comment in the B<.ph> file.
This is primarily used for debugging I<h2ph>.
+=item -Q
+
+``Quiet'' mode; don't print out the names of the files being converted.
+
=back
=head1 ENVIRONMENT
@@ -626,6 +706,24 @@ that it can translate.
It's only intended as a rough tool.
You may need to dicker with the files produced.
+Doesn't run with C<use strict>
+
+You have to run this program by hand; it's not run as part of the Perl
+installation.
+
+Doesn't handle complicated expressions built piecemeal, a la:
+
+ enum {
+ FIRST_VALUE,
+ SECOND_VALUE,
+ #ifdef ABC
+ THIRD_VALUE
+ #endif
+ };
+
+Doesn't necessarily locate all of your C compiler's internally-defined
+symbols.
+
=cut
!NO!SUBS!
diff --git a/contrib/perl5/utils/h2xs.PL b/contrib/perl5/utils/h2xs.PL
index 52f590b..129b01b 100644
--- a/contrib/perl5/utils/h2xs.PL
+++ b/contrib/perl5/utils/h2xs.PL
@@ -211,7 +211,7 @@ The usual warnings if it cannot read or write the files involved.
=cut
-my( $H2XS_VERSION ) = ' $Revision: 1.18 $ ' =~ /\$Revision:\s+([^\s]+)/;
+my( $H2XS_VERSION ) = ' $Revision: 1.19 $ ' =~ /\$Revision:\s+([^\s]+)/;
my $TEMPLATE_VERSION = '0.01';
use Getopt::Std;
@@ -499,6 +499,7 @@ sub AUTOLOAD {
croak "Your vendor has not defined $module macro \$constname";
}
}
+ no strict 'refs';
*\$AUTOLOAD = sub () { \$val };
goto &\$AUTOLOAD;
}
@@ -591,15 +592,9 @@ if( ! $opt_X ){ # print XS, unless it is disabled
warn "Writing $ext$modpname/$modfname.xs\n";
print XS <<"END";
-#ifdef __cplusplus
-extern "C" {
-#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-#ifdef __cplusplus
-}
-#endif
END
if( @path_h ){
@@ -615,17 +610,14 @@ if( @path_h ){
if( ! $opt_c ){
print XS <<"END";
static int
-not_here(s)
-char *s;
+not_here(char *s)
{
croak("$module::%s not implemented on this architecture", s);
return -1;
}
static double
-constant(name, arg)
-char *name;
-int arg;
+constant(char *name, int arg)
{
errno = 0;
switch (*name) {
diff --git a/contrib/perl5/utils/perlbug.PL b/contrib/perl5/utils/perlbug.PL
index 589e7e6..6f87589 100644
--- a/contrib/perl5/utils/perlbug.PL
+++ b/contrib/perl5/utils/perlbug.PL
@@ -528,7 +528,7 @@ EOF
Environment for perl $]:
EOF
for my $env (sort
- (qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR),
+ (qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE),
grep /^(?:PERL|LC_)/, keys %ENV)
) {
print OUT " $env",
@@ -901,6 +901,13 @@ it all, but at least have a look at the sections that I<seem> relevant).
Be aware of the familiar traps that perl programmers of various hues
fall into. See L<perltrap>.
+Check in L<perldiag> to see what any Perl error message(s) mean.
+If message isn't in perldiag, it probably isn't generated by Perl.
+Consult your operating system documentation instead.
+
+If you are on a non-UNIX platform check also L<perlport>, some
+features may not be implemented or work differently.
+
Try to study the problem under the perl debugger, if necessary.
See L<perldebug>.
@@ -916,6 +923,17 @@ A good test case is almost always a good candidate to be on the perl
test suite. If you have the time, consider making your test case so
that it will readily fit into the standard test suite.
+Remember also to include the B<exact> error messages, if any.
+"Perl complained something" is not an exact error message.
+
+If you get a core dump (or equivalent), you may use a debugger
+(B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
+report. NOTE: unless your Perl has been compiled with debug info
+(often B<-g>), the stack trace is likely to be somewhat hard to use
+because it will most probably contain only the function names, not
+their arguments. If possible, recompile your Perl with debug info and
+reproduce the dump and the stack trace.
+
=item Can you describe the bug in plain English?
The easier it is to understand a reproducible bug, the more likely it
@@ -954,6 +972,11 @@ it to B<perlbug@perl.com>. If, for some reason, you cannot run
C<perlbug> at all on your system, be sure to include the entire output
produced by running C<perl -V> (note the uppercase V).
+Whether you use C<perlbug> or send the email manually, please make
+your subject informative. "a bug" not informative. Neither is "perl
+crashes" nor "HELP!!!", these all are null information. A compact
+description of what's wrong is fine.
+
=back
Having done your bit, please be prepared to wait, to be told the bug
@@ -1071,12 +1094,14 @@ Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
-(E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>)
-and Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>).
+(E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
+Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>), and
+Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>).
=head1 SEE ALSO
-perl(1), perldebug(1), perltrap(1), diff(1), patch(1)
+perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
+diff(1), patch(1), dbx(1), gdb(1)
=head1 BUGS
@@ -1090,4 +1115,3 @@ close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
chdir $origdir;
-
diff --git a/contrib/perl5/utils/perldoc.PL b/contrib/perl5/utils/perldoc.PL
index 875cd25..2633510 100644
--- a/contrib/perl5/utils/perldoc.PL
+++ b/contrib/perl5/utils/perldoc.PL
@@ -91,7 +91,7 @@ Options:
-F Arguments are file names, not modules
-v Verbosely describe what's going on
-X use index if present (looks for pod.idx at $Config{archlib})
-
+ -q Search the text of questions (not answers) in perlfaq[1-9]
PageName|ModuleName...
is the name of a piece of documentation that you want to look at. You
@@ -188,7 +188,7 @@ sub minus_f_nocase {
if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
# on a case-forgiving file system or if case is important
# that is it all we can do
- warn "Ignored $file: unreadable\n" if -f _;
+ warn "Ignored $path: unreadable\n" if -f _;
return '';
}
local *DIR;
@@ -227,7 +227,7 @@ sub minus_f_nocase {
return "" unless $found;
push @p, $cip;
return "@p" if -f "@p" and -r _;
- warn "Ignored $file: unreadable\n" if -f _;
+ warn "Ignored @p: unreadable\n" if -f _;
}
}
return "";
@@ -408,6 +408,9 @@ if ($opt_f) {
my $perlfunc = shift @found;
open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
+ # Functions like -r, -e, etc. are listed under `-X'.
+ my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/) ? 'I<-X' : $opt_f ;
+
# Skip introduction
while (<PFUNC>) {
last if /^=head2 Alphabetical Listing of Perl Functions/;
@@ -417,7 +420,7 @@ if ($opt_f) {
my $found = 0;
my @pod;
while (<PFUNC>) {
- if (/^=item\s+\Q$opt_f\E\b/o) {
+ if (/^=item\s+\Q$search_string\E\b/o) {
$found = 1;
} elsif (/^=item/) {
last if $found > 1;
@@ -456,7 +459,7 @@ if ($opt_q) {
my @pod;
while (<>) {
- if (/^=head2\s+.*$opt_q/oi) {
+ if (/^=head2\s+.*(?:$opt_q)/oi) {
$found = 1;
push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
} elsif (/^=head2/) {
OpenPOWER on IntegriCloud