X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F80-threads.t;fp=t%2F80-threads.t;h=73359c3da8c727c364c7eecd9f01b92eed6ce327;hb=05e35b66f2a12a2416a5964be485a4f741682a47;hp=0000000000000000000000000000000000000000;hpb=55716e9a7414ca5da96259d66fd0f20c1cbba893;p=perl%2Fmodules%2FLexical-Types.git

diff --git a/t/80-threads.t b/t/80-threads.t
new file mode 100644
index 0000000..73359c3
--- /dev/null
+++ b/t/80-threads.t
@@ -0,0 +1,63 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use lib 't/lib';
+use Lexical::Types::TestThreads;
+
+use Test::More 'no_plan';
+
+my $threads = 10;
+my $runs    = 2;
+
+{
+ package Lexical::Types::Test::Tag;
+
+ sub TYPEDSCALAR {
+  my $tid = threads->tid();
+  my ($file, $line) = (caller(0))[1, 2];
+  my $where = "at $file line $line in thread $tid";
+  local $Test::Builder::Level = $Test::Builder::Level + 1;
+  Test::More::is($_[0], __PACKAGE__, "base type is correct $where");
+  Test::More::is($_[2], 'Tag', "original type is correct $where");
+  $_[1] = $tid;
+  ();
+ }
+}
+
+{ package Tag; }
+
+use Lexical::Types as => 'Lexical::Types::Test::';
+
+sub try {
+ my $tid = threads->tid();
+
+ for (1 .. $runs) {
+  my Tag $t;
+  is $t, $tid, "typed lexical correctly initialized at run $_ in thread $tid";
+
+  eval <<'EVALD';
+   use Lexical::Types as => "Lexical::Types::Test::";
+   my Tag $t2;
+   is $t2, $tid, "typed lexical correctly initialized in eval at run $_ in thread $tid";
+EVALD
+  diag $@ if $@;
+
+SKIP:
+  {
+   skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3
+                                                           unless "$]" >= 5.010;
+   eval <<'EVALD';
+    my Tag $t3;
+    is $t3, $tid, "typed lexical correctly initialized in eval (propagated) at run $_ in thread $tid"
+EVALD
+  }
+ }
+}
+
+my @t = map spawn(\&try), 1 .. $threads;
+
+$_->join for @t;
+
+pass 'done';