From 43051805d53a3e4c5b2185a17655cab5bedc17ed Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Thu, 14 May 1998 06:24:38 +0000 Subject: [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 --- MANIFEST | 2 ++ Porting/patchls | 84 ++++++++++++++++++++++++++++++++++++++++++-------------- hints/openbsd.sh | 54 ++++++++++++++++++++++++++++++++++++ perl.c | 2 +- perlsdio.h | 6 ++++ pod/perlfunc.pod | 17 +++++++++--- t/op/pos.t | 0 utils/perldoc.PL | 11 +++++++- 8 files changed, 150 insertions(+), 26 deletions(-) create mode 100644 hints/openbsd.sh mode change 100644 => 100755 t/op/pos.t 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 (); + } + if (open CHIP,"<$dir/from") { + chop($chip = ); + $ls->{From} = { $chip => 1 }; + } + if (open CHIP,"<$dir/tag") { + chop($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 # --- 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 +# Edited to allow Configure command-line overrides by +# Andy Dougherty +# + +# 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 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 old mode 100644 new mode 100755 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"; -- cgit v1.2.1