develooper 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


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About