]> git.vpit.fr Git - perl/modules/indirect.git/commitdiff
Properly handle method_named ops
authorVincent Pit <vince@profvince.com>
Thu, 19 Aug 2010 14:22:05 +0000 (16:22 +0200)
committerVincent Pit <vince@profvince.com>
Thu, 19 Aug 2010 14:22:58 +0000 (16:22 +0200)
They are directly generated (i.e. without being mutated from a method op)
for use foo/no foo. This should solve the random failures of t/30-scope.t.

MANIFEST
indirect.xs
t/47-stress-use.t [new file with mode: 0644]

index 69f13ed4f152b3e781678823b26dc002fea599a2..10c08fd2684bc6f0d011fa67fb43aff8ca08b80f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -21,6 +21,7 @@ t/40-threads.t
 t/41-threads-teardown.t
 t/45-memory.t
 t/46-stress.t
+t/47-stress-use.t
 t/80-regressions.t
 t/91-pod.t
 t/92-pod-coverage.t
index 7f234a09037e04a72ab23c8a5f849713247c0f99..8a4a1920d9d89fa876ca4fcf01f24730d6d62814 100644 (file)
@@ -659,6 +659,41 @@ done:
  return o;
 }
 
+/* ... ck_method_named ..................................................... */
+
+/* "use foo/no foo" compiles its call to import/unimport directly to a
+ * method_named op. */
+
+STATIC OP *(*indirect_old_ck_method_named)(pTHX_ OP *) = 0;
+
+STATIC OP *indirect_ck_method_named(pTHX_ OP *o) {
+ if (indirect_hint()) {
+  const char *s;
+  line_t line;
+  SV *sv;
+
+  sv   = cSVOPo_sv;
+  if (!SvPOK(sv) || (SvTYPE(sv) < SVt_PV))
+   goto done;
+  sv   = sv_mortalcopy(sv);
+  s    = indirect_find(sv, PL_oldbufptr);
+  if (!s)
+   goto done;
+  line = CopLINE(&PL_compiling);
+
+  o = CALL_FPTR(indirect_old_ck_method_named)(aTHX_ o);
+
+  indirect_map_store(o, s, sv, line);
+  return o;
+ }
+
+done:
+ o = CALL_FPTR(indirect_old_ck_method_named)(aTHX_ o);
+
+ indirect_map_delete(o);
+ return o;
+}
+
 /* ... ck_entersub ......................................................... */
 
 STATIC int indirect_is_indirect(const indirect_op_info_t *moi, const indirect_op_info_t *ooi) {
@@ -772,21 +807,23 @@ STATIC void indirect_teardown(pTHX_ void *root) {
  ptable_hints_free(MY_CXT.tbl);
 #endif
 
- PL_check[OP_CONST]       = MEMBER_TO_FPTR(indirect_old_ck_const);
- indirect_old_ck_const    = 0;
- PL_check[OP_RV2SV]       = MEMBER_TO_FPTR(indirect_old_ck_rv2sv);
- indirect_old_ck_rv2sv    = 0;
- PL_check[OP_PADANY]      = MEMBER_TO_FPTR(indirect_old_ck_padany);
- indirect_old_ck_padany   = 0;
- PL_check[OP_SCOPE]       = MEMBER_TO_FPTR(indirect_old_ck_scope);
- indirect_old_ck_scope    = 0;
- PL_check[OP_LINESEQ]     = MEMBER_TO_FPTR(indirect_old_ck_lineseq);
- indirect_old_ck_lineseq  = 0;
-
- PL_check[OP_METHOD]      = MEMBER_TO_FPTR(indirect_old_ck_method);
- indirect_old_ck_method   = 0;
- PL_check[OP_ENTERSUB]    = MEMBER_TO_FPTR(indirect_old_ck_entersub);
- indirect_old_ck_entersub = 0;
+ PL_check[OP_CONST]           = MEMBER_TO_FPTR(indirect_old_ck_const);
+ indirect_old_ck_const        = 0;
+ PL_check[OP_RV2SV]           = MEMBER_TO_FPTR(indirect_old_ck_rv2sv);
+ indirect_old_ck_rv2sv        = 0;
+ PL_check[OP_PADANY]          = MEMBER_TO_FPTR(indirect_old_ck_padany);
+ indirect_old_ck_padany       = 0;
+ PL_check[OP_SCOPE]           = MEMBER_TO_FPTR(indirect_old_ck_scope);
+ indirect_old_ck_scope        = 0;
+ PL_check[OP_LINESEQ]         = MEMBER_TO_FPTR(indirect_old_ck_lineseq);
+ indirect_old_ck_lineseq      = 0;
+
+ PL_check[OP_METHOD]          = MEMBER_TO_FPTR(indirect_old_ck_method);
+ indirect_old_ck_method       = 0;
+ PL_check[OP_METHOD_NAMED]    = MEMBER_TO_FPTR(indirect_old_ck_method_named);
+ indirect_old_ck_method_named = 0;
+ PL_check[OP_ENTERSUB]        = MEMBER_TO_FPTR(indirect_old_ck_entersub);
+ indirect_old_ck_entersub     = 0;
 
  indirect_initialized = 0;
 }
@@ -805,21 +842,23 @@ STATIC void indirect_setup(pTHX) {
   MY_CXT.map   = ptable_new();
  }
 
- indirect_old_ck_const    = PL_check[OP_CONST];
- PL_check[OP_CONST]       = MEMBER_TO_FPTR(indirect_ck_const);
- indirect_old_ck_rv2sv    = PL_check[OP_RV2SV];
- PL_check[OP_RV2SV]       = MEMBER_TO_FPTR(indirect_ck_rv2sv);
- indirect_old_ck_padany   = PL_check[OP_PADANY];
- PL_check[OP_PADANY]      = MEMBER_TO_FPTR(indirect_ck_padany);
- indirect_old_ck_scope    = PL_check[OP_SCOPE];
- PL_check[OP_SCOPE]       = MEMBER_TO_FPTR(indirect_ck_scope);
- indirect_old_ck_lineseq  = PL_check[OP_LINESEQ];
- PL_check[OP_LINESEQ]     = MEMBER_TO_FPTR(indirect_ck_scope);
-
- indirect_old_ck_method   = PL_check[OP_METHOD];
- PL_check[OP_METHOD]      = MEMBER_TO_FPTR(indirect_ck_method);
- indirect_old_ck_entersub = PL_check[OP_ENTERSUB];
- PL_check[OP_ENTERSUB]    = MEMBER_TO_FPTR(indirect_ck_entersub);
+ indirect_old_ck_const        = PL_check[OP_CONST];
+ PL_check[OP_CONST]           = MEMBER_TO_FPTR(indirect_ck_const);
+ indirect_old_ck_rv2sv        = PL_check[OP_RV2SV];
+ PL_check[OP_RV2SV]           = MEMBER_TO_FPTR(indirect_ck_rv2sv);
+ indirect_old_ck_padany       = PL_check[OP_PADANY];
+ PL_check[OP_PADANY]          = MEMBER_TO_FPTR(indirect_ck_padany);
+ indirect_old_ck_scope        = PL_check[OP_SCOPE];
+ PL_check[OP_SCOPE]           = MEMBER_TO_FPTR(indirect_ck_scope);
+ indirect_old_ck_lineseq      = PL_check[OP_LINESEQ];
+ PL_check[OP_LINESEQ]         = MEMBER_TO_FPTR(indirect_ck_scope);
+
+ indirect_old_ck_method       = PL_check[OP_METHOD];
+ PL_check[OP_METHOD]          = MEMBER_TO_FPTR(indirect_ck_method);
+ indirect_old_ck_method_named = PL_check[OP_METHOD_NAMED];
+ PL_check[OP_METHOD_NAMED]    = MEMBER_TO_FPTR(indirect_ck_method_named);
+ indirect_old_ck_entersub     = PL_check[OP_ENTERSUB];
+ PL_check[OP_ENTERSUB]        = MEMBER_TO_FPTR(indirect_ck_entersub);
 
 #if I_MULTIPLICITY
  call_atexit(indirect_teardown, aTHX);
diff --git a/t/47-stress-use.t b/t/47-stress-use.t
new file mode 100644 (file)
index 0000000..cc83d93
--- /dev/null
@@ -0,0 +1,37 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 3 * (2 * 1);
+
+my $n = 1_000;
+
+sub linear {
+ my ($n, $force_use) = @_;
+
+ my @lines;
+ my $use = $force_use;
+ for (1 .. $n) {
+  my $stmt = $use ? 'use indirect;' : 'no indirect;';
+  $use = !$use unless defined $force_use;
+  push @lines, "{ $stmt }";
+ }
+
+ return '{ no indirect; ', @lines, '}';
+}
+
+for my $test ([ 1, 'always use' ], [ 0, 'always no' ], [ undef, 'mixed' ]) {
+ my ($force_use, $desc) = @$test;
+ my $code = join "\n", linear $n, $force_use;
+ my ($err, @warns);
+ {
+  local $SIG{__WARN__} = sub { push @warns, "@_" };
+  local $@;
+  eval $code;
+  $err = $@;
+ }
+ is $err,   '', "linear ($desc): no errror";
+ is @warns, 0,  "linear ($desc): no warnings";
+ diag $_ for @warns;
+}