Front page | perl.perl5.porters |
Postings from July 2016
Correct way to access %^H from XS?
Thread Next
From:
Maxwell Carey
Date:
July 11, 2016 20:39
Subject:
Correct way to access %^H from XS?
Message ID:
CADLEpY6M76NNq6yJGh45QfrAsGP3K5nAHjAcTwCV25nxbvALBQ@mail.gmail.com
I'm trying to access %^H from XS code. I've looked at several examples on
CPAN, but they all do it differently, and all seem to fail for $^H{key} = 0.
Here is my .pm (I know it should be lowercase foo since it's a pragma but I
already made the example):
########################################################################
$ cat lib/Foo.pm
package Foo;
use 5.024000;
use strict;
use warnings;
our $VERSION = '0.01';
require XSLoader;
XSLoader::load('Foo', $VERSION);
sub import {
$^H{'Foo/bar'} = 1;
}
sub unimport {
$^H{'Foo/bar'} = 0;
}
1;
########################################################################
Here's some XS based on what re::engine::GNU does:
########################################################################
$ cat Foo.xs.GNU
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
SV* barkey_sv;
int key2int(pTHX_ const char *key, SV * const key_sv) {
if (GvHV(PL_hintgv) && (PL_hints & HINT_LOCALIZE_HH) ==
HINT_LOCALIZE_HH) {
HE* const he = hv_fetch_ent(GvHV(PL_hintgv), key_sv, FALSE, 0U);
if (he != NULL) {
SV* val = HeVAL(he);
if (val != &PL_sv_placeholder) {
return (int)SvIV(val);
}
}
}
return 0;
}
MODULE = Foo PACKAGE = Foo
BOOT:
barkey_sv = newSVpvs_share("Foo/bar");
void
print_key()
CODE:
printf("Value: %d\n", key2int(aTHX_ "Foo/bar", barkey_sv));
########################################################################
And the output:
########################################################################
$ perl -MExtUtils::testlib -e'use Foo; Foo::print_key; no Foo;
Foo::print_key; use Foo; Foo::print_key'
Value: 0
Value: 0
Value: 0
########################################################################
XS based on re::engine::RE2:
########################################################################
$ cat Foo.xs.RE2
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
MODULE = Foo PACKAGE = Foo
void
print_key()
CODE:
SV *const bar = cophh_fetch_pvs(PL_curcop->cop_hints_hash,
"Foo/bar", 0);
if (SvOK(bar) && SvIV_nomg(bar)) {
printf("Value: %d\n", SvIV(bar));
}
else {
printf("Value: -1\n");
}
########################################################################
Output:
########################################################################
$ perl -MExtUtils::testlib -e'use Foo; Foo::print_key; no Foo;
Foo::print_key; use Foo; Foo::print_key'
Value: 1
Value: -1
Value: 1
########################################################################
XS based on re::engine::TRE:
########################################################################
$ cat Foo.xs.TRE
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
I32
get_hint(const char *key, I32 def) {
#if ((PERL_VERSION >= 13) && (PERL_SUBVERSION >= 7)) || (PERL_VERSION >= 14)
SV *const val = cophh_fetch_pvn(PL_curcop->cop_hints_hash, key,
strlen(key), 0, 0);
#else
SV *const val = Perl_refcounted_he_fetch(aTHX_
PL_curcop->cop_hints_hash, Nullsv, key, strlen(key), 0, 0);
#endif
if (SvOK(val) && SvIV_nomg(val)) {
return SvIV(val);
}
else {
return def;
}
}
MODULE = Foo PACKAGE = Foo
void
print_key()
CODE:
printf("Value: %d\n", get_hint("Foo/bar", -1));
########################################################################
Output:
########################################################################
$ perl -MExtUtils::testlib -e'use Foo; Foo::print_key; no Foo;
Foo::print_key; use Foo; Foo::print_key'
Value: 1
Value: -1
Value: 1
########################################################################
If I change the value in Foo::unimport from 0 to 2, both the
re::engine::RE2 version and re::engine::TRE version output the values 1, 2,
1, as expected.
So, the GNU approach always fails, the RE2 and TRE approaches fail when
$^H{key} is zero, and the RE2 and TRE approaches use experimental
cophh_fetch_pv* functions that perlapi says could be changed at any time.
I wouldn't be surprised if I'm doing something wrong, but what is the
correct way to read values of %^H in XS code?
Thread Next
-
Correct way to access %^H from XS?
by Maxwell Carey