From: Nicholas Clark Date: Sun, 10 Jun 2001 23:25:41 +0000 (+0100) Subject: ExtUtils::Constant X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3414cef00cbe871b34a427fbbdf64738315ff89e;p=p5sagit%2Fp5-mst-13.2.git ExtUtils::Constant Message-ID: <20010610232540.C76396@plum.flirble.org> p4raw-id: //depot/perl@10507 --- diff --git a/lib/ExtUtils/Constant.pm b/lib/ExtUtils/Constant.pm index 4efccfe..25feacc 100644 --- a/lib/ExtUtils/Constant.pm +++ b/lib/ExtUtils/Constant.pm @@ -55,6 +55,18 @@ NUL terminated string, length will be determined with C A fixed length thing, given as a [pointer, length] pair. If you know the length of a string at compile time you may use this instead of I +=item YES + +Truth. (C) The value is not needed (and ignored). + +=item NO + +Defined Falsehood. (C) The value is not needed (and ignored). + +=item UNDEF + +C. The value of the macro is not needed. + =back =head1 FUNCTIONS @@ -75,7 +87,7 @@ $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; @ISA = 'Exporter'; -$VERSION = '0.03'; +$VERSION = '0.04'; %EXPORT_TAGS = ( 'all' => [ qw( XS_constant constant_types return_clause memEQ_clause C_stringify @@ -89,7 +101,10 @@ $VERSION = '0.03'; UV => 'PUSHu((UV)iv)', NV => 'PUSHn(nv)', PV => 'PUSHp(pv, strlen(pv))', - PVN => 'PUSHp(pv, iv)' + PVN => 'PUSHp(pv, iv)', + YES => 'PUSHs(&PL_sv_yes)', + NO => 'PUSHs(&PL_sv_no)', + UNDEF => '' # implicit undef ); %XS_TypeSet = ( @@ -97,7 +112,8 @@ $VERSION = '0.03'; UV => '*iv_return = (IV)', NV => '*nv_return =', PV => '*pv_return =', - PVN => ['*pv_return =', '*iv_return = (IV)'] + PVN => ['*pv_return =', '*iv_return = (IV)'], + YES => undef, NO => undef, UNDEF => undef ); @@ -116,6 +132,9 @@ sub C_stringify { s/([\"\'])/\\$1/g; # Grr. fix perl mode. s/\n/\\n/g; # Ensure newlines don't end up in octal s/\r/\\r/g; + s/\t/\\t/g; + s/\f/\\f/g; + s/\a/\\a/g; s/([[:cntrl:]])/sprintf "\\%03o", ord $1/ge; s/\177/\\177/g; # DEL doesn't seem to be a [:cntrl:] $_; @@ -201,16 +220,16 @@ Is for the components. sub assign { my $indent = shift; my $type = shift; - my $typeset = $XS_TypeSet{$type}; my $clause; - die "Can't generate code for type $type" unless defined $typeset; + die "Can't generate code for type $type" unless exists $XS_TypeSet{$type}; + my $typeset = $XS_TypeSet{$type}; if (ref $typeset) { die "Type $type is aggregate, but only single value given" if @_ == 1; foreach (0 .. $#$typeset) { $clause .= $indent . "$typeset->[$_] $_[$_];\n"; } - } else { + } elsif (defined $typeset) { die "Aggregate value given for type $type" if @_ > 1; $clause .= $indent . "$typeset $_[0];\n"; @@ -372,6 +391,8 @@ EOT # Ensure that the enclosing C comment doesn't end # by turning */ into *" . "/ $line =~ s!\*\/!\*" . "/!gs; + # gcc -Wall doesn't like finding /* inside a comment + $line =~ s!\/\*!/" . "\*!gs; $result .= $line; } } diff --git a/t/lib/extutils.t b/t/lib/extutils.t index 9d54dad..48c2aa3 100644 --- a/t/lib/extutils.t +++ b/t/lib/extutils.t @@ -1,6 +1,6 @@ #!./perl -w -print "1..18\n"; +print "1..21\n"; BEGIN { chdir 't' if -d 't'; @@ -47,9 +47,15 @@ my @names = ("FIVE", {name=>"OK6", type=>"PV",}, value=>['"not ok 7\\n\\0ok 7\\n"', 15]}, {name => "FARTHING", type=>"NV"}, {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"}, + {name => "OPEN", type=>"PV", value=>'"/*"', + macro=>["#if 1\n", "#endif\n"]}, {name => "CLOSE", type=>"PV", value=>'"*/"', macro=>["#if 1\n", "#endif\n"]}, - {name => "ANSWER", default=>["UV", 42]}, "NOTDEF"); + {name => "ANSWER", default=>["UV", 42]}, "NOTDEF", + {name => "Yes", type=>"YES"}, + {name => "No", type=>"NO"}, + {name => "Undef", type=>"UNDEF"} +); my @names_only = map {(ref $_) ? $_->{name} : $_} @names; @@ -69,6 +75,9 @@ print FH <<'EOT'; #define OK7 1 #define FARTHING 0.25 #define NOT_ZERO 1 +#define Yes 0 +#define No 1 +#define Undef 1 #undef NOTDEF EOT close FH or die "close $header: $!\n"; @@ -199,6 +208,30 @@ if (defined $notthere) { print "ok 13\n"; } +# Truth +my $yes = Yes; +if ($yes) { + print "ok 14\n"; +} else { + print "not ok 14 # $yes='\$yes'\n"; +} + +# Falsehood +my $no = No; +if (defined $no and !$no) { + print "ok 15\n"; +} else { + print "not ok 15 # \$no=" . defined ($no) ? "'$no'\n" : "undef\n"; +} + +# Undef +my $undef = Undef; +unless (defined $undef) { + print "ok 16\n"; +} else { + print "not ok 16 # \$undef='$undef'\n"; +} + EOT close FH or die "close $testpl: $!\n"; @@ -276,27 +309,29 @@ if ($Config{usedl}) { } } -my $test = 14; +my $test = 17; my $maketest = "$make test"; print "# make = '$maketest'\n"; $makeout = `$maketest`; -if ($?) { - print "not ok $test # $maketest failed: $?\n"; -} else { - # echo of running the test script - $makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m; - $makeout =~ s/^MCR.+test.pl\n//mig if $^O eq 'VMS'; - # GNU make babblings - $makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig; +# echo of running the test script +$makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m; +$makeout =~ s/^MCR.+test.pl\n//mig if $^O eq 'VMS'; + +# GNU make babblings +$makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig; - # Hopefully gets most make's babblings - # make -f Makefile.aperl perl - $makeout =~ s/^\w*?make.+\sperl[^A-Za-z0-9]*\n//mig; - # make[1]: `perl' is up to date. - $makeout =~ s/^\w*?make.+perl.+?is up to date.*?\n//mig; +# Hopefully gets most make's babblings +# make -f Makefile.aperl perl +$makeout =~ s/^\w*?make.+\sperl[^A-Za-z0-9]*\n//mig; +# make[1]: `perl' is up to date. +$makeout =~ s/^\w*?make.+perl.+?is up to date.*?\n//mig; - print $makeout; +print $makeout; + +if ($?) { + print "not ok $test # $maketest failed: $?\n"; +} else { print "ok $test\n"; } $test++;