"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/ExtUtils/Typemaps/OutputMap.pm" (10 Mar 2019, 4428 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package ExtUtils::Typemaps::OutputMap;
    2 use 5.006001;
    3 use strict;
    4 use warnings;
    5 our $VERSION = '3.38';
    6 
    7 =head1 NAME
    8 
    9 ExtUtils::Typemaps::OutputMap - Entry in the OUTPUT section of a typemap
   10 
   11 =head1 SYNOPSIS
   12 
   13   use ExtUtils::Typemaps;
   14   ...
   15   my $output = $typemap->get_output_map('T_NV');
   16   my $code = $output->code();
   17   $output->code("...");
   18 
   19 =head1 DESCRIPTION
   20 
   21 Refer to L<ExtUtils::Typemaps> for details.
   22 
   23 =head1 METHODS
   24 
   25 =cut
   26 
   27 =head2 new
   28 
   29 Requires C<xstype> and C<code> parameters.
   30 
   31 =cut
   32 
   33 sub new {
   34   my $prot = shift;
   35   my $class = ref($prot)||$prot;
   36   my %args = @_;
   37 
   38   if (!ref($prot)) {
   39     if (not defined $args{xstype} or not defined $args{code}) {
   40       die("Need xstype and code parameters");
   41     }
   42   }
   43 
   44   my $self = bless(
   45     (ref($prot) ? {%$prot} : {})
   46     => $class
   47   );
   48 
   49   $self->{xstype} = $args{xstype} if defined $args{xstype};
   50   $self->{code} = $args{code} if defined $args{code};
   51   $self->{code} =~ s/^(?=\S)/\t/mg;
   52 
   53   return $self;
   54 }
   55 
   56 =head2 code
   57 
   58 Returns or sets the OUTPUT mapping code for this entry.
   59 
   60 =cut
   61 
   62 sub code {
   63   $_[0]->{code} = $_[1] if @_ > 1;
   64   return $_[0]->{code};
   65 }
   66 
   67 =head2 xstype
   68 
   69 Returns the name of the XS type of the OUTPUT map.
   70 
   71 =cut
   72 
   73 sub xstype {
   74   return $_[0]->{xstype};
   75 }
   76 
   77 =head2 cleaned_code
   78 
   79 Returns a cleaned-up copy of the code to which certain transformations
   80 have been applied to make it more ANSI compliant.
   81 
   82 =cut
   83 
   84 sub cleaned_code {
   85   my $self = shift;
   86   my $code = $self->code;
   87 
   88   # Move C pre-processor instructions to column 1 to be strictly ANSI
   89   # conformant. Some pre-processors are fussy about this.
   90   $code =~ s/^\s+#/#/mg;
   91   $code =~ s/\s*\z/\n/;
   92 
   93   return $code;
   94 }
   95 
   96 =head2 targetable
   97 
   98 This is an obscure but effective optimization that used to
   99 live in C<ExtUtils::ParseXS> directly. Not implementing it
  100 should never result in incorrect use of typemaps, just less
  101 efficient code.
  102 
  103 In a nutshell, this will check whether the output code
  104 involves calling C<sv_setiv>, C<sv_setuv>, C<sv_setnv>, C<sv_setpv> or
  105 C<sv_setpvn> to set the special C<$arg> placeholder to a new value
  106 B<AT THE END OF THE OUTPUT CODE>. If that is the case, the code is
  107 eligible for using the C<TARG>-related macros to optimize this.
  108 Thus the name of the method: C<targetable>.
  109 
  110 If this optimization is applicable, C<ExtUtils::ParseXS> will
  111 emit a C<dXSTARG;> definition at the start of the generated XSUB code,
  112 and type (see below) dependent code to set C<TARG> and push it on
  113 the stack at the end of the generated XSUB code.
  114 
  115 If the optimization can not be applied, this returns undef.
  116 If it can be applied, this method returns a hash reference containing
  117 the following information:
  118 
  119   type:      Any of the characters i, u, n, p
  120   with_size: Bool indicating whether this is the sv_setpvn variant
  121   what:      The code that actually evaluates to the output scalar
  122   what_size: If "with_size", this has the string length (as code,
  123              not constant, including leading comma)
  124 
  125 =cut
  126 
  127 sub targetable {
  128   my $self = shift;
  129   return $self->{targetable} if exists $self->{targetable};
  130 
  131   our $bal; # ()-balanced
  132   $bal = qr[
  133     (?:
  134       (?>[^()]+)
  135       |
  136       \( (??{ $bal }) \)
  137     )*
  138   ]x;
  139   my $bal_no_comma = qr[
  140     (?:
  141       (?>[^(),]+)
  142       |
  143       \( (??{ $bal }) \)
  144     )+
  145   ]x;
  146 
  147   # matches variations on (SV*)
  148   my $sv_cast = qr[
  149     (?:
  150       \( \s* SV \s* \* \s* \) \s*
  151     )?
  152   ]x;
  153 
  154   my $size = qr[ # Third arg (to setpvn)
  155     , \s* (??{ $bal })
  156   ]xo;
  157 
  158   my $code = $self->code;
  159 
  160   # We can still bootstrap compile 're', because in code re.pm is
  161   # available to miniperl, and does not attempt to load the XS code.
  162   use re 'eval';
  163 
  164   my ($type, $with_size, $arg, $sarg) =
  165     ($code =~
  166       m[^
  167         \s+
  168         sv_set([iunp])v(n)?    # Type, is_setpvn
  169         \s*
  170         \( \s*
  171           $sv_cast \$arg \s* , \s*
  172           ( $bal_no_comma )    # Set from
  173           ( $size )?           # Possible sizeof set-from
  174         \s* \) \s* ; \s* $
  175       ]xo
  176   );
  177 
  178   my $rv = undef;
  179   if ($type) {
  180     $rv = {
  181       type      => $type,
  182       with_size => $with_size,
  183       what      => $arg,
  184       what_size => $sarg,
  185     };
  186   }
  187   $self->{targetable} = $rv;
  188   return $rv;
  189 }
  190 
  191 =head1 SEE ALSO
  192 
  193 L<ExtUtils::Typemaps>
  194 
  195 =head1 AUTHOR
  196 
  197 Steffen Mueller C<<smueller@cpan.org>>
  198 
  199 =head1 COPYRIGHT & LICENSE
  200 
  201 Copyright 2009, 2010, 2011, 2012 Steffen Mueller
  202 
  203 This program is free software; you can redistribute it and/or
  204 modify it under the same terms as Perl itself.
  205 
  206 =cut
  207 
  208 1;
  209