summaryrefslogtreecommitdiff
path: root/utf8.c
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>2000-09-30 12:18:00 +0000
committerNick Ing-Simmons <nik@tiuk.ti.com>2000-09-30 12:18:00 +0000
commit818d34d74a277ee45cab1d7bd18addfa7fbc4498 (patch)
treeff1d6f1a77730ac1007ca44d8ac26884b6aa3bcf /utf8.c
parentaaffcfbeac058698c3cb8e7dbcb91b010642ea9c (diff)
downloadperl-818d34d74a277ee45cab1d7bd18addfa7fbc4498.tar.gz
Re-instate Perl_utf8_to_uv without checking parameter - added in change 7075.
i.e. rename Simon's function to Perl_utf8_to_uv_chk, change all calls to it to use new name and add Perl_utf8_to_uv() as a wrapper which calls it passing 0 to checking to get the warning. p4raw-id: //depot/perl@7096
Diffstat (limited to 'utf8.c')
-rw-r--r--utf8.c48
1 files changed, 34 insertions, 14 deletions
diff --git a/utf8.c b/utf8.c
index d23c9f7bc7..3ab402c497 100644
--- a/utf8.c
+++ b/utf8.c
@@ -143,7 +143,7 @@ string, false otherwise.
=cut
*/
-bool
+bool
Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len)
{
U8* x=s;
@@ -159,7 +159,7 @@ Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len)
}
/*
-=for apidoc Am|U8* s|utf8_to_uv|I32 *retlen|I32 checking
+=for apidoc Am|U8* s|utf8_to_uv_chk|I32 *retlen|I32 checking
Returns the character value of the first character in the string C<s>
which is assumed to be in UTF8 encoding; C<retlen> will be set to the
@@ -176,7 +176,7 @@ warning is produced.
*/
UV
-Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen, bool checking)
+Perl_utf8_to_uv_chk(pTHX_ U8* s, I32* retlen, bool checking)
{
UV uv = *s;
int len;
@@ -192,7 +192,7 @@ Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen, bool checking)
return 0;
}
- if (ckWARN_d(WARN_UTF8))
+ if (ckWARN_d(WARN_UTF8))
Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character");
if (retlen)
*retlen = 1;
@@ -219,7 +219,7 @@ Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen, bool checking)
return 0;
}
- if (ckWARN_d(WARN_UTF8))
+ if (ckWARN_d(WARN_UTF8))
Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character");
if (retlen)
*retlen -= len + 1;
@@ -231,6 +231,26 @@ Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen, bool checking)
return uv;
}
+/*
+=for apidoc Am|U8* s|utf8_to_uv|I32 *retlen
+
+Returns the character value of the first character in the string C<s>
+which is assumed to be in UTF8 encoding; C<retlen> will be set to the
+length, in bytes, of that character, and the pointer C<s> will be
+advanced to the end of the character.
+
+If C<s> does not point to a well-formed UTF8 character, an optional UTF8
+warning is produced.
+
+=cut
+*/
+
+UV
+Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen)
+{
+ return Perl_utf8_to_uv_chk(aTHX_ s, retlen, 0);
+}
+
/* utf8_distance(a,b) returns the number of UTF8 characters between
the pointers a and b */
@@ -302,7 +322,7 @@ Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN *len)
if (c >= 0x80 &&
( (s >= send) || ((*s++ & 0xc0) != 0x80) || ((c & 0xfe) != 0xc2))) {
*len = -1;
- return 0;
+ return 0;
}
}
s = save;
@@ -311,7 +331,7 @@ Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN *len)
*d++ = *s++;
else {
I32 ulen;
- *d++ = (U8)utf8_to_uv(s, &ulen, 0);
+ *d++ = (U8)utf8_to_uv(s, &ulen);
s += ulen;
}
}
@@ -839,7 +859,7 @@ Perl_to_utf8_upper(pTHX_ U8 *p)
if (!PL_utf8_toupper)
PL_utf8_toupper = swash_init("utf8", "ToUpper", &PL_sv_undef, 4, 0);
uv = swash_fetch(PL_utf8_toupper, p);
- return uv ? uv : utf8_to_uv(p,0,0);
+ return uv ? uv : utf8_to_uv_chk(p,0,0);
}
UV
@@ -850,7 +870,7 @@ Perl_to_utf8_title(pTHX_ U8 *p)
if (!PL_utf8_totitle)
PL_utf8_totitle = swash_init("utf8", "ToTitle", &PL_sv_undef, 4, 0);
uv = swash_fetch(PL_utf8_totitle, p);
- return uv ? uv : utf8_to_uv(p,0,0);
+ return uv ? uv : utf8_to_uv_chk(p,0,0);
}
UV
@@ -861,7 +881,7 @@ Perl_to_utf8_lower(pTHX_ U8 *p)
if (!PL_utf8_tolower)
PL_utf8_tolower = swash_init("utf8", "ToLower", &PL_sv_undef, 4, 0);
uv = swash_fetch(PL_utf8_tolower, p);
- return uv ? uv : utf8_to_uv(p,0,0);
+ return uv ? uv : utf8_to_uv_chk(p,0,0);
}
/* a "swash" is a swatch hash */
@@ -871,7 +891,7 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
{
SV* retval;
char tmpbuf[256];
- dSP;
+ dSP;
if (!gv_stashpv(pkg, 0)) { /* demand load utf8 */
ENTER;
@@ -895,7 +915,7 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
if (PL_curcop == &PL_compiling) /* XXX ought to be handled by lex_start */
strncpy(tmpbuf, PL_tokenbuf, sizeof tmpbuf);
if (call_method("SWASHNEW", G_SCALAR))
- retval = newSVsv(*PL_stack_sp--);
+ retval = newSVsv(*PL_stack_sp--);
else
retval = &PL_sv_undef;
LEAVE;
@@ -951,11 +971,11 @@ Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr)
PUSHMARK(SP);
EXTEND(SP,3);
PUSHs((SV*)sv);
- PUSHs(sv_2mortal(newSViv(utf8_to_uv(ptr, 0, 0) & ~(needents - 1))));
+ PUSHs(sv_2mortal(newSViv(utf8_to_uv_chk(ptr, 0, 0) & ~(needents - 1))));
PUSHs(sv_2mortal(newSViv(needents)));
PUTBACK;
if (call_method("SWASHGET", G_SCALAR))
- retval = newSVsv(*PL_stack_sp--);
+ retval = newSVsv(*PL_stack_sp--);
else
retval = &PL_sv_undef;
POPSTACK;