diff --git a/README.md b/README.md index c924b8f..42edb4b 100644 --- a/README.md +++ b/README.md @@ -262,9 +262,12 @@ So-called "pass-by-value" is not and will not be supported. For - [FFI::C](https://metacpan.org/pod/FFI::C) - [FFI::C::Array](https://metacpan.org/pod/FFI::C::Array) - [FFI::C::ArrayDef](https://metacpan.org/pod/FFI::C::ArrayDef) +- [FFI::C::ASCIIString](https://metacpan.org/pod/FFI::C::ASCIIString) +- [FFI::C::Buffer](https://metacpan.org/pod/FFI::C::Buffer) - [FFI::C::Def](https://metacpan.org/pod/FFI::C::Def) - [FFI::C::File](https://metacpan.org/pod/FFI::C::File) - [FFI::C::PosixFile](https://metacpan.org/pod/FFI::C::PosixFile) +- [FFI::C::String](https://metacpan.org/pod/FFI::C::String) - [FFI::C::Struct](https://metacpan.org/pod/FFI::C::Struct) - [FFI::C::StructDef](https://metacpan.org/pod/FFI::C::StructDef) - [FFI::C::Union](https://metacpan.org/pod/FFI::C::Union) diff --git a/examples/synopsis/ascii_string.pl b/examples/synopsis/ascii_string.pl new file mode 100644 index 0000000..25fd162 --- /dev/null +++ b/examples/synopsis/ascii_string.pl @@ -0,0 +1,20 @@ +use strict; +use warnings; +use FFI::Platypus; +use FFI::C::ASCIIString; + +my $ffi = FFI::Platypus->new( api => 1, lib => [undef]); + +$ffi->attach( puts => ['opaque'] => 'int' ); + +my $str = FFI::C::ASCIIString->new(1024); +$str->from_perl("Hello: "); + +print "length = ", $str->strlen, "\n"; # prints 7 + +puts($str->ptr); # prints Hello: + +$str->strcat("World!"); + +puts($str->ptr); # prints Hello: World! + diff --git a/examples/synopsis/buffer.pl b/examples/synopsis/buffer.pl new file mode 100644 index 0000000..ec70014 --- /dev/null +++ b/examples/synopsis/buffer.pl @@ -0,0 +1,34 @@ +use strict; +use warnings; +use FFI::Platypus; +use FFI::C::Buffer; + +my $ffi = FFI::Platypus->new( api => 1, lib => [undef]); +my $open = $ffi->function( 'open' => [ 'string', 'int', 'mode_t' ] => 'int' ); +my $read = $ffi->function( 'read' => [ 'int','opaque','size_t' ] => 'ssize_t' ); +my $write = $ffi->function( 'write' => [ 'int','opaque','size_t' ] => 'ssize_t' ); + +my $buf1 = FFI::C::Buffer->new(\"Hello World!\n"); + +# send a buffer to C land as a const char * for it to read from +$write->call(1, $buf1->ptr, $buf1->buffer_size); + +# open this script for read +my $fd = $open->call(__FILE__, 0, 0); # O_RDONLY + +# allocate an uninitzlized buffer of 1024 bytes. +# we can reuse this over and over to avoid having +# to reallocate the memory. +my $buf2 = FFI::C::Buffer->new(1024); + +while(1) +{ + # send a buffer to C land as a const char * fro it to write to + my $count = $read->call($fd, $buf2->ptr, $buf2->buffer_size); + + die "error reading into buffer" if $count < 0; + + last if $count == 0; + + $write->call(1, $buf2->ptr, $count); +} diff --git a/lib/FFI/C.pm b/lib/FFI/C.pm index 91c2c6a..fa21c1b 100644 --- a/lib/FFI/C.pm +++ b/lib/FFI/C.pm @@ -261,12 +261,18 @@ So-called "pass-by-value" is not and will not be supported. For =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/ASCIIString.pm b/lib/FFI/C/ASCIIString.pm new file mode 100644 index 0000000..fd50c68 --- /dev/null +++ b/lib/FFI/C/ASCIIString.pm @@ -0,0 +1,216 @@ +package FFI::C::ASCIIString; + +use strict; +use warnings; +use Ref::Util qw( is_plain_scalarref is_ref ); +use FFI::Platypus::Buffer 1.28 (); +use base qw( FFI::C::String ); + +# ABSTRACT: C string class for ASCII +# VERSION + +=head1 SYNOPSIS + +# EXAMPLE: examples/synopsis/ascii_string.pl + +=head1 DESCRIPTION + +This class represents a NULL terminated C ASCII string, which is common to many C APIs. +It inherits from L and L, so you can use all of the +methods that those classes implement. + +In particular, the amount of memory allocated for the string B be more than initially +needed, which allows appending (C below) to the end of the string. By default just +enough space is allocated to store the string, including its NULL termination. + +This class endeavors to ensure the string contain only ASCII characters. If non-ASCII +characters are seen passing to or from C space then this class will throw an exception. + +Typically the C built-in type that comes with L will work just +fine for ASCII strings, without needing this class. Where this class may come in handy +is when you have to keep a C string around for multiple calls into C space, or passing +a string from one C API to another. + +=head1 CONSTRUCTOR + +=head2 new + + my $str = FFI::C::ASCIIString->new($buffer_size); + my $str = FFI::C::ASCIIString->new(\$perl_string); + +Creates a new NULL terminated string C string object. + +The first form creates a new NULL terminated string C<""> with a buffer capacity of C<$buffer_size>. + +The second form computes the buffer size from the provided C<$perl_string> and copies it to the +new C string. If the Perl string doesn't include the NULL termination it will be added to the +new C string. If there are non-ASCII characters in the C<$perl_string> then it will throw an exception. + +=cut + +sub new +{ + my $class = shift; + + if(@_ == 1) + { + if(is_plain_scalarref $_[0] && !is_ref ${$_[0]}) + { + Carp::croak("Non ASCII characters found in string") if ${$_[0]} =~ /[^[:ascii:]]/; + + return ${$_[0]} =~ /\0/ + ? $class->SUPER::new($_[0]) + : $class->SUPER::new(\"${$_[0]}\0"); + } + elsif(!is_ref $_[0]) + { + my $self = $class->SUPER::new(@_); + $self->from_perl("\0"); + return $self; + } + else + { + return $class->SUPER::new(@_); + } + } + else + { + return $class->SUPER::new(@_); + } +} + +=head1 ATTRIBUTES + +=head2 encoding_name + + my $name = FFI::C::ASCIIString->encoding_name; + my $name = $str->encoding_name; + +Returns the name of the string encoding. For this class it should always be C. + +=cut + +sub encoding_name { 'ascii' } + +=head2 encoding_width + + my $width = FFI::C::ASCIIString->encoding_width; + my $width = $str->encoding_width; + +Returns the size of a character, if the encoding has fixed width characters. For this +class it should always be C<1>. + +=cut + +sub encoding_width { 1 } + +=head1 METHODS + +=head2 to_perl + + my $perl_string = $str->to_perl; + +Copies the NULL terminated C string to a Perl string. +If the string contains non-ASCII characters it will +throw an exception. + +=cut + +sub to_perl +{ + my $self = shift; + my $win; + $self->window($win); + Carp::croak("Non ASCII characters found in string") if $win =~ /[^[:ascii:]]/; + my $copy = "$win"; + $copy =~ s/\0.*$//; + $copy; +} + +=head2 from_perl + + $str->from_perl($perl_string); + $str->from_perl($perl_string, $size); + +=cut + +sub from_perl +{ + my $self = shift; + Carp::croak("Argument is undef") unless @_ >= 1 && defined $_[0]; + Carp::croak("Non ASCII characters found in string") if $_[0] =~ /[^[:ascii:]]/; + if($_[0] !~ /\0/) + { + my $str = shift @_; + unshift @_, "$str\0"; + } + $self->SUPER::from_perl(@_); +} + +=head2 strlen + + my $len = $str->strlen; + +Returns the length of the string in characters. + +=cut + +$FFI::C::FFI::ffi->attach( [ strnlen => 'strlen' ] => ['opaque','size_t'] => 'size_t' => sub { + my($xsub, $self) = @_; + $xsub->($self->ptr, $self->buffer_size); +}); + +=head2 strcat + + $str->strcat($perl_string); + +Append the content of the Perl string to the end of the C string. + +=cut + +$FFI::C::FFI::ffi->attach( [ 'strncat' => 'strcat' ] => ['opaque','string','size_t'] => sub { + my $xsub = shift; + my $self = shift; + Carp::croak("Non ASCII characters found in string") if $_[0] =~ /[^[:ascii:]]/; + $xsub->($self->ptr, $_[0], $self->buffer_size); +}); + +1; + +=head1 SEE ALSO + +=over 4 + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=back + +=cut diff --git a/lib/FFI/C/Array.pm b/lib/FFI/C/Array.pm index d3c7f2b..3657b81 100644 --- a/lib/FFI/C/Array.pm +++ b/lib/FFI/C/Array.pm @@ -133,12 +133,18 @@ sub CLEAR =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/ArrayDef.pm b/lib/FFI/C/ArrayDef.pm index adfc743..f21ee27 100644 --- a/lib/FFI/C/ArrayDef.pm +++ b/lib/FFI/C/ArrayDef.pm @@ -213,12 +213,18 @@ sub create =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/Buffer.pm b/lib/FFI/C/Buffer.pm new file mode 100644 index 0000000..1746e23 --- /dev/null +++ b/lib/FFI/C/Buffer.pm @@ -0,0 +1,268 @@ +package FFI::C::Buffer; + +use strict; +use warnings; +use FFI::Platypus::Buffer 1.28 (); +use FFI::C::FFI (); +use Ref::Util qw( is_ref is_plain_scalarref ); +use Carp qw( croak ); + +# ABSTRACT: Interface to unstructured C buffer data +# VERSION + +=head1 SYNOPSIS + +# EXAMPLE: examples/synopsis/buffer.pl + +=head1 DESCRIPTION + +This class provides an interface to an unstructured buffer in memory. This is essentially a +region of memory as defined by a pointer and a size in bytes. + +The size can be undefined when a buffer is immediately returned from C space because buffers +are typically returned as two argument types or an argument and a return value. Be sure +to set the buffer size on the object as soon as possible, otherwise some operations may +not work. + +The buffer is freed when the buffer object is undefined or falls out of scope. Care must be +taken that the pointer isn't being used after the buffer is freed. + +=head1 CONSTRUCTOR + +=head2 new + + my $buf = FFI::C::BUffer->new($buffer_size); + my $buf = FFI::C::Buffer->new(\$raw); + +Creates a new buffer of the given size. + +The first form creates an uninitialized buffer of the given size. + +The second form creates a buffer the same size as C<$raw> and copies +the content of C<$raw> into it. Keep in mind that if C<$raw> is a +UTF-8 Perl string then that flag will be lost when the data is +retrieved from the buffer object in Perl and you will need to encode +it to get it back to its original state. + +=cut + +sub new +{ + my $class = shift; + + Carp::croak("You cannot create an instance of FFI::C::String directly") + if $class eq 'FFI::C::String'; + + my $buffer_size; + my $ptr; + my $owner; + + if(@_ == 1) + { + my $src_ptr; + if(is_plain_scalarref $_[0] && !is_ref ${$_[0]}) + { + ($src_ptr, $buffer_size) = FFI::Platypus::Buffer::scalar_to_buffer(${$_[0]}); + } + elsif(!is_ref $_[0]) + { + $buffer_size = shift; + } + else + { + die 'bad usage'; + } + $ptr = FFI::C::FFI::malloc($buffer_size); + die "Unable to allocate $buffer_size bytes" unless defined $ptr; + FFI::C::FFI::memcpy($ptr, $src_ptr, $buffer_size) if defined $src_ptr; + } + elsif(@_ == 2) + { + ($ptr, $owner) = @_; + } + else + { + die 'wrong number of arguments'; + } + + return bless { + ptr => $ptr, + buffer_size => $buffer_size, + owner => $owner, + }, $class; +} + +=head1 METHODS + +=head2 ptr + + my $ptr = $buf->ptr; + +Get the pointer to the start of the buffer. + +Care should be taken when using this pointer, because the buffer will be +freed if the C<$buf> object is explicitly freed or falls out of scope. +If the buffer is freed then the pointer is no longer valid. + +=cut + +sub ptr +{ + shift->{ptr}; +} + +=head2 buffer_size + + my $size = $buf->buffer_size; + $buf->buffer_size($size); + +Get or set the size of the buffer. + +Setting the buffer size should be done with great care! Normally you would only ever +set the buffer size if the buffer is returned from C code and the size of the buffer +is provided by another argument. + +You could also set the buffer size to a smaller size to truncate the size of the buffer, +although the space will not be freed until the entire buffer is freed. + +=cut + +sub buffer_size +{ + my $self = shift; + @_ > 0 + ? $self->{buffer_size} = shift + : $self->{buffer_size}; +} + +=head2 to_perl + + my $raw = $buf->to_perl; + +Copies the raw data into a Perl scalar and returns it. If this is UTF-8 (or some +other encoding) data then you will want to encode it before treating it as such. + +=cut + +sub to_perl +{ + my($self) = @_; + my $win; + $self->window($win); + return $win; # oddly this will copy the scalar. +} + +=head2 window + + $buf->window($win); + +This creates a read-only window into the buffer. This can save some memory and +time if you want to just read from the buffer in Perl without having to copy +it into a real Perl scalar. + +As with other methods, care must be taken with the window variable if the buffer +is freed. + +=cut + +sub window +{ + my $self = shift; + if(@_ == 1) + { + push @_, $self->ptr, $self->buffer_size; + goto \&FFI::Platypus::Buffer::window; + } + else + { + Carp::croak("usage: \$buf->window(\$win)"); + } +} + +=head2 from_perl + + $buf->from_perl($raw) + $buf->from_perl($raw, $size) + +Copies the raw data from C<$raw> into the buffer. In the first form the size copied is +computed from the size of the scalar C<$raw>. If the size of C<$raw> is larger than +the buffer, then an exception will be thrown. + +In the second form, C<$size> bytes will be copied. If this is larger than C<$raw> or +larger than the buffer then an exception will be thrown. + +=cut + +sub from_perl +{ + my $self = shift; + if(@_ == 1) + { + my($src_ptr, $src_size) = FFI::Platypus::Buffer::scalar_to_buffer($_[0]); + Carp::croak("Source scalar is larger than the buffer") if $src_size > $self->buffer_size; + FFI::C::FFI::memcpy($self->{ptr}, $src_ptr, $src_size); + } + elsif(@_ == 2) + { + my $size = pop; + my($src_ptr, $src_size) = FFI::Platypus::Buffer::scalar_to_buffer($_[0]); + Carp::croak("Specified size is larger than source string") if $size > $src_size; + Carp::croak("Specified size is larger than the buffer") if $size > $self->buffer_size; + FFI::C::FFI::memcpy($self->{ptr}, $src_ptr, $size); + } + else + { + Carp::croak("usage: \$buf->from_perl(\$raw [, \$size])"); + } + + 1; +} + +sub DESTROY +{ + my($self) = @_; + if($self->{ptr} && !$self->{owner}) + { + FFI::C::FFI::free(delete $self->{ptr}); + } +} + +1; + +=head1 SEE ALSO + +=over 4 + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=back + +=cut diff --git a/lib/FFI/C/Def.pm b/lib/FFI/C/Def.pm index cba90a0..d2c8e31 100644 --- a/lib/FFI/C/Def.pm +++ b/lib/FFI/C/Def.pm @@ -437,12 +437,18 @@ sub rev { shift->{rev} } =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/FFI.pm b/lib/FFI/C/FFI.pm index b6fc6e6..36836fe 100644 --- a/lib/FFI/C/FFI.pm +++ b/lib/FFI/C/FFI.pm @@ -21,13 +21,14 @@ This module is private for L our @EXPORT_OK = qw( malloc free memset memcpy_addr ); -my $ffi = FFI::Platypus->new( api => 1, lib => [undef] ); +our $ffi = FFI::Platypus->new( api => 1, lib => [undef] ); constant->import( memcpy_addr => $ffi->find_symbol( 'memcpy' ) ); -$ffi->attach( malloc => ['size_t'] => 'opaque', '$' ); -$ffi->attach( free => ['opaque'] => 'void', '$' ); -$ffi->attach( memset => ['opaque','int','size_t'] => 'opaque', '$$$' ); +$ffi->attach( malloc => ['size_t'] => 'opaque', '$' ); +$ffi->attach( free => ['opaque'] => 'void', '$' ); +$ffi->attach( memset => ['opaque','int','size_t'] => 'opaque', '$$$' ); +$ffi->attach( memcpy => ['opaque','opaque','size_t'] => 'opaque', '$$$' ); ## should this be configurable for when we hunt for memory leaks? #sub malloc ($) @@ -60,12 +61,18 @@ $ffi->attach( memset => ['opaque','int','size_t'] => 'opaque', '$$$' ); =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/File.pm b/lib/FFI/C/File.pm index 8be6d78..d8af647 100644 --- a/lib/FFI/C/File.pm +++ b/lib/FFI/C/File.pm @@ -373,12 +373,18 @@ sub DESTROY =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/PosixFile.pm b/lib/FFI/C/PosixFile.pm index 0130795..1aee392 100644 --- a/lib/FFI/C/PosixFile.pm +++ b/lib/FFI/C/PosixFile.pm @@ -11,7 +11,7 @@ use base qw( FFI::C::File ); =head1 SYNOPSIS use FFI::C::PosixFile; - + my $stdout = FFI::C::PosixFile->fdopen(1, "w"); say $stdout->fileno; # prints 1 @@ -101,12 +101,18 @@ else =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/String.pm b/lib/FFI/C/String.pm new file mode 100644 index 0000000..ea68ba9 --- /dev/null +++ b/lib/FFI/C/String.pm @@ -0,0 +1,121 @@ +package FFI::C::String; + +use strict; +use warnings; +use base qw( FFI::C::Buffer ); +use Carp (); +use Ref::Util qw( is_blessed_hashref ); + +# ABSTRACT: Base class for C string classes +# VERSION + +=head1 SYNOPSIS + +# EXAMPLE: examples/synopsis/ascii_string.pl + +=head1 DESCRIPTION + +This is a base class for classes that represent NULL terminated C strings. +The encoding is defined by the subclass. This class can be instantiated + + +This class is itself a subclass of L, so you can use all +of the methods that class provides. In particular it is worth remembering +that the buffer size of the C string object can be larger than the string +contained within. + +Subclasses include: + +=over 4 + +=item L + +=back + +=head1 ATTRIBUTES + +=head2 encoding_name + + my $name = $str->encoding_name; + +Returns the name of the string encoding. Throws + +=cut + +sub encoding_name +{ + my($self) = @_; + + if(is_blessed_hashref $self && exists $self->{encoding_name}) + { + return $self->{encoding_name}; + } + else + { + Carp::croak("No encoding specified for this class / object"); + } +} + +=head2 encoding_width + + my $width = FFI::C::ASCIIString->encoding_width; + my $width = $str->encoding_width; + +Returns the size of a character, if the encoding has fixed width characters. For encodings +which do not have a fixed width per-character this will return undef. + +=cut + +sub encoding_width +{ + my($self) = @_; + + if(is_blessed_hashref $self && exists $self->{encoding_width}) + { + return $self->{encoding_width}; + } + else + { + return undef; + } +} + +1; + +=head1 SEE ALSO + +=over 4 + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=back + +=cut diff --git a/lib/FFI/C/Struct.pm b/lib/FFI/C/Struct.pm index a8658bc..d316dbe 100644 --- a/lib/FFI/C/Struct.pm +++ b/lib/FFI/C/Struct.pm @@ -207,12 +207,18 @@ sub CLEAR =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/StructDef.pm b/lib/FFI/C/StructDef.pm index 60bec9e..a99f4e5 100644 --- a/lib/FFI/C/StructDef.pm +++ b/lib/FFI/C/StructDef.pm @@ -396,12 +396,18 @@ sub trim_string { shift->{trim_string} } =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/Union.pm b/lib/FFI/C/Union.pm index da642d8..20e8d5e 100644 --- a/lib/FFI/C/Union.pm +++ b/lib/FFI/C/Union.pm @@ -39,12 +39,18 @@ Creates a new instance of the C. =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/UnionDef.pm b/lib/FFI/C/UnionDef.pm index 6380572..433c28d 100644 --- a/lib/FFI/C/UnionDef.pm +++ b/lib/FFI/C/UnionDef.pm @@ -66,12 +66,18 @@ You can optionally initialize member values using C<%init>. =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/lib/FFI/C/Util.pm b/lib/FFI/C/Util.pm index b8e2722..a59e682 100644 --- a/lib/FFI/C/Util.pm +++ b/lib/FFI/C/Util.pm @@ -91,6 +91,10 @@ sub c_to_perl ($) return \%h; } + elsif($inst->isa('FFI::C::Buffer')) + { + return $inst->to_perl; + } else { my %h; @@ -207,12 +211,18 @@ sub set_array_count ($$) =item L +=item L + +=item L + =item L =item L =item L +=item L + =item L =item L diff --git a/t/00_diag.t b/t/00_diag.t index d465ad6..eaef0ef 100644 --- a/t/00_diag.t +++ b/t/00_diag.t @@ -14,6 +14,7 @@ $modules{$_} = $_ for qw( Class::Inspector ExtUtils::MakeMaker FFI::Platypus + FFI::Platypus::Buffer FFI::Platypus::Memory FFI::Platypus::Record FFI::Platypus::Type::Enum diff --git a/t/ffi_c_asciistring.t b/t/ffi_c_asciistring.t new file mode 100644 index 0000000..b0ee1f8 --- /dev/null +++ b/t/ffi_c_asciistring.t @@ -0,0 +1,39 @@ +use Test2::V0 -no_srand => 1; +use FFI::C::ASCIIString; + +subtest 'very basic' => sub { + + my $str = FFI::C::ASCIIString->new(\"foobar"); + + is( + $str, + object { + call [ isa => 'FFI::C::Buffer' ] => T(); + call [ isa => 'FFI::C::String' ] => T(); + call [ isa => 'FFI::C::ASCIIString' ] => T(); + + call to_perl => 'foobar'; + call buffer_size => 7; + call strlen => 6; + + call encoding_name => 'ascii'; + call encoding_width => 1; + }, + ); + + my $win; + $str->window($win); + + is $win, "foobar\0"; + + $str->from_perl('baz'); + + is $win, "baz\0ar\0"; + + $str->strcat("xx"); + + is $win, "bazxx\0\0"; + +}; + +done_testing; diff --git a/t/ffi_c_buffer.t b/t/ffi_c_buffer.t new file mode 100644 index 0000000..020ae30 --- /dev/null +++ b/t/ffi_c_buffer.t @@ -0,0 +1,92 @@ +use Test2::V0 -no_srand => 1; +use FFI::C::Util qw( take owned perl_to_c c_to_perl ); +use FFI::C::Buffer; +use Encode; + +subtest 'very basic' => sub { + + my $buf = FFI::C::Buffer->new(100); + + is( + $buf, + object { + call [ isa => 'FFI::C::Buffer' ] => T(); + call ptr => match qr/^[0-9]+$/; + call buffer_size => 100; + }, + ); + + is owned $buf, T(); + + undef $buf; + + # appears to free without crashing! + ok 1; + +}; + +subtest 'copy' => sub { + + my $buf = FFI::C::Buffer->new(\'foobar'); + + is( + $buf, + object { + call [ isa => 'FFI::C::Buffer' ] => T(); + call ptr => match qr/^[0-9]+$/; + call buffer_size => 6; + call to_perl => 'foobar'; + }, + ); + + my $win; + $buf->window($win); + is($win, 'foobar'); + + $buf->from_perl('baz'); + + is($buf->to_perl, 'bazbar'); + is($win, 'bazbar'); + + $buf->from_perl('onetwo'); + + is($buf->to_perl, 'onetwo'); + is($win, 'onetwo'); + + is dies { $buf->from_perl('onetwothree') }, match qr/Source scalar is larger than the buffer/; + is dies { $buf->from_perl('xo', 3) }, match qr/Specified size is larger than source string/; + + $buf->from_perl('foobarbaz',3); + + is($buf->to_perl, 'footwo'); + is($win, 'footwo'); + + is(c_to_perl($buf), 'footwo'); + # TODO? what do do with perl_to_c +}; + +subtest 'take and reconstitute' => sub { + + my $buf1 = FFI::C::Buffer->new(100); + isa_ok $buf1, 'FFI::C::Buffer'; + is owned $buf1, T(); + + my $ptr = take $buf1; + like $ptr, qr/^[0-9]+$/; + + my $buf2 = FFI::C::Buffer->new($ptr, \{}); + isa_ok $buf2, 'FFI::C::Buffer'; + is $buf2->buffer_size, U(); + is owned $buf2, F(); + + my $buf3 = FFI::C::Buffer->new($ptr, undef); + isa_ok $buf3, 'FFI::C::Buffer'; + is $buf3->buffer_size, U(); + is owned $buf3, T(); + + $buf3->buffer_size(50); + is $buf3->buffer_size, 50; + +}; + +done_testing; diff --git a/t/ffi_c_string.t b/t/ffi_c_string.t new file mode 100644 index 0000000..33edf21 --- /dev/null +++ b/t/ffi_c_string.t @@ -0,0 +1,6 @@ +use Test2::V0 -no_srand => 1; +use FFI::C::String; + +is dies { FFI::C::String->new }, match qr/You cannot create an instance of FFI::C::String/; + +done_testing;