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