This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move two heredocs into Utilities::standard_XS_defs().
authorJames E. Keenan <jkeenan@cpan.org>
Tue, 6 Apr 2010 23:46:54 +0000 (19:46 -0400)
committerSteffen Mueller <smueller@cpan.org>
Tue, 12 Jul 2011 18:53:55 +0000 (20:53 +0200)
dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm

index c13faa0..ee46715 100644 (file)
@@ -19,6 +19,7 @@ use ExtUtils::ParseXS::Utilities qw(
   process_typemaps
   make_targetable
   map_type
+  standard_XS_defs
 );
 
 our @ISA = qw(Exporter);
@@ -247,62 +248,7 @@ EOM
 
   print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $self->{WantLineNumbers};
 
-  print <<"EOF";
-#ifndef PERL_UNUSED_VAR
-#  define PERL_UNUSED_VAR(var) if (0) var = var
-#endif
-
-EOF
-
-  print <<"EOF";
-#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
-#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
-
-/* prototype to pass -Wmissing-prototypes */
-STATIC void
-S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);
-
-STATIC void
-S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
-{
-    const GV *const gv = CvGV(cv);
-
-    PERL_ARGS_ASSERT_CROAK_XS_USAGE;
-
-    if (gv) {
-        const char *const gvname = GvNAME(gv);
-        const HV *const stash = GvSTASH(gv);
-        const char *const hvname = stash ? HvNAME(stash) : NULL;
-
-        if (hvname)
-            Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
-        else
-            Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
-    } else {
-        /* Pants. I don't think that it should be possible to get here. */
-        Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
-    }
-}
-#undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE
-
-#ifdef PERL_IMPLICIT_CONTEXT
-#define croak_xs_usage(a,b)    S_croak_xs_usage(aTHX_ a,b)
-#else
-#define croak_xs_usage        S_croak_xs_usage
-#endif
-
-#endif
-
-/* NOTE: the prototype of newXSproto() is different in versions of perls,
- * so we define a portable version of newXSproto()
- */
-#ifdef newXS_flags
-#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
-#else
-#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
-#endif /* !defined(newXS_flags) */
-
-EOF
+  standard_XS_defs();
 
   print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $self->{WantLineNumbers};
 
index 06efc6e..b5314c2 100644 (file)
@@ -17,6 +17,7 @@ our (@ISA, @EXPORT_OK);
   process_single_typemap
   make_targetable
   map_type
+  standard_XS_defs
 );
 
 =head1 NAME
@@ -430,4 +431,63 @@ sub map_type {
   return $type;
 }
 
+sub standard_XS_defs {
+  print <<"EOF";
+#ifndef PERL_UNUSED_VAR
+#  define PERL_UNUSED_VAR(var) if (0) var = var
+#endif
+
+EOF
+
+  print <<"EOF";
+#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
+#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
+
+/* prototype to pass -Wmissing-prototypes */
+STATIC void
+S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);
+
+STATIC void
+S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+{
+    const GV *const gv = CvGV(cv);
+
+    PERL_ARGS_ASSERT_CROAK_XS_USAGE;
+
+    if (gv) {
+        const char *const gvname = GvNAME(gv);
+        const HV *const stash = GvSTASH(gv);
+        const char *const hvname = stash ? HvNAME(stash) : NULL;
+
+        if (hvname)
+            Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
+        else
+            Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
+    } else {
+        /* Pants. I don't think that it should be possible to get here. */
+        Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
+    }
+}
+#undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#define croak_xs_usage(a,b)    S_croak_xs_usage(aTHX_ a,b)
+#else
+#define croak_xs_usage        S_croak_xs_usage
+#endif
+
+#endif
+
+/* NOTE: the prototype of newXSproto() is different in versions of perls,
+ * so we define a portable version of newXSproto()
+ */
+#ifdef newXS_flags
+#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
+#else
+#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
+#endif /* !defined(newXS_flags) */
+
+EOF
+}
+
 1;