Integrate changes #7971(perlio),8982,9061,9062,9068,9069,

9079,9083,9089,9090,9091 from mainline to maintperl.

Quieten some noise in Win32 builds

Fixes the bugs 20010221.005 and 20010221.008: "the taint checker..."

The perlretut was still talking about the old \p and \P
definitions.

More tweakage on the Unicode character class descriptions.

Subject: Re: [ID 20010305.012] chop() against list assignment returns char chopped from el zero

Subject: 'no *POSIX' Patch speeding up make on BS2000 

Subject: [PATCH] perldata.pod here-doc docs

Add /sbin and /usr/sbin to the list of directories scanned
for setuid programs.  Takes care of bug id 20010309.003.

       Subject: Re: [ID 19990808.001] [PATCH] FETCH triggered on exists()

In op/stat #35 better to scan all the potential directories
for setuids, not just the first one.

p4raw-link: @7971 on //depot/perlio: b474837

p4raw-id: //depot/maint-5.6/perl@9230
p4raw-integrated: from //depot/perlio@7971 'edit in' doio.c (@7859..)
	'merge in' perl.h (@7945..) toke.c (@7960..) win32/win32.h
	(@7970..)
p4raw-integrated: from //depot/perl@9229 'copy in' makedepend.SH
	(@5930..) t/op/chop.t (@8824..) pod/perldata.pod (@8979..)
	pod/perlretut.pod (@9061..) t/op/stat.t (@9089..) 'edit in'
	doio.c (@8963..) 'merge in' hv.c (@8919..)
p4raw-edited: from //depot/perl@9069 'edit in' Makefile.SH (@8879..)
p4raw-integrated: from //depot/perl@9068 'merge in' pp.c (@8966..)
p4raw-integrated: from //depot/perl@9062 'merge in'
	lib/unicode/mktables.PL (@8771..)

Author: jhi

Makefile.SH

@@ -132,6 +132,15 @@ case "$osname" in
 	;;
 esac
 
+# Handle the usage of different yaccs in posix-bc (During Configure we
+# us yacc for perly.y and byacc for a2p.y.  The makefiles must use the
+# same configuration for run_byacc!):
+case "$osname" in
+    posix-bc)
+	byacc=$yacc
+	;;
+esac
+
 echo "Extracting Makefile (with variable substitutions)"
 $spitshell >Makefile <<!GROK!THIS!
 # Makefile.SH
@@ -319,7 +328,7 @@ FORCE:
 $spitshell >>Makefile <<!GROK!THIS!
 opmini\$(OBJ_EXT): op.c config.h
 	\$(RMS) opmini.c
-	\$(LNS) op.c opmini.c
+	\$(CPS) op.c opmini.c
 	\$(CCCMD) \$(PLDLFLAGS) $DPERL_EXTERNAL_GLOB opmini.c
 	\$(RMS) opmini.c
 

doio.c

@@ -1279,11 +1279,11 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 	    (really && *tmps != '/'))		/* will execvp use PATH? */
 	    TAINT_ENV();		/* testing IFS here is overkill, probably */
 	if (really && *tmps)
-	    PerlProc_execvp(tmps,PL_Argv);
+	    PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
 	else
-	    PerlProc_execvp(PL_Argv[0],PL_Argv);
+	    PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
 	if (ckWARN(WARN_EXEC))
-	    Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s", 
+	    Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s",
 		(really ? tmps : PL_Argv[0]), Strerror(errno));
 	if (do_report) {
 	    int e = errno;

hv.c

@@ -793,11 +793,12 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 
     if (SvRMAGICAL(hv)) {
 	if (mg_find((SV*)hv,'P')) {
+	    SV* svret = sv_newmortal();
 	    sv = sv_newmortal();
 	    keysv = sv_2mortal(newSVsv(keysv));
-	    mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); 
-	    magic_existspack(sv, mg_find(sv, 'p'));
-	    return SvTRUE(sv);
+	    mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
+	    magic_existspack(svret, mg_find(sv, 'p'));
+	    return SvTRUE(svret);
 	}
 #ifdef ENV_IS_CASELESS
 	else if (mg_find((SV*)hv,'E')) {

lib/unicode/mktables.PL

@@ -31,7 +31,8 @@ mkdir "To", 0755;
     ['IsSpacePerl',
                  '$cat  =~ /^Z/ ||
                   $code =~ /^(0009|000A|000C|000D)$/',		''],
-    ['IsBlank',  '$cat  =~ /^Z[^lp]$/ ||  $code eq "0009"',	''],
+    ['IsBlank',  '$code =~ /^(0020|0009)$/ ||
+		  $cat  =~ /^Z[^lp]$/',	''],
     ['IsDigit',  '$cat =~ /^Nd$/',	''],
     ['IsUpper',  '$cat =~ /^L[ut]$/',	''],
     ['IsLower',  '$cat =~ /^Ll$/',	''],

makedepend.SH

@@ -108,7 +108,11 @@ for file in `$cat .clist`; do
 			if [ "$archname" = cygwin ]; then
 				uwinfix="-e s,\\\\\\\\,/,g"
 			else
-				uwinfix=
+				if [ "$osname" = posix-bc ]; then
+					uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/"
+				else
+					uwinfix=
+				fi
 			fi
 		fi
 	fi

perl.h

@@ -705,6 +705,10 @@ typedef struct perl_mstats perl_mstats_t;
 
 #include <errno.h>
 
+#if defined(WIN32) && (defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI))
+#  define WIN32SCK_IS_STDSCK		/* don't pull in custom wsock layer */
+#endif
+
 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
 # include <sys/socket.h>
 # if defined(USE_SOCKS) && defined(I_SOCKS)
@@ -3434,6 +3438,10 @@ typedef struct am_table_short AMTS;
 #   include <libutil.h>		/* setproctitle() in some FreeBSDs */
 #endif
 
+#ifndef EXEC_ARGV_CAST
+#define EXEC_ARGV_CAST(x) x
+#endif
+
 /* and finally... */
 #define PERL_PATCHLEVEL_H_IMPLICIT
 #include "patchlevel.h"

pod/perldata.pod

@@ -413,20 +413,20 @@ string may be either an identifier (a word), or some quoted text.  If
 quoted, the type of quotes you use determines the treatment of the
 text, just as in regular quoting.  An unquoted identifier works like
 double quotes.  There must be no space between the C<< << >> and
-the identifier.  (If you put a space it will be treated as a null
-identifier, which is valid, and matches the first empty line.)  The
-terminating string must appear by itself (unquoted and with no
-surrounding whitespace) on the terminating line.
+the identifier, unless the identifier is quoted.  (If you put a space it
+will be treated as a null identifier, which is valid, and matches the first
+empty line.)  The terminating string must appear by itself (unquoted and
+with no surrounding whitespace) on the terminating line.
 
 	print <<EOF;
     The price is $Price.
     EOF
 
-	print <<"EOF";	# same as above
+	print << "EOF";	# same as above
     The price is $Price.
     EOF
 
-	print <<`EOC`;	# execute commands
+	print << `EOC`;	# execute commands
     echo hi there
     echo lo there
     EOC
@@ -437,7 +437,7 @@ surrounding whitespace) on the terminating line.
     I said bar.
     bar
 
-	myfunc(<<"THIS", 23, <<'THAT');
+	myfunc(<< "THIS", 23, <<'THAT');
     Here's a line
     or two.
     THIS
@@ -478,6 +478,23 @@ you have to write
     the other 
     E 
 
+If the terminating identifier is on the last line of the program, you
+must be sure there is a newline after it; otherwise, Perl will give the
+warning B<Can't find string terminator "END" anywhere before EOF...>.
+
+Additionally, the quoting rules for the identifier are not related to
+Perl's quoting rules -- C<q()>, C<qq()>, and the like are not supported
+in place of C<''> and C<"">, and the only interpolation is for backslashing
+the quoting character:
+
+    print << "abc\"def";
+    testing...
+    abc"def
+
+Finally, quoted strings cannot span multiple lines.  The general rule is
+that the identifier must be a string literal.  Stick with that, and you
+should be safe.
+
 =head2 List value constructors
 
 List values are denoted by separating individual values by commas

pod/perlretut.pod

@@ -1720,29 +1720,32 @@ characters,
     $x =~ /^\p{IsLower}/;   # doesn't match, lowercase char class
     $x =~ /^\P{IsLower}/;   # matches, char class sans lowercase
 
-If a C<name> is just one letter, the braces can be dropped.  For
-instance, C<\pM> is the character class of Unicode 'marks'.  Here is
-the association between some Perl named classes and the traditional
-Unicode classes:
+Here is the association between some Perl named classes and the
+traditional Unicode classes:
 
-    Perl class name  Unicode class name
+    Perl class name  Unicode class name or regular expression
 
-    IsAlpha          Lu, Ll, or Lo
-    IsAlnum          Lu, Ll, Lo, or Nd
-    IsASCII          $code le 127
-    IsCntrl          C
+    IsAlpha          /^[LM]/
+    IsAlnum          /^[LMN]/
+    IsASCII          $code <= 127
+    IsCntrl          /^C/
+    IsBlank          $code =~ /^(0020|0009)$/ || /^Z[^lp]/
     IsDigit          Nd
-    IsGraph          [^C] and $code ne "0020"
+    IsGraph          /^([LMNPS]|Co)/
     IsLower          Ll
-    IsPrint          [^C]
-    IsPunct          P
-    IsSpace          Z, or ($code lt "0020" and chr(hex $code) is a \s)
-    IsUpper          Lu
-    IsWord           Lu, Ll, Lo, Nd or $code eq "005F"
+    IsPrint          /^([LMNPS]|Co|Zs)/
+    IsPunct          /^P/
+    IsSpace          /^Z/ || ($code =~ /^(0009|000A|000B|000C|000D)$/
+    IsSpacePerl      /^Z/ || ($code =~ /^(0009|000A|000C|000D)$/
+    IsUpper          /^L[ut]/
+    IsWord           /^[LMN]/ || $code eq "005F"
     IsXDigit         $code =~ /^00(3[0-9]|[46][1-6])$/
 
-For a full list of Perl class names, consult the mktables.PL program
-in the lib/perl5/5.6.0/unicode directory.
+You can also use the official Unicode class names with the C<\p> and
+C<\P>, like C<\p{L}> for Unicode 'letters', or C<\p{Lu}> for uppercase
+letters, or C<\P{Nd}> for non-digits.  If a C<name> is just one
+letter, the braces can be dropped.  For instance, C<\pM> is the
+character class of Unicode 'marks'.
 
 C<\X> is an abbreviation for a character class sequence that includes
 the Unicode 'combining character sequences'.  A 'combining character

pp.c

@@ -737,9 +737,9 @@ PP(pp_schop)
 
 PP(pp_chop)
 {
-    djSP; dMARK; dTARGET;
-    while (SP > MARK)
-	do_chop(TARG, POPs);
+    djSP; dMARK; dTARGET; dORIGMARK;
+    while (MARK < SP)
+	do_chop(TARG, *++MARK);
     PUSHTARG;
     RETURN;
 }

t/op/chop.t

@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..33\n";
+print "1..37\n";
 
 # optimized
 
@@ -103,3 +103,16 @@ print $_ eq "abc\x{1234}" ? "ok 32\n" : "not ok 32\n";
 $_ = "\x{1234}\x{2345}";
 chop;
 print $_ eq "\x{1234}" ? "ok 33\n" : "not ok 33\n";
+
+my @stuff = qw(this that);
+print chop(@stuff[0,1]) eq 't' ? "ok 34\n" : "not ok 34\n";
+
+# bug id 20010305.012
+@stuff = qw(ab cd ef);
+print chop(@stuff = @stuff) eq 'f' ? "ok 35\n" : "not ok 35\n";
+
+@stuff = qw(ab cd ef);
+print chop(@stuff[0, 2]) eq 'f' ? "ok 36\n" : "not ok 36\n";
+
+my %stuff = (1..4);
+print chop(@stuff{1, 3}) eq '4' ? "ok 37\n" : "not ok 37\n";

t/op/stat.t

@@ -178,14 +178,18 @@ if ($^O eq 'mpeix' or $^O eq 'amigaos' or $Is_Dosish or $Is_Cygwin) {
 $cnt = $uid = 0;
 
 die "Can't run op/stat.t test 35 without pwd working" unless $cwd;
-($bin) = grep {-d} ($^O eq 'machten' ? qw(/usr/bin /bin) : qw(/bin /usr/bin))
-    or print ("not ok 35\n"), goto tty_test;
-opendir BIN, $bin or die "Can't opendir $bin: $!";
-while (defined($_ = readdir BIN)) {
-    $_ = "$bin/$_";
-    $cnt++;
-    $uid++ if -u;
-    last if $uid && $uid < $cnt;
+my @bin = grep {-d} ($^O eq 'machten' ?
+		     qw(/usr/bin /bin) :
+		     qw(/sbin /usr/sbin /bin /usr/bin));
+unless (@bin) { print ("not ok 35\n"), goto tty_test; }
+for my $bin (@bin) {
+    opendir BIN, $bin or die "Can't opendir $bin: $!";
+    while (defined($_ = readdir BIN)) {
+        $_ = "$bin/$_";
+        $cnt++;
+        $uid++ if -u;
+        last if $uid && $uid < $cnt;
+    }
 }
 closedir BIN;
 

toke.c

@@ -2733,7 +2733,7 @@ Perl_yylex(pTHX)
 		    else
 			newargv = PL_origargv;
 		    newargv[0] = ipath;
-		    PerlProc_execv(ipath, newargv);
+		    PerlProc_execv(ipath, EXEC_ARGV_CAST(newargv));
 		    Perl_croak(aTHX_ "Can't exec %s", ipath);
 		}
 #endif

win32/win32.h

@@ -545,5 +545,7 @@ EXTERN_C _CRTIMP ioinfo* __pioinfo[];
  */
 #include "win32iop.h"
 
+#define EXEC_ARGV_CAST(x) ((const char *const *) x)
+
 #endif /* _INC_WIN32_PERL5 */