diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 1999-03-28 12:30:01 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 1999-03-28 12:30:01 +0000 |
commit | 58c73031a2db6ad9857e14239f5bac5fa7097f3c (patch) | |
tree | dfacbc3cdbb79a3465da0421e4c61cf7ba57b0b8 | |
parent | 6c1b87e5b61fa4275aa57590a99cb42541e71aa8 (diff) | |
parent | 95470547e854df745a1dec3565d4ef1ed8634342 (diff) | |
download | perl-58c73031a2db6ad9857e14239f5bac5fa7097f3c.tar.gz |
Integrate from mainperl.
p4raw-id: //depot/cfgperl@3194
-rw-r--r-- | MANIFEST | 1 | ||||
-rwxr-xr-x | Porting/p4desc | 15 | ||||
-rw-r--r-- | ext/Thread/Thread.xs | 6 | ||||
-rw-r--r-- | op.c | 2 | ||||
-rwxr-xr-x | t/lib/thread.t | 2 | ||||
-rwxr-xr-x | t/op/grep.t | 31 |
6 files changed, 53 insertions, 4 deletions
@@ -1177,6 +1177,7 @@ t/op/glob.t See if <*> works t/op/goto.t See if goto works t/op/goto_xs.t See if "goto &sub" works on XSUBs t/op/grent.t See if getgr*() functions work +t/op/grep.t See if grep() and map() work t/op/groups.t See if $( works t/op/gv.t See if typeglobs work t/op/hashwarn.t See if warnings for bad hash assignments work diff --git a/Porting/p4desc b/Porting/p4desc index 062a6f122b..7bac3eb1f2 100755 --- a/Porting/p4desc +++ b/Porting/p4desc @@ -1,4 +1,4 @@ -#!/l/local/bin/perl -wpi.bak +#!/usr/bin/perl -wpi.bak # # Munge "p4 describe ..." output to include new files. @@ -90,12 +90,23 @@ sub newfiles { my $addfile; my $ret = ""; for $addfile (@addfiles) { + my $type = `p4 -p $p4port files $addfile`; + if ($?) { + warn "$0: `p4 -p $p4port print $addfile` failed, status[$?]\n"; + next; + } + $type =~ m|^//.*\((.+)\)$| or next; + $type = $1; + unless ($type =~ /text/) { + $ret .= "\n==== $addfile ($type) ====\n\n"; + next; + } my @new = `p4 -p $p4port print $addfile`; if ($?) { die "$0: `p4 -p $p4port print $addfile` failed, status[$?]\n"; } my $desc = shift @new; # discard initial description - $ret .= "\n==== $addfile (text) ====\n\n"; + $ret .= "\n==== $addfile ($type) ====\n\n"; my $lines = "," . @new; $lines = "" if @new < 2; $ret .= "\@\@ -0,0 +1$lines \@\@\n"; diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 543ecf00cf..c3b468314a 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -238,6 +238,11 @@ newthread (SV *startsv, AV *initargs, char *classname) savethread = thr; thr = new_struct_thread(thr); + /* temporarily pretend to be the child thread in case the + * XPUSHs() below want to grow the child's stack. This is + * safe, since the other thread is not yet created, and we + * are the only ones who know about it */ + SET_THR(thr); SPAGAIN; DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: newthread (%p), tid is %u, preparing stack\n", @@ -251,6 +256,7 @@ newthread (SV *startsv, AV *initargs, char *classname) PUTBACK; /* On your marks... */ + SET_THR(savethread); MUTEX_LOCK(&thr->mutex); #ifdef THREAD_CREATE @@ -4306,7 +4306,7 @@ newAVREF(OP *o) OP * newGVREF(I32 type, OP *o) { - if (type == OP_MAPSTART) + if (type == OP_MAPSTART || type == OP_GREPSTART) return newUNOP(OP_NULL, 0, o); return ref(newUNOP(OP_RV2GV, OPf_REF, o), type); } diff --git a/t/lib/thread.t b/t/lib/thread.t index 61997cfc8b..5cc2eaf886 100755 --- a/t/lib/thread.t +++ b/t/lib/thread.t @@ -24,7 +24,7 @@ sub content } # create a thread passing args and immedaietly wait for it. -my $t = new Thread \&content,("ok 2\n","ok 3\n"); +my $t = new Thread \&content,("ok 2\n","ok 3\n", 1..1000); print $t->join; # check that lock works ... diff --git a/t/op/grep.t b/t/op/grep.t new file mode 100755 index 0000000000..45d0e25a27 --- /dev/null +++ b/t/op/grep.t @@ -0,0 +1,31 @@ +#!./perl + +# +# grep() and map() tests +# + +print "1..3\n"; + +$test = 1; + +sub ok { + my ($got,$expect) = @_; + print "# expected [$expect], got [$got]\nnot " if $got ne $expect; + print "ok $test\n"; +} + +{ + my @lol = ([qw(a b c)], [], [qw(1 2 3)]); + my @mapped = map {scalar @$_} @lol; + ok "@mapped", "3 0 3"; + $test++; + + my @grepped = grep {scalar @$_} @lol; + ok "@grepped", "$lol[0] $lol[2]"; + $test++; + + @grepped = grep { $_ } @mapped; + ok "@grepped", "3 3"; + $test++; +} + |