Skip to content

Commit 7c119be

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 e098f86 commit 7c119be

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
@@ -1562,7 +1569,7 @@ sub as_code {
15621569
{
15631570
# make them findable with fetchmethod
15641571
my $packid = $pxs->{map_overloaded_package_to_C_package}{$package};
1565-
print ExtUtils::ParseXS::Q(<<"EOF");
1572+
print $self->Q(<<"EOF");
15661573
|XS_EUPXS(XS_${packid}_nil); /* prototype to pass -Wmissing-prototypes */
15671574
|XS_EUPXS(XS_${packid}_nil)
15681575
|{
@@ -1583,7 +1590,7 @@ sub as_boot_code {
15831590
for my $package (sort keys %{$pxs->{map_overloaded_package_to_C_package}})
15841591
{
15851592
my $packid = $pxs->{map_overloaded_package_to_C_package}{$package};
1586-
push @early, ExtUtils::ParseXS::Q(<<"EOF");
1593+
push @early, $self->Q(<<"EOF");
15871594
| /* Making a sub named "${package}::()" allows the package */
15881595
| /* to be findable via fetchmethod(), and causes */
15891596
| /* overload::Overloaded("$package") to return true. */
@@ -1624,7 +1631,7 @@ sub as_code {
16241631

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

1627-
print ExtUtils::ParseXS::Q(<<"EOF");
1634+
print $self->Q(<<"EOF");
16281635
|#ifdef __cplusplus
16291636
|extern "C" $open_brace
16301637
|#endif
@@ -1652,7 +1659,7 @@ EOF
16521659
# the wrong qualifier is used, it causes breakage with C++ compilers and
16531660
# warnings with recent gcc.
16541661

1655-
print ExtUtils::ParseXS::Q(<<"EOF") if $pxs->{seen_an_XSUB};
1662+
print $self->Q(<<"EOF") if $pxs->{seen_an_XSUB};
16561663
|#if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
16571664
| char* file = __FILE__;
16581665
|#else
@@ -1664,14 +1671,14 @@ EOF
16641671

16651672
# Emit assorted declarations
16661673

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

16731680
if ($pxs->{VERSIONCHECK_value}) {
1674-
print ExtUtils::ParseXS::Q(<<"EOF");
1681+
print $self->Q(<<"EOF");
16751682
|#if PERL_VERSION_LE(5, 21, 5)
16761683
| XS_VERSION_BOOTCHECK;
16771684
|# ifdef XS_APIVERSION_BOOTCHECK
@@ -1682,7 +1689,7 @@ EOF
16821689
EOF
16831690
}
16841691
else {
1685-
print ExtUtils::ParseXS::Q(<<"EOF") ;
1692+
print $self->Q(<<"EOF") ;
16861693
|#if PERL_VERSION_LE(5, 21, 5) && defined(XS_APIVERSION_BOOTCHECK)
16871694
| XS_APIVERSION_BOOTCHECK;
16881695
|#endif
@@ -1697,7 +1704,7 @@ EOF
16971704
# XSINTERFACE_FUNC_SET(cv, $value);
16981705

16991706
if ($pxs->{need_boot_cv}) {
1700-
print ExtUtils::ParseXS::Q(<<"EOF");
1707+
print $self->Q(<<"EOF");
17011708
| $open_brace
17021709
| CV * cv;
17031710
|
@@ -1711,7 +1718,7 @@ EOF
17111718
# Before 5.10, PL_amagic_generation used to need setting to at
17121719
# least a non-zero value to tell perl that any overloading was
17131720
# present.
1714-
print ExtUtils::ParseXS::Q(<<"EOF");
1721+
print $self->Q(<<"EOF");
17151722
| /* register the overloading (type 'A') magic */
17161723
|#if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
17171724
| PL_amagic_generation++;
@@ -1732,7 +1739,7 @@ EOF
17321739
: $fallback eq 'FALSE' ? '&PL_sv_no'
17331740
: '&PL_sv_undef';
17341741

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

17531760
if ($pxs->{need_boot_cv}) {
1754-
print ExtUtils::ParseXS::Q(<<"EOF");
1761+
print $self->Q(<<"EOF");
17551762
| $close_brace
17561763
EOF
17571764
}
17581765

17591766
# Emit any lines derived from BOOT: sections
17601767

17611768
if (@$later) {
1762-
print ExtUtils::ParseXS::Q(<<"EOF");
1769+
print $self->Q(<<"EOF");
17631770
|
17641771
| /* Initialisation Section */
17651772
|
@@ -1770,7 +1777,7 @@ EOF
17701777
print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n"
17711778
if $pxs->{config_WantLineNumbers};
17721779

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

1783-
print ExtUtils::ParseXS::Q(<<"EOF");
1790+
print $self->Q(<<"EOF");
17841791
|#if PERL_VERSION_LE(5, 21, 5)
17851792
|# if PERL_VERSION_GE(5, 9, 0)
17861793
| if (PL_unitcheckav)
@@ -2014,7 +2021,7 @@ sub as_code {
20142021
my $cname = $self->{decl}{full_C_name};
20152022

20162023
# Emit function header
2017-
print ExtUtils::ParseXS::Q(<<"EOF");
2024+
print $self->Q(<<"EOF");
20182025
|$extern
20192026
|XS_EUPXS(XS_$cname); /* prototype to pass -Wmissing-prototypes */
20202027
|XS_EUPXS(XS_$cname)
@@ -2023,15 +2030,15 @@ sub as_code {
20232030
EOF
20242031
}
20252032

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

20302037
if ($self->{seen_INTERFACE}) {
20312038
my $type = $self->{decl}{return_type}{type};
20322039
$type =~ tr/:/_/
20332040
unless $pxs->{config_RetainCplusplusHierarchicalTypes};
2034-
print ExtUtils::ParseXS::Q(<<"EOF") if $self->{seen_INTERFACE};
2041+
print $self->Q(<<"EOF") if $self->{seen_INTERFACE};
20352042
| dXSFUNCTION($type);
20362043
EOF
20372044
}
@@ -2047,22 +2054,22 @@ EOF
20472054
$params->{nargs});
20482055

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

20552062
if ($condition_code) {
20562063
my $p = $params->usage_string();
20572064
$p =~ s/"/\\"/g;
2058-
print ExtUtils::ParseXS::Q(<<"EOF");
2065+
print $self->Q(<<"EOF");
20592066
| if ($condition_code)
20602067
| croak_xs_usage(cv, "$p");
20612068
EOF
20622069
}
20632070
else {
20642071
# cv and items likely to be unused
2065-
print ExtUtils::ParseXS::Q(<<"EOF");
2072+
print $self->Q(<<"EOF");
20662073
| PERL_UNUSED_VAR(cv); /* -W */
20672074
| PERL_UNUSED_VAR(items); /* -W */
20682075
EOF
@@ -2074,11 +2081,11 @@ EOF
20742081
# dXSARGS) is unused.
20752082
# XXX: could breakup the dXSARGS; into dSP;dMARK;dITEMS
20762083
# but such a move could break third-party extensions
2077-
print ExtUtils::ParseXS::Q(<<"EOF") if $self->{seen_PPCODE};
2084+
print $self->Q(<<"EOF") if $self->{seen_PPCODE};
20782085
| PERL_UNUSED_VAR(ax); /* -Wall */
20792086
EOF
20802087

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

@@ -2095,7 +2102,7 @@ EOF
20952102
# bracket.
20962103
# ----------------------------------------------------------------
20972104

2098-
print ExtUtils::ParseXS::Q(<<"EOF") if $pxs->{config_allow_exceptions};
2105+
print $self->Q(<<"EOF") if $pxs->{config_allow_exceptions};
20992106
| if (errbuf[0])
21002107
| Perl_croak(aTHX_ errbuf);
21012108
EOF
@@ -2191,7 +2198,7 @@ sub as_boot_code {
21912198
%{ $self->{map_alias_name_to_value} })
21922199
{
21932200
my $value = $self->{map_alias_name_to_value}{$xname};
2194-
push(@code, ExtUtils::ParseXS::Q(<<"EOF"));
2201+
push(@code, $self->Q(<<"EOF"));
21952202
| cv = $newXS(\"$xname\", XS_$cname$file_arg$proto_arg);
21962203
| XSANY.any_i32 = $value;
21972204
EOF
@@ -2202,7 +2209,7 @@ EOF
22022209
# Generate a standard newXS() call, plus a single call to
22032210
# apply_attrs_string() call with the string of attributes.
22042211
my $attrs = "@{$self->{attributes}}";
2205-
push(@code, ExtUtils::ParseXS::Q(<<"EOF"));
2212+
push(@code, $self->Q(<<"EOF"));
22062213
| cv = $newXS(\"$pname\", XS_$cname$file_arg$proto_arg);
22072214
| apply_attrs_string("$self->{PACKAGE_name}", cv, "$attrs", 0);
22082215
EOF
@@ -2221,7 +2228,7 @@ EOF
22212228

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

4180-
print ExtUtils::ParseXS::Q(<<"EOF") if $pxs->{config_allow_exceptions};
4187+
print $self->Q(<<"EOF") if $pxs->{config_allow_exceptions};
41814188
| BEGHANDLERS
41824189
| CATCHALL
41834190
| sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason);
@@ -4294,7 +4301,7 @@ sub as_code {
42944301
}
42954302

42964303
# The matching closes will be emitted in xbody->as_code()
4297-
print ExtUtils::ParseXS::Q(<<"EOF") if $xsub->{SCOPE_enabled};
4304+
print $self->Q(<<"EOF") if $xsub->{SCOPE_enabled};
42984305
| ENTER;
42994306
| $open_brace
43004307
EOF
@@ -5017,7 +5024,7 @@ sub parse {
50175024
my $is_cmd = $self->{is_cmd};
50185025

50195026
if ($is_cmd) {
5020-
$f = ExtUtils::ParseXS::QuoteArgs($f) if $^O eq 'VMS';
5027+
$f = $self->QuoteArgs($f) if $^O eq 'VMS';
50215028

50225029
$pxs->death("INCLUDE_COMMAND: command missing")
50235030
unless length $f;
@@ -5146,15 +5153,15 @@ sub as_code {
51465153

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

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

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

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

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

0 commit comments

Comments
 (0)