From: Lukas Mai <l.mai@web.de>
Date: Tue, 11 Jun 2013 21:23:04 +0000 (+0200)
Subject: handle unicode keywords
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c28aa8df8db96dbf0d1a93e6aee9ff5e9b744f1c;p=p5sagit%2FFunction-Parameters.git

handle unicode keywords
---

diff --git a/MANIFEST b/MANIFEST
index ffa02de..6d407eb 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -111,3 +111,4 @@ t/types_moose.t
 t/types_moose_2.t
 t/types_moosex.t
 t/unicode.t
+t/unicode2.t
diff --git a/Parameters.xs b/Parameters.xs
index 8f77a63..3ca4d40 100644
--- a/Parameters.xs
+++ b/Parameters.xs
@@ -979,10 +979,11 @@ static void register_info(pTHX_ UV key, SV *declarator, const KWSpec *kws, const
 		mPUSHu(key);
 	}
 	/* 1 */ {
-		size_t n;
+		STRLEN n;
 		char *p = SvPV(declarator, n);
 		char *q = memchr(p, ' ', n);
-		mPUSHp(p, q ? (size_t)(q - p) : n);
+		SV *tmp = newSVpvn_utf8(p, q ? (size_t)(q - p) : n, SvUTF8(declarator));
+		mPUSHs(tmp);
 	}
 	if (!ps) {
 		if (SvTRUE(kws->shift)) {
@@ -1119,6 +1120,9 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL
 	I32 c;
 
 	declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len));
+	if (lex_bufutf8()) {
+		SvUTF8_on(declarator);
+	}
 
 	lex_read_space(0);
 
@@ -1950,6 +1954,7 @@ static int kw_flags_enter(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len,
 	SV *sv, **psv;
 	const char *p, *kw_active;
 	STRLEN kw_active_len;
+	bool kw_is_utf8;
 
 	if (!(hints = GvHV(PL_hintgv))) {
 		return FALSE;
@@ -1962,6 +1967,9 @@ static int kw_flags_enter(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len,
 	if (kw_active_len <= kw_len) {
 		return FALSE;
 	}
+
+	kw_is_utf8 = lex_bufutf8();
+
 	for (
 		p = kw_active;
 		(p = strchr(p, *kw_ptr)) &&
@@ -1985,11 +1993,16 @@ static int kw_flags_enter(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len,
 #define FETCH_HINTK_INTO(NAME, PTR, LEN, X) STMT_START { \
 	const char *fk_ptr_; \
 	STRLEN fk_len_; \
+	I32 fk_xlen_; \
 	SV *fk_sv_; \
 	fk_sv_ = sentinel_mortalize(sen, newSVpvs(HINTK_ ## NAME)); \
 	sv_catpvn(fk_sv_, PTR, LEN); \
 	fk_ptr_ = SvPV(fk_sv_, fk_len_); \
-	if (!((X) = hv_fetch(hints, fk_ptr_, fk_len_, 0))) { \
+	fk_xlen_ = fk_len_; \
+	if (kw_is_utf8) { \
+		fk_xlen_ = -fk_xlen_; \
+	} \
+	if (!((X) = hv_fetch(hints, fk_ptr_, fk_xlen_, 0))) { \
 		croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)fk_len_, fk_ptr_); \
 	} \
 } STMT_END
diff --git a/t/unicode2.t b/t/unicode2.t
new file mode 100644
index 0000000..464c408
--- /dev/null
+++ b/t/unicode2.t
@@ -0,0 +1,57 @@
+#!perl
+use utf8;
+use Test::More tests => 25;
+
+use warnings FATAL => 'all';
+use strict;
+
+use Function::Parameters { pŕöç => 'function_strict' };
+
+pŕöç hörps($x) { $x * 2 }
+pŕöç drau($spın̈al_tap) { $spın̈al_tap * 3 }
+pŕöç ääää($éééééé) { $éééééé * 4 }
+
+is hörps(10), 20;
+is drau(11), 33;
+is ääää(12), 48;
+
+is eval('pŕöç á(){} 1'), 1;
+is á(), undef;
+
+is eval('pŕöç ́(){} 1'), undef;
+like $@, qr/pŕöç.* function body/s;
+
+is eval(q<pŕöç 'hi(){} 1>), undef;
+like $@, qr/pŕöç.* function body/s;
+
+is eval('pŕöç ::hi($z){} 1'), 1;
+is hi(42), undef;
+
+is eval('pŕöç 123(){} 1'), undef;
+like $@, qr/pŕöç.* function body/s;
+
+is eval('pŕöç main::234(){} 1'), undef;
+like $@, qr/pŕöç.* function body/s;
+
+is eval('pŕöç m123($z){} 1'), 1;
+is m123(42), undef;
+
+is eval('pŕöç ::m234($z){} 1'), 1;
+is m234(42), undef;
+
+is eval { ääää }, undef;
+like $@, qr/pŕöç.*ääää/s;
+
+SKIP: {
+	eval { require Moo } or skip "info requires Moo", 4;
+
+	for my $info (Function::Parameters::info \&ääää) {
+		is $info->keyword, 'pŕöç';
+		is join(' ', $info->positional_required), '$éééééé';
+	}
+
+	for my $info (Function::Parameters::info \&drau) {
+		is $info->keyword, 'pŕöç';
+		is join(' ', $info->positional_required), '$spın̈al_tap';
+	}
+}