X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke_on_crack.c.inc;h=1607c782a00f0d0ba95f560540486e4e00238bbb;hb=7817d698ba4e55c46484533c96bd45ee8b02e502;hp=325ed72626452a96a37551d8b11c38064721a931;hpb=7dd355352bd7dbd40d3c364250cd9d1b905cb262;p=p5sagit%2FFunction-Parameters.git

diff --git a/toke_on_crack.c.inc b/toke_on_crack.c.inc
index 325ed72..1607c78 100644
--- a/toke_on_crack.c.inc
+++ b/toke_on_crack.c.inc
@@ -18,21 +18,21 @@
 #define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline))
 
 #ifdef USE_UTF8_SCRIPTS
-#   define UTF (!IN_BYTES)
+#   define PARSING_UTF (!IN_BYTES)
 #else
-#   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
+#   define PARSING_UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
 #endif
 
 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 */
+		if (isALNUM(*s) || (!PARSING_UTF && isALNUMC_L1(*s))) {  /* UTF handled below */
 			s++;
-		} else if (allow_package && s > start && *s == '\'' && isIDFIRST_lazy_if(s+1, UTF)) {
+		} else if (allow_package && s > start && *s == '\'' && isIDFIRST_lazy_if(s+1, PARSING_UTF)) {
 			s++;
-		} else if (allow_package && s[0] == ':' && s[1] == ':' && isIDFIRST_lazy_if(s+2, UTF)) {
+		} else if (allow_package && s[0] == ':' && s[1] == ':' && isIDFIRST_lazy_if(s+2, PARSING_UTF)) {
 			s += 2;
-		} else if (UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) {
+		} else if (PARSING_UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) {
 			do {
 				s += UTF8SKIP(s);
 			} while (UTF8_IS_CONTINUED(*s) && is_utf8_mark((U8*)s));
@@ -63,16 +63,15 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
 
 	/* after skipping whitespace, the next character is the terminator */
 	term = *s;
-	if (!UTF) {
+	if (!PARSING_UTF) {
 		termcode = termstr[0] = term;
 		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
+		termcode = IF_HAVE_PERL_5_16(
+			utf8_to_uvchr_buf((U8*)s, (U8*)PL_bufend, &termlen),
+			utf8_to_uvchr((U8*)s, &termlen)
+		);
 		Copy(s, termstr, termlen, U8);
 		if (!UTF8_IS_INVARIANT(term))
 			has_utf8 = TRUE;
@@ -100,7 +99,7 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
 		sv_catpvn(sv, s, termlen);
 	s += termlen;
 	for (;;) {
-		if (PL_encoding && !UTF) {
+		if (PL_encoding && !PARSING_UTF) {
 			bool cont = TRUE;
 
 			while (cont) {
@@ -111,10 +110,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
-#if HAVE_PERL_VERSION(5, 16, 0)
-						&& !PL_parser->filtered
-#endif
+					if (*s == '\n' && !PL_rsfp &&
+						IF_HAVE_PERL_5_16(
+							!PL_parser->filtered,
+							TRUE
+						)
 					)
 						CopLINE_inc(PL_curcop);
 				}
@@ -182,10 +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
-#if HAVE_PERL_VERSION(5, 16, 0)
-					&& !PL_parser->filtered
-#endif
+				if (*s == '\n' && !PL_rsfp &&
+					IF_HAVE_PERL_5_16(
+						!PL_parser->filtered,
+						1
+					)
 				)
 					CopLINE_inc(PL_curcop);
 				/* handle quoted delimiters */
@@ -204,7 +205,7 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
 					if (s+termlen <= PL_bufend && memEQ(s, (char*)termstr, termlen))
 						break;
 				}
-				else if (!has_utf8 && !UTF8_IS_INVARIANT((U8)*s) && UTF)
+				else if (!has_utf8 && !UTF8_IS_INVARIANT((U8)*s) && PARSING_UTF)
 					has_utf8 = TRUE;
 				*to = *s;
 			}
@@ -218,10 +219,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
-#if HAVE_PERL_VERSION(5, 16, 0)
-					&& !PL_parser->filtered
-#endif
+				if (*s == '\n' && !PL_rsfp &&
+					IF_HAVE_PERL_5_16(
+						!PL_parser->filtered,
+						1
+					)
 				)
 					CopLINE_inc(PL_curcop);
 				/* backslashes can escape the open or closing characters */
@@ -237,7 +239,7 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
 					break;
 				else if (*s == PL_multi_open)
 					brackets++;
-				else if (!has_utf8 && !UTF8_IS_INVARIANT((U8)*s) && UTF)
+				else if (!has_utf8 && !UTF8_IS_INVARIANT((U8)*s) && PARSING_UTF)
 					has_utf8 = TRUE;
 				*to = *s;
 			}
@@ -284,7 +286,7 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
 
 	/* at this point, we have successfully read the delimited string */
 
-	if (!PL_encoding || UTF) {
+	if (!PL_encoding || PARSING_UTF) {
 		if (keep_delims)
 			sv_catpvn(sv, s, termlen);
 		s += termlen;
@@ -303,4 +305,84 @@ static char *S_scan_str(pTHX_ SV *sv, int keep_quoted, int keep_delims) {
 	PL_bufptr = s;
 	return s;
 }
+
+static void S_check_prototype(pTHX_ const SV *declarator, SV *proto) {
+	bool bad_proto = FALSE;
+	bool in_brackets = FALSE;
+	char greedy_proto = ' ';
+	bool proto_after_greedy_proto = FALSE;
+	bool must_be_last = FALSE;
+	bool underscore = FALSE;
+	bool seen_underscore = FALSE;
+	const bool warnillegalproto = ckWARN(WARN_ILLEGALPROTO);
+	char *d, *p;
+	STRLEN tmp, tmplen;
+
+	/* strip spaces and check for bad characters */
+	d = SvPV(proto, tmplen);
+	tmp = 0;
+	for (p = d; tmplen; tmplen--, ++p) {
+		if (!isSPACE(*p)) {
+			d[tmp++] = *p;
+
+			if (warnillegalproto) {
+				if (must_be_last) {
+					proto_after_greedy_proto = TRUE;
+				}
+				if (!strchr("$@%*;[]&\\_+", *p) || *p == '\0') {
+					bad_proto = TRUE;
+				} else {
+					if (underscore) {
+						if (!strchr(";@%", *p)) {
+							bad_proto = TRUE;
+						}
+						underscore = FALSE;
+					}
+					if (*p == '[') {
+						in_brackets = TRUE;
+					} else if (*p == ']') {
+						in_brackets = FALSE;
+					} else if (
+						(*p == '@' || *p == '%') &&
+						(tmp < 2 || d[tmp - 2] != '\\') &&
+						!in_brackets
+					) {
+						must_be_last = TRUE;
+						greedy_proto = *p;
+					} else if (*p == '_') {
+						underscore = seen_underscore = TRUE;
+					}
+				}
+			}
+		}
+	}
+	d[tmp] = '\0';
+	SvCUR_set(proto, tmp);
+	if (proto_after_greedy_proto) {
+		Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
+			"In %"SVf": prototype after '%c': %s",
+			 SVfARG(declarator), greedy_proto, d
+		);
+	}
+	if (bad_proto) {
+		SV *dsv = newSVpvs_flags("", SVs_TEMP);
+		Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
+			"In %"SVf": illegal character %sin prototype: %s",
+			SVfARG(declarator),
+			seen_underscore ? "after '_' " : "",
+			SvUTF8(proto)
+				? sv_uni_display(dsv,
+					newSVpvn_flags(d, tmp, SVs_TEMP | SVf_UTF8),
+					tmp,
+					UNI_DISPLAY_ISPRINT
+				)
+				: pv_pretty(dsv, d, tmp, 60, NULL, NULL,
+					PERL_PV_ESCAPE_NONASCII
+				)
+		);
+	}
+	SvCUR_set(proto, tmp);
+}
+
+#undef CLINE
 /* ^^^^^^^^^^^^^^^^^^^^^ I HAVE NO IDEA WHAT I'M DOING ^^^^^^^^^^^^^^^^^^^^ */