summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>1999-03-28 12:30:01 +0000
committerJarkko Hietaniemi <jhi@iki.fi>1999-03-28 12:30:01 +0000
commit58c73031a2db6ad9857e14239f5bac5fa7097f3c (patch)
treedfacbc3cdbb79a3465da0421e4c61cf7ba57b0b8
parent6c1b87e5b61fa4275aa57590a99cb42541e71aa8 (diff)
parent95470547e854df745a1dec3565d4ef1ed8634342 (diff)
downloadperl-58c73031a2db6ad9857e14239f5bac5fa7097f3c.tar.gz
Integrate from mainperl.
p4raw-id: //depot/cfgperl@3194
-rw-r--r--MANIFEST1
-rwxr-xr-xPorting/p4desc15
-rw-r--r--ext/Thread/Thread.xs6
-rw-r--r--op.c2
-rwxr-xr-xt/lib/thread.t2
-rwxr-xr-xt/op/grep.t31
6 files changed, 53 insertions, 4 deletions
diff --git a/MANIFEST b/MANIFEST
index af10ce8df4..2b69bc22d0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
diff --git a/op.c b/op.c
index f22a5d2072..d5af3c90a8 100644
--- a/op.c
+++ b/op.c
@@ -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++;
+}
+