Skip to content

Commit d88ca93

Browse files
iabyniabyn
committed
ParseXS: refactor: add Node::Q method
Add a method which is a simple wrapper around ExtUtils::ParseXS::Q. This means throughout Node.pm, you can write $self->Q(<<"EOF") rather than the more long-winded ExtUtils::ParseXS::Q(<<"EOF");
1 parent 1324bc4 commit d88ca93

File tree

1 file changed

+44
-37
lines changed
  • dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS

1 file changed

+44
-37
lines changed

‎dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Node.pm‎

Lines changed: 44 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -479,8 +479,6 @@ sub as_boot_code {
479479
}
480480

481481

482-
483-
484482
# as_concise(): for debugging:
485483
#
486484
# Return a string representing a concise line-per-node representation
@@ -547,6 +545,15 @@ sub as_concise {
547545
}
548546

549547

548+
# Simple method wrapper for ExtUtils::ParseXS::Q
549+
550+
sub Q {
551+
my __PACKAGE__ $self = shift;
552+
my $text = shift;
553+
return ExtUtils::ParseXS::Q($text);
554+
}
555+
556+
550557
# ======================================================================
551558

552559
package ExtUtils::ParseXS::Node::XS_file;
@@ -680,7 +687,7 @@ sub as_code {
680687
# Emit preamble at start of C file, including the
681688
# version it was generated by.
682689

683-
print ExtUtils::ParseXS::Q(<<"EOM");
690+
print $self->Q(<<"EOM");
684691
|/*
685692
| * This file was generated automatically by ExtUtils::ParseXS version $ExtUtils::ParseXS::VERSION from the
686693
| * contents of $pxs->{in_filename}. Do not edit this file, edit $pxs->{in_filename} instead.
@@ -823,7 +830,7 @@ sub as_code {
823830
# we are safe.
824831
# - Nicholas Clark
825832

826-
print ExtUtils::ParseXS::Q(<<"EOF");
833+
print $self->Q(<<"EOF");
827834
|#if 0
828835
| "Skipped embedded POD."
829836
|#endif
@@ -911,7 +918,7 @@ sub as_code {
911918
# Emit boilerplate postamble following any code passed through from
912919
# the 'C' part of the XS file
913920

914-
print ExtUtils::ParseXS::Q(<<'EOF');
921+
print $self->Q(<<'EOF');
915922
|#ifndef PERL_UNUSED_VAR
916923
|# define PERL_UNUSED_VAR(var) if (0) var = var
917924
|#endif
@@ -1563,7 +1570,7 @@ sub as_code {
15631570
{
15641571
# make them findable with fetchmethod
15651572
my $packid = $pxs->{map_overloaded_package_to_C_package}{$package};
1566-
print ExtUtils::ParseXS::Q(<<"EOF");
1573+
print $self->Q(<<"EOF");
15671574
|XS_EUPXS(XS_${packid}_nil); /* prototype to pass -Wmissing-prototypes */
15681575
|XS_EUPXS(XS_${packid}_nil)
15691576
|{
@@ -1584,7 +1591,7 @@ sub as_boot_code {
15841591
for my $package (sort keys %{$pxs->{map_overloaded_package_to_C_package}})
15851592
{
15861593
my $packid = $pxs->{map_overloaded_package_to_C_package}{$package};
1587-
push @early, ExtUtils::ParseXS::Q(<<"EOF");
1594+
push @early, $self->Q(<<"EOF");
15881595
| /* Making a sub named "${package}::()" allows the package */
15891596
| /* to be findable via fetchmethod(), and causes */
15901597
| /* overload::Overloaded("$package") to return true. */
@@ -1625,7 +1632,7 @@ sub as_code {
16251632

16261633
# Emit the boot_Foo__Bar() C function / XSUB
16271634

1628-
print ExtUtils::ParseXS::Q(<<"EOF");
1635+
print $self->Q(<<"EOF");
16291636
|#ifdef __cplusplus
16301637
|extern "C" $open_brace
16311638
|#endif
@@ -1653,7 +1660,7 @@ EOF
16531660
# the wrong qualifier is used, it causes breakage with C++ compilers and
16541661
# warnings with recent gcc.
16551662

1656-
print ExtUtils::ParseXS::Q(<<"EOF") if $pxs->{seen_an_XSUB};
1663+
print $self->Q(<<"EOF") if $pxs->{seen_an_XSUB};
16571664
|#if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
16581665
| char* file = __FILE__;
16591666
|#else
@@ -1665,14 +1672,14 @@ EOF
16651672

16661673
# Emit assorted declarations
16671674

1668-
print ExtUtils::ParseXS::Q(<<"EOF");
1675+
print $self->Q(<<"EOF");
16691676
|
16701677
| PERL_UNUSED_VAR(cv); /* -W */
16711678
| PERL_UNUSED_VAR(items); /* -W */
16721679
EOF
16731680

16741681
if ($pxs->{VERSIONCHECK_value}) {
1675-
print ExtUtils::ParseXS::Q(<<"EOF");
1682+
print $self->Q(<<"EOF");
16761683
|#if PERL_VERSION_LE(5, 21, 5)
16771684
| XS_VERSION_BOOTCHECK;
16781685
|# ifdef XS_APIVERSION_BOOTCHECK
@@ -1683,7 +1690,7 @@ EOF
16831690
EOF
16841691
}
16851692
else {
1686-
print ExtUtils::ParseXS::Q(<<"EOF") ;
1693+
print $self->Q(<<"EOF") ;
16871694
|#if PERL_VERSION_LE(5, 21, 5) && defined(XS_APIVERSION_BOOTCHECK)
16881695
| XS_APIVERSION_BOOTCHECK;
16891696
|#endif
@@ -1698,7 +1705,7 @@ EOF
16981705
# XSINTERFACE_FUNC_SET(cv, $value);
16991706

17001707
if ($pxs->{need_boot_cv}) {
1701-
print ExtUtils::ParseXS::Q(<<"EOF");
1708+
print $self->Q(<<"EOF");
17021709
| $open_brace
17031710
| CV * cv;
17041711
|
@@ -1712,7 +1719,7 @@ EOF
17121719
# Before 5.10, PL_amagic_generation used to need setting to at
17131720
# least a non-zero value to tell perl that any overloading was
17141721
# present.
1715-
print ExtUtils::ParseXS::Q(<<"EOF");
1722+
print $self->Q(<<"EOF");
17161723
| /* register the overloading (type 'A') magic */
17171724
|#if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
17181725
| PL_amagic_generation++;
@@ -1733,7 +1740,7 @@ EOF
17331740
: $fallback eq 'FALSE' ? '&PL_sv_no'
17341741
: '&PL_sv_undef';
17351742

1736-
print ExtUtils::ParseXS::Q(<<"EOF");
1743+
print $self->Q(<<"EOF");
17371744
| /* The magic for overload gets a GV* via gv_fetchmeth as */
17381745
| /* mentioned above, and looks in the SV* slot of it for */
17391746
| /* the "fallback" status. */
@@ -1752,15 +1759,15 @@ EOF
17521759
# Emit closing scope for the 'CV *cv' declaration
17531760

17541761
if ($pxs->{need_boot_cv}) {
1755-
print ExtUtils::ParseXS::Q(<<"EOF");
1762+
print $self->Q(<<"EOF");
17561763
| $close_brace
17571764
EOF
17581765
}
17591766

17601767
# Emit any lines derived from BOOT: sections
17611768

17621769
if (@$later) {
1763-
print ExtUtils::ParseXS::Q(<<"EOF");
1770+
print $self->Q(<<"EOF");
17641771
|
17651772
| /* Initialisation Section */
17661773
|
@@ -1771,7 +1778,7 @@ EOF
17711778
print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n"
17721779
if $pxs->{config_WantLineNumbers};
17731780

1774-
print ExtUtils::ParseXS::Q(<<"EOF");
1781+
print $self->Q(<<"EOF");
17751782
|
17761783
| /* End of Initialisation Section */
17771784
|
@@ -1781,7 +1788,7 @@ EOF
17811788
# Emit code to call any UNITCHECK blocks and return true.
17821789
# Since 5.22, this is been put into a separate function.
17831790

1784-
print ExtUtils::ParseXS::Q(<<"EOF");
1791+
print $self->Q(<<"EOF");
17851792
|#if PERL_VERSION_LE(5, 21, 5)
17861793
|# if PERL_VERSION_GE(5, 9, 0)
17871794
| if (PL_unitcheckav)
@@ -2015,7 +2022,7 @@ sub as_code {
20152022
my $cname = $self->{decl}{full_C_name};
20162023

20172024
# Emit function header
2018-
print ExtUtils::ParseXS::Q(<<"EOF");
2025+
print $self->Q(<<"EOF");
20192026
|$extern
20202027
|XS_EUPXS(XS_$cname); /* prototype to pass -Wmissing-prototypes */
20212028
|XS_EUPXS(XS_$cname)
@@ -2024,15 +2031,15 @@ sub as_code {
20242031
EOF
20252032
}
20262033

2027-
print ExtUtils::ParseXS::Q(<<"EOF") if $self->{seen_ALIAS};
2034+
print $self->Q(<<"EOF") if $self->{seen_ALIAS};
20282035
| dXSI32;
20292036
EOF
20302037

20312038
if ($self->{seen_INTERFACE}) {
20322039
my $type = $self->{decl}{return_type}{type};
20332040
$type =~ tr/:/_/
20342041
unless $pxs->{config_RetainCplusplusHierarchicalTypes};
2035-
print ExtUtils::ParseXS::Q(<<"EOF") if $self->{seen_INTERFACE};
2042+
print $self->Q(<<"EOF") if $self->{seen_INTERFACE};
20362043
| dXSFUNCTION($type);
20372044
EOF
20382045
}
@@ -2048,22 +2055,22 @@ EOF
20482055
$params->{nargs});
20492056

20502057
# "-except" cmd line switch
2051-
print ExtUtils::ParseXS::Q(<<"EOF") if $pxs->{config_allow_exceptions};
2058+
print $self->Q(<<"EOF") if $pxs->{config_allow_exceptions};
20522059
| char errbuf[1024];
20532060
| *errbuf = '\\0';
20542061
EOF
20552062

20562063
if ($condition_code) {
20572064
my $p = $params->usage_string();
20582065
$p =~ s/"/\\"/g;
2059-
print ExtUtils::ParseXS::Q(<<"EOF");
2066+
print $self->Q(<<"EOF");
20602067
| if ($condition_code)
20612068
| croak_xs_usage(cv, "$p");
20622069
EOF
20632070
}
20642071
else {
20652072
# cv and items likely to be unused
2066-
print ExtUtils::ParseXS::Q(<<"EOF");
2073+
print $self->Q(<<"EOF");
20672074
| PERL_UNUSED_VAR(cv); /* -W */
20682075
| PERL_UNUSED_VAR(items); /* -W */
20692076
EOF
@@ -2075,11 +2082,11 @@ EOF
20752082
# dXSARGS) is unused.
20762083
# XXX: could breakup the dXSARGS; into dSP;dMARK;dITEMS
20772084
# but such a move could break third-party extensions
2078-
print ExtUtils::ParseXS::Q(<<"EOF") if $self->{seen_PPCODE};
2085+
print $self->Q(<<"EOF") if $self->{seen_PPCODE};
20792086
| PERL_UNUSED_VAR(ax); /* -Wall */
20802087
EOF
20812088

2082-
print ExtUtils::ParseXS::Q(<<"EOF") if $self->{seen_PPCODE};
2089+
print $self->Q(<<"EOF") if $self->{seen_PPCODE};
20832090
| SP -= items;
20842091
EOF
20852092

@@ -2096,7 +2103,7 @@ EOF
20962103
# bracket.
20972104
# ----------------------------------------------------------------
20982105

2099-
print ExtUtils::ParseXS::Q(<<"EOF") if $pxs->{config_allow_exceptions};
2106+
print $self->Q(<<"EOF") if $pxs->{config_allow_exceptions};
21002107
| if (errbuf[0])
21012108
| Perl_croak(aTHX_ errbuf);
21022109
EOF
@@ -2192,7 +2199,7 @@ sub as_boot_code {
21922199
%{ $self->{map_alias_name_to_value} })
21932200
{
21942201
my $value = $self->{map_alias_name_to_value}{$xname};
2195-
push(@code, ExtUtils::ParseXS::Q(<<"EOF"));
2202+
push(@code, $self->Q(<<"EOF"));
21962203
| cv = $newXS(\"$xname\", XS_$cname$file_arg$proto_arg);
21972204
| XSANY.any_i32 = $value;
21982205
EOF
@@ -2203,7 +2210,7 @@ EOF
22032210
# Generate a standard newXS() call, plus a single call to
22042211
# apply_attrs_string() call with the string of attributes.
22052212
my $attrs = "@{$self->{attributes}}";
2206-
push(@code, ExtUtils::ParseXS::Q(<<"EOF"));
2213+
push(@code, $self->Q(<<"EOF"));
22072214
| cv = $newXS(\"$pname\", XS_$cname$file_arg$proto_arg);
22082215
| apply_attrs_string("$self->{PACKAGE_name}", cv, "$attrs", 0);
22092216
EOF
@@ -2222,7 +2229,7 @@ EOF
22222229

22232230
my $macro = $self->{interface_macro_set};
22242231
$macro = 'XSINTERFACE_FUNC_SET' unless defined $macro;
2225-
push(@code, ExtUtils::ParseXS::Q(<<"EOF"));
2232+
push(@code, $self->Q(<<"EOF"));
22262233
| cv = $newXS(\"$yname\", XS_$cname$file_arg$proto_arg);
22272234
| $macro(cv,$value);
22282235
EOF
@@ -4178,7 +4185,7 @@ sub as_code {
41784185
# matches the $open_brace at the start of this function
41794186
print " $close_brace\n";
41804187

4181-
print ExtUtils::ParseXS::Q(<<"EOF") if $pxs->{config_allow_exceptions};
4188+
print $self->Q(<<"EOF") if $pxs->{config_allow_exceptions};
41824189
| BEGHANDLERS
41834190
| CATCHALL
41844191
| sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason);
@@ -4295,7 +4302,7 @@ sub as_code {
42954302
}
42964303

42974304
# The matching closes will be emitted in xbody->as_code()
4298-
print ExtUtils::ParseXS::Q(<<"EOF") if $xsub->{SCOPE_enabled};
4305+
print $self->Q(<<"EOF") if $xsub->{SCOPE_enabled};
42994306
| ENTER;
43004307
| $open_brace
43014308
EOF
@@ -5018,7 +5025,7 @@ sub parse {
50185025
my $is_cmd = $self->{is_cmd};
50195026

50205027
if ($is_cmd) {
5021-
$f = ExtUtils::ParseXS::QuoteArgs($f) if $^O eq 'VMS';
5028+
$f = $self->QuoteArgs($f) if $^O eq 'VMS';
50225029

50235030
$pxs->death("INCLUDE_COMMAND: command missing")
50245031
unless length $f;
@@ -5147,15 +5154,15 @@ sub as_code {
51475154

51485155
$comment .= " '$self->{inc_filename}' from '$self->{old_filename}'";
51495156

5150-
print ExtUtils::ParseXS::Q(<<"EOF");
5157+
print $self->Q(<<"EOF");
51515158
|
51525159
|/* $comment */
51535160
|
51545161
EOF
51555162

51565163
$_->as_code($pxs) for @{$self->{kids}};
51575164

5158-
print ExtUtils::ParseXS::Q(<<"EOF");
5165+
print $self->Q(<<"EOF");
51595166
|
51605167
|/* INCLUDE: Returning to '$self->{old_filename}' from '$self->{inc_filename}' */
51615168
|
@@ -5290,7 +5297,7 @@ sub as_code {
52905297
# XS_EUPXS(fXS_Foo_foo) XSUB declarations will expand to
52915298
# XS_EXTERNAL/XS_INTERNAL as appropriate
52925299

5293-
print ExtUtils::ParseXS::Q(<<"EOF");
5300+
print $self->Q(<<"EOF");
52945301
|#undef XS_EUPXS
52955302
|#if defined(PERL_EUPXS_ALWAYS_EXPORT)
52965303
|# define XS_EUPXS(name) XS_EXTERNAL(name)

0 commit comments

Comments
 (0)