summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1998-05-14 06:24:38 +0000
committerGurusamy Sarathy <gsar@cpan.org>1998-05-14 06:24:38 +0000
commit43051805d53a3e4c5b2185a17655cab5bedc17ed (patch)
treee2db8140ee431ea4490e4a62d46c8aebc55a920f
parent9510368719223cd3ecddcaa064744e809b020662 (diff)
downloadperl-43051805d53a3e4c5b2185a17655cab5bedc17ed.tar.gz
[win32] merge changes#755..759,763,764 from maintbranch
p4raw-link: @764 on //depot/maint-5.004/perl: b55845b185b3655fbcb60a4cd75d05dde49129cb p4raw-link: @763 on //depot/maint-5.004/perl: 150da09659bcba17cd7d84357c9e11bb0c85c6d8 p4raw-link: @759 on //depot/maint-5.004/perl: c8d70d09e95768371f69f084e8e237d2195ede65 p4raw-link: @755 on //depot/maint-5.004/perl: 284fa67c1ad7208c8b4dd82288a92c22d0bfdaca p4raw-id: //depot/win32/perl@934
-rw-r--r--MANIFEST2
-rw-r--r--Porting/patchls84
-rw-r--r--hints/openbsd.sh54
-rw-r--r--perl.c2
-rw-r--r--perlsdio.h6
-rw-r--r--pod/perlfunc.pod17
-rwxr-xr-x[-rw-r--r--]t/op/pos.t0
-rw-r--r--utils/perldoc.PL11
8 files changed, 150 insertions, 26 deletions
diff --git a/MANIFEST b/MANIFEST
index 082a2f3828..8d7f49971c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -358,6 +358,7 @@ hints/newsos4.sh Hints for named architecture
hints/next_3.sh Hints for named architecture
hints/next_3_0.sh Hints for named architecture
hints/next_4.sh Hints for named architecture
+hints/openbsd.sh Hints for named architecture
hints/opus.sh Hints for named architecture
hints/os2.sh Hints for named architecture
hints/os390.sh Hints for named architecture
@@ -844,6 +845,7 @@ t/op/oct.t See if oct and hex work
t/op/ord.t See if ord works
t/op/pack.t See if pack and unpack work
t/op/pat.t See if esoteric patterns work
+t/op/pos.t See if pos works
t/op/push.t See if push and pop work
t/op/quotemeta.t See if quotemeta works
t/op/rand.t See if rand works
diff --git a/Porting/patchls b/Porting/patchls
index 1d4bd5ac40..5b958323d2 100644
--- a/Porting/patchls
+++ b/Porting/patchls
@@ -17,10 +17,10 @@ use Text::Tabs qw(expand unexpand);
use strict;
use vars qw($VERSION);
-$VERSION = 2.04;
+$VERSION = 2.05;
sub usage {
-die q{
+die qq{
patchls [options] patchfile [ ... ]
-h no filename headers (like grep), only the listing.
@@ -31,12 +31,17 @@ die q{
-p N strip N levels of directory Prefix (like patch), else automatic.
-v more verbose (-d for noisy debugging).
-f F only list patches which patch files matching regexp F
- (F has $ appended unless it contains a /).
+ (F has \$ appended unless it contains a /).
+ -e Expect patched files to Exist (relative to current directory)
+ Will print warnings for files which don't. Also affects -4 option.
other options for special uses:
-I just gather and display summary Information about the patches.
-4 write to stdout the PerForce commands to prepare for patching.
+ -5 like -4 but add "|| exit 1" after each command
-M T Like -m but only output listed meta tags (eg -M 'Title From')
-W N set wrap width to N (defaults to 70, use 0 for no wrap)
+
+ patchls version $VERSION by Tim Bunce
}
}
@@ -49,21 +54,25 @@ $::opt_h = 0;
$::opt_l = 0;
$::opt_c = 0;
$::opt_f = '';
+$::opt_e = 0;
# special purpose options
$::opt_I = 0;
$::opt_4 = 0; # output PerForce commands to prepare for patching
+$::opt_5 = 0;
$::opt_M = ''; # like -m but only output these meta items (-M Title)
$::opt_W = 70; # set wrap width columns (see Text::Wrap module)
+$::opt_C = 0; # 'Chip' mode (handle from/tags/article/bug files) undocumented
usage unless @ARGV;
-getopts("mihlvc4p:f:IM:W:") or usage;
+getopts("mihlvecC45p:f:IM:W:") or usage;
$columns = $::opt_W || 9999999;
$::opt_m = 1 if $::opt_M;
-my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID');
+$::opt_4 = 1 if $::opt_5;
+my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID'); # see get_meta_info()
my %cat_title = (
'BUILD' => 'BUILD PROCESS',
@@ -77,7 +86,17 @@ my %cat_title = (
'OTHER' => 'OTHER CHANGES',
);
-my %ls;
+
+sub get_meta_info {
+ my $ls = shift;
+ local($_) = shift;
+ $ls->{From}{$1}=1 if /^From:\s+(.*\S)/i;
+ $ls->{Title}{$1}=1 if /^Subject:\s+(?:Re: )?(.*\S)/i;
+ $ls->{'Msg-ID'}{$1}=1 if /^Message-Id:\s+(.*\S)/i;
+ $ls->{Date}{$1}=1 if /^Date:\s+(.*\S)/i;
+ $ls->{$1}{$2}=1 if $::opt_M && /^([-\w]+):\s+(.*\S)/;
+}
+
# Style 1:
# *** perl-5.004/embed.h Sat May 10 03:39:32 1997
@@ -97,10 +116,14 @@ my %ls;
# Variation:
# Index: embed.h
-my($in, $prevline, $prevtype, $ls);
-my(@removed, @added);
+my %ls;
+
+my ($in, $prevline, $ls);
+my $prevtype = '';
+my (@removed, @added);
my $prologue = 1; # assume prologue till patch or /^exit\b/ seen
+
foreach my $argv (@ARGV) {
$in = $argv;
unless (open F, "<$in") {
@@ -119,12 +142,7 @@ foreach my $argv (@ARGV) {
push @removed, $1 if /^rm\s+(?:-f)?\s*(\S+)/;
$prologue = 0 if /^exit\b/;
}
- next unless $::opt_m;
- $ls->{From}{$1}=1,next if /^From:\s+(.*\S)/i;
- $ls->{Title}{$1}=1,next if /^Subject:\s+(?:Re: )?(.*\S)/i;
- $ls->{'Msg-ID'}{$1}=1,next if /^Message-Id:\s+(.*\S)/i;
- $ls->{Date}{$1}=1,next if /^Date:\s+(.*\S)/i;
- $ls->{$1}{$2}=1,next if /^([-\w]+):\s+(.*\S)/;
+ get_meta_info($ls, $_) if $::opt_m;
next;
}
$type = $1;
@@ -155,6 +173,25 @@ foreach my $argv (@ARGV) {
$prevtype = $type;
$type = '';
}
+
+ # special mode for patch sets from Chip
+ if ($::opt_C && $in =~ m:[\\/]patch$:) {
+ my $chip;
+ my $dir; ($dir = $in) =~ s:[\\/]patch$::;
+ if (!$ls->{From} && (open(CHIP,"$dir/article") || open(CHIP,"$dir/bug"))) {
+ get_meta_info($ls, $_) while (<CHIP>);
+ }
+ if (open CHIP,"<$dir/from") {
+ chop($chip = <CHIP>);
+ $ls->{From} = { $chip => 1 };
+ }
+ if (open CHIP,"<$dir/tag") {
+ chop($chip = <CHIP>);
+ $ls->{Title} = { $chip => 1 };
+ }
+ $ls->{From} = { "Chip Salzenberg" => 1 } unless $ls->{From};
+ }
+
# if we don't have a title for -m then use the file name
$ls->{Title}{$in}=1 if $::opt_m
and !$ls->{Title} and $ls->{out};
@@ -190,14 +227,18 @@ if ($::opt_f) { # filter out patches based on -f <regexp>
# --- Handle special modes ---
if ($::opt_4) {
- print map { "p4 delete $_\n" } @removed if @removed;
- print map { "p4 add $_\n" } @added if @added;
+ my $tail = ($::opt_5) ? "|| exit 1" : "";
+ print map { "p4 delete $_$tail\n" } @removed if @removed;
+ print map { "p4 add $_$tail\n" } @added if @added;
my @patches = grep { $_->{is_in} } @ls;
my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches;
delete @patched{@added};
my @patched = sort keys %patched;
- print map { "p4 edit $_\n" } @patched if @patched;
- exit 0;
+ print map {
+ my $edit = ($::opt_e && !-f $_) ? "add " : "edit";
+ "p4 $edit $_$tail\n"
+ } @patched if @patched;
+ exit 0 unless $::opt_C;
}
if ($::opt_I) {
@@ -267,6 +308,8 @@ sub add_file {
$ls->{out}->{$out} = 1;
+ warn "$out patched but not present\n" if $::opt_e && !-f $out;
+
# do the -i inverse as well, even if we're not doing -i
my $i = $ls{$out} ||= {
is_out => 1,
@@ -308,7 +351,8 @@ sub list_files_by_patch {
my @list = sort keys %{$ls->{$meta}};
push @meta, sprintf "%7s: ", $meta;
if ($meta eq 'Title') {
- @list = map { s/\[?PATCH\]?:?\s*//g; "\"$_\""; } @list
+ @list = map { s/\[?(PATCH|PERL)\]?:?\s*//g; "\"$_\""; } @list;
+ push @list, "#$1" if $::opt_C && $ls->{in} =~ m:\b(\w\d+)/patch$:;
}
elsif ($meta eq 'From') {
# fix-up bizzare addresses from japan and ibm :-)
@@ -329,7 +373,7 @@ sub list_files_by_patch {
}
# don't print the header unless the file contains something interesting
return if !@meta and !$ls->{out};
- print("$ls->{in}\n"),return if $::opt_l; # -l = no listing
+ print("$ls->{in}\n"),return if $::opt_l; # -l = no listing, just names
# a twisty maze of little options
my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : "";
diff --git a/hints/openbsd.sh b/hints/openbsd.sh
new file mode 100644
index 0000000000..633ac35d54
--- /dev/null
+++ b/hints/openbsd.sh
@@ -0,0 +1,54 @@
+# hints/openbsd.sh
+#
+# hints file for OpenBSD; Todd Miller <millert@openbsd.org>
+# Edited to allow Configure command-line overrides by
+# Andy Dougherty <doughera@lafcol.lafayette.edu>
+#
+
+# OpenBSD has a better malloc than perl...
+test "$usemymalloc" || usemymalloc='n'
+
+# Currently, vfork(2) is not a real win over fork(2) but this will
+# change in a future release.
+usevfork='true'
+
+# setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS versions
+# in 4.4BSD. Configure will find these but they are just emulated
+# and do not have the same semantics as in 4.3BSD.
+d_setregid='undef'
+d_setreuid='undef'
+d_setrgid='undef'
+d_setruid='undef'
+
+#
+# Not all platforms support shared libs...
+#
+case `uname -m` in
+alpha|mips|powerpc|vax)
+ d_dlopen=$undef
+ ;;
+*)
+ d_dlopen=$define
+ d_dlerror=$define
+ # we use -fPIC here because -fpic is *NOT* enough for some of the
+ # extensions like Tk on some OpenBSD platforms (ie: sparc)
+ cccdlflags="-DPIC -fPIC $cccdlflags"
+ lddlflags="-Bforcearchive -Bshareable $lddlflags"
+ ;;
+esac
+
+# OpenBSD doesn't need libcrypt but many folks keep a stub lib
+# around for old NetBSD binaries.
+libswanted=`echo $libswanted | sed 's/ crypt / /'`
+
+# Avoid telldir prototype conflict in pp_sys.c (OpenBSD uses const DIR *)
+pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
+
+# Configure can't figure this out non-interactively
+d_suidsafe='define'
+
+# cc is gcc so we can do better than -O
+# Allow a command-line override, such as -Doptimize=-g
+test "$optimize" || optimize='-O2'
+
+# end
diff --git a/perl.c b/perl.c
index c99c75711e..1240a5bf05 100644
--- a/perl.c
+++ b/perl.c
@@ -2688,7 +2688,7 @@ init_perllib(void)
ARCHLIB PRIVLIB SITEARCH and SITELIB
*/
#ifdef APPLLIB_EXP
- incpush(APPLLIB_EXP, FALSE);
+ incpush(APPLLIB_EXP, TRUE);
#endif
#ifdef ARCHLIB_EXP
diff --git a/perlsdio.h b/perlsdio.h
index a539a0a3d9..efc52e1cd4 100644
--- a/perlsdio.h
+++ b/perlsdio.h
@@ -272,8 +272,14 @@
#define fputc(c,f) PerlIO_putc(f,c)
#define fputs(s,f) PerlIO_puts(f,s)
#define getc(f) PerlIO_getc(f)
+#ifdef getc_unlocked
+#undef getc_unlocked
+#endif
#define getc_unlocked(f) PerlIO_getc(f)
#define putc(c,f) PerlIO_putc(f,c)
+#ifdef putc_unlocked
+#undef putc_unlocked
+#endif
#define putc_unlocked(c,f) PerlIO_putc(c,f)
#define ungetc(c,f) PerlIO_ungetc(f,c)
#if 0
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 7ddb710cf6..9c021ce16f 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -3098,10 +3098,12 @@ sanity checks in the interest of speed.
=item splice ARRAY,OFFSET
Removes the elements designated by OFFSET and LENGTH from an array, and
-replaces them with the elements of LIST, if any. Returns the elements
-removed from the array. The array grows or shrinks as necessary. If
-LENGTH is omitted, removes everything from OFFSET onward. The
-following equivalences hold (assuming C<$[ == 0>):
+replaces them with the elements of LIST, if any. In a list context,
+returns the elements removed from the array. In a scalar context,
+returns the last element removed, or C<undef> if no elements are
+removed. The array grows or shrinks as necessary. If LENGTH is
+omitted, removes everything from OFFSET onward. The following
+equivalences hold (assuming C<$[ == 0>):
push(@a,$x,$y) splice(@a,$#a+1,0,$x,$y)
pop(@a) splice(@a,-1)
@@ -4009,6 +4011,13 @@ for no value (void context).
Produces a message on STDERR just like die(), but doesn't exit or throw
an exception.
+If LIST is empty and $@ already contains a value (typically from a
+previous eval) that value is used after appending "\t...caught"
+to $@. This is useful for staying almost, but not entirely similar to
+die().
+
+If $@ is empty then the string "Warning: Something's wrong" is used.
+
No message is printed if there is a C<$SIG{__WARN__}> handler
installed. It is the handler's responsibility to deal with the message
as it sees fit (like, for instance, converting it into a die()). Most
diff --git a/t/op/pos.t b/t/op/pos.t
index 46811b7bbc..46811b7bbc 100644..100755
--- a/t/op/pos.t
+++ b/t/op/pos.t
diff --git a/utils/perldoc.PL b/utils/perldoc.PL
index 3a6059b4fd..752f335ca2 100644
--- a/utils/perldoc.PL
+++ b/utils/perldoc.PL
@@ -391,14 +391,23 @@ if ($opt_f) {
++$found if /^\w/; # found descriptive text
}
if (@pod) {
+ my $lines = $ENV{LINES} || 24;
+
if ($opt_t) {
open(FORMATTER, "| pod2text") || die "Can't start filter";
print FORMATTER "=over 8\n\n";
print FORMATTER @pod;
print FORMATTER "=back\n";
close(FORMATTER);
- } else {
+ } elsif (@pod < $lines-2) {
print @pod;
+ } else {
+ foreach $pager (@pagers) {
+ open (PAGER, "| $pager") or next;
+ print PAGER @pod ;
+ close(PAGER) or next;
+ last;
+ }
}
} else {
die "No documentation for perl function `$opt_f' found\n";