https://perl5.git.perl.org / perl5.git / blame
| Commit | Line | Data |
|---|---|---|
| f4c6fd49 RGS |
1 | void |
| 2 | constant(sv) | |
| 3 | PREINIT: | |
| 4 | #ifdef dXSTARG | |
| 5 | dXSTARG; /* Faster if we have it. */ | |
| 6 | #else | |
| 7 | dTARGET; | |
| 8 | #endif | |
| 9 | STRLEN len; | |
| 10 | int type; | |
| 11 | IV iv; | |
| 12 | /* NV nv; Uncomment this if you need to return NVs */ | |
| 13 | const char *pv; | |
| 14 | INPUT: | |
| 15 | SV * sv; | |
| 16 | const char * s = SvPV(sv, len); | |
| 17 | PPCODE: | |
| 18 | /* Change this to constant(aTHX_ s, len, &iv, &nv); | |
| 19 | if you need to return both NVs and IVs */ | |
| 20 | type = constant(aTHX_ s, len, &iv, &pv); | |
| 21 | /* Return 1 or 2 items. First is error message, or undef if no error. | |
| 22 | Second, if present, is found value */ | |
| 23 | switch (type) { | |
| 24 | case PERL_constant_NOTFOUND: | |
| 25 | sv = sv_2mortal(newSVpvf("%s is not a valid Zlib macro", s)); | |
| 26 | PUSHs(sv); | |
| 27 | break; | |
| 28 | case PERL_constant_NOTDEF: | |
| 29 | sv = sv_2mortal(newSVpvf( | |
| 30 | "Your vendor has not defined Zlib macro %s, used", s)); | |
| 31 | PUSHs(sv); | |
| 32 | break; | |
| 33 | case PERL_constant_ISIV: | |
| 34 | EXTEND(SP, 1); | |
| 35 | PUSHs(&PL_sv_undef); | |
| 36 | PUSHi(iv); | |
| 37 | break; | |
| 38 | /* Uncomment this if you need to return NOs | |
| 39 | case PERL_constant_ISNO: | |
| 40 | EXTEND(SP, 1); | |
| 41 | PUSHs(&PL_sv_undef); | |
| 42 | PUSHs(&PL_sv_no); | |
| 43 | break; */ | |
| 44 | /* Uncomment this if you need to return NVs | |
| 45 | case PERL_constant_ISNV: | |
| 46 | EXTEND(SP, 1); | |
| 47 | PUSHs(&PL_sv_undef); | |
| 48 | PUSHn(nv); | |
| 49 | break; */ | |
| 50 | case PERL_constant_ISPV: | |
| 51 | EXTEND(SP, 1); | |
| 52 | PUSHs(&PL_sv_undef); | |
| 53 | PUSHp(pv, strlen(pv)); | |
| 54 | break; | |
| 55 | /* Uncomment this if you need to return PVNs | |
| 56 | case PERL_constant_ISPVN: | |
| 57 | EXTEND(SP, 1); | |
| 58 | PUSHs(&PL_sv_undef); | |
| 59 | PUSHp(pv, iv); | |
| 60 | break; */ | |
| 61 | /* Uncomment this if you need to return SVs | |
| 62 | case PERL_constant_ISSV: | |
| 63 | EXTEND(SP, 1); | |
| 64 | PUSHs(&PL_sv_undef); | |
| 65 | PUSHs(sv); | |
| 66 | break; */ | |
| 67 | /* Uncomment this if you need to return UNDEFs | |
| 68 | case PERL_constant_ISUNDEF: | |
| 69 | break; */ | |
| 70 | /* Uncomment this if you need to return UVs | |
| 71 | case PERL_constant_ISUV: | |
| 72 | EXTEND(SP, 1); | |
| 73 | PUSHs(&PL_sv_undef); | |
| 74 | PUSHu((UV)iv); | |
| 75 | break; */ | |
| 76 | /* Uncomment this if you need to return YESs | |
| 77 | case PERL_constant_ISYES: | |
| 78 | EXTEND(SP, 1); | |
| 79 | PUSHs(&PL_sv_undef); | |
| 80 | PUSHs(&PL_sv_yes); | |
| 81 | break; */ | |
| 82 | default: | |
| 83 | sv = sv_2mortal(newSVpvf( | |
| 84 | "Unexpected return type %d while processing Zlib macro %s, used", | |
| 85 | type, s)); | |
| 86 | PUSHs(sv); | |
| 87 | } |