https://perl5.git.perl.org / perl5.git / blame
| Commit | Line | Data |
|---|---|---|
| f2ab5a41 MHM |
1 | ################################################################################ |
| 2 | ## | |
| c07deaaf | 3 | ## $Revision: 3 $ |
| f2ab5a41 | 4 | ## $Author: mhx $ |
| c07deaaf | 5 | ## $Date: 2006/05/22 12:27:50 +0200 $ |
| f2ab5a41 MHM |
6 | ## |
| 7 | ################################################################################ | |
| 8 | ## | |
| 9 | ## Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz. | |
| 10 | ## Version 2.x, Copyright (C) 2001, Paul Marquess. | |
| 11 | ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. | |
| 12 | ## | |
| 13 | ## This program is free software; you can redistribute it and/or | |
| 14 | ## modify it under the same terms as Perl itself. | |
| 15 | ## | |
| 16 | ################################################################################ | |
| 17 | ||
| 18 | =provides | |
| 19 | ||
| 20 | __UNDEFINED__ | |
| 21 | ||
| 22 | =implementation | |
| 23 | ||
| 24 | /* concatenating with "" ensures that only literal strings are accepted as argument | |
| 25 | * note that STR_WITH_LEN() can't be used as argument to macros or functions that | |
| 26 | * under some configurations might be macros | |
| 27 | */ | |
| 28 | ||
| 29 | __UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1) | |
| 30 | ||
| 31 | __UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) | |
| 32 | __UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) | |
| 33 | __UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) | |
| c07deaaf MHM |
34 | __UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) |
| 35 | __UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) | |
| f2ab5a41 MHM |
36 | |
| 37 | =xsubs | |
| 38 | ||
| 39 | void | |
| 40 | newSVpvs() | |
| 41 | PPCODE: | |
| 42 | XPUSHs(newSVpvs("newSVpvs")); | |
| 43 | XSRETURN(1); | |
| 44 | ||
| 45 | void | |
| 46 | sv_catpvs(sv) | |
| 47 | SV *sv | |
| 48 | PPCODE: | |
| 49 | sv_catpvs(sv, "sv_catpvs"); | |
| 50 | ||
| 51 | void | |
| 52 | sv_setpvs(sv) | |
| 53 | SV *sv | |
| 54 | PPCODE: | |
| 55 | sv_setpvs(sv, "sv_setpvs"); | |
| 56 | ||
| 57 | void | |
| 58 | hv_fetchs(hv) | |
| 59 | SV *hv | |
| 60 | PREINIT: | |
| 61 | SV **s; | |
| 62 | PPCODE: | |
| 63 | s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0); | |
| 64 | XPUSHs(sv_mortalcopy(*s)); | |
| 65 | XSRETURN(1); | |
| 66 | ||
| 67 | void | |
| 68 | hv_stores(hv, sv) | |
| 69 | SV *hv | |
| 70 | SV *sv | |
| 71 | PPCODE: | |
| c07deaaf | 72 | hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc(sv)); |
| f2ab5a41 MHM |
73 | |
| 74 | =tests plan => 7 | |
| 75 | ||
| 76 | my $x = 'foo'; | |
| 77 | ||
| 78 | ok(Devel::PPPort::newSVpvs(), "newSVpvs"); | |
| 79 | ||
| 80 | Devel::PPPort::sv_catpvs($x); | |
| 81 | ok($x, "foosv_catpvs"); | |
| 82 | ||
| 83 | Devel::PPPort::sv_setpvs($x); | |
| 84 | ok($x, "sv_setpvs"); | |
| 85 | ||
| 86 | my %h = ('hv_fetchs' => 42); | |
| 87 | Devel::PPPort::hv_stores(\%h, 4711); | |
| 88 | ok(scalar keys %h, 2); | |
| 89 | ok(exists $h{'hv_stores'}); | |
| 90 | ok($h{'hv_stores'}, 4711); | |
| 91 | ok(Devel::PPPort::hv_fetchs(\%h), 42); |