Add targetable method

This does the same thing for a simple output map as the make_targetable
function in ExtUtils::ParseXS::Utilities does for all output maps. The
latter function is intended to be superseded by this new method.

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
index 5aca32c..e60c7e6 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
@@ -92,6 +92,86 @@ sub cleaned_code {
   return $code;
 }
 
+=head2 targetable
+
+This is an obscure optimization that used to live in C<ExtUtils::ParseXS>
+directly.
+
+In a nutshell, this will check whether the output code
+involves calling C<set_iv>, C<set_uv>, C<set_nv>, C<set_pv> or C<set_pvn>
+to set the special C<$arg> placeholder to a new value
+B<AT THE END OF THE OUTPUT CODE>. If that is the case, the code is
+eligible for using the C<TARG>-related macros to optimize this.
+Thus the name of the method: C<targetable>.
+
+If the optimization can not be applied, this returns undef.
+If it can be applied, this method returns a hash reference containing
+the following information:
+
+  type: Any of the characters i, u, n, p
+  with_size: Bool indicating whether this is the sv_setpvn variant
+  what: The code that actually evaluates to the output scalar
+  what_size: If "with_size", this has the string length (as code, not constant)
+
+=cut
+
+sub targetable {
+  my $self = shift;
+  return $self->{targetable} if exists $self->{targetable};
+
+  our $bal; # ()-balanced
+  $bal = qr[
+    (?:
+      (?>[^()]+)
+      |
+      \( (??{ $bal }) \)
+    )*
+  ]x;
+
+  # matches variations on (SV*)
+  my $sv_cast = qr[
+    (?:
+      \( \s* SV \s* \* \s* \) \s*
+    )?
+  ]x;
+
+  my $size = qr[ # Third arg (to setpvn)
+    , \s* (??{ $bal })
+  ]x;
+
+  my $code = $self->code;
+
+  # We can still bootstrap compile 're', because in code re.pm is
+  # available to miniperl, and does not attempt to load the XS code.
+  use re 'eval';
+
+  my ($type, $with_size, $arg, $sarg) =
+    ($code =~
+      m[^
+        \s+
+        sv_set([iunp])v(n)?    # Type, is_setpvn
+        \s*
+        \( \s*
+          $sv_cast \$arg \s* , \s*
+          ( (??{ $bal }) )    # Set from
+        ( (??{ $size }) )?    # Possible sizeof set-from
+        \) \s* ; \s* $
+      ]x
+  );
+
+  my $rv = undef;
+  if ($type) {
+    $rv = {
+      type      => $type,
+      with_size => $with_size,
+      what      => $arg,
+      what_size => $sarg,
+    };
+  }
+  $self->{targetable} = $rv;
+  return $rv;
+}
+
 =head1 SEE ALSO
 
 L<ExtUtils::Typemaps>