make things compile on threaded and/or 5.14 perls
Lukas Mai [Sun, 17 Jun 2012 08:13:43 +0000 (10:13 +0200)]
Makefile.PL
Parameters.xs
lib/Function/Parameters.pm
toke_on_crack.c.inc

index b9fdbfa..a96a82f 100644 (file)
@@ -24,7 +24,7 @@ WriteMakefile(
         'warnings' => 0,
         'strict' => 0,
     },
-    MIN_PERL_VERSION => '5.12.0',
+    MIN_PERL_VERSION => '5.14.0',
     dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
     clean               => { FILES => 'Function-Parameters-*' },
 );
index 6d4be46..29baa13 100644 (file)
@@ -42,6 +42,7 @@ See http://dev.perl.org/licenses/ for more information.
 #endif
 
 
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -56,6 +57,9 @@ WARNINGS_ENABLE
 #define HINTK_NAME_    MY_PKG "/name:"
 #define HINTK_SHIFT_   MY_PKG "/shift:"
 
+#define HAVE_PERL_VERSION(R, V, S) \
+       (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
+
 typedef struct {
        enum {
                FLAG_NAME_OPTIONAL = 1,
@@ -67,7 +71,7 @@ typedef struct {
 
 static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
 
-static int kw_flags(const char *kw_ptr, STRLEN kw_len, Spec *spec) {
+static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, Spec *spec) {
        HV *hints;
        SV *sv, **psv;
        const char *p, *kw_active;
@@ -123,7 +127,7 @@ static int kw_flags(const char *kw_ptr, STRLEN kw_len, Spec *spec) {
 #include "toke_on_crack.c.inc"
 
 
-static int parse_fun(OP **pop, const char *keyword_ptr, STRLEN keyword_len, const Spec *spec) {
+static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len, const Spec *spec) {
        SV *gen, *declarator, *params, *sv;
        line_t line_start;
        int saw_name, saw_colon;
@@ -141,7 +145,7 @@ static int parse_fun(OP **pop, const char *keyword_ptr, STRLEN keyword_len, cons
        /* function name */
        saw_name = 0;
        s = PL_parser->bufptr;
-       if (spec->name != FLAG_NAME_PROHIBITED && (len = S_scan_word(s, TRUE))) {
+       if (spec->name != FLAG_NAME_PROHIBITED && (len = S_scan_word(aTHX_ s, TRUE))) {
                sv_catpvs(gen, " ");
                sv_catpvn(gen, s, len);
                sv_catpvs(declarator, " ");
@@ -171,7 +175,7 @@ static int parse_fun(OP **pop, const char *keyword_ptr, STRLEN keyword_len, cons
                                lex_read_space(0);
 
                                s = PL_parser->bufptr;
-                               if (!(len = S_scan_word(s, FALSE))) {
+                               if (!(len = S_scan_word(aTHX_ s, FALSE))) {
                                        croak("In %.*s: missing identifier", (int)SvCUR(declarator), SvPV_nolen(declarator));
                                }
                                if (saw_slurpy) {
@@ -218,7 +222,7 @@ static int parse_fun(OP **pop, const char *keyword_ptr, STRLEN keyword_len, cons
                        saw_colon = 1;
                } else {
                        sv = sv_2mortal(newSVpvs(""));
-                       if (!S_scan_str(sv, TRUE, TRUE)) {
+                       if (!S_scan_str(aTHX_ sv, TRUE, TRUE)) {
                                croak("In %.*s: malformed prototype", (int)SvCUR(declarator), SvPV_nolen(declarator));
                        }
                        sv_catsv(gen, sv);
@@ -245,7 +249,7 @@ static int parse_fun(OP **pop, const char *keyword_ptr, STRLEN keyword_len, cons
        if (saw_colon) {
                for (;;) {
                        s = PL_parser->bufptr;
-                       if (!(len = S_scan_word(s, FALSE))) {
+                       if (!(len = S_scan_word(aTHX_ s, FALSE))) {
                                break;
                        }
                        sv_catpvs(gen, ":");
@@ -255,7 +259,7 @@ static int parse_fun(OP **pop, const char *keyword_ptr, STRLEN keyword_len, cons
                        c = lex_peek_unichar(0);
                        if (c == '(') {
                                sv = sv_2mortal(newSVpvs(""));
-                               if (!S_scan_str(sv, TRUE, TRUE)) {
+                               if (!S_scan_str(aTHX_ sv, TRUE, TRUE)) {
                                        croak("In %.*s: malformed attribute argument list", (int)SvCUR(declarator), SvPV_nolen(declarator));
                                }
                                sv_catsv(gen, sv);
@@ -312,10 +316,10 @@ static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **o
 
        SAVETMPS;
 
-       if (kw_flags(keyword_ptr, keyword_len, &spec)) {
-               ret = parse_fun(op_ptr, keyword_ptr, keyword_len, &spec);
+       if (kw_flags(aTHX_ keyword_ptr, keyword_len, &spec)) {
+               ret = parse_fun(aTHX_ op_ptr, keyword_ptr, keyword_len, &spec);
        } else {
-               ret = next_keyword_plugin(keyword_ptr, keyword_len, op_ptr);
+               ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
        }
 
        FREETMPS;
index 50fb348..87cbd3b 100644 (file)
@@ -1,5 +1,7 @@
 package Function::Parameters;
 
+use v5.14.0;
+
 use strict;
 use warnings;
 
index 905c85f..325ed72 100644 (file)
@@ -2,6 +2,7 @@
  * This code was copied from perl/toke.c and subsequently butchered
  * by Lukas Mai (2012).
  */
+/* vi: set ft=c: */
 
 /* vvvvvvvvvvvvvvvvvvvvv I HAVE NO IDEA WHAT I'M DOING vvvvvvvvvvvvvvvvvvvv */
 #define PL_linestr              (PL_parser->linestr)
@@ -22,7 +23,7 @@
 #   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
 #endif
 
-static STRLEN S_scan_word(const char *start, int allow_package) {
+static STRLEN S_scan_word(pTHX_ const char *start, int allow_package) {
        const char *s = start;
        for (;;) {
                if (isALNUM(*s) || (!UTF && isALNUMC_L1(*s))) {  /* UTF handled below */
@@ -67,7 +68,11 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
                termlen = 1;
        }
        else {
+#if HAVE_PERL_VERSION(5, 16, 0)
                termcode = utf8_to_uvchr_buf((U8*)s, (U8*)PL_bufend, &termlen);
+#else
+               termcode = utf8_to_uvchr((U8*)s, &termlen);
+#endif
                Copy(s, termstr, termlen, U8);
                if (!UTF8_IS_INVARIANT(term))
                        has_utf8 = TRUE;
@@ -106,7 +111,11 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
                                char * const svlast = SvEND(sv) - 1;
 
                                for (; s < ns; s++) {
-                                       if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)
+                                       if (*s == '\n' && !PL_rsfp
+#if HAVE_PERL_VERSION(5, 16, 0)
+                                               && !PL_parser->filtered
+#endif
+                                       )
                                                CopLINE_inc(PL_curcop);
                                }
                                if (!found)
@@ -173,7 +182,11 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
                if (PL_multi_open == PL_multi_close) {
                        for (; s < PL_bufend; s++,to++) {
                                /* embedded newlines increment the current line number */
-                               if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)
+                               if (*s == '\n' && !PL_rsfp
+#if HAVE_PERL_VERSION(5, 16, 0)
+                                       && !PL_parser->filtered
+#endif
+                               )
                                        CopLINE_inc(PL_curcop);
                                /* handle quoted delimiters */
                                if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
@@ -205,7 +218,11 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
                        /* read until we run out of string, or we find the terminator */
                        for (; s < PL_bufend; s++,to++) {
                                /* embedded newlines increment the line count */
-                               if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)
+                               if (*s == '\n' && !PL_rsfp
+#if HAVE_PERL_VERSION(5, 16, 0)
+                                       && !PL_parser->filtered
+#endif
+                               )
                                        CopLINE_inc(PL_curcop);
                                /* backslashes can escape the open or closing characters */
                                if (*s == '\\' && s+1 < PL_bufend) {