Integrate with Sarathy.

p4raw-id: //depot/cfgperl@4419

diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm
index 731d3ff..2899849 100644 (file)
--- a/lib/CPAN/FirstTime.pm
+++ b/lib/CPAN/FirstTime.pm
@@ -78,7 +78,8 @@ dialog anytime later by typing 'o conf init' at the cpan prompt.)
       } else {
        $fastread = 1;
        $CPAN::Config->{urllist} ||= [];
-       *prompt = sub {
+       # prototype should match that of &MakeMaker::prompt
+       *prompt = sub ($;$) {
          my($q,$a) = @_;
          my($ret) = defined $a ? $a : "";
          printf qq{%s [%s]\n\n}, $q, $ret;

diff --git a/op.c b/op.c
index 64d801f..f38b26c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6187,7 +6187,7 @@ Perl_peep(pTHX_ register OP *o)
            break;
 
        case OP_RETURN:
-           if (o->op_next->op_type != OP_LEAVESUBLV) {
+           if (o->op_next && o->op_next->op_type != OP_LEAVESUBLV) {
                o->op_seq = PL_op_seqmax++;
                break;
            }

diff --git a/opcode.h b/opcode.h
index e0bf4ff..81d9f36 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1490,8 +1490,8 @@ EXT U32 PL_opargs[] = {
        0x00003014,     /* trans */
        0x00000004,     /* sassign */
        0x00044408,     /* aassign */
-       0x0000570d,     /* chop */
-       0x0001378c,     /* schop */
+       0x0000560d,     /* chop */
+       0x0001368c,     /* schop */
        0x0000570d,     /* chomp */
        0x0001378c,     /* schomp */
        0x00013694,     /* defined */
@@ -1502,9 +1502,9 @@ EXT U32 PL_opargs[] = {
        0x00002254,     /* i_preinc */
        0x00002264,     /* predec */
        0x00002254,     /* i_predec */
-       0x0000236c,     /* postinc */
+       0x0000226c,     /* postinc */
        0x0000235c,     /* i_postinc */
-       0x0000236c,     /* postdec */
+       0x0000226c,     /* postdec */
        0x0000235c,     /* i_postdec */
        0x0002250e,     /* pow */
        0x0002252e,     /* multiply */
@@ -1543,13 +1543,13 @@ EXT U32 PL_opargs[] = {
        0x00022416,     /* seq */
        0x00022416,     /* sne */
        0x0002241e,     /* scmp */
-       0x0002250e,     /* bit_and */
-       0x0002250e,     /* bit_xor */
-       0x0002250e,     /* bit_or */
-       0x0000232e,     /* negate */
+       0x0002240e,     /* bit_and */
+       0x0002240e,     /* bit_xor */
+       0x0002240e,     /* bit_or */
+       0x0000222e,     /* negate */
        0x0000231e,     /* i_negate */
        0x00002216,     /* not */
-       0x0000230e,     /* complement */
+       0x0000220e,     /* complement */
        0x0002290e,     /* atan2 */
        0x0001378e,     /* sin */
        0x0001378e,     /* cos */

diff --git a/opcode.pl b/opcode.pl
index a41ef8b..53acd4d 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -289,6 +289,10 @@ sub tab {
 
 # lt and friends do SETs (including ncmp, but not scmp)
 
+# Additional mode of failure: the opcode can modify TARG before it "used"
+# all the arguments (or may call an external function which does the same).
+# If the target coincides with one of the arguments ==> kaboom.
+
 # pp.c pos substr each not OK (RETPUSHUNDEF)
 #      substr vec also not OK due to LV to target (are they???)
 #      ref not OK (RETPUSHNO)
@@ -299,11 +303,21 @@ sub tab {
 #      sprintf: is calling do_sprintf(TARG,...) which can act on TARG
 #        before other args are processed.
 
+#      Suspicious wrt "additional mode of failure" (and only it):
+#      schop, chop, postinc/dec, bit_and etc, negate, complement.
+
+#      Also suspicious: 4-arg substr, sprintf, uc/lc (POK_only), reverse, pack.
+
+#      substr/vec: doing TAINT_off()???
+
 # pp_hot.c
 #      readline - unknown whether it is safe
 #      match subst not OK (dTARG)
 #      grepwhile not OK (not always setting)
 
+#      Suspicious wrt "additional mode of failure": concat (dealt with
+#      in ck_sassign()), join (same).
+
 # pp_ctl.c
 #      mapwhile flip caller not OK (not always setting)
 
@@ -317,6 +331,8 @@ sub tab {
 #      sselect shm* sem* msg* syscall - unknown whether they are safe
 #      gmtime not OK (list context)
 
+#      Suspicious wrt "additional mode of failure": warn, die, select.
+
 __END__
 
 # New ops always go at the very end
@@ -382,8 +398,8 @@ trans               transliteration (tr///) ck_null         is"     S
 sassign                scalar assignment       ck_sassign      s0
 aassign                list assignment         ck_null         t2      L L
 
-chop           chop                    ck_spair        mTs%    L
-schop          scalar chop             ck_null         sTu%    S?
+chop           chop                    ck_spair        mts%    L
+schop          scalar chop             ck_null         stu%    S?
 chomp          chomp                   ck_spair        mTs%    L
 schomp         scalar chomp            ck_null         sTu%    S?
 defined                defined operator        ck_defined      isu%    S?
@@ -395,9 +411,9 @@ preinc              preincrement (++)               ck_lfun         dIs1    S
 i_preinc       integer preincrement (++)       ck_lfun         dis1    S
 predec         predecrement (--)               ck_lfun         dIs1    S
 i_predec       integer predecrement (--)       ck_lfun         dis1    S
-postinc                postincrement (++)              ck_lfun         dIsT1   S
+postinc                postincrement (++)              ck_lfun         dIst1   S
 i_postinc      integer postincrement (++)      ck_lfun         disT1   S
-postdec                postdecrement (--)              ck_lfun         dIsT1   S
+postdec                postdecrement (--)              ck_lfun         dIst1   S
 i_postdec      integer postdecrement (--)      ck_lfun         disT1   S
 
 # Ordinary operators.
@@ -445,14 +461,14 @@ seq               string eq               ck_null         ifs2    S S
 sne            string ne               ck_null         ifs2    S S
 scmp           string comparison (cmp) ck_scmp         ifst2   S S
 
-bit_and                bitwise and (&)         ck_bitop        fsT2    S S
-bit_xor                bitwise xor (^)         ck_bitop        fsT2    S S
-bit_or         bitwise or (|)          ck_bitop        fsT2    S S
+bit_and                bitwise and (&)         ck_bitop        fst2    S S
+bit_xor                bitwise xor (^)         ck_bitop        fst2    S S
+bit_or         bitwise or (|)          ck_bitop        fst2    S S
 
-negate         negation (-)            ck_null         IfsT1   S
+negate         negation (-)            ck_null         Ifst1   S
 i_negate       integer negation (-)    ck_null         ifsT1   S
 not            not                     ck_null         ifs1    S
-complement     1's complement (~)      ck_bitop        fsT1    S
+complement     1's complement (~)      ck_bitop        fst1    S
 
 # High falutin' math.
 

diff --git a/t/lib/glob-basic.t b/t/lib/glob-basic.t
index e3e53fe..dde8773 100755 (executable)
--- a/t/lib/glob-basic.t
+++ b/t/lib/glob-basic.t
@@ -68,16 +68,20 @@ print "ok 5\n";
 
 # check bad protections
 # should return an empty list, and set ERROR
-$dir = "PtEeRsLt.dir";
-mkdir $dir, 0;
-@a = File::Glob::glob("$dir/*", GLOB_ERR);
-#print "\@a = ", array(@a);
-rmdir $dir;
-if (scalar(@a) != 0 || (($^O ne 'MSWin32' and $^O ne 'os2')
-                       && GLOB_ERROR == 0)) {
-    print "not ";
+if ($^O eq 'MSWin32' or $^O eq 'os2' or not $>) {
+    print "ok 6 # skipped\n";
+}
+else {
+    $dir = "PtEeRsLt.dir";
+    mkdir $dir, 0;
+    @a = File::Glob::glob("$dir/*", GLOB_ERR);
+    #print "\@a = ", array(@a);
+    rmdir $dir;
+    if (scalar(@a) != 0 || GLOB_ERROR == 0) {
+       print "not ";
+    }
+    print "ok 6\n";
 }
-print "ok 6\n";
 
 # check for csh style globbing
 @a = File::Glob::glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);

diff --git a/t/op/sort.t b/t/op/sort.t
index f7bba3d..9abc410 100755 (executable)
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -163,7 +163,10 @@ print $@ ? "not ok 21\n# $@" : "ok 21\n";
 
 ## exercise sort builtins... ($a <=> $b already tested)
 @a = ( 5, 19, 1996, 255, 90 );
-@b = sort { $b <=> $a } @a;
+@b = sort {
+    my $dummy;         # force blockness
+    return $b <=> $a
+} @a;
 print ("@b" eq '1996 255 90 19 5' ? "ok 30\n" : "not ok 30\n");
 print "# x = '@b'\n";
 $x = join('', sort { $a cmp $b } @harry);