This patch implements prototypes for Inline::C. It starts by intuiting
prototypes from argument types (AV*, HV*, CV* and GV*), as originally
proposed by Brian:
http:[EMAIL PROTECTED]/msg00546.html
This idea is expanded to pseudo-types SCALAR, LIST and PAIRS which are
typedefs of SV*, AV* and HV* with $, @ and % prototypes.
To handle optional prototypes, I implemented C++ style default parameters.
And since I was mucking around Inline::C::grammar, I added support for
functions with zero or more arguments as well.
BTW, I don't like the patch to Inline::C::grammar. It was the result of
blind trial and error. Someone with more knowledge of Parse::RecDescent
should apply some logic to it before applying the patch.
--- Inline-0.43/C/C.pod.orig Fri Jul 20 03:28:43 2001
+++ Inline-0.43/C/C.pod Thu Mar 28 16:31:24 2002
@@ -22,19 +22,22 @@
The Inline grammar for C recognizes certain function definitions (or signatures) in
your C code. If a signature is recognized by Inline, then it will be available in
Perl-space. That is, Inline will generate the "glue" necessary to call that function
as if it were a Perl subroutine. If the signature is not recognized, Inline will
simply ignore it, with no complaints. It will not be available from Perl-space,
although it I<will> be available from C-space.
-Inline looks for ANSI/prototype style function definitions. They must be of the form:
+Inline looks for ANSI/prototype style function definitions. C++ style default
+parameters may also be used, and an explicit Perl L<prototype|/Perl Prototypes> may
+follow the argument list. Function definitions must be of the form:
return-type function-name ( type-name-pairs ) { ... }
+ return-type function-name ( type-name-pairs ) ( prototype ) { ... }
-The most common types are: C<int>, C<long>, C<double>, C<char*>, and C<SV*>. But you
can use any type for which Inline can find a typemap. Inline uses the C<typemap> file
distributed with Perl as the default. You can specify more typemaps with the TYPEMAPS
configuration option.
+The most common types are: C<int>, C<long>, C<double>, C<char*>, and C<SV*>. But you
+can use any type for which Inline can find a typemap. Inline uses the C<typemap> file
+distributed with Perl and one of its own as the defaults. You can specify more
+typemaps with the TYPEMAPS configuration option.
A return type of C<void> may also be used. The following are examples of valid
function definitions.
int Foo(double num, char* str) {
void Foo(double num, char* str) {
SV* Foo() {
+ void Foo(...) {
void Foo(SV*, ...) {
- long Foo(int i, int j, ...) {
+ long Foo(int i = 1, int j = 2, ...) {
+ int Foo(AV* aref, int i) ($$) {
The following definitions would not be recognized:
@@ -149,6 +152,8 @@
Inline uses the default Perl typemap file for its default types. This file is called
C</usr/local/lib/perl5/5.6.1/ExtUtils/typemap>, or something similar, depending on
your Perl installation. It has definitions for over 40 types, which are automatically
used by Inline. (You should probably browse this file at least once, just to get an
idea of the possibilities.)
+In addition to the Perl typemap file, Inline also uses its own typemap file
+C<$lib/Inline/C/typemap> to better handle implicit L<prototypes|/Perl Prototypes>.
+It redefines mappings for the C<AV*>, C<HV*>, C<CV*>, and C<GV*> types and defines
+new mappings for C<SCALAR>, C<LIST>, and C<PAIRS> pseudo-types.
+
Inline parses your code for these types and generates the XS code to map them. The
most commonly used types are:
- int
@@ -162,9 +167,72 @@
A return type of C<void> has a special meaning to Inline. It means that you plan to
push the values back onto the B<Stack> yourself. This is what you need to do to return
a list of values. If you really don't want to return anything (the traditional meaning
of C<void>) then simply don't push anything back.
-If ellipsis or C<...> is used at the end of an argument list, it means that any
number of C<SV*>s may follow. Again you will need to pop the values off of the
C<Stack> yourself.
+If ellipsis or C<...> is used at the end of an argument list, it means that any
+number of C<SV*>s may follow. If C<...> is used as the only thing in an argument
+list, it means that there are any number of C<SV*>s in the list. Again you will need
+to pop the values off of the C<Stack> yourself.
See L<"Examples"> below.
+
+=head1 Perl Prototypes
+
+Inline can "glue" a C function to a L<prototyped|perlsub/Prototypes> Perl subroutine.
+ Prototypes are implicitly generated if a C function argument list includes one of
+the following types:
+
+ C Type Perl Prototype
+ -------- --------------
+ AV* \@
+ HV* \%
+ CV* &
+ GV* *
+ SCALAR $
+ LIST @
+ PAIRS %
+
+All other types are mapped to C<$>. If the argument list ends with C<...>, then an
+C<@> is appended to the prototype. For example:
+
+ C Function Perl Subroutine
+ ------------------------------------ --------------------
+ int mypush (AV* array, ...) sub mypush (\@@)
+ void mykeys (HV* hash) sub mykeys (\%)
+ void mygrep (CV* code, ...) sub mygrep (&@)
+ bool mypipe (GV* read, GV* write) sub mypipe (**)
+ void mylock (SCALAR thing) sub mylock ($)
+ void mykill (LIST list) sub mykill (@)
+ int mynew (PAIRS named_params) sub mynew (%)
+
+Inline I<typedefs> the C<SCALAR>, C<LIST>, and C<PAIRS> types to C<SV*>, C<AV*>, and
+C<HV*>, respectively. A C<SCALAR> type argument forces scalar context. A C<LIST> type
+argument forces list context and slurps up all remaining arguments from the B<Stack>.
+And a C<PAIRS> type argument slurps up all remaining arguments as key-value pairs (an
+odd number of remaining arguments is fatal).
+
+For optional prototypes, use C++ style default parameters:
+
+ C Function Perl Subroutine
+ ----------------------------------------------- ------------------
+ double myrand (double num = 1.0) sub myrand (;$)
+ int myint (double num = SvNV(DEFSV)) sub myint (;$)
+ bool mymkdir (char* dir, int mask = 0777) sub mymkdir ($;$)
+ bool myopen (GV* io, char* file = "") sub myopen (*;$)
+
+Functions that take no arguments get an empty prototype, and functions that take a
+variable number of arguments get an C<@> prototype:
+
+ C Function Perl Subroutine
+ ----------------------- --------------------
+ int mytime () sub mytime ()
+ int myutime (...) sub myutime (@)
+
+You may also explicitly set a prototype.
+
+ int myadd (int i, int j) ($$) {...} # No implicit prototype
+ SV* mypop (AV* array) (@) {...} # Override implicit \@
+
+Note that prototyped Perl subroutines must be visible at compile time, but the
+C<DATA> filehandle can't be read until runtime. This means that when using
+prototypes, do B<not> put your C code after the C<__END__> or C<__DATA__> tokens of
+your program. Instead, use either the C<FILE> keyword:
+
+ use Inline::Files;
+ use Inline C => 'FILE';
+
+ __C__
+ /* Put your C code here */
+
+Or place your code in a string:
+
+ use Inline C => <<'CODE';
+ /* Put your C code here */
+ CODE
=head1 The Inline Stack Macros
--- Inline-0.43/C/C.pm.orig Sun Jul 22 08:09:35 2001
+++ Inline-0.43/C/C.pm Thu Mar 28 16:31:37 2002
@@ -7,6 +7,7 @@
use Data::Dumper;
use Carp;
use Cwd qw(cwd abs_path);
+use File::Spec;
$Inline::C::VERSION = '0.43';
@Inline::C::ISA = qw(Inline);
@@ -277,8 +278,10 @@
my $parser = $o->{ILSM}{parser} = $o->get_parser;
Inline::Struct::parse($o) if $o->{STRUCT}{'.any'};
- $parser->code($o->{ILSM}{code})
+
+ my $code = $parser->code($o->{ILSM}{code})
or croak "Bad $o->{API}{language} code passed to Inline at @{[caller(2)]}\n";
+ $o->{ILSM}{code} = $code unless $code eq '1';
}
# Create and initialize a parser
@@ -300,6 +303,11 @@
sub get_maps {
my $o = shift;
+ my ($vol, $dir, $file) = File::Spec->splitpath($INC{'Inline/C/grammar.pm'});
+ my $path = File::Spec->rel2abs(File::Spec->catpath($vol, $dir, 'typemap'));
+ ($path) = $path =~ /(.*)/ if $o->UNTAINT;
+ unshift(@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, $path) if -f $path;
+
my $typemap = '';
$typemap = "$Config::Config{installprivlib}/ExtUtils/typemap"
if -f "$Config::Config{installprivlib}/ExtUtils/typemap";
@@ -515,18 +523,69 @@
"Check your C function definition(s) for Inline compatibility\n\n")
if ((not defined$data->{functions}) and ($^W));
+ my %type2proto = (
+ 'AV *' => '\@',
+ 'HV *' => '\%',
+ 'CV *' => '&',
+ 'GV *' => '*',
+ 'SCALAR' => '$',
+ 'LIST' => '@',
+ 'PAIRS' => '%',
+ '...' => '@',
+ );
+
+ my %type2default = (
+ 'LIST' => 'newAV()',
+ 'PAIRS' => 'newHV()',
+ );
+
for my $function (@{$data->{functions}}) {
- my $return_type = $data->{function}->{$function}->{return_type};
- my @arg_names = @{$data->{function}->{$function}->{arg_names}};
- my @arg_types = @{$data->{function}->{$function}->{arg_types}};
-
- $XS .= join '', ("\n$return_type\n$function (",
- join(', ', @arg_names), ")\n");
-
- for my $arg_name (@arg_names) {
- my $arg_type = shift @arg_types;
- last if $arg_type eq '...';
- $XS .= "\t$arg_type\t$arg_name\n";
+ my $return_type = $data->{function}->{$function}->{return_type};
+ my $prototype = $data->{function}->{$function}->{prototype};
+ my @arg_names = @{$data->{function}->{$function}->{arg_names}};
+ my @arg_types = @{$data->{function}->{$function}->{arg_types}};
+ my @arg_defaults = @{$data->{function}->{$function}->{arg_defaults}}
+ if ref $data->{function}->{$function}->{arg_defaults};
+
+ my $proto = join '', map $type2proto{$_} || '-', @arg_types;
+
+ if (@arg_types and $type2default{$arg_types[-1]}) {
+ push @arg_types, '...';
+ push @arg_names, '...';
+ }
+
+ my $semicolon;
+
+ my $arg_names = join ', ', map {
+ if (defined $arg_defaults[$_]) {
+ $semicolon = $_ unless defined $semicolon;
+ "$arg_names[$_] = $arg_defaults[$_]";
+ } else {
+ $arg_names[$_];
+ }
+ } 0..$#arg_names;
+
+ substr $arg_names, -5, 0, "=$type2default{$arg_types[-2]}"
+ if @arg_types > 1
+ && $arg_types[-1] eq '...'
+ && $type2default{$arg_types[-2]};
+
+ $XS .= "\n$return_type\n$function ($arg_names)\n";
+
+ for (0..$#arg_names) {
+ last if $arg_types[$_] eq '...';
+ $XS .= "\t$arg_types[$_]\t$arg_names[$_]\n";
+ }
+
+ if ($prototype) {
+ $XS .= "\tPROTOTYPE: $prototype\n";
+ } elsif (defined $semicolon) {
+ substr $proto, $semicolon, 0, ';';
+ $proto =~ tr/-/$/;
+ $XS .= "\tPROTOTYPE: $proto\n";
+ } elsif ($proto !~ /^-+\@?$/) {
+ $proto =~ tr/-/$/;
+ $XS .= "\tPROTOTYPE: $proto\n";
}
my $listargs = '';
@@ -603,6 +662,10 @@
#define inline_stack_done Inline_Stack_Done
#define inline_stack_return(x) Inline_Stack_Return(x)
#define inline_stack_void Inline_Stack_Void
+
+typedef SV* SCALAR;
+typedef AV* LIST;
+typedef HV* PAIRS;
END
close HEADER;
--- Inline-0.43/C/grammar/grammar.pm.orig Fri Jul 20 18:03:10 2001
+++ Inline-0.43/C/grammar/grammar.pm Thu Mar 28 16:32:31 2002
@@ -7,13 +7,17 @@
sub grammar {
<<'END';
-code: part(s) {1}
+code: part(s) { join "\n", @{$item[1]} }
part: comment
| function_definition
{
my $function = $item[1][0];
- $return = 1, last if $thisparser->{data}{done}{$function}++;
+ $return = "$item[1][1] $function(" . join(
+ ', ' => map {ref $_ ? "$_->[0] $_->[1]" : '...'} @{$item[1][2]}
+ ) . ") {";
+ $return =~ s/\Q(...) {\E$/( ) {/;
+ last if $thisparser->{data}{done}{$function}++;
push @{$thisparser->{data}{functions}}, $function;
$thisparser->{data}{function}{$function}{return_type} =
$item[1][1];
@@ -21,12 +25,21 @@
[map {ref $_ ? $_->[0] : '...'} @{$item[1][2]}];
$thisparser->{data}{function}{$function}{arg_names} =
[map {ref $_ ? $_->[1] : '...'} @{$item[1][2]}];
+ $thisparser->{data}{function}{$function}{arg_defaults} =
+ [map {ref $_ ? $_->[2] : undef} @{$item[1][2]}];
+ $thisparser->{data}{function}{$function}{prototype} =
+ $item[1][3];
+ 1;
}
| function_declaration
{
- $return = 1, last unless $thisparser->{data}{AUTOWRAP};
+ $return = "$item[1][1] $item[1][0](" . join(
+ ', ' => map {ref $_ ? "$_->[0] $_->[1]" : '...'} @{$item[1][2]}
+ ) . ");";
+ $return =~ s/\Q(...);\E$/( );/;
+ last unless $thisparser->{data}{AUTOWRAP};
my $function = $item[1][0];
- $return = 1, last if $thisparser->{data}{done}{$function}++;
+ last if $thisparser->{data}{done}{$function}++;
my $dummy = 'arg1';
push @{$thisparser->{data}{functions}}, $function;
$thisparser->{data}{function}{$function}{return_type} =
@@ -35,19 +48,25 @@
[map {ref $_ ? $_->[0] : '...'} @{$item[1][2]}];
$thisparser->{data}{function}{$function}{arg_names} =
[map {ref $_ ? ($_->[1] || $dummy++) : '...'} @{$item[1][2]}];
+ $thisparser->{data}{function}{$function}{arg_defaults} =
+ [map {ref $_ ? $_->[2] : undef} @{$item[1][2]}];
+ $thisparser->{data}{function}{$function}{prototype} =
+ $item[1][3];
+ 1;
}
- | anything_else
+ | anything_else {$item[1]}
comment: m{\s* // [^\n]* \n }x
| m{\s* /\* (?:[^*]+|\*(?!/))* \*/ ([ \t]*)? }x
function_definition:
- rtype IDENTIFIER '(' <leftop: arg ',' arg>(s?) ')' '{'
- {[@item[2,1], $item[4]]}
+ rtype IDENTIFIER '(' <leftop: arg ',' arg>(s?) ')' prototype(?) '{'
+ {[@item[2,1], $item[4], $item[6][0]]}
function_declaration:
- rtype IDENTIFIER '(' <leftop: arg_decl ',' arg_decl>(s?) ')' ';'
- {[@item[2,1], $item[4]]}
+ rtype IDENTIFIER '(' <leftop: arg_decl ',' arg_decl>(s?) ')' prototype(?) ';'
+ {[@item[2,1], $item[4], $item[6][0]]}
+# {[@item[2,1,4,6]]}
rtype: TYPE star(s?)
{
@@ -64,11 +83,34 @@
return undef unless (defined
$thisparser->{data}{typeconv}{valid_rtypes}{$return});
}
-arg: type IDENTIFIER {[@item[1,2]]}
+arg: type IDENTIFIER default(?) {[@item[1,2], $item[3][0]]}
| '...'
-arg_decl: type IDENTIFIER(s?) {[$item[1], $item[2][0] || '']}
+arg_decl: type IDENTIFIER(s?) default(?)
+ {[ $item[1], $item[2][0] || '', $item[3][0] ]}
| '...'
+
+default: '=' expression
+
+expression: outer_chunk(s) { join '', @{$item[1]} }
+
+outer_chunk: string | character | parenthesis | outer_continuation
+
+inner_chunk: string | character | parenthesis | inner_continuation
+
+parenthesis: '(' inner_chunk(s?) ')' { join '', '(', @{$item[2]} , ')' }
+
+string: /"(?:[^"\\]+|\\.)*"/
+
+character: /'\\?.'/
+
+outer_continuation: /[^'"(),]+/
+
+inner_continuation: /[^'"()]+/
+
+prototype: '(' proto ')' {$item[2]}
+
+proto: /[\$\@%&*\\;]+/
type: TYPE star(s?)
{
--- /dev/null Wed Dec 31 16:00:00 1969
+++ Inline-0.43/C/typemap Thu Mar 28 16:32:05 2002
@@ -0,0 +1,81 @@
+TYPEMAP
+
+AV * IC_ARRAY
+HV * IC_HASH
+CV * IC_CODE
+GV * IC_GLOB
+SCALAR IC_SCALAR
+LIST IC_LIST
+PAIRS IC_PAIRS
+
+INPUT
+
+IC_ARRAY
+ if (SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVAV)
+ $var = (AV*) SvRV($arg);
+ else
+ croak(\"$var is not an ARRAY reference\")
+IC_HASH
+ if (SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVHV)
+ $var = (HV*) SvRV($arg);
+ else
+ croak(\"$var is not a HASH reference\")
+IC_CODE
+ if (SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVCV)
+ $var = (CV*) SvRV($arg);
+ else
+ croak(\"$var is not a CODE reference\")
+IC_GLOB
+ if (SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVGV)
+ $var = (GV*) SvRV($arg);
+ else
+ $var = (GV*) SvRV(eval_pv(SvPV_nolen(newSVpvf(
+ \"use Symbol; qualify_to_ref('%s', caller)\",
+ SvPV_nolen($arg)
+ )), TRUE));
+IC_SCALAR
+ $var = $arg
+IC_LIST
+ {
+ int i;
+ $var = newAV();
+ for (i = $argoff; i < items; i++)
+ av_push($var, ST(i));
+ }
+IC_PAIRS
+ {
+ SV** store;
+ int i;
+ char* key;
+ STRLEN len;
+ $var = newHV();
+ if ((items - $argoff) % 2)
+ croak(\"Odd number of elements in hash prototype\");
+ for (i = $argoff + 1; i < items; i += 2) {
+ key = SvPV(ST(i - 1), len);
+ store = hv_store($var, key, len, ST(i), 0);
+ }
+ }
+
+OUTPUT
+
+IC_ARRAY
+ $arg = newRV((SV*) $var);
+IC_HASH
+ $arg = newRV((SV*) $var);
+IC_CODE
+ $arg = newRV((SV*) $var);
+IC_GLOB
+ $arg = newRV((SV*) $var);
+IC_LIST
+ {
+ int i;
+ int len = av_len($var) + 1;
+ XSprePUSH;
+ for (i = 0; i < len; i++)
+ PUSHs(sv_mortalcopy(av_shift($var)));
+ XSRETURN(len);
+ }
+
+
+
--- /dev/null Wed Dec 31 16:00:00 1969
+++ Inline-0.43/C/t/06grammar.t Thu Mar 28 16:34:48 2002
@@ -0,0 +1,65 @@
+use lib qw(../blib/lib ./blib/lib);
+use strict;
+use Test;
+use diagnostics;
+use Inline Config => DIRECTORY => './_Inline_test';
+
+BEGIN {
+ plan(tests => 11,
+ todo => [],
+ onfail => sub {},
+ );
+}
+
+use Inline C => <<'END_OF_C_CODE';
+
+int integer(double num) {
+ return (int) num;
+}
+
+int power(int x, int y = 2) {
+ return pow(x, y);
+}
+
+int negate(int i = SvIV(DEFSV)) {
+ return -i;
+}
+
+int count(int i) ($) {
+ return i;
+}
+
+int sum(...) {
+ INLINE_STACK_VARS;
+ int tot = 0;
+ int i;
+ for (i = 0; i < INLINE_STACK_ITEMS; i++)
+ tot += SvIV(INLINE_STACK_ITEM(i));
+ return tot;
+}
+
+END_OF_C_CODE
+
+# test 1 - Check ANSI/prototypes still work
+my $i = integer(21.2);
+ok($i == 21);
+
+# test 2..5 - Check C++ style default parameters
+ok(power(2, 3) == 2**3);
+ok(power(2) == 2**2);
+ok(negate(10) == -10);
+$_ = 8;
+ok(negate == -8);
+
+# test 6..7 - Check explicit prototype
+ok(count(5) == 5);
+my @a = 'a'..'z';
+ok(count(@a) == @a);
+
+# test 8..11 - Check variable argument list
+ok(sum == 0);
+ok(sum(100) == 100);
+ok(sum(100, 10) == 110);
+ok(sum(100, 10, 1) == 111);
+
+__END__
--- /dev/null Wed Dec 31 16:00:00 1969
+++ Inline-0.43/C/t/07prototypes.t Thu Mar 28 16:35:07 2002
@@ -0,0 +1,145 @@
+use lib qw(../blib/lib ./blib/lib);
+use strict;
+use Test;
+use diagnostics;
+use Inline Config => DIRECTORY => './_Inline_test';
+
+BEGIN {
+ plan(tests => 24,
+ todo => [],
+ onfail => sub {},
+ );
+}
+
+use Inline C => <<'END_OF_C_CODE';
+
+int array_length(AV* av) {
+ return av_len(av) + 1;
+}
+
+int hash_keys(HV* hv) {
+ return HvKEYS(hv);
+}
+
+void code_repeat(CV* cv, int iter) {
+ int i;
+ dSP;
+ PUSHMARK(SP);
+ for (i = 0; i < iter; i++)
+ call_sv((SV*) cv, G_DISCARD|G_NOARGS);
+}
+
+char* glob_string(GV* gv) {
+ return SvPV_nolen(GvSV(gv));
+}
+
+SV* scalar_value(SCALAR sv) {
+ return newSVsv(sv);
+}
+
+int list_sum(LIST av) {
+ int tot = 0;
+ SV* sv;
+ while ((sv = av_pop(av)) != &PL_sv_undef)
+ tot += SvNV(sv);
+ return tot;
+}
+
+int pairs_area(PAIRS hv) {
+ SV** fetch;
+ int width, height;
+ fetch = hv_fetch(hv, "width", 5, FALSE);
+ width = fetch == NULL ? 0 : SvIV(*fetch);
+ fetch = hv_fetch(hv, "height", 6, FALSE);
+ height = fetch == NULL ? 0 : SvIV(*fetch);
+ return width * height;
+}
+
+char opt_letter(char* str, int index = 0) {
+ return str[index];
+}
+
+void empty() {
+ return;
+}
+
+void variable(...) {
+ return;
+}
+
+void explicit(AV* av) ($) {
+ return;
+}
+
+END_OF_C_CODE
+
+# test 1..11 - Check prototypes
+ok(prototype \&array_length eq '\@');
+ok(prototype \&hash_keys eq '\%');
+ok(prototype \&code_repeat eq '&$');
+ok(prototype \&glob_string eq '*');
+ok(prototype \&scalar_value eq '$');
+ok(prototype \&list_sum eq '@');
+ok(prototype \&pairs_area eq '%');
+ok(prototype \&opt_letter eq '$;$');
+ok(prototype \&variable eq '@');
+ok(prototype \&explicit eq '$');
+my $empty = prototype \∅
+ok(defined $empty and $empty eq "");
+
+# test 12 - Check AV* binding
+my @a = 'a'..'z';
+my $len = eval 'array_length @a';
+ok(!$@ and $len == @a);
+
+# test 13 - Check HV* binding
+my %h;
+@h{@a} = ();
+$len = eval 'hash_keys %h';
+ok(!$@ and $len == keys %h);
+
+# test 14 - Check CV* binding
+my $x = 10;
+eval 'code_repeat { $x++ } 4';
+ok(!$@ and $x == 14);
+
+# test 15..16 - Check GV* binding
+our $str = 'Just another Inline hacker';
+my $ret = eval 'glob_string *str';
+ok(!$@ and $ret eq $str);
+$str = uc $str;
+$ret = eval 'glob_string str';
+ok(!$@ and $ret eq $str);
+
+# test 17 - Check SCALAR binding
+$len = eval 'scalar_value @a';
+ok(!$@ and $len == @a);
+
+# test 18..20 - Check LIST binding
+my $sum = eval 'list_sum 1..4';
+ok(!$@ and $sum == 1 + 2 + 3 + 4);
+$sum = eval 'list_sum 8';
+ok(!$@ and $sum == 8);
+$sum = eval 'list_sum';
+ok(!$@ and $sum == 0);
+
+# test 21..22 - Check PAIRS binding.
+my $area = eval 'pairs_area width => 10, height => 20';
+ok(!$@ and $area == 10 * 20);
+my $warn;
+$area = eval q{
+ local $SIG{__WARN__} = sub {
+ $warn++ if $_[0] =~ /^Odd number of elements in hash prototype/;
+ };
+ pairs_area width => 4, height => 8, 1;
+};
+ok(!$@ and $warn and $area == 4 * 8);
+
+# test 23..24 - Check optional prototypes
+my $letter = eval 'opt_letter "perl", 2';
+ok(!$@ and $letter eq 'r');
+$letter = eval 'opt_letter "perl"';
+ok(!$@ and $letter eq 'p');
+
+__END__
+
--
Tim Gim Yee
[EMAIL PROTECTED]
