On Dec 8, 9:43 pm, [EMAIL PROTECTED] (Allswellthatendswell)
wrote:
> Hello. I read Alexander Kolbasov's excellent blog on the pitfalls
> of Perl XS with enums. I used the following xs_test.h and got
> Alexander's h2xs fixes to work the way the blog described.
>
> // xs_test.h
> typedef enum mdNameNameHints {
> NameFull=1,
> NameInverse=2,
> NameGovernmentInverse=4,
> NameMixedFirst=8,
> NameMixedLast=16} xst_NameHints_t;
>
> I am now trying to call a C function by passing in one of these enum
> values in perl 5.8.8. This is the perl script:
>
> use mdNamePerl;
> my $g;
> #Create
> mdName Object$g=&mdNamePerl::mdNameCreate();
> &mdNamePerl::mdNameSetPrimaryNameHint($g,NameFull);
>
> mdNamePerl is a Perl XS application which glues a C/C++ application
> together with Perl.
>
> The C prototype I am trying to access is :
> MDAPI int __stdcall mdNameSetPrimaryNameHint(mdName, enum
> mdNameNameHints);
>
> In the typemap, I have mapped enum mdNameNameHints to a T_IV(integer)
> but when I run this perl program I get the error : Argument "NameFull"
> isn't numeric in entersub at test.pl line 66, <CONFIG> chunk 39.
>
> Does anyone have any ideas how I can pass the enumeration NameFull
> to the perl subroutine call correctly given that I have
> implemented(hopefully correctly) the h2xs fixes in Alexander's
> blog ,"Pitfals of the Perl XS or what to do when things do not work as
> advertised"? Thank you very much.
I have found out the source of the problem. Yesterday, I was running
my tests on a Sun Solaris 8 which did not have have the perl package
ExtUtils::Constant installed. Today, I changed to Red Hat Enterprise
Linux 5.1 which has the perl package ExtUtils::Constant installed.
Thank you.
Here is my Perl test program and the MakeFile.PL
#XS-Test1.t
# Before `make install' is performed this script should be runnable
with
# `make test'. After `make install' it should work as `perl XS-
Test1.t'
# change 'tests => 2' to 'tests => last_test_to_print';
use Test::More tests => 22;
BEGIN { use_ok('XS::Test1') };
my $fail = 0;
foreach my $constname (qw(
Aggressive Blank ConfigFile Conservative DatabaseExpired Female
FirstLast Formal Informal Male Mixed NameFull NameGovernmentInverse
NameInverse NameMixedFirst NameMixedLast Neutral NoError Slug
Unknown)) {
next if (eval "my \$a = $constname; 1");
if ($@ =~ /^Your vendor has not defined XS::Test1 macro $constname/)
{
print "# pass: $@";
} else {
print "# fail: $@";
$fail = 1;
}
}
ok( $fail == 0 , 'Constants' );
########################
# Insert your test code below, the Test::More module is use()ed here
so read
# its man page ( perldoc Test::More ) for help writing this test
script.
is(NoError,0);
is(ConfigFile,1);
is(DatabaseExpired,2);
is(Unknown,3);
is(NameFull,1);
is(NameInverse,2);
is(NameGovernmentInverse,4);
is(NameMixedFirst,8);
is(NameMixedLast,16);
is(Male,1);
is(Mixed,2);
is(Female,3);
is(Aggressive,1);
is(Neutral,2);
is(Conservative,3);
is(Formal,0);
is(Informal,1);
is(FirstLast,2);
is(Slug,3);
is(Blank,4);
my $record;
my $g;
#Create mdName Object
$g=&XS::Test1::mdNameCreate();
#Set Master License String
&XS::Test1::mdNameSetLicenseString($g,"b1cac9c8cfcc0162");
#Set Path to Name File
&XS::Test1::mdNameSetPathToNameFiles($g,"/home/frankc/Test/
mdNameTest/Distribution");
if(&XS::Test1::mdNameInitializeDataFiles($g) != NoError)
{
diag( "Failed to Initialize mdName::mdName ".
&XS::Test1::mdNameGetInitializeErrorString($g)."\n");
}
#Check build number method
diag( "Build Number: " .&XS::Test1::mdNameGetBuildNumber($g).
"\n") ;
#Database Date
diag( "Database Date: " .&XS::Test1::mdNameGetDatabaseDate($g).
"\n");
#Check expiration date
diag( "Expiration Date: " .&XS::Test1::mdNameGetExpirationDate($g).
"\n");
&XS::Test1::mdNameSetFirstNameSpellingCorrection($g,1);
# open file handle
open CONFIG, "/home/frankc/Test/mdNameTest/Distribution/DemoData/
mdName.sdf";
while ($record = <CONFIG>) {
$record =~ s/^\s+//; #remove leading whitespaces
$record =~ s/\s+$//; #remove trailing whitespaces
diag( "FullName: " .$record. "\n");
&XS::Test1::mdNameClearProperties($g);
&XS::Test1::mdNameSetFullName($g,$record);
&XS::Test1::mdNameSetPrimaryNameHint($g,NameFull);
&XS::Test1::mdNameSetSecondaryNameHint($g,NameInverse);
# Parse the fullname
&XS::Test1::mdNameParse($g);
#Gender
diag( "Gender: " .&XS::Test1::mdNameGetGender($g). "\n");
#Prefix
diag( "Prefix: " .&XS::Test1::mdNameGetPrefix($g). "\n");
#First Name
diag( "First Name: " .&XS::Test1::mdNameGetFirstName($g). "\n");
#Middle Name
diag( "Middle Name: " .&XS::Test1::mdNameGetMiddleName($g). "\n");
#Last Name
diag( "Last name: " .&XS::Test1::mdNameGetLastName($g). "\n");
#Suffix
diag( "Suffix: " .&XS::Test1::mdNameGetSuffix($g). "\n");
#Gender2
diag( "Gender 2: " .&XS::Test1::mdNameGetGender2($g). "\n");
#Prefix2
diag( "Prefix 2: " .&XS::Test1::mdNameGetPrefix2($g). "\n");
#First Name2
diag( "First Name 2: " .&XS::Test1::mdNameGetFirstName2($g). "\n");
#Middle Name2
diag( "Middle Name 2: " .&XS::Test1::mdNameGetMiddleName2($g).
"\n");
#Last Name2
diag( "Last name 2: " .&XS::Test1::mdNameGetLastName2($g). "\n");
#Suffix2
diag( "Suffix2: " .&XS::Test1::mdNameGetSuffix2($g). "\n");
#Salutation
diag( "Salutation: " .&XS::Test1::mdNameGetSalutation($g). "\n");
#Status Code
diag( "Status Code: " .&XS::Test1::mdNameGetStatusCode($g). "\n");
#Error Code
diag( "Error Code: " .&XS::Test1::mdNameGetErrorCode($g). "\n");
#Change Code
diag( "Change Code: " .&XS::Test1::mdNameGetChangeCode($g). "\n");
}
close CONFIG;
##########################################################################################
#MakeFile.PL
use 5.008008;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'XS::Test1',
VERSION_FROM => 'lib/XS/Test1.pm', # finds $VERSION
PREREQ_PM => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/XS/Test1.pm', # retrieve abstract from
module
AUTHOR => 'Frank Chang <[EMAIL PROTECTED]>') : ()),
LIBS => ['-L/home/frankc/Test/mdNameTest/liunkg_deb -
lmdName'], # e.g., '-lm'
DEFINE => '', # e.g., '-DHAVE_SOMETHING'
INC => '-I.', # e.g., '-I. -I/usr/include/other'
# Un-comment this if you add C files to link with later:
# OBJECT => '$(O_FILES)', # link all the C files too
);
if (eval {require ExtUtils::Constant; 1}) {
# If you edit these definitions to change the constants used by this
module,
# you will need to use the generated const-c.inc and const-xs.inc
# files to replace their "fallback" counterparts before distributing
your
# changes.
my @names = ({name=>"Aggressive", macro=>"1"},
{name=>"Blank", macro=>"1"},
{name=>"ConfigFile", macro=>"1"},
{name=>"Conservative", macro=>"1"},
{name=>"DatabaseExpired", macro=>"1"},
{name=>"Female", macro=>"1"},
{name=>"FirstLast", macro=>"1"},
{name=>"Formal", macro=>"1"},
{name=>"Informal", macro=>"1"},
{name=>"Male", macro=>"1"},
{name=>"Mixed", macro=>"1"},
{name=>"NameFull", macro=>"1"},
{name=>"NameGovernmentInverse", macro=>"1"},
{name=>"NameInverse", macro=>"1"},
{name=>"NameMixedFirst", macro=>"1"},
{name=>"NameMixedLast", macro=>"1"},
{name=>"Neutral", macro=>"1"},
{name=>"NoError", macro=>"1"},
{name=>"Slug", macro=>"1"},
{name=>"Unknown", macro=>"1"});
ExtUtils::Constant::WriteConstants(
NAME => 'XS::Test1',
NAMES => [EMAIL PROTECTED],
DEFAULT_TYPE => 'IV',
C_FILE => 'const-c.inc',
XS_FILE => 'const-xs.inc',
);
}
else {
use File::Copy;
use File::Spec;
foreach my $file ('const-c.inc', 'const-xs.inc') {
my $fallback = File::Spec->catfile('fallback', $file);
copy ($fallback, $file) or die "Can't copy $fallback to $file:
$!";
}
}
