This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #91834] utf8::decode does not respect copy-on-write
[perl5.git] / universal.c
CommitLineData
d6376244
JH
1/* universal.c
2 *
b5f8cc5c 3 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
1129b882 4 * 2005, 2006, 2007, 2008 by Larry Wall and others
d6376244
JH
5 *
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
8 *
9 */
10
d31a8517 11/*
4ac71550
TC
12 * '"The roots of those mountains must be roots indeed; there must be
13 * great secrets buried there which have not been discovered since the
14 * beginning."' --Gandalf, relating Gollum's history
15 *
16 * [p.54 of _The Lord of the Rings_, I/ii: "The Shadow of the Past"]
d31a8517
AT
17 */
18
166f8a29
DM
19/* This file contains the code that implements the functions in Perl's
20 * UNIVERSAL package, such as UNIVERSAL->can().
192b9cd1
AB
21 *
22 * It is also used to store XS functions that need to be present in
23 * miniperl for a lack of a better place to put them. It might be
486ec47a 24 * clever to move them to separate XS files which would then be pulled
192b9cd1 25 * in by some to-be-written build process.
166f8a29
DM
26 */
27
6d4a7be2 28#include "EXTERN.h"
864dbfa3 29#define PERL_IN_UNIVERSAL_C
6d4a7be2 30#include "perl.h"
6d4a7be2 31
39f7a870
JH
32#ifdef USE_PERLIO
33#include "perliol.h" /* For the PERLIO_F_XXX */
34#endif
35
6d4a7be2
PP
36/*
37 * Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
38 * The main guts of traverse_isa was actually copied from gv_fetchmeth
39 */
40
a9ec700e 41STATIC bool
515a4f72 42S_isa_lookup(pTHX_ HV *stash, const char * const name)
6d4a7be2 43{
97aff369 44 dVAR;
a49ba3fc 45 const struct mro_meta *const meta = HvMROMETA(stash);
4340b386 46 HV *isa = meta->isa;
a49ba3fc
NC
47 STRLEN len = strlen(name);
48 const HV *our_stash;
6d4a7be2 49
7918f24d
NC
50 PERL_ARGS_ASSERT_ISA_LOOKUP;
51
4340b386
FC
52 if (!isa) {
53 (void)mro_get_linear_isa(stash);
54 isa = meta->isa;
55 }
56
a49ba3fc
NC
57 if (hv_common(isa, NULL, name, len, 0 /* No "UTF-8" flag possible with only
58 a char * argument*/,
59 HV_FETCH_ISEXISTS, NULL, 0)) {
60 /* Direct name lookup worked. */
a9ec700e 61 return TRUE;
a49ba3fc 62 }
6d4a7be2 63
a49ba3fc 64 /* A stash/class can go by many names (ie. User == main::User), so
81a5123c
FC
65 we use the HvENAME in the stash itself, which is canonical, falling
66 back to HvNAME if necessary. */
a49ba3fc
NC
67 our_stash = gv_stashpvn(name, len, 0);
68
69 if (our_stash) {
81a5123c
FC
70 HEK *canon_name = HvENAME_HEK(our_stash);
71 if (!canon_name) canon_name = HvNAME_HEK(our_stash);
a1d407e8 72
a49ba3fc
NC
73 if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name),
74 HEK_FLAGS(canon_name),
75 HV_FETCH_ISEXISTS, NULL, HEK_HASH(canon_name))) {
e1a479c5 76 return TRUE;
a49ba3fc 77 }
6d4a7be2
PP
78 }
79
a9ec700e 80 return FALSE;
6d4a7be2
PP
81}
82
954c1994 83/*
ccfc67b7
JH
84=head1 SV Manipulation Functions
85
954c1994
GS
86=for apidoc sv_derived_from
87
6885da0e 88Returns a boolean indicating whether the SV is derived from the specified class
89I<at the C level>. To check derivation at the Perl level, call C<isa()> as a
90normal Perl method.
954c1994
GS
91
92=cut
93*/
94
55497cff 95bool
15f169a1 96Perl_sv_derived_from(pTHX_ SV *sv, const char *const name)
55497cff 97{
97aff369 98 dVAR;
0b6f4f5c 99 HV *stash;
46e4b22b 100
7918f24d
NC
101 PERL_ARGS_ASSERT_SV_DERIVED_FROM;
102
5b295bef 103 SvGETMAGIC(sv);
55497cff
PP
104
105 if (SvROK(sv)) {
0b6f4f5c 106 const char *type;
55497cff
PP
107 sv = SvRV(sv);
108 type = sv_reftype(sv,0);
0b6f4f5c
AL
109 if (type && strEQ(type,name))
110 return TRUE;
111 stash = SvOBJECT(sv) ? SvSTASH(sv) : NULL;
55497cff
PP
112 }
113 else {
da51bb9b 114 stash = gv_stashsv(sv, 0);
55497cff 115 }
46e4b22b 116
4a9e32d8 117 return stash ? isa_lookup(stash, name) : FALSE;
55497cff
PP
118}
119
cbc021f9 120/*
121=for apidoc sv_does
122
123Returns a boolean indicating whether the SV performs a specific, named role.
124The SV can be a Perl object or the name of a Perl class.
125
126=cut
127*/
128
1b026014
NIS
129#include "XSUB.h"
130
cbc021f9 131bool
15f169a1 132Perl_sv_does(pTHX_ SV *sv, const char *const name)
cbc021f9 133{
134 const char *classname;
135 bool does_it;
59e7186f 136 SV *methodname;
cbc021f9 137 dSP;
7918f24d
NC
138
139 PERL_ARGS_ASSERT_SV_DOES;
140
cbc021f9 141 ENTER;
142 SAVETMPS;
143
144 SvGETMAGIC(sv);
145
146 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
7ce46f2a
GG
147 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv)))) {
148 LEAVE;
cbc021f9 149 return FALSE;
7ce46f2a 150 }
cbc021f9 151
152 if (sv_isobject(sv)) {
153 classname = sv_reftype(SvRV(sv),TRUE);
154 } else {
94707740 155 classname = SvPV_nolen(sv);
cbc021f9 156 }
157
7ce46f2a
GG
158 if (strEQ(name,classname)) {
159 LEAVE;
cbc021f9 160 return TRUE;
7ce46f2a 161 }
cbc021f9 162
163 PUSHMARK(SP);
164 XPUSHs(sv);
6e449a3a 165 mXPUSHs(newSVpv(name, 0));
cbc021f9 166 PUTBACK;
167
84bafc02 168 methodname = newSVpvs_flags("isa", SVs_TEMP);
59e7186f
RGS
169 /* ugly hack: use the SvSCREAM flag so S_method_common
170 * can figure out we're calling DOES() and not isa(),
171 * and report eventual errors correctly. --rgs */
172 SvSCREAM_on(methodname);
173 call_sv(methodname, G_SCALAR | G_METHOD);
cbc021f9 174 SPAGAIN;
175
176 does_it = SvTRUE( TOPs );
177 FREETMPS;
178 LEAVE;
179
180 return does_it;
181}
182
afa74d42
NC
183/*
184=for apidoc croak_xs_usage
185
186A specialised variant of C<croak()> for emitting the usage message for xsubs
187
188 croak_xs_usage(cv, "eee_yow");
189
190works out the package name and subroutine name from C<cv>, and then calls
191C<croak()>. Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
192
1b1ee2ef 193 Perl_croak(aTHX_ "Usage: %s::%s(%s)", "ouch" "awk", "eee_yow");
afa74d42
NC
194
195=cut
196*/
197
198void
199Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
200{
201 const GV *const gv = CvGV(cv);
202
203 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
204
205 if (gv) {
206 const char *const gvname = GvNAME(gv);
207 const HV *const stash = GvSTASH(gv);
208 const char *const hvname = stash ? HvNAME_get(stash) : NULL;
209
210 if (hvname)
211 Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
212 else
213 Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
214 } else {
215 /* Pants. I don't think that it should be possible to get here. */
93c51217 216 Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
afa74d42
NC
217 }
218}
55497cff 219
6d4a7be2
PP
220XS(XS_UNIVERSAL_isa)
221{
97aff369 222 dVAR;
6d4a7be2 223 dXSARGS;
6d4a7be2
PP
224
225 if (items != 2)
afa74d42 226 croak_xs_usage(cv, "reference, kind");
c4420975
AL
227 else {
228 SV * const sv = ST(0);
229 const char *name;
6d4a7be2 230
c4420975 231 SvGETMAGIC(sv);
d3f7f2b2 232
c4420975
AL
233 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
234 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
235 XSRETURN_UNDEF;
f8f70380 236
c4420975 237 name = SvPV_nolen_const(ST(1));
6d4a7be2 238
c4420975
AL
239 ST(0) = boolSV(sv_derived_from(sv, name));
240 XSRETURN(1);
241 }
6d4a7be2
PP
242}
243
6d4a7be2
PP
244XS(XS_UNIVERSAL_can)
245{
97aff369 246 dVAR;
6d4a7be2
PP
247 dXSARGS;
248 SV *sv;
6867be6d 249 const char *name;
6d4a7be2 250 SV *rv;
6f08146e 251 HV *pkg = NULL;
6d4a7be2
PP
252
253 if (items != 2)
afa74d42 254 croak_xs_usage(cv, "object-ref, method");
6d4a7be2
PP
255
256 sv = ST(0);
f8f70380 257
5b295bef 258 SvGETMAGIC(sv);
d3f7f2b2 259
253ecd6d
RGS
260 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
261 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
f8f70380
GS
262 XSRETURN_UNDEF;
263
0510663f 264 name = SvPV_nolen_const(ST(1));
3280af22 265 rv = &PL_sv_undef;
6d4a7be2 266
46e4b22b 267 if (SvROK(sv)) {
daba3364 268 sv = MUTABLE_SV(SvRV(sv));
46e4b22b 269 if (SvOBJECT(sv))
6f08146e
NIS
270 pkg = SvSTASH(sv);
271 }
272 else {
da51bb9b 273 pkg = gv_stashsv(sv, 0);
6f08146e
NIS
274 }
275
276 if (pkg) {
c4420975 277 GV * const gv = gv_fetchmethod_autoload(pkg, name, FALSE);
dc848c6f 278 if (gv && isGV(gv))
daba3364 279 rv = sv_2mortal(newRV(MUTABLE_SV(GvCV(gv))));
6d4a7be2
PP
280 }
281
282 ST(0) = rv;
283 XSRETURN(1);
284}
285
cbc021f9 286XS(XS_UNIVERSAL_DOES)
287{
288 dVAR;
289 dXSARGS;
58c0efa5 290 PERL_UNUSED_ARG(cv);
cbc021f9 291
292 if (items != 2)
46404226 293 Perl_croak(aTHX_ "Usage: invocant->DOES(kind)");
cbc021f9 294 else {
295 SV * const sv = ST(0);
296 const char *name;
297
298 name = SvPV_nolen_const(ST(1));
299 if (sv_does( sv, name ))
300 XSRETURN_YES;
301
302 XSRETURN_NO;
303 }
304}
305
6d4a7be2
PP
306XS(XS_UNIVERSAL_VERSION)
307{
97aff369 308 dVAR;
6d4a7be2
PP
309 dXSARGS;
310 HV *pkg;
311 GV **gvp;
312 GV *gv;
313 SV *sv;
e1ec3a88 314 const char *undef;
58c0efa5 315 PERL_UNUSED_ARG(cv);
6d4a7be2 316
1571675a 317 if (SvROK(ST(0))) {
daba3364 318 sv = MUTABLE_SV(SvRV(ST(0)));
1571675a 319 if (!SvOBJECT(sv))
cea2e8a9 320 Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
6d4a7be2
PP
321 pkg = SvSTASH(sv);
322 }
323 else {
da51bb9b 324 pkg = gv_stashsv(ST(0), 0);
6d4a7be2
PP
325 }
326
4608196e 327 gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
6d4a7be2 328
0008872a 329 if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
c4420975 330 SV * const nsv = sv_newmortal();
6d4a7be2
PP
331 sv_setsv(nsv, sv);
332 sv = nsv;
137d6fc0 333 if ( !sv_derived_from(sv, "version"))
ac0e6a2f 334 upg_version(sv, FALSE);
c445ea15 335 undef = NULL;
6d4a7be2
PP
336 }
337 else {
daba3364 338 sv = &PL_sv_undef;
6d4a7be2
PP
339 undef = "(undef)";
340 }
341
1571675a 342 if (items > 1) {
1571675a
GS
343 SV *req = ST(1);
344
62658f4d 345 if (undef) {
bfcb3514 346 if (pkg) {
c4420975 347 const char * const name = HvNAME_get(pkg);
a3b680e6 348 Perl_croak(aTHX_
bfcb3514
NC
349 "%s does not define $%s::VERSION--version check failed",
350 name, name);
351 } else {
a3b680e6
AL
352 Perl_croak(aTHX_
353 "%s defines neither package nor VERSION--version check failed",
0510663f 354 SvPVx_nolen_const(ST(0)) );
62658f4d
PM
355 }
356 }
ad63d80f 357
137d6fc0
JP
358 if ( !sv_derived_from(req, "version")) {
359 /* req may very well be R/O, so create a new object */
ac0e6a2f 360 req = sv_2mortal( new_version(req) );
137d6fc0 361 }
1571675a 362
ac0e6a2f 363 if ( vcmp( req, sv ) > 0 ) {
ef8f7699 364 if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) {
ac0e6a2f
RGS
365 Perl_croak(aTHX_ "%s version %"SVf" required--"
366 "this is only version %"SVf"", HvNAME_get(pkg),
e3a22e3f 367 SVfARG(sv_2mortal(vnormal(req))),
368 SVfARG(sv_2mortal(vnormal(sv))));
ac0e6a2f
RGS
369 } else {
370 Perl_croak(aTHX_ "%s version %"SVf" required--"
371 "this is only version %"SVf"", HvNAME_get(pkg),
e3a22e3f 372 SVfARG(sv_2mortal(vstringify(req))),
373 SVfARG(sv_2mortal(vstringify(sv))));
ac0e6a2f
RGS
374 }
375 }
376
2d8e6c8d 377 }
6d4a7be2 378
2b140d5b 379 if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
e3a22e3f 380 ST(0) = sv_2mortal(vstringify(sv));
13f8f398
JP
381 } else {
382 ST(0) = sv;
b38a9dc5 383 }
6d4a7be2
PP
384
385 XSRETURN(1);
386}
387
439cb1c4
JP
388XS(XS_version_new)
389{
97aff369 390 dVAR;
439cb1c4 391 dXSARGS;
129318bd 392 if (items > 3)
afa74d42 393 croak_xs_usage(cv, "class, version");
439cb1c4
JP
394 SP -= items;
395 {
137d6fc0
JP
396 SV *vs = ST(1);
397 SV *rv;
c4420975
AL
398 const char * const classname =
399 sv_isobject(ST(0)) /* get the class if called as an object method */
400 ? HvNAME(SvSTASH(SvRV(ST(0))))
401 : (char *)SvPV_nolen(ST(0));
9137345a 402
91152fc1 403 if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */
92dcf8ce
JP
404 /* create empty object */
405 vs = sv_newmortal();
be5574c0 406 sv_setpvs(vs, "0");
9137345a
JP
407 }
408 else if ( items == 3 ) {
409 vs = sv_newmortal();
cfd0369c 410 Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
129318bd 411 }
439cb1c4 412
137d6fc0 413 rv = new_version(vs);
0723351e 414 if ( strcmp(classname,"version") != 0 ) /* inherited new() */
da51bb9b 415 sv_bless(rv, gv_stashpv(classname, GV_ADD));
137d6fc0 416
6e449a3a 417 mPUSHs(rv);
439cb1c4
JP
418 PUTBACK;
419 return;
420 }
421}
422
423XS(XS_version_stringify)
424{
97aff369 425 dVAR;
41be1fbd
JH
426 dXSARGS;
427 if (items < 1)
afa74d42 428 croak_xs_usage(cv, "lobj, ...");
41be1fbd
JH
429 SP -= items;
430 {
d808b681 431 SV * lobj = ST(0);
41be1fbd 432
d808b681
JP
433 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
434 lobj = SvRV(lobj);
41be1fbd
JH
435 }
436 else
437 Perl_croak(aTHX_ "lobj is not of type version");
438
6e449a3a 439 mPUSHs(vstringify(lobj));
41be1fbd
JH
440
441 PUTBACK;
442 return;
443 }
439cb1c4
JP
444}
445
446XS(XS_version_numify)
447{
97aff369 448 dVAR;
41be1fbd
JH
449 dXSARGS;
450 if (items < 1)
afa74d42 451 croak_xs_usage(cv, "lobj, ...");
41be1fbd
JH
452 SP -= items;
453 {
d808b681 454 SV * lobj = ST(0);
41be1fbd 455
d808b681
JP
456 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
457 lobj = SvRV(lobj);
41be1fbd
JH
458 }
459 else
460 Perl_croak(aTHX_ "lobj is not of type version");
461
6e449a3a 462 mPUSHs(vnumify(lobj));
41be1fbd
JH
463
464 PUTBACK;
465 return;
466 }
439cb1c4
JP
467}
468
9137345a
JP
469XS(XS_version_normal)
470{
97aff369 471 dVAR;
9137345a
JP
472 dXSARGS;
473 if (items < 1)
afa74d42 474 croak_xs_usage(cv, "lobj, ...");
9137345a
JP
475 SP -= items;
476 {
d808b681 477 SV * lobj = ST(0);
9137345a 478
d808b681
JP
479 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
480 lobj = SvRV(lobj);
9137345a
JP
481 }
482 else
483 Perl_croak(aTHX_ "lobj is not of type version");
484
6e449a3a 485 mPUSHs(vnormal(lobj));
9137345a
JP
486
487 PUTBACK;
488 return;
489 }
490}
491
439cb1c4
JP
492XS(XS_version_vcmp)
493{
97aff369 494 dVAR;
41be1fbd
JH
495 dXSARGS;
496 if (items < 1)
afa74d42 497 croak_xs_usage(cv, "lobj, ...");
41be1fbd
JH
498 SP -= items;
499 {
d808b681 500 SV * lobj = ST(0);
41be1fbd 501
d808b681
JP
502 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
503 lobj = SvRV(lobj);
41be1fbd
JH
504 }
505 else
506 Perl_croak(aTHX_ "lobj is not of type version");
507
508 {
509 SV *rs;
510 SV *rvs;
511 SV * robj = ST(1);
7452cf6a 512 const IV swap = (IV)SvIV(ST(2));
41be1fbd
JH
513
514 if ( ! sv_derived_from(robj, "version") )
515 {
e3a22e3f 516 robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
517 sv_2mortal(robj);
41be1fbd
JH
518 }
519 rvs = SvRV(robj);
520
521 if ( swap )
522 {
523 rs = newSViv(vcmp(rvs,lobj));
524 }
525 else
526 {
527 rs = newSViv(vcmp(lobj,rvs));
528 }
529
6e449a3a 530 mPUSHs(rs);
41be1fbd
JH
531 }
532
533 PUTBACK;
534 return;
535 }
439cb1c4
JP
536}
537
538XS(XS_version_boolean)
539{
97aff369
JH
540 dVAR;
541 dXSARGS;
542 if (items < 1)
afa74d42 543 croak_xs_usage(cv, "lobj, ...");
97aff369 544 SP -= items;
d808b681 545 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
c4420975 546 SV * const lobj = SvRV(ST(0));
396482e1 547 SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
6e449a3a 548 mPUSHs(rs);
c4420975
AL
549 PUTBACK;
550 return;
551 }
552 else
553 Perl_croak(aTHX_ "lobj is not of type version");
439cb1c4
JP
554}
555
556XS(XS_version_noop)
557{
97aff369 558 dVAR;
2dfd8427
AL
559 dXSARGS;
560 if (items < 1)
afa74d42 561 croak_xs_usage(cv, "lobj, ...");
d808b681 562 if (sv_derived_from(ST(0), "version") && SvROK(ST(0)))
2dfd8427
AL
563 Perl_croak(aTHX_ "operation not supported with version object");
564 else
565 Perl_croak(aTHX_ "lobj is not of type version");
566#ifndef HASATTRIBUTE_NORETURN
567 XSRETURN_EMPTY;
568#endif
439cb1c4
JP
569}
570
c8d69e4a
JP
571XS(XS_version_is_alpha)
572{
97aff369 573 dVAR;
c8d69e4a
JP
574 dXSARGS;
575 if (items != 1)
afa74d42 576 croak_xs_usage(cv, "lobj");
c8d69e4a 577 SP -= items;
d808b681 578 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
c4420975 579 SV * const lobj = ST(0);
ef8f7699 580 if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "alpha", 5 ) )
c4420975
AL
581 XSRETURN_YES;
582 else
583 XSRETURN_NO;
c8d69e4a
JP
584 PUTBACK;
585 return;
586 }
c4420975
AL
587 else
588 Perl_croak(aTHX_ "lobj is not of type version");
c8d69e4a
JP
589}
590
137d6fc0
JP
591XS(XS_version_qv)
592{
97aff369 593 dVAR;
137d6fc0 594 dXSARGS;
4ed3fda4 595 PERL_UNUSED_ARG(cv);
137d6fc0
JP
596 SP -= items;
597 {
f941e658
JP
598 SV * ver = ST(0);
599 SV * rv;
600 const char * classname = "";
91152fc1 601 if ( items == 2 && SvOK(ST(1)) ) {
f941e658
JP
602 /* getting called as object or class method */
603 ver = ST(1);
604 classname =
605 sv_isobject(ST(0)) /* class called as an object method */
606 ? HvNAME_get(SvSTASH(SvRV(ST(0))))
607 : (char *)SvPV_nolen(ST(0));
608 }
609 if ( !SvVOK(ver) ) { /* not already a v-string */
610 rv = sv_newmortal();
ac0e6a2f
RGS
611 sv_setsv(rv,ver); /* make a duplicate */
612 upg_version(rv, TRUE);
f941e658
JP
613 } else {
614 rv = sv_2mortal(new_version(ver));
137d6fc0 615 }
f941e658
JP
616 if ( items == 2 && strcmp(classname,"version") ) { /* inherited new() */
617 sv_bless(rv, gv_stashpv(classname, GV_ADD));
137d6fc0 618 }
f941e658
JP
619 PUSHs(rv);
620 }
621 PUTBACK;
622 return;
623}
137d6fc0 624
f941e658
JP
625XS(XS_version_is_qv)
626{
627 dVAR;
628 dXSARGS;
629 if (items != 1)
630 croak_xs_usage(cv, "lobj");
631 SP -= items;
d808b681 632 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
f941e658
JP
633 SV * const lobj = ST(0);
634 if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "qv", 2 ) )
635 XSRETURN_YES;
636 else
637 XSRETURN_NO;
137d6fc0
JP
638 PUTBACK;
639 return;
640 }
f941e658
JP
641 else
642 Perl_croak(aTHX_ "lobj is not of type version");
137d6fc0
JP
643}
644
8800c35a
JH
645XS(XS_utf8_is_utf8)
646{
97aff369 647 dVAR;
41be1fbd
JH
648 dXSARGS;
649 if (items != 1)
afa74d42 650 croak_xs_usage(cv, "sv");
c4420975 651 else {
76f73021 652 SV * const sv = ST(0);
653 SvGETMAGIC(sv);
c4420975
AL
654 if (SvUTF8(sv))
655 XSRETURN_YES;
656 else
657 XSRETURN_NO;
41be1fbd
JH
658 }
659 XSRETURN_EMPTY;
8800c35a
JH
660}
661
1b026014
NIS
662XS(XS_utf8_valid)
663{
97aff369 664 dVAR;
41be1fbd
JH
665 dXSARGS;
666 if (items != 1)
afa74d42 667 croak_xs_usage(cv, "sv");
c4420975
AL
668 else {
669 SV * const sv = ST(0);
670 STRLEN len;
671 const char * const s = SvPV_const(sv,len);
672 if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len))
673 XSRETURN_YES;
674 else
675 XSRETURN_NO;
676 }
41be1fbd 677 XSRETURN_EMPTY;
1b026014
NIS
678}
679
680XS(XS_utf8_encode)
681{
97aff369 682 dVAR;
1b026014
NIS
683 dXSARGS;
684 if (items != 1)
afa74d42 685 croak_xs_usage(cv, "sv");
c4420975 686 sv_utf8_encode(ST(0));
1b026014
NIS
687 XSRETURN_EMPTY;
688}
689
690XS(XS_utf8_decode)
691{
97aff369 692 dVAR;
1b026014
NIS
693 dXSARGS;
694 if (items != 1)
afa74d42 695 croak_xs_usage(cv, "sv");
c4420975
AL
696 else {
697 SV * const sv = ST(0);
40f11004 698 if (SvIsCOW(sv)) sv_force_normal(sv);
6867be6d 699 const bool RETVAL = sv_utf8_decode(sv);
1b026014
NIS
700 ST(0) = boolSV(RETVAL);
701 sv_2mortal(ST(0));
702 }
703 XSRETURN(1);
704}
705
706XS(XS_utf8_upgrade)
707{
97aff369 708 dVAR;
1b026014
NIS
709 dXSARGS;
710 if (items != 1)
afa74d42 711 croak_xs_usage(cv, "sv");
c4420975
AL
712 else {
713 SV * const sv = ST(0);
1b026014
NIS
714 STRLEN RETVAL;
715 dXSTARG;
716
717 RETVAL = sv_utf8_upgrade(sv);
718 XSprePUSH; PUSHi((IV)RETVAL);
719 }
720 XSRETURN(1);
721}
722
723XS(XS_utf8_downgrade)
724{
97aff369 725 dVAR;
1b026014
NIS
726 dXSARGS;
727 if (items < 1 || items > 2)
afa74d42 728 croak_xs_usage(cv, "sv, failok=0");
c4420975
AL
729 else {
730 SV * const sv = ST(0);
6867be6d
AL
731 const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
732 const bool RETVAL = sv_utf8_downgrade(sv, failok);
1b026014 733
1b026014
NIS
734 ST(0) = boolSV(RETVAL);
735 sv_2mortal(ST(0));
736 }
737 XSRETURN(1);
738}
739
740XS(XS_utf8_native_to_unicode)
741{
97aff369 742 dVAR;
1b026014 743 dXSARGS;
6867be6d 744 const UV uv = SvUV(ST(0));
b7953727
JH
745
746 if (items > 1)
afa74d42 747 croak_xs_usage(cv, "sv");
b7953727 748
1b026014
NIS
749 ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv)));
750 XSRETURN(1);
751}
752
753XS(XS_utf8_unicode_to_native)
754{
97aff369 755 dVAR;
1b026014 756 dXSARGS;
6867be6d 757 const UV uv = SvUV(ST(0));
b7953727
JH
758
759 if (items > 1)
afa74d42 760 croak_xs_usage(cv, "sv");
b7953727 761
1b026014
NIS
762 ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv)));
763 XSRETURN(1);
764}
765
14a976d6 766XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
29569577 767{
97aff369 768 dVAR;
29569577 769 dXSARGS;
80b6a949
AB
770 SV * const svz = ST(0);
771 SV * sv;
58c0efa5 772 PERL_UNUSED_ARG(cv);
6867be6d 773
80b6a949
AB
774 /* [perl #77776] - called as &foo() not foo() */
775 if (!SvROK(svz))
776 croak_xs_usage(cv, "SCALAR[, ON]");
777
778 sv = SvRV(svz);
779
29569577
JH
780 if (items == 1) {
781 if (SvREADONLY(sv))
782 XSRETURN_YES;
783 else
784 XSRETURN_NO;
785 }
786 else if (items == 2) {
787 if (SvTRUE(ST(1))) {
788 SvREADONLY_on(sv);
789 XSRETURN_YES;
790 }
791 else {
14a976d6 792 /* I hope you really know what you are doing. */
29569577
JH
793 SvREADONLY_off(sv);
794 XSRETURN_NO;
795 }
796 }
14a976d6 797 XSRETURN_UNDEF; /* Can't happen. */
29569577
JH
798}
799
14a976d6 800XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
29569577 801{
97aff369 802 dVAR;
29569577 803 dXSARGS;
80b6a949
AB
804 SV * const svz = ST(0);
805 SV * sv;
58c0efa5 806 PERL_UNUSED_ARG(cv);
6867be6d 807
80b6a949
AB
808 /* [perl #77776] - called as &foo() not foo() */
809 if (!SvROK(svz))
810 croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
811
812 sv = SvRV(svz);
813
29569577 814 if (items == 1)
14a976d6 815 XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
29569577 816 else if (items == 2) {
14a976d6 817 /* I hope you really know what you are doing. */
29569577
JH
818 SvREFCNT(sv) = SvIV(ST(1));
819 XSRETURN_IV(SvREFCNT(sv));
820 }
14a976d6 821 XSRETURN_UNDEF; /* Can't happen. */
29569577
JH
822}
823
f044d0d1 824XS(XS_Internals_hv_clear_placehold)
dfd4ef2f 825{
97aff369 826 dVAR;
dfd4ef2f 827 dXSARGS;
6867be6d 828
80b6a949 829 if (items != 1 || !SvROK(ST(0)))
afa74d42 830 croak_xs_usage(cv, "hv");
c4420975 831 else {
ef8f7699 832 HV * const hv = MUTABLE_HV(SvRV(ST(0)));
c4420975
AL
833 hv_clear_placeholders(hv);
834 XSRETURN(0);
835 }
dfd4ef2f 836}
39f7a870
JH
837
838XS(XS_PerlIO_get_layers)
839{
97aff369 840 dVAR;
39f7a870
JH
841 dXSARGS;
842 if (items < 1 || items % 2 == 0)
afa74d42 843 croak_xs_usage(cv, "filehandle[,args]");
5fef3b4a 844#ifdef USE_PERLIO
39f7a870
JH
845 {
846 SV * sv;
847 GV * gv;
848 IO * io;
849 bool input = TRUE;
850 bool details = FALSE;
851
852 if (items > 1) {
c4420975 853 SV * const *svp;
39f7a870 854 for (svp = MARK + 2; svp <= SP; svp += 2) {
c4420975
AL
855 SV * const * const varp = svp;
856 SV * const * const valp = svp + 1;
39f7a870 857 STRLEN klen;
c4420975 858 const char * const key = SvPV_const(*varp, klen);
39f7a870
JH
859
860 switch (*key) {
861 case 'i':
862 if (klen == 5 && memEQ(key, "input", 5)) {
863 input = SvTRUE(*valp);
864 break;
865 }
866 goto fail;
867 case 'o':
868 if (klen == 6 && memEQ(key, "output", 6)) {
869 input = !SvTRUE(*valp);
870 break;
871 }
872 goto fail;
873 case 'd':
874 if (klen == 7 && memEQ(key, "details", 7)) {
875 details = SvTRUE(*valp);
876 break;
877 }
878 goto fail;
879 default:
880 fail:
881 Perl_croak(aTHX_
882 "get_layers: unknown argument '%s'",
883 key);
884 }
885 }
886
887 SP -= (items - 1);
888 }
889
890 sv = POPs;
159b6efe 891 gv = MUTABLE_GV(sv);
39f7a870
JH
892
893 if (!isGV(sv)) {
894 if (SvROK(sv) && isGV(SvRV(sv)))
159b6efe 895 gv = MUTABLE_GV(SvRV(sv));
671d49be 896 else if (SvPOKp(sv))
f776e3cd 897 gv = gv_fetchsv(sv, 0, SVt_PVIO);
39f7a870
JH
898 }
899
900 if (gv && (io = GvIO(gv))) {
c4420975 901 AV* const av = PerlIO_get_layers(aTHX_ input ?
39f7a870
JH
902 IoIFP(io) : IoOFP(io));
903 I32 i;
c4420975 904 const I32 last = av_len(av);
39f7a870
JH
905 I32 nitem = 0;
906
907 for (i = last; i >= 0; i -= 3) {
c4420975
AL
908 SV * const * const namsvp = av_fetch(av, i - 2, FALSE);
909 SV * const * const argsvp = av_fetch(av, i - 1, FALSE);
910 SV * const * const flgsvp = av_fetch(av, i, FALSE);
39f7a870 911
c4420975
AL
912 const bool namok = namsvp && *namsvp && SvPOK(*namsvp);
913 const bool argok = argsvp && *argsvp && SvPOK(*argsvp);
914 const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
39f7a870
JH
915
916 if (details) {
92e45a3e
NC
917 /* Indents of 5? Yuck. */
918 /* We know that PerlIO_get_layers creates a new SV for
919 the name and flags, so we can just take a reference
920 and "steal" it when we free the AV below. */
ec3bab8e 921 XPUSHs(namok
92e45a3e 922 ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))
ec3bab8e
NC
923 : &PL_sv_undef);
924 XPUSHs(argok
92e45a3e
NC
925 ? newSVpvn_flags(SvPVX_const(*argsvp),
926 SvCUR(*argsvp),
927 (SvUTF8(*argsvp) ? SVf_UTF8 : 0)
928 | SVs_TEMP)
929 : &PL_sv_undef);
96ccaf53 930 XPUSHs(flgok
92e45a3e 931 ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp))
ec3bab8e 932 : &PL_sv_undef);
39f7a870
JH
933 nitem += 3;
934 }
935 else {
936 if (namok && argok)
1eb9e81d 937 XPUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
be2597df 938 SVfARG(*namsvp),
1eb9e81d 939 SVfARG(*argsvp))));
39f7a870 940 else if (namok)
92e45a3e 941 XPUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)));
39f7a870
JH
942 else
943 XPUSHs(&PL_sv_undef);
944 nitem++;
945 if (flgok) {
c4420975 946 const IV flags = SvIVX(*flgsvp);
39f7a870
JH
947
948 if (flags & PERLIO_F_UTF8) {
84bafc02 949 XPUSHs(newSVpvs_flags("utf8", SVs_TEMP));
39f7a870
JH
950 nitem++;
951 }
952 }
953 }
954 }
955
956 SvREFCNT_dec(av);
957
958 XSRETURN(nitem);
959 }
960 }
5fef3b4a 961#endif
39f7a870
JH
962
963 XSRETURN(0);
964}
965
9a7034eb 966XS(XS_Internals_hash_seed)
c910b28a 967{
97aff369 968 dVAR;
c85d3f85
NC
969 /* Using dXSARGS would also have dITEM and dSP,
970 * which define 2 unused local variables. */
557b887a 971 dAXMARK;
53c1dcc0 972 PERL_UNUSED_ARG(cv);
ad73156c 973 PERL_UNUSED_VAR(mark);
81eaca17 974 XSRETURN_UV(PERL_HASH_SEED);
c910b28a
JH
975}
976
008fb0c0 977XS(XS_Internals_rehash_seed)
8e90d776 978{
97aff369 979 dVAR;
8e90d776
NC
980 /* Using dXSARGS would also have dITEM and dSP,
981 * which define 2 unused local variables. */
557b887a 982 dAXMARK;
53c1dcc0 983 PERL_UNUSED_ARG(cv);
ad73156c 984 PERL_UNUSED_VAR(mark);
008fb0c0 985 XSRETURN_UV(PL_rehash_seed);
8e90d776
NC
986}
987
05619474
NC
988XS(XS_Internals_HvREHASH) /* Subject to change */
989{
97aff369 990 dVAR;
05619474 991 dXSARGS;
93c51217 992 PERL_UNUSED_ARG(cv);
05619474 993 if (SvROK(ST(0))) {
ef8f7699 994 const HV * const hv = (const HV *) SvRV(ST(0));
05619474
NC
995 if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
996 if (HvREHASH(hv))
997 XSRETURN_YES;
998 else
999 XSRETURN_NO;
1000 }
1001 }
1002 Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
1003}
241d1a3b 1004
80305961
YO
1005XS(XS_re_is_regexp)
1006{
1007 dVAR;
1008 dXSARGS;
f7e71195
AB
1009 PERL_UNUSED_VAR(cv);
1010
80305961 1011 if (items != 1)
afa74d42 1012 croak_xs_usage(cv, "sv");
f7e71195 1013
f7e71195
AB
1014 if (SvRXOK(ST(0))) {
1015 XSRETURN_YES;
1016 } else {
1017 XSRETURN_NO;
80305961
YO
1018 }
1019}
1020
192b9cd1 1021XS(XS_re_regnames_count)
80305961 1022{
192b9cd1
AB
1023 REGEXP *rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1024 SV * ret;
80305961
YO
1025 dVAR;
1026 dXSARGS;
192b9cd1
AB
1027
1028 if (items != 0)
afa74d42 1029 croak_xs_usage(cv, "");
192b9cd1
AB
1030
1031 SP -= items;
fdae9473 1032 PUTBACK;
192b9cd1
AB
1033
1034 if (!rx)
1035 XSRETURN_UNDEF;
1036
1037 ret = CALLREG_NAMED_BUFF_COUNT(rx);
1038
1039 SPAGAIN;
fdae9473
NC
1040 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1041 XSRETURN(1);
192b9cd1
AB
1042}
1043
1044XS(XS_re_regname)
1045{
1046 dVAR;
1047 dXSARGS;
1048 REGEXP * rx;
1049 U32 flags;
1050 SV * ret;
1051
28d8d7f4 1052 if (items < 1 || items > 2)
afa74d42 1053 croak_xs_usage(cv, "name[, all ]");
192b9cd1 1054
80305961 1055 SP -= items;
fdae9473 1056 PUTBACK;
80305961 1057
192b9cd1
AB
1058 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1059
1060 if (!rx)
1061 XSRETURN_UNDEF;
1062
1063 if (items == 2 && SvTRUE(ST(1))) {
f1b875a0 1064 flags = RXapif_ALL;
192b9cd1 1065 } else {
f1b875a0 1066 flags = RXapif_ONE;
80305961 1067 }
f1b875a0 1068 ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(0), (flags | RXapif_REGNAME));
192b9cd1 1069
fdae9473
NC
1070 SPAGAIN;
1071 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1072 XSRETURN(1);
80305961
YO
1073}
1074
192b9cd1 1075
80305961
YO
1076XS(XS_re_regnames)
1077{
192b9cd1 1078 dVAR;
80305961 1079 dXSARGS;
192b9cd1
AB
1080 REGEXP * rx;
1081 U32 flags;
1082 SV *ret;
1083 AV *av;
1084 I32 length;
1085 I32 i;
1086 SV **entry;
1087
1088 if (items > 1)
afa74d42 1089 croak_xs_usage(cv, "[all]");
192b9cd1
AB
1090
1091 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1092
1093 if (!rx)
1094 XSRETURN_UNDEF;
1095
1096 if (items == 1 && SvTRUE(ST(0))) {
f1b875a0 1097 flags = RXapif_ALL;
192b9cd1 1098 } else {
f1b875a0 1099 flags = RXapif_ONE;
192b9cd1
AB
1100 }
1101
80305961 1102 SP -= items;
fdae9473 1103 PUTBACK;
80305961 1104
f1b875a0 1105 ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES));
192b9cd1
AB
1106
1107 SPAGAIN;
1108
192b9cd1
AB
1109 if (!ret)
1110 XSRETURN_UNDEF;
1111
502c6561 1112 av = MUTABLE_AV(SvRV(ret));
192b9cd1
AB
1113 length = av_len(av);
1114
1115 for (i = 0; i <= length; i++) {
1116 entry = av_fetch(av, i, FALSE);
1117
1118 if (!entry)
1119 Perl_croak(aTHX_ "NULL array element in re::regnames()");
1120
ec83ea38 1121 mXPUSHs(SvREFCNT_inc_simple_NN(*entry));
80305961 1122 }
ec83ea38
MHM
1123
1124 SvREFCNT_dec(ret);
1125
192b9cd1
AB
1126 PUTBACK;
1127 return;
80305961
YO
1128}
1129
192c1e27
JH
1130XS(XS_re_regexp_pattern)
1131{
1132 dVAR;
1133 dXSARGS;
1134 REGEXP *re;
192c1e27
JH
1135
1136 if (items != 1)
afa74d42 1137 croak_xs_usage(cv, "sv");
192c1e27
JH
1138
1139 SP -= items;
1140
1141 /*
1142 Checks if a reference is a regex or not. If the parameter is
1143 not a ref, or is not the result of a qr// then returns false
1144 in scalar context and an empty list in list context.
1145 Otherwise in list context it returns the pattern and the
1146 modifiers, in scalar context it returns the pattern just as it
1147 would if the qr// was stringified normally, regardless as
486ec47a 1148 to the class of the variable and any stringification overloads
192c1e27
JH
1149 on the object.
1150 */
1151
1152 if ((re = SvRX(ST(0)))) /* assign deliberate */
1153 {
22c985d5 1154 /* Houston, we have a regex! */
192c1e27 1155 SV *pattern;
192c1e27
JH
1156
1157 if ( GIMME_V == G_ARRAY ) {
9de15fec 1158 STRLEN left = 0;
a62b1201 1159 char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH];
69af1167
SH
1160 const char *fptr;
1161 char ch;
1162 U16 match_flags;
1163
192c1e27
JH
1164 /*
1165 we are in list context so stringify
1166 the modifiers that apply. We ignore "negative
a62b1201 1167 modifiers" in this scenario, and the default character set
192c1e27
JH
1168 */
1169
a62b1201
KW
1170 if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) {
1171 STRLEN len;
1172 const char* const name = get_regex_charset_name(RX_EXTFLAGS(re),
1173 &len);
1174 Copy(name, reflags + left, len, char);
1175 left += len;
9de15fec 1176 }
69af1167 1177 fptr = INT_PAT_MODS;
73134a2e 1178 match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME)
192c1e27
JH
1179 >> RXf_PMf_STD_PMMOD_SHIFT);
1180
1181 while((ch = *fptr++)) {
1182 if(match_flags & 1) {
1183 reflags[left++] = ch;
1184 }
1185 match_flags >>= 1;
1186 }
1187
fb632ce3
NC
1188 pattern = newSVpvn_flags(RX_PRECOMP(re),RX_PRELEN(re),
1189 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
192c1e27
JH
1190
1191 /* return the pattern and the modifiers */
1192 XPUSHs(pattern);
fb632ce3 1193 XPUSHs(newSVpvn_flags(reflags, left, SVs_TEMP));
192c1e27
JH
1194 XSRETURN(2);
1195 } else {
1196 /* Scalar, so use the string that Perl would return */
1197 /* return the pattern in (?msix:..) format */
1198#if PERL_VERSION >= 11
daba3364 1199 pattern = sv_2mortal(newSVsv(MUTABLE_SV(re)));
192c1e27 1200#else
fb632ce3
NC
1201 pattern = newSVpvn_flags(RX_WRAPPED(re), RX_WRAPLEN(re),
1202 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
192c1e27
JH
1203#endif
1204 XPUSHs(pattern);
1205 XSRETURN(1);
1206 }
1207 } else {
1208 /* It ain't a regexp folks */
1209 if ( GIMME_V == G_ARRAY ) {
1210 /* return the empty list */
1211 XSRETURN_UNDEF;
1212 } else {
1213 /* Because of the (?:..) wrapping involved in a
1214 stringified pattern it is impossible to get a
1215 result for a real regexp that would evaluate to
1216 false. Therefore we can return PL_sv_no to signify
1217 that the object is not a regex, this means that one
1218 can say
1219
1220 if (regex($might_be_a_regex) eq '(?:foo)') { }
1221
1222 and not worry about undefined values.
1223 */
1224 XSRETURN_NO;
1225 }
1226 }
1227 /* NOT-REACHED */
1228}
1229
eff5b9d5
NC
1230struct xsub_details {
1231 const char *name;
1232 XSUBADDR_t xsub;
1233 const char *proto;
1234};
1235
1236struct xsub_details details[] = {
1237 {"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL},
1238 {"UNIVERSAL::can", XS_UNIVERSAL_can, NULL},
1239 {"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL},
1240 {"UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, NULL},
1241 {"version::()", XS_version_noop, NULL},
1242 {"version::new", XS_version_new, NULL},
1243 {"version::parse", XS_version_new, NULL},
1244 {"version::(\"\"", XS_version_stringify, NULL},
1245 {"version::stringify", XS_version_stringify, NULL},
1246 {"version::(0+", XS_version_numify, NULL},
1247 {"version::numify", XS_version_numify, NULL},
1248 {"version::normal", XS_version_normal, NULL},
1249 {"version::(cmp", XS_version_vcmp, NULL},
1250 {"version::(<=>", XS_version_vcmp, NULL},
1251 {"version::vcmp", XS_version_vcmp, NULL},
1252 {"version::(bool", XS_version_boolean, NULL},
1253 {"version::boolean", XS_version_boolean, NULL},
1254 {"version::(nomethod", XS_version_noop, NULL},
1255 {"version::noop", XS_version_noop, NULL},
1256 {"version::is_alpha", XS_version_is_alpha, NULL},
1257 {"version::qv", XS_version_qv, NULL},
1258 {"version::declare", XS_version_qv, NULL},
1259 {"version::is_qv", XS_version_is_qv, NULL},
1260 {"utf8::is_utf8", XS_utf8_is_utf8, NULL},
1261 {"utf8::valid", XS_utf8_valid, NULL},
1262 {"utf8::encode", XS_utf8_encode, NULL},
1263 {"utf8::decode", XS_utf8_decode, NULL},
1264 {"utf8::upgrade", XS_utf8_upgrade, NULL},
1265 {"utf8::downgrade", XS_utf8_downgrade, NULL},
1266 {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL},
1267 {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL},
1268 {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"},
1269 {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
1270 {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
1271 {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
1272 {"Internals::hash_seed", XS_Internals_hash_seed, ""},
1273 {"Internals::rehash_seed", XS_Internals_rehash_seed, ""},
1274 {"Internals::HvREHASH", XS_Internals_HvREHASH, "\\%"},
1275 {"re::is_regexp", XS_re_is_regexp, "$"},
1276 {"re::regname", XS_re_regname, ";$$"},
1277 {"re::regnames", XS_re_regnames, ";$"},
1278 {"re::regnames_count", XS_re_regnames_count, ""},
1279 {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
eff5b9d5
NC
1280};
1281
1282void
1283Perl_boot_core_UNIVERSAL(pTHX)
1284{
1285 dVAR;
1286 static const char file[] = __FILE__;
1287 struct xsub_details *xsub = details;
1288 const struct xsub_details *end
1289 = details + sizeof(details) / sizeof(details[0]);
1290
1291 do {
1292 newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
1293 } while (++xsub < end);
1294
1295 /* register the overloading (type 'A') magic */
1296 PL_amagic_generation++;
1297
1298 /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */
1299 CvFILE(newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL))
1300 = (char *)file;
1301}
80305961 1302
241d1a3b
NC
1303/*
1304 * Local variables:
1305 * c-indentation-style: bsd
1306 * c-basic-offset: 4
1307 * indent-tabs-mode: t
1308 * End:
1309 *
37442d52
RGS
1310 * ex: set ts=8 sts=4 sw=4 noet:
1311 */