use File::Spec;
use lib qw( lib );
use ExtUtils::ParseXS::Constants ();
-require ExtUtils::Typemaps;
+
+our $VERSION = '3.06';
our (@ISA, @EXPORT_OK);
@ISA = qw(Exporter);
C_string
valid_proto_string
process_typemaps
- process_single_typemap
make_targetable
map_type
standard_XS_defs
analyze_preprocessor_statements
set_cond
Warn
+ current_line_number
blurt
death
check_conditional_preprocessor_statements
C_string
valid_proto_string
process_typemaps
- process_single_typemap
make_targetable
map_type
standard_XS_defs
=item * Arguments
- my ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) =
- process_typemaps( $args{typemap}, $pwd );
+ my $typemaps_object = process_typemaps( $args{typemap}, $pwd );
List of two elements: C<typemap> element from C<%args>; current working
directory.
=item * Return Value
-Upon success, returns a list of four hash references. (This will probably be
-refactored.) Here is a I<rough> description of what is in these hashrefs:
-
-=over 4
-
-=item * C<$type_kind_ref>
-
- {
- 'char **' => 'T_PACKEDARRAY',
- 'bool_t' => 'T_IV',
- 'AV *' => 'T_AVREF',
- 'InputStream' => 'T_IN',
- 'double' => 'T_DOUBLE',
- # ...
- }
-
-Keys: C types. Values: XS types identifiers
-
-=item * C<$proto_letter_ref>
-
- {
- 'char **' => '$',
- 'bool_t' => '$',
- 'AV *' => '$',
- 'InputStream' => '$',
- 'double' => '$',
- # ...
- }
-
-Keys: C types. Values. Corresponding prototype letters.
-
-=item * C<$input_expr_ref>
-
- {
- 'T_CALLBACK' => ' $var = make_perl_cb_$type($arg)
- ',
- 'T_OUT' => ' $var = IoOFP(sv_2io($arg))
- ',
- 'T_REF_IV_PTR' => ' if (sv_isa($arg, \\"${ntype}\\")) {
- # ...
- }
-
-Keys: XS typemap identifiers. Values: Newline-terminated strings that
-will be written to C source code (F<.c>) files. The strings are C code, but
-with Perl variables whose values will be interpolated at F<xsubpp>'s runtime
-by one of the C<eval EXPR> statements in ExtUtils::ParseXS.
-
-=item * C<$output_expr_ref>
-
- {
- 'T_CALLBACK' => ' sv_setpvn($arg, $var.context.value().chp(),
- $var.context.value().size());
- ',
- 'T_OUT' => ' {
- GV *gv = newGVgen("$Package");
- if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
- sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
- else
- $arg = &PL_sv_undef;
- }
- ',
- # ...
- }
-
-Keys: XS typemap identifiers. Values: Newline-terminated strings that
-will be written to C source code (F<.c>) files. The strings are C code, but
-with Perl variables whose values will be interpolated at F<xsubpp>'s runtime
-by one of the C<eval EXPR> statements in ExtUtils::ParseXS.
-
-=back
+Upon success, returns an L<ExtUtils::Typemaps> object.
=back
push @tm, standard_typemap_locations( \@INC );
+ require ExtUtils::Typemaps;
my $typemap = ExtUtils::Typemaps->new;
foreach my $typemap_loc (@tm) {
next unless -f $typemap_loc;
$typemap->merge(file => $typemap_loc, replace => 1);
}
- return (
- $typemap->_get_typemap_hash(),
- $typemap->_get_prototype_hash(),
- $typemap->_get_inputmap_hash(),
- $typemap->_get_outputmap_hash(),
- );
-}
-
-=head2 C<process_single_typemap()>
-
-=over 4
-
-=item * Purpose
-
-Process a single typemap within C<process_typemaps()>.
-
-=item * Arguments
-
- ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) =
- process_single_typemap( $typemap,
- $type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
-
-List of five elements: The individual typemap needing processing and four
-references.
-
-=item * Return Value
-
-List of four references -- modified versions of those passed in as arguments.
-
-=back
-
-=cut
-
-sub process_single_typemap {
- my ($typemap,
- $type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) = @_;
- open my $TYPEMAP, '<', $typemap
- or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
- my $mode = 'Typemap';
- my $junk = "";
- my $current = \$junk;
- while (<$TYPEMAP>) {
- # skip comments
- next if /^\s*#/;
- if (/^INPUT\s*$/) {
- $mode = 'Input'; $current = \$junk; next;
- }
- if (/^OUTPUT\s*$/) {
- $mode = 'Output'; $current = \$junk; next;
- }
- if (/^TYPEMAP\s*$/) {
- $mode = 'Typemap'; $current = \$junk; next;
- }
- if ($mode eq 'Typemap') {
- chomp;
- my $logged_line = $_;
- trim_whitespace($_);
- # skip blank lines
- next if /^$/;
- my($type,$kind, $proto) =
- m/^\s*(.*?\S)\s+(\S+)\s*($ExtUtils::ParseXS::Constants::PrototypeRegexp*)\s*$/
- or warn(
- "Warning: File '$typemap' Line $. '$logged_line' " .
- "TYPEMAP entry needs 2 or 3 columns\n"
- ),
- next;
- $type = tidy_type($type);
- $type_kind_ref->{$type} = $kind;
- # prototype defaults to '$'
- $proto = "\$" unless $proto;
- $proto_letter_ref->{$type} = C_string($proto);
- }
- elsif (/^\s/) {
- $$current .= $_;
- }
- elsif ($mode eq 'Input') {
- s/\s+$//;
- $input_expr_ref->{$_} = '';
- $current = \$input_expr_ref->{$_};
- }
- else {
- s/\s+$//;
- $output_expr_ref->{$_} = '';
- $current = \$output_expr_ref->{$_};
- }
- }
- close $TYPEMAP;
- return ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
+ return $typemap;
}
=head2 C<make_targetable()>
=item * Return Value
-Implicitly returns true when final C<print> statement completes.
+Returns true.
=back
# define PERL_UNUSED_VAR(var) if (0) var = var
#endif
+#ifndef dVAR
+# define dVAR dNOOP
+#endif
+
+
+/* This stuff is not part of the API! You have been warned. */
+#ifndef PERL_VERSION_DECIMAL
+# define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
+#endif
+#ifndef PERL_DECIMAL_VERSION
+# define PERL_DECIMAL_VERSION \\
+ PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
+#endif
+#ifndef PERL_VERSION_GE
+# define PERL_VERSION_GE(r,v,s) \\
+ (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
+#endif
+#ifndef PERL_VERSION_LE
+# define PERL_VERSION_LE(r,v,s) \\
+ (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
+#endif
+
+/* XS_INTERNAL is the explicit static-linkage variant of the default
+ * XS macro.
+ *
+ * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
+ * "STATIC", ie. it exports XSUB symbols. You probably don't want that
+ * for anything but the BOOT XSUB.
+ *
+ * See XSUB.h in core!
+ */
+
+
+/* TODO: This might be compatible further back than 5.10.0. */
+#if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
+# undef XS_EXTERNAL
+# undef XS_INTERNAL
+# if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
+# define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
+# define XS_INTERNAL(name) STATIC XSPROTO(name)
+# endif
+# if defined(__SYMBIAN32__)
+# define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
+# define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
+# endif
+# ifndef XS_EXTERNAL
+# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
+# define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
+# define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
+# else
+# ifdef __cplusplus
+# define XS_EXTERNAL(name) extern "C" XSPROTO(name)
+# define XS_INTERNAL(name) static XSPROTO(name)
+# else
+# define XS_EXTERNAL(name) XSPROTO(name)
+# define XS_INTERNAL(name) STATIC XSPROTO(name)
+# endif
+# endif
+# endif
+#endif
+
+/* perl >= 5.10.0 && perl <= 5.15.1 */
+
+
+/* The XS_EXTERNAL macro is used for functions that must not be static
+ * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
+ * macro defined, the best we can do is assume XS is the same.
+ * Dito for XS_INTERNAL.
+ */
+#ifndef XS_EXTERNAL
+# define XS_EXTERNAL(name) XS(name)
+#endif
+#ifndef XS_INTERNAL
+# define XS_INTERNAL(name) XS(name)
+#endif
+
+/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
+ * internal macro that we're free to redefine for varying linkage due
+ * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
+ * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
+ */
+
+#undef XS_EUPXS
+#if defined(PERL_EUPXS_ALWAYS_EXPORT)
+# define XS_EUPXS(name) XS_EXTERNAL(name)
+#else
+ /* default to internal */
+# define XS_EUPXS(name) XS_INTERNAL(name)
+#endif
+
EOF
print <<"EOF";
#endif /* !defined(newXS_flags) */
EOF
+ return 1;
}
=head2 C<assign_func_args()>
push(@{ $self->{XSStack} }, {type => 'if'});
}
else {
- death ("Error: `$statement' with no matching `if'")
+ $self->death("Error: '$statement' with no matching 'if'")
if $self->{XSStack}->[-1]{type} ne 'if';
if ($self->{XSStack}->[-1]{varname}) {
push(@{ $self->{InitFileCode} }, "#endif\n");
return $cond;
}
+=head2 C<current_line_number()>
+
+=over 4
+
+=item * Purpose
+
+Figures out the current line number in the XS file.
+
+=item * Arguments
+
+C<$self>
+
+=item * Return Value
+
+The current line number.
+
+=back
+
+=cut
+
+sub current_line_number {
+ my $self = shift;
+ my $line_number = $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1];
+ return $line_number;
+}
+
=head2 C<Warn()>
=over 4
sub Warn {
my $self = shift;
- # work out the line number
- my $warn_line_number = $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1];
-
+ my $warn_line_number = $self->current_line_number();
print STDERR "@_ in $self->{filename}, line $warn_line_number\n";
}
sub blurt {
my $self = shift;
- Warn($self, @_);
+ $self->Warn(@_);
$self->{errors}++
}
sub death {
my $self = shift;
- Warn($self, @_);
+ $self->Warn(@_);
exit 1;
}
$cpplevel++;
}
elsif (!$cpplevel) {
- Warn( $self, "Warning: #else/elif/endif without #if in this function");
+ $self->Warn("Warning: #else/elif/endif without #if in this function");
print STDERR " (precede it with a blank line if the matching #if is outside the function)\n"
if $self->{XSStack}->[-1]{type} eq 'if';
return;
$cpplevel--;
}
}
- Warn( $self, "Warning: #if without #endif in this function") if $cpplevel;
+ $self->Warn("Warning: #if without #endif in this function") if $cpplevel;
}
}
https://perl5.git.perl.org / perl5.git / blobdiff