This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix example #4 in perlXStut
[perl5.git] / gv.c
CommitLineData
a0d0e21e 1/* gv.c
79072805 2 *
a0d0e21e 3 * Copyright (c) 1991-1994, Larry Wall
79072805
LW
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
a0d0e21e
LW
8 */
9
10/*
11 * 'Mercy!' cried Gandalf. 'If the giving of information is to be the cure
12 * of your inquisitiveness, I shall spend all the rest of my days answering
13 * you. What more do you want to know?'
14 * 'The names of all the stars, and of all living things, and the whole
15 * history of Middle-earth and Over-heaven and of the Sundering Seas,'
16 * laughed Pippin.
79072805
LW
17 */
18
19#include "EXTERN.h"
20#include "perl.h"
21
71be2cbc 22EXT char rcsid[];
93a17b20 23
79072805
LW
24GV *
25gv_AVadd(gv)
26register GV *gv;
27{
a0d0e21e
LW
28 if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
29 croak("Bad symbol for array");
79072805
LW
30 if (!GvAV(gv))
31 GvAV(gv) = newAV();
32 return gv;
33}
34
35GV *
36gv_HVadd(gv)
37register GV *gv;
38{
a0d0e21e
LW
39 if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
40 croak("Bad symbol for hash");
79072805 41 if (!GvHV(gv))
463ee0b2 42 GvHV(gv) = newHV();
79072805
LW
43 return gv;
44}
45
46GV *
a0d0e21e
LW
47gv_IOadd(gv)
48register GV *gv;
49{
50 if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
51 croak("Bad symbol for filehandle");
52 if (!GvIOp(gv))
53 GvIOp(gv) = newIO();
54 return gv;
55}
56
57GV *
79072805
LW
58gv_fetchfile(name)
59char *name;
60{
61 char tmpbuf[1200];
8ebc5c01 62 STRLEN tmplen;
79072805
LW
63 GV *gv;
64
8ebc5c01
PP
65 sprintf(tmpbuf, "_<%s", name);
66 tmplen = strlen(tmpbuf);
67 gv = *(GV**)hv_fetch(defstash, tmpbuf, tmplen, TRUE);
68 if (!isGV(gv))
69 gv_init(gv, defstash, tmpbuf, tmplen, FALSE);
79072805 70 sv_setpv(GvSV(gv), name);
8ebc5c01 71 if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm")))
a5f75d66 72 GvMULTI_on(gv);
79072805 73 if (perldb)
93a17b20 74 hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
79072805
LW
75 return gv;
76}
77
463ee0b2
LW
78void
79gv_init(gv, stash, name, len, multi)
80GV *gv;
81HV *stash;
82char *name;
83STRLEN len;
84int multi;
85{
86 register GP *gp;
87
dc437b57 88 sv_upgrade((SV*)gv, SVt_PVGV);
463ee0b2
LW
89 if (SvLEN(gv))
90 Safefree(SvPVX(gv));
91 Newz(602,gp, 1, GP);
8990e307 92 GvGP(gv) = gp_ref(gp);
463ee0b2
LW
93 GvREFCNT(gv) = 1;
94 GvSV(gv) = NEWSV(72,0);
95 GvLINE(gv) = curcop->cop_line;
8990e307 96 GvFILEGV(gv) = curcop->cop_filegv;
463ee0b2
LW
97 GvEGV(gv) = gv;
98 sv_magic((SV*)gv, (SV*)gv, '*', name, len);
99 GvSTASH(gv) = stash;
a0d0e21e 100 GvNAME(gv) = savepvn(name, len);
463ee0b2
LW
101 GvNAMELEN(gv) = len;
102 if (multi)
a5f75d66 103 GvMULTI_on(gv);
463ee0b2
LW
104}
105
a0d0e21e
LW
106static void
107gv_init_sv(gv, sv_type)
108GV* gv;
109I32 sv_type;
110{
111 switch (sv_type) {
112 case SVt_PVIO:
113 (void)GvIOn(gv);
114 break;
115 case SVt_PVAV:
116 (void)GvAVn(gv);
117 break;
118 case SVt_PVHV:
119 (void)GvHVn(gv);
120 break;
121 }
122}
123
79072805 124GV *
a0d0e21e 125gv_fetchmeth(stash, name, len, level)
79072805
LW
126HV* stash;
127char* name;
463ee0b2 128STRLEN len;
a0d0e21e 129I32 level;
79072805
LW
130{
131 AV* av;
463ee0b2 132 GV* topgv;
79072805 133 GV* gv;
463ee0b2 134 GV** gvp;
a0d0e21e 135 HV* lastchance;
748a9306 136 CV* cv;
a0d0e21e
LW
137
138 if (!stash)
139 return 0;
140 if (level > 100)
141 croak("Recursive inheritance detected");
463ee0b2
LW
142
143 gvp = (GV**)hv_fetch(stash, name, len, TRUE);
144
145 DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
146 topgv = *gvp;
147 if (SvTYPE(topgv) != SVt_PVGV)
148 gv_init(topgv, stash, name, len, TRUE);
149
7a4c00b4
PP
150 if (cv = GvCV(topgv)) {
151 if (CvXSUB(cv) || CvROOT(cv) || CvGV(cv)) { /* Not deleted, possibly autoloaded. */
152 if (GvCVGEN(topgv) >= sub_generation)
153 return topgv; /* valid cached inheritance */
154 if (!GvCVGEN(topgv)) { /* not an inheritance cache */
155 return topgv;
156 }
748a9306 157 }
7a4c00b4
PP
158 /* stale cached entry, just junk it */
159 SvREFCNT_dec(cv);
160 GvCV(topgv) = cv = 0;
161 GvCVGEN(topgv) = 0;
463ee0b2 162 }
7a4c00b4 163 /* Now cv = 0, and there is no cv in topgv. */
79072805
LW
164
165 gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
166 if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
167 SV** svp = AvARRAY(av);
168 I32 items = AvFILL(av) + 1;
169 while (items--) {
79072805 170 SV* sv = *svp++;
a0d0e21e 171 HV* basestash = gv_stashsv(sv, FALSE);
9bbf4081 172 if (!basestash) {
79072805 173 if (dowarn)
a0d0e21e 174 warn("Can't locate package %s for @%s::ISA",
463ee0b2 175 SvPVX(sv), HvNAME(stash));
79072805
LW
176 continue;
177 }
a0d0e21e 178 gv = gv_fetchmeth(basestash, name, len, level + 1);
463ee0b2
LW
179 if (gv) {
180 GvCV(topgv) = GvCV(gv); /* cache the CV */
181 GvCVGEN(topgv) = sub_generation; /* valid for now */
7a4c00b4 182 SvREFCNT_inc(GvCV(gv));
79072805 183 return gv;
463ee0b2 184 }
79072805
LW
185 }
186 }
a0d0e21e
LW
187
188 if (!level) {
dc437b57 189 if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) {
a0d0e21e
LW
190 if (gv = gv_fetchmeth(lastchance, name, len, level + 1)) {
191 GvCV(topgv) = GvCV(gv); /* cache the CV */
192 GvCVGEN(topgv) = sub_generation; /* valid for now */
7a4c00b4 193 SvREFCNT_inc(GvCV(gv));
a0d0e21e
LW
194 return gv;
195 }
196 }
197 }
198
79072805
LW
199 return 0;
200}
201
202GV *
463ee0b2
LW
203gv_fetchmethod(stash, name)
204HV* stash;
205char* name;
206{
207 register char *nend;
a0d0e21e
LW
208 char *nsplit = 0;
209 GV* gv;
463ee0b2
LW
210
211 for (nend = name; *nend; nend++) {
a0d0e21e
LW
212 if (*nend == ':' || *nend == '\'')
213 nsplit = nend;
214 }
215 if (nsplit) {
216 char ch;
217 char *origname = name;
218 name = nsplit + 1;
219 ch = *nsplit;
220 if (*nsplit == ':')
221 --nsplit;
222 *nsplit = '\0';
4633a7c4
LW
223 if (strEQ(origname,"SUPER")) {
224 /* Degenerate case ->SUPER::method should really lookup in original stash */
37120919 225 SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash),0));
4633a7c4 226 sv_catpvn(tmpstr, "::SUPER", 7);
dc437b57 227 stash = gv_stashpvn(SvPVX(tmpstr),SvCUR(tmpstr),TRUE);
4633a7c4
LW
228 *nsplit = ch;
229 DEBUG_o( deb("Treating %s as %s::%s\n",origname,HvNAME(stash),name) );
230 } else {
dc437b57 231 stash = gv_stashpvn(origname, nsplit - origname, TRUE);
4633a7c4
LW
232 *nsplit = ch;
233 }
a0d0e21e
LW
234 }
235 gv = gv_fetchmeth(stash, name, nend - name, 0);
4633a7c4
LW
236
237 if (!gv) {
238 /* Failed obvious case - look for SUPER as last element of stash's name */
239 char *packname = HvNAME(stash);
240 STRLEN len = strlen(packname);
760ac839 241 if (len >= 7 && strEQ(packname+len-7,"::SUPER")) {
4633a7c4
LW
242 /* Now look for @.*::SUPER::ISA */
243 GV** gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
760ac839 244 len -= 7;
4633a7c4
LW
245 if (!gvp || (gv = *gvp) == (GV*)&sv_undef || !GvAV(gv)) {
246 /* No @ISA in package ending in ::SUPER - drop suffix
247 and see if there is an @ISA there
248 */
249 HV *basestash;
dc437b57 250 char ch = packname[len];
4633a7c4 251 AV *av;
dc437b57
PP
252 packname[len] = '\0';
253 basestash = gv_stashpvn(packname, len, TRUE);
254 packname[len] = ch;
4633a7c4
LW
255 gvp = (GV**)hv_fetch(basestash,"ISA",3,FALSE);
256 if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
257 /* Okay found @ISA after dropping the SUPER, alias it */
258 SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
259 sv_catpvn(tmpstr, "::ISA", 5);
260 gv = gv_fetchpv(SvPV(tmpstr,na),TRUE,SVt_PVGV);
261 if (gv) {
262 GvAV(gv) = (AV*)SvREFCNT_inc(av);
263 /* ... and re-try lookup */
264 gv = gv_fetchmeth(stash, name, nend - name, 0);
265 } else {
266 croak("Cannot create %s::ISA",HvNAME(stash));
267 }
268 }
269 }
270 }
271 }
272
a0d0e21e
LW
273 if (!gv) {
274 CV* cv;
275
702887b4 276 if (strEQ(name,"import"))
dc437b57 277 gv = (GV*)&sv_yes;
a0d0e21e 278 else if (strNE(name, "AUTOLOAD")) {
8ebc5c01
PP
279 if (gv = gv_fetchmeth(stash, "AUTOLOAD", 8, 0)) {
280 /* One more chance... */
748a9306 281 SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
a0d0e21e
LW
282 sv_catpvn(tmpstr,"::", 2);
283 sv_catpvn(tmpstr, name, nend - name);
8ebc5c01 284 cv = GvCV(gv);
a0d0e21e 285 sv_setsv(GvSV(CvGV(cv)), tmpstr);
bbce6d69 286 SvTAINTED_off(GvSV(CvGV(cv)));
a0d0e21e 287 }
463ee0b2
LW
288 }
289 }
a0d0e21e
LW
290 return gv;
291}
292
293HV*
294gv_stashpv(name,create)
295char *name;
296I32 create;
297{
dc437b57
PP
298 return gv_stashpvn(name, strlen(name), create);
299}
300
301HV*
302gv_stashpvn(name,namelen,create)
303char *name;
304U32 namelen;
305I32 create;
306{
307 char tmpbuf[1203];
a0d0e21e
LW
308 HV *stash;
309 GV *tmpgv;
dc437b57
PP
310
311 if (namelen > 1200) {
312 namelen = 1200;
313#ifdef VMS
314 warn("Weird package name \"%s\" truncated", name);
315#else
316 warn("Weird package name \"%.*s...\" truncated", namelen, name);
317#endif
318 }
319 Copy(name,tmpbuf,namelen,char);
320 tmpbuf[namelen++] = ':';
321 tmpbuf[namelen++] = ':';
322 tmpbuf[namelen] = '\0';
a0d0e21e
LW
323 tmpgv = gv_fetchpv(tmpbuf,create, SVt_PVHV);
324 if (!tmpgv)
325 return 0;
326 if (!GvHV(tmpgv))
327 GvHV(tmpgv) = newHV();
328 stash = GvHV(tmpgv);
329 if (!HvNAME(stash))
330 HvNAME(stash) = savepv(name);
331 return stash;
463ee0b2
LW
332}
333
a0d0e21e
LW
334HV*
335gv_stashsv(sv,create)
336SV *sv;
337I32 create;
338{
dc437b57
PP
339 register char *ptr;
340 STRLEN len;
341 ptr = SvPV(sv,len);
342 return gv_stashpvn(ptr, len, create);
a0d0e21e
LW
343}
344
345
463ee0b2 346GV *
a0d0e21e 347gv_fetchpv(nambeg,add,sv_type)
463ee0b2 348char *nambeg;
79072805 349I32 add;
a0d0e21e 350I32 sv_type;
79072805 351{
463ee0b2
LW
352 register char *name = nambeg;
353 register GV *gv = 0;
79072805 354 GV**gvp;
79072805
LW
355 I32 len;
356 register char *namend;
463ee0b2 357 HV *stash = 0;
79072805 358 bool global = FALSE;
85e6fe83 359 char *tmpbuf;
79072805 360
c07a80fd
PP
361 if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
362 name++;
363
79072805 364 for (namend = name; *namend; namend++) {
463ee0b2
LW
365 if ((*namend == '\'' && namend[1]) ||
366 (*namend == ':' && namend[1] == ':'))
367 {
463ee0b2
LW
368 if (!stash)
369 stash = defstash;
dc437b57 370 if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */
a0d0e21e 371 return Nullgv;
463ee0b2 372
85e6fe83
LW
373 len = namend - name;
374 if (len > 0) {
a0d0e21e
LW
375 New(601, tmpbuf, len+3, char);
376 Copy(name, tmpbuf, len, char);
377 tmpbuf[len++] = ':';
378 tmpbuf[len++] = ':';
379 tmpbuf[len] = '\0';
463ee0b2 380 gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
85e6fe83 381 Safefree(tmpbuf);
463ee0b2
LW
382 if (!gvp || *gvp == (GV*)&sv_undef)
383 return Nullgv;
384 gv = *gvp;
85e6fe83 385
463ee0b2 386 if (SvTYPE(gv) == SVt_PVGV)
a5f75d66 387 GvMULTI_on(gv);
a0d0e21e
LW
388 else if (!add)
389 return Nullgv;
463ee0b2
LW
390 else
391 gv_init(gv, stash, nambeg, namend - nambeg, (add & 2));
85e6fe83 392
463ee0b2
LW
393 if (!(stash = GvHV(gv)))
394 stash = GvHV(gv) = newHV();
85e6fe83 395
463ee0b2 396 if (!HvNAME(stash))
a0d0e21e 397 HvNAME(stash) = savepvn(nambeg, namend - nambeg);
463ee0b2
LW
398 }
399
400 if (*namend == ':')
401 namend++;
402 namend++;
403 name = namend;
404 if (!*name)
dc437b57 405 return gv ? gv : (GV*)*hv_fetch(defstash, "main::", 6, TRUE);
79072805 406 }
79072805 407 }
a0d0e21e
LW
408 len = namend - name;
409 if (!len)
410 len = 1;
463ee0b2
LW
411
412 /* No stash in name, so see how we can default */
413
414 if (!stash) {
415 if (isIDFIRST(*name)) {
416 if (isUPPER(*name)) {
417 if (*name > 'I') {
418 if (*name == 'S' && (
419 strEQ(name, "SIG") ||
420 strEQ(name, "STDIN") ||
421 strEQ(name, "STDOUT") ||
422 strEQ(name, "STDERR") ))
423 global = TRUE;
424 }
425 else if (*name > 'E') {
426 if (*name == 'I' && strEQ(name, "INC"))
427 global = TRUE;
428 }
429 else if (*name > 'A') {
430 if (*name == 'E' && strEQ(name, "ENV"))
431 global = TRUE;
432 }
433 else if (*name == 'A' && (
434 strEQ(name, "ARGV") ||
435 strEQ(name, "ARGVOUT") ))
436 global = TRUE;
437 }
438 else if (*name == '_' && !name[1])
439 global = TRUE;
440 if (global)
441 stash = defstash;
85e6fe83 442 else if ((COP*)curcop == &compiling) {
a0d0e21e 443 stash = curstash;
748a9306
LW
444 if (add && (hints & HINT_STRICT_VARS) &&
445 sv_type != SVt_PVCV &&
446 sv_type != SVt_PVGV &&
4633a7c4 447 sv_type != SVt_PVFM &&
c07a80fd 448 sv_type != SVt_PVIO &&
377b8fbc 449 !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
748a9306 450 {
4633a7c4
LW
451 gvp = (GV**)hv_fetch(stash,name,len,0);
452 if (!gvp ||
a5f75d66
AD
453 *gvp == (GV*)&sv_undef ||
454 SvTYPE(*gvp) != SVt_PVGV)
455 {
4633a7c4 456 stash = 0;
a5f75d66
AD
457 }
458 else if (sv_type == SVt_PV && !GvIMPORTED_SV(*gvp) ||
459 sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) ||
460 sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) )
4633a7c4 461 {
a5f75d66 462 warn("Variable \"%c%s\" is not imported",
4633a7c4
LW
463 sv_type == SVt_PVAV ? '@' :
464 sv_type == SVt_PVHV ? '%' : '$',
465 name);
8ebc5c01 466 if (GvCVu(*gvp))
4633a7c4 467 warn("(Did you mean &%s instead?)\n", name);
a0d0e21e 468 stash = 0;
4633a7c4 469 }
a0d0e21e 470 }
85e6fe83 471 }
463ee0b2
LW
472 else
473 stash = curcop->cop_stash;
474 }
475 else
476 stash = defstash;
477 }
478
479 /* By this point we should have a stash and a name */
480
a0d0e21e
LW
481 if (!stash) {
482 if (add) {
483 warn("Global symbol \"%s\" requires explicit package name", name);
484 ++error_count;
485 stash = curstash ? curstash : defstash; /* avoid core dumps */
486 }
487 else
488 return Nullgv;
489 }
490
491 if (!SvREFCNT(stash)) /* symbol table under destruction */
492 return Nullgv;
493
79072805
LW
494 gvp = (GV**)hv_fetch(stash,name,len,add);
495 if (!gvp || *gvp == (GV*)&sv_undef)
496 return Nullgv;
497 gv = *gvp;
498 if (SvTYPE(gv) == SVt_PVGV) {
a0d0e21e 499 if (add) {
a5f75d66 500 GvMULTI_on(gv);
a0d0e21e
LW
501 gv_init_sv(gv, sv_type);
502 }
79072805
LW
503 return gv;
504 }
93a17b20
LW
505
506 /* Adding a new symbol */
507
a0d0e21e
LW
508 if (add & 4)
509 warn("Had to create %s unexpectedly", nambeg);
463ee0b2 510 gv_init(gv, stash, name, len, add & 2);
a0d0e21e 511 gv_init_sv(gv, sv_type);
93a17b20
LW
512
513 /* set up magic where warranted */
514 switch (*name) {
a0d0e21e
LW
515 case 'A':
516 if (strEQ(name, "ARGV")) {
517 IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
518 }
519 break;
520
ed6116ce
LW
521 case 'a':
522 case 'b':
523 if (len == 1)
a5f75d66 524 GvMULTI_on(gv);
ed6116ce 525 break;
a0d0e21e
LW
526 case 'E':
527 if (strnEQ(name, "EXPORT", 6))
a5f75d66 528 GvMULTI_on(gv);
a0d0e21e 529 break;
463ee0b2
LW
530 case 'I':
531 if (strEQ(name, "ISA")) {
532 AV* av = GvAVn(gv);
a5f75d66 533 GvMULTI_on(gv);
a0d0e21e
LW
534 sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
535 if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1)
85e6fe83 536 {
a0d0e21e
LW
537 char *pname;
538 av_push(av, newSVpv(pname = "NDBM_File",0));
dc437b57 539 gv_stashpvn(pname, 9, TRUE);
a0d0e21e 540 av_push(av, newSVpv(pname = "DB_File",0));
dc437b57 541 gv_stashpvn(pname, 7, TRUE);
a0d0e21e 542 av_push(av, newSVpv(pname = "GDBM_File",0));
dc437b57 543 gv_stashpvn(pname, 9, TRUE);
a0d0e21e 544 av_push(av, newSVpv(pname = "SDBM_File",0));
dc437b57 545 gv_stashpvn(pname, 9, TRUE);
a0d0e21e 546 av_push(av, newSVpv(pname = "ODBM_File",0));
dc437b57 547 gv_stashpvn(pname, 9, TRUE);
85e6fe83 548 }
463ee0b2
LW
549 }
550 break;
a0d0e21e
LW
551#ifdef OVERLOAD
552 case 'O':
553 if (strEQ(name, "OVERLOAD")) {
554 HV* hv = GvHVn(gv);
a5f75d66 555 GvMULTI_on(gv);
a0d0e21e
LW
556 sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0);
557 }
558 break;
559#endif /* OVERLOAD */
93a17b20
LW
560 case 'S':
561 if (strEQ(name, "SIG")) {
562 HV *hv;
dc437b57 563 I32 i;
93a17b20 564 siggv = gv;
a5f75d66 565 GvMULTI_on(siggv);
93a17b20
LW
566 hv = GvHVn(siggv);
567 hv_magic(hv, siggv, 'S');
dc437b57
PP
568 for(i=1;sig_name[i];i++) {
569 SV ** init;
570 init=hv_fetch(hv,sig_name[i],strlen(sig_name[i]),1);
571 if(init)
572 sv_setsv(*init,&sv_undef);
573 psig_ptr[i] = 0;
574 psig_name[i] = 0;
575 }
93a17b20
LW
576 /* initialize signal stack */
577 signalstack = newAV();
93a17b20 578 AvREAL_off(signalstack);
a0d0e21e
LW
579 av_extend(signalstack, 30);
580 av_fill(signalstack, 0);
93a17b20
LW
581 }
582 break;
583
584 case '&':
463ee0b2
LW
585 if (len > 1)
586 break;
93a17b20
LW
587 ampergv = gv;
588 sawampersand = TRUE;
a0d0e21e 589 goto ro_magicalize;
93a17b20
LW
590
591 case '`':
463ee0b2
LW
592 if (len > 1)
593 break;
93a17b20
LW
594 leftgv = gv;
595 sawampersand = TRUE;
a0d0e21e 596 goto ro_magicalize;
93a17b20
LW
597
598 case '\'':
463ee0b2
LW
599 if (len > 1)
600 break;
93a17b20
LW
601 rightgv = gv;
602 sawampersand = TRUE;
a0d0e21e 603 goto ro_magicalize;
93a17b20
LW
604
605 case ':':
463ee0b2
LW
606 if (len > 1)
607 break;
93a17b20
LW
608 sv_setpv(GvSV(gv),chopset);
609 goto magicalize;
610
93a17b20 611 case '#':
a0d0e21e
LW
612 case '*':
613 if (dowarn && len == 1 && sv_type == SVt_PV)
614 warn("Use of $%s is deprecated", name);
615 /* FALL THROUGH */
616 case '[':
617 case '!':
93a17b20
LW
618 case '?':
619 case '^':
620 case '~':
621 case '=':
622 case '-':
623 case '%':
624 case '.':
93a17b20
LW
625 case '(':
626 case ')':
627 case '<':
628 case '>':
629 case ',':
630 case '\\':
631 case '/':
93a17b20 632 case '|':
748a9306 633 case '\001':
93a17b20 634 case '\004':
ad8898e0 635 case '\005':
748a9306 636 case '\006':
a0d0e21e 637 case '\010':
ad8898e0 638 case '\017':
93a17b20
LW
639 case '\t':
640 case '\020':
641 case '\024':
642 case '\027':
463ee0b2
LW
643 if (len > 1)
644 break;
645 goto magicalize;
646
a0d0e21e 647 case '+':
463ee0b2
LW
648 case '1':
649 case '2':
650 case '3':
651 case '4':
652 case '5':
653 case '6':
654 case '7':
655 case '8':
656 case '9':
a0d0e21e
LW
657 ro_magicalize:
658 SvREADONLY_on(GvSV(gv));
93a17b20 659 magicalize:
463ee0b2 660 sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
93a17b20
LW
661 break;
662
663 case '\014':
463ee0b2
LW
664 if (len > 1)
665 break;
93a17b20
LW
666 sv_setpv(GvSV(gv),"\f");
667 formfeed = GvSV(gv);
668 break;
669 case ';':
463ee0b2
LW
670 if (len > 1)
671 break;
93a17b20
LW
672 sv_setpv(GvSV(gv),"\034");
673 break;
463ee0b2
LW
674 case ']':
675 if (len == 1) {
93a17b20
LW
676 SV *sv;
677 sv = GvSV(gv);
678 sv_upgrade(sv, SVt_PVNV);
a0d0e21e 679 sv_setpv(sv, patchlevel);
93a17b20
LW
680 }
681 break;
79072805 682 }
93a17b20 683 return gv;
79072805
LW
684}
685
686void
f6aff53a 687gv_fullname3(sv, gv, prefix)
79072805
LW
688SV *sv;
689GV *gv;
f967eb5f 690char *prefix;
79072805
LW
691{
692 HV *hv = GvSTASH(gv);
f967eb5f
PP
693 if (!hv) {
694 SvOK_off(sv);
79072805 695 return;
f967eb5f
PP
696 }
697 sv_setpv(sv, prefix ? prefix : "");
79072805 698 sv_catpv(sv,HvNAME(hv));
463ee0b2 699 sv_catpvn(sv,"::", 2);
79072805
LW
700 sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
701}
702
703void
f6aff53a 704gv_efullname3(sv, gv, prefix)
79072805
LW
705SV *sv;
706GV *gv;
f967eb5f 707char *prefix;
79072805 708{
f967eb5f 709 GV *egv = GvEGV(gv);
748a9306
LW
710 if (!egv)
711 egv = gv;
f6aff53a
PP
712 gv_fullname3(sv, egv, prefix);
713}
714
715/* XXX compatibility with versions <= 5.003. */
716void
717gv_fullname(sv,gv)
718SV *sv;
719GV *gv;
720{
721 gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : "");
722}
723
724/* XXX compatibility with versions <= 5.003. */
725void
726gv_efullname(sv,gv)
727SV *sv;
728GV *gv;
729{
730 gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : "");
79072805
LW
731}
732
733IO *
734newIO()
735{
736 IO *io;
8990e307
LW
737 GV *iogv;
738
739 io = (IO*)NEWSV(0,0);
a0d0e21e 740 sv_upgrade((SV *)io,SVt_PVIO);
8990e307
LW
741 SvREFCNT(io) = 1;
742 SvOBJECT_on(io);
dc437b57 743 iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
8990e307 744 SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
79072805
LW
745 return io;
746}
747
748void
463ee0b2
LW
749gv_check(stash)
750HV* stash;
79072805
LW
751{
752 register HE *entry;
753 register I32 i;
754 register GV *gv;
463ee0b2 755 HV *hv;
a0d0e21e 756 GV *filegv;
463ee0b2 757
8990e307
LW
758 if (!HvARRAY(stash))
759 return;
a0d0e21e 760 for (i = 0; i <= (I32) HvMAX(stash); i++) {
dc437b57
PP
761 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
762 if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
763 (gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv))
a0d0e21e
LW
764 {
765 if (hv != defstash)
766 gv_check(hv); /* nested package */
767 }
dc437b57
PP
768 else if (isALPHA(*HeKEY(entry))) {
769 gv = (GV*)HeVAL(entry);
a5f75d66 770 if (GvMULTI(gv))
463ee0b2
LW
771 continue;
772 curcop->cop_line = GvLINE(gv);
a0d0e21e
LW
773 filegv = GvFILEGV(gv);
774 curcop->cop_filegv = filegv;
a5f75d66 775 if (filegv && GvMULTI(filegv)) /* Filename began with slash */
8990e307 776 continue;
dc437b57 777 warn("Name \"%s::%s\" used only once: possible typo",
a0d0e21e 778 HvNAME(stash), GvNAME(gv));
463ee0b2 779 }
79072805
LW
780 }
781 }
782}
783
784GV *
a0d0e21e
LW
785newGVgen(pack)
786char *pack;
79072805 787{
a0d0e21e 788 (void)sprintf(tokenbuf,"%s::_GEN_%ld",pack,(long)gensym++);
85e6fe83 789 return gv_fetchpv(tokenbuf,TRUE, SVt_PVGV);
79072805
LW
790}
791
792/* hopefully this is only called on local symbol table entries */
793
794GP*
795gp_ref(gp)
796GP* gp;
797{
798 gp->gp_refcnt++;
799 return gp;
800
801}
802
803void
804gp_free(gv)
805GV* gv;
806{
79072805 807 GP* gp;
377b8fbc 808 CV* cv;
79072805
LW
809
810 if (!gv || !(gp = GvGP(gv)))
811 return;
812 if (gp->gp_refcnt == 0) {
813 warn("Attempt to free unreferenced glob pointers");
814 return;
815 }
748a9306
LW
816 if (--gp->gp_refcnt > 0) {
817 if (gp->gp_egv == gv)
818 gp->gp_egv = 0;
79072805 819 return;
748a9306 820 }
79072805 821
8990e307
LW
822 SvREFCNT_dec(gp->gp_sv);
823 SvREFCNT_dec(gp->gp_av);
824 SvREFCNT_dec(gp->gp_hv);
377b8fbc 825 SvREFCNT_dec(gp->gp_io);
a6006777 826 SvREFCNT_dec(gp->gp_cv);
748a9306
LW
827 SvREFCNT_dec(gp->gp_form);
828
79072805
LW
829 Safefree(gp);
830 GvGP(gv) = 0;
831}
832
833#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
834#define MICROPORT
835#endif
836
837#ifdef MICROPORT /* Microport 2.4 hack */
838AV *GvAVn(gv)
839register GV *gv;
840{
841 if (GvGP(gv)->gp_av)
842 return GvGP(gv)->gp_av;
843 else
844 return GvGP(gv_AVadd(gv))->gp_av;
845}
846
847HV *GvHVn(gv)
848register GV *gv;
849{
850 if (GvGP(gv)->gp_hv)
851 return GvGP(gv)->gp_hv;
852 else
853 return GvGP(gv_HVadd(gv))->gp_hv;
854}
855#endif /* Microport 2.4 hack */
a0d0e21e
LW
856
857#ifdef OVERLOAD
858/* Updates and caches the CV's */
859
860bool
861Gv_AMupdate(stash)
862HV* stash;
863{
864 GV** gvp;
865 HV* hv;
866 GV* gv;
867 CV* cv;
868 MAGIC* mg=mg_find((SV*)stash,'c');
748a9306 869 AMT *amtp=mg ? (AMT*)mg->mg_ptr: NULL;
a6006777 870 AMT amt;
a0d0e21e
LW
871
872 if (mg && (amtp=((AMT*)(mg->mg_ptr)))->was_ok_am == amagic_generation &&
873 amtp->was_ok_sub == sub_generation)
a6006777
PP
874 return AMT_AMAGIC(amtp);
875 if (amtp && AMT_AMAGIC(amtp)) { /* Have table. */
748a9306 876 int i;
a6006777 877 for (i=1; i<NofAMmeth; i++) {
748a9306
LW
878 if (amtp->table[i]) {
879 SvREFCNT_dec(amtp->table[i]);
880 }
881 }
882 }
a0d0e21e
LW
883 sv_unmagic((SV*)stash, 'c');
884
885 DEBUG_o( deb("Recalcing overload magic in package %s\n",HvNAME(stash)) );
886
a6006777
PP
887 amt.was_ok_am = amagic_generation;
888 amt.was_ok_sub = sub_generation;
889 amt.fallback = AMGfallNO;
890 amt.flags = 0;
891
892#ifdef OVERLOAD_VIA_HASH
893 gvp=(GV**)hv_fetch(stash,"OVERLOAD",8,FALSE); /* A shortcut */
a0d0e21e
LW
894 if (gvp && ((gv = *gvp) != (GV*)&sv_undef && (hv = GvHV(gv)))) {
895 int filled=0;
896 int i;
897 char *cp;
a0d0e21e
LW
898 SV* sv;
899 SV** svp;
a0d0e21e
LW
900
901 /* Work with "fallback" key, which we assume to be first in AMG_names */
902
a6006777
PP
903 if (( cp = (char *)AMG_names[0] ) &&
904 (svp = (SV**)hv_fetch(hv,cp,strlen(cp),FALSE)) && (sv = *svp)) {
a0d0e21e
LW
905 if (SvTRUE(sv)) amt.fallback=AMGfallYES;
906 else if (SvOK(sv)) amt.fallback=AMGfallNEVER;
907 }
a6006777
PP
908 for (i = 1; i < NofAMmeth; i++) {
909 cv = 0;
910 cp = (char *)AMG_names[i];
911
912 svp = (SV**)hv_fetch(hv, cp, strlen(cp), FALSE);
dc437b57 913 if (svp && ((sv = *svp) != &sv_undef)) {
a0d0e21e
LW
914 switch (SvTYPE(sv)) {
915 default:
916 if (!SvROK(sv)) {
917 if (!SvOK(sv)) break;
748a9306 918 gv = gv_fetchmethod(stash, SvPV(sv, na));
a0d0e21e
LW
919 if (gv) cv = GvCV(gv);
920 break;
921 }
922 cv = (CV*)SvRV(sv);
923 if (SvTYPE(cv) == SVt_PVCV)
924 break;
925 /* FALL THROUGH */
926 case SVt_PVHV:
927 case SVt_PVAV:
a6006777 928 croak("Not a subroutine reference in overload table");
a0d0e21e
LW
929 return FALSE;
930 case SVt_PVCV:
8ebc5c01
PP
931 cv = (CV*)sv;
932 break;
a0d0e21e 933 case SVt_PVGV:
8ebc5c01
PP
934 if (!(cv = GvCVu((GV*)sv)))
935 cv = sv_2cv(sv, &stash, &gv, TRUE);
936 break;
a0d0e21e
LW
937 }
938 if (cv) filled=1;
939 else {
a6006777 940 croak("Method for operation %s not found in package %.256s during blessing\n",
a0d0e21e
LW
941 cp,HvNAME(stash));
942 return FALSE;
943 }
944 }
a6006777
PP
945#else
946 {
947 int filled = 0;
948 int i;
949 char *cp;
950 SV* sv = NULL;
951 SV** svp;
952
953 /* Work with "fallback" key, which we assume to be first in AMG_names */
954
955 if ( cp = (char *)AMG_names[0] ) {
956 /* Try to find via inheritance. */
957 gv = gv_fetchmeth(stash, "()", 2, 0); /* A cooky: "()". */
958 if (gv) sv = GvSV(gv);
959
960 if (!sv) /* Empty */;
961 else if (SvTRUE(sv)) amt.fallback=AMGfallYES;
962 else if (SvOK(sv)) amt.fallback=AMGfallNEVER;
963 }
964
965 for (i = 1; i < NofAMmeth; i++) {
966 cv = 0;
967 cp = (char *)AMG_names[i];
968
969 *buf = '('; /* A cooky: "(". */
970 strcpy(buf + 1, cp);
971 gv = gv_fetchmeth(stash, buf, strlen(buf), 0); /* fills the stash! */
972 if(gv && (cv = GvCV(gv))) filled = 1;
973#endif
974 amt.table[i]=(CV*)SvREFCNT_inc(cv);
a0d0e21e 975 }
a0d0e21e 976 if (filled) {
a6006777
PP
977 AMT_AMAGIC_on(&amt);
978 sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMT));
a0d0e21e
LW
979 return TRUE;
980 }
981 }
a6006777
PP
982 /* Here we have no table: */
983 AMT_AMAGIC_off(&amt);
984 sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMTS));
a0d0e21e
LW
985 return FALSE;
986}
987
988/* During call to this subroutine stack can be reallocated. It is
989 * advised to call SPAGAIN macro in your code after call */
990
991SV*
992amagic_call(left,right,method,flags)
993SV* left;
994SV* right;
995int method;
996int flags;
997{
998 MAGIC *mg;
999 CV *cv;
1000 CV **cvp=NULL, **ocvp=NULL;
1001 AMT *amtp, *oamtp;
1002 int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
748a9306 1003 int postpr=0, inc_dec_ass=0, assignshift=assign?1:0;
a0d0e21e
LW
1004 HV* stash;
1005 if (!(AMGf_noleft & flags) && SvAMAGIC(left)
1006 && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c'))
a6006777
PP
1007 && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
1008 ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
1009 : NULL))
748a9306
LW
1010 && ((cv = cvp[off=method+assignshift])
1011 || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
1012 * usual method */
1013 (fl = 1, cv = cvp[off=method])))) {
a0d0e21e
LW
1014 lr = -1; /* Call method for left argument */
1015 } else {
1016 if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) {
1017 int logic;
1018
1019 /* look for substituted methods */
1020 switch (method) {
1021 case inc_amg:
748a9306 1022 if (((cv = cvp[off=add_ass_amg]) && (inc_dec_ass=1))
a0d0e21e
LW
1023 || ((cv = cvp[off=add_amg]) && (postpr=1))) {
1024 right = &sv_yes; lr = -1; assign = 1;
1025 }
1026 break;
1027 case dec_amg:
748a9306 1028 if (((cv = cvp[off=subtr_ass_amg]) && (inc_dec_ass=1))
a0d0e21e
LW
1029 || ((cv = cvp[off=subtr_amg]) && (postpr=1))) {
1030 right = &sv_yes; lr = -1; assign = 1;
1031 }
1032 break;
1033 case bool__amg:
1034 (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=string_amg]));
1035 break;
1036 case numer_amg:
1037 (void)((cv = cvp[off=string_amg]) || (cv = cvp[off=bool__amg]));
1038 break;
1039 case string_amg:
1040 (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg]));
1041 break;
dc437b57
PP
1042 case not_amg:
1043 (void)((cv = cvp[off=bool__amg])
1044 || (cv = cvp[off=numer_amg])
1045 || (cv = cvp[off=string_amg]));
1046 postpr = 1;
1047 break;
748a9306
LW
1048 case copy_amg:
1049 {
1050 SV* ref=SvRV(left);
1051 if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) { /* Just to be
1052 * extra
1053 * causious,
1054 * maybe in some
1055 * additional
1056 * cases sv_setsv
1057 * is safe too */
1058 SV* newref = newSVsv(ref);
1059 SvOBJECT_on(newref);
1060 SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref));
1061 return newref;
1062 }
1063 }
1064 break;
a0d0e21e 1065 case abs_amg:
748a9306 1066 if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg])
a0d0e21e 1067 && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
748a9306 1068 SV* nullsv=sv_2mortal(newSViv(0));
a0d0e21e 1069 if (off1==lt_amg) {
748a9306 1070 SV* lessp = amagic_call(left,nullsv,
a0d0e21e
LW
1071 lt_amg,AMGf_noright);
1072 logic = SvTRUE(lessp);
1073 } else {
748a9306 1074 SV* lessp = amagic_call(left,nullsv,
a0d0e21e
LW
1075 ncmp_amg,AMGf_noright);
1076 logic = (SvNV(lessp) < 0);
1077 }
1078 if (logic) {
1079 if (off==subtr_amg) {
1080 right = left;
748a9306 1081 left = nullsv;
a0d0e21e
LW
1082 lr = 1;
1083 }
1084 } else {
1085 return left;
1086 }
1087 }
1088 break;
1089 case neg_amg:
1090 if (cv = cvp[off=subtr_amg]) {
1091 right = left;
1092 left = sv_2mortal(newSViv(0));
1093 lr = 1;
1094 }
1095 break;
1096 default:
1097 goto not_found;
1098 }
1099 if (!cv) goto not_found;
1100 } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
1101 && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c'))
a6006777
PP
1102 && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
1103 ? (amtp = (AMT*)mg->mg_ptr)->table
1104 : NULL))
a0d0e21e
LW
1105 && (cv = cvp[off=method])) { /* Method for right
1106 * argument found */
1107 lr=1;
748a9306 1108 } else if (((ocvp && oamtp->fallback > AMGfallNEVER
4633a7c4 1109 && (cvp=ocvp) && (lr = -1))
a0d0e21e
LW
1110 || (cvp && amtp->fallback > AMGfallNEVER && (lr=1)))
1111 && !(flags & AMGf_unary)) {
1112 /* We look for substitution for
1113 * comparison operations and
1114 * concatendation */
1115 if (method==concat_amg || method==concat_ass_amg
1116 || method==repeat_amg || method==repeat_ass_amg) {
1117 return NULL; /* Delegate operation to string conversion */
1118 }
1119 off = -1;
1120 switch (method) {
1121 case lt_amg:
1122 case le_amg:
1123 case gt_amg:
1124 case ge_amg:
1125 case eq_amg:
1126 case ne_amg:
1127 postpr = 1; off=ncmp_amg; break;
1128 case slt_amg:
1129 case sle_amg:
1130 case sgt_amg:
1131 case sge_amg:
1132 case seq_amg:
1133 case sne_amg:
1134 postpr = 1; off=scmp_amg; break;
1135 }
1136 if (off != -1) cv = cvp[off];
1137 if (!cv) {
1138 goto not_found;
1139 }
1140 } else {
a6006777 1141 not_found: /* No method found, either report or croak */
a0d0e21e
LW
1142 if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */
1143 notfound = 1; lr = -1;
1144 } else if (cvp && (cv=cvp[nomethod_amg])) {
1145 notfound = 1; lr = 1;
1146 } else {
748a9306 1147 if (off==-1) off=method;
06b43eb7 1148 sprintf(buf, "Operation `%s': no method found,\n\tleft argument %s%.256s,\n\tright argument %s%.256s",
a6006777 1149 AMG_names[method + assignshift],
a0d0e21e
LW
1150 SvAMAGIC(left)?
1151 "in overloaded package ":
1152 "has no overloaded magic",
1153 SvAMAGIC(left)?
1154 HvNAME(SvSTASH(SvRV(left))):
1155 "",
1156 SvAMAGIC(right)?
1157 "in overloaded package ":
1158 "has no overloaded magic",
1159 SvAMAGIC(right)?
1160 HvNAME(SvSTASH(SvRV(right))):
1161 "");
1162 if (amtp && amtp->fallback >= AMGfallYES) {
06b43eb7 1163 DEBUG_o( deb(buf) );
a0d0e21e 1164 } else {
a6006777 1165 croak(buf);
a0d0e21e
LW
1166 }
1167 return NULL;
1168 }
1169 }
1170 }
1171 if (!notfound) {
06b43eb7 1172 DEBUG_o( deb("Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
a6006777 1173 AMG_names[off],
748a9306
LW
1174 method+assignshift==off? "" :
1175 " (initially `",
1176 method+assignshift==off? "" :
a6006777 1177 AMG_names[method+assignshift],
748a9306
LW
1178 method+assignshift==off? "" : "')",
1179 flags & AMGf_unary? "" :
1180 lr==1 ? " for right argument": " for left argument",
1181 flags & AMGf_unary? " for argument" : "",
a0d0e21e
LW
1182 HvNAME(stash),
1183 fl? ",\n\tassignment variant used": "") );
748a9306
LW
1184 /* Since we use shallow copy during assignment, we need
1185 * to dublicate the contents, probably calling user-supplied
1186 * version of copy operator
1187 */
c07a80fd 1188 if ((method + assignshift==off
748a9306
LW
1189 && (assign || method==inc_amg || method==dec_amg))
1190 || inc_dec_ass) RvDEEPCP(left);
a0d0e21e
LW
1191 }
1192 {
1193 dSP;
1194 BINOP myop;
1195 SV* res;
1196
1197 Zero(&myop, 1, BINOP);
1198 myop.op_last = (OP *) &myop;
1199 myop.op_next = Nullop;
1200 myop.op_flags = OPf_KNOW|OPf_STACKED;
1201
1202 ENTER;
1203 SAVESPTR(op);
1204 op = (OP *) &myop;
dc437b57
PP
1205 if (perldb && curstash != debstash)
1206 op->op_private |= OPpENTERSUB_DB;
a0d0e21e
LW
1207 PUTBACK;
1208 pp_pushmark();
1209
1210 EXTEND(sp, notfound + 5);
1211 PUSHs(lr>0? right: left);
1212 PUSHs(lr>0? left: right);
1213 PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no));
1214 if (notfound) {
a6006777 1215 PUSHs( sv_2mortal(newSVpv((char *)AMG_names[method + assignshift],0)) );
a0d0e21e
LW
1216 }
1217 PUSHs((SV*)cv);
1218 PUTBACK;
1219
1220 if (op = pp_entersub())
ad8898e0 1221 runops();
a0d0e21e
LW
1222 LEAVE;
1223 SPAGAIN;
1224
1225 res=POPs;
1226 PUTBACK;
1227
1228 if (notfound) {
1229 /* sv_2mortal(res); */
1230 return NULL;
1231 }
1232
1233 if (postpr) {
1234 int ans;
1235 switch (method) {
1236 case le_amg:
1237 case sle_amg:
1238 ans=SvIV(res)<=0; break;
1239 case lt_amg:
1240 case slt_amg:
1241 ans=SvIV(res)<0; break;
1242 case ge_amg:
1243 case sge_amg:
1244 ans=SvIV(res)>=0; break;
1245 case gt_amg:
1246 case sgt_amg:
1247 ans=SvIV(res)>0; break;
1248 case eq_amg:
1249 case seq_amg:
1250 ans=SvIV(res)==0; break;
1251 case ne_amg:
1252 case sne_amg:
1253 ans=SvIV(res)!=0; break;
1254 case inc_amg:
1255 case dec_amg:
bbce6d69 1256 SvSetSV(left,res); return left;
dc437b57
PP
1257 case not_amg:
1258ans=!SvOK(res); break;
a0d0e21e
LW
1259 }
1260 return ans? &sv_yes: &sv_no;
748a9306
LW
1261 } else if (method==copy_amg) {
1262 if (!SvROK(res)) {
a6006777 1263 croak("Copy method did not return a reference");
748a9306
LW
1264 }
1265 return SvREFCNT_inc(SvRV(res));
a0d0e21e
LW
1266 } else {
1267 return res;
1268 }
1269 }
1270}
1271#endif /* OVERLOAD */