[SCM] Debian packaging of libzeromq-perl branch, master, updated. debian/0.18-1-7-g59ed744
Alessandro Ghedini
al3xbio at gmail.com
Thu Dec 8 15:01:53 UTC 2011
The following commit has been merged in the master branch:
commit e75a20684fc6d30d991b6eacecb90f02e55567eb
Author: Alessandro Ghedini <al3xbio at gmail.com>
Date: Thu Dec 8 16:30:50 2011 +0100
Imported Upstream version 0.19
diff --git a/Changes b/Changes
index fa032fd..81c5201 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,12 @@
Changelog for Perl module ZeroMQ.
+0.19 Dec 08 2011
+ - Fix socket/context destruction order (github #20).
+ - Apply doc patches.
+ - Make ZMQ_NOBLOCK to ZMQ_DONTWAIT when libzmq >= 3
+ - Change tests to using Test::Fatal instead of Test::Exception
+ - Change tests to using Test::TCP object interface
+
0.18 Nov 06 2011
- Pass $flags in ZeroMQ::Socket->recv_as() as is documented
diff --git a/MANIFEST b/MANIFEST
index cacc3cf..256b698 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -35,6 +35,7 @@ Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
META.yml
+MYMETA.json
README
t/000_compile.t
t/001_context.t
@@ -51,8 +52,8 @@ t/105_poll.t
t/cover.sh
t/rt64944.t
tools/check_mi_mods.pl
-tools/genfiles.pl
tools/detect_zmq.pl
+tools/genfiles.pl
xs/perl_zeromq.h
xs/perl_zeromq.xs
xt/100_eg_hello_world.t
@@ -62,6 +63,19 @@ xt/103_eg_xreqxrep.t
xt/999_leak.t
xt/999_pod-coverage.t
xt/999_pod.t
+xt/compat_000_compile.t
+xt/compat_001_context.t
+xt/compat_002_socket.t
+xt/compat_003_message.t
+xt/compat_004_version.t
+xt/compat_005_poll.t
+xt/compat_006_anyevent.t
+xt/compat_100_basic.t
+xt/compat_101_threads.t
+xt/compat_103_json.t
+xt/compat_104_ipc.t
+xt/compat_105_poll.t
+xt/compat_rt64944.t
xt/pubsub_stress.t
xt/rt64836.t
xt/rt64836_lowlevel.t
diff --git a/META.yml b/META.yml
index 238f246..ec5d22f 100644
--- a/META.yml
+++ b/META.yml
@@ -6,18 +6,19 @@ author:
build_requires:
Devel::CheckLib: 0.4
Devel::PPPort: 3.19
- ExtUtils::MakeMaker: 6.42
- ExtUtils::ParseXS: 2.21
- Test::Exception: 0.29
+ ExtUtils::MakeMaker: 6.62
+ Test::Fatal: 0
Test::More: 0.98
Test::Requires: 0
- Test::TCP: 0
+ Test::TCP: 1.08
configure_requires:
Devel::CheckLib: 0.4
Devel::PPPort: 3.19
- ExtUtils::MakeMaker: 6.42
+ ExtUtils::MakeMaker: 6.62
+ ExtUtils::ParseXS: 2.21
distribution_type: module
-generated_by: 'Module::Install version 1.01'
+dynamic_config: 1
+generated_by: 'Module::Install version 1.04'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -38,4 +39,4 @@ requires:
resources:
license: http://dev.perl.org/licenses/
repository: http://github.com/lestrrat/ZeroMQ-Perl
-version: 0.18
+version: 0.19
diff --git a/MYMETA.json b/MYMETA.json
new file mode 100644
index 0000000..8f5b3fe
--- /dev/null
+++ b/MYMETA.json
@@ -0,0 +1,67 @@
+{
+ "abstract" : "A ZeroMQ2 wrapper for Perl",
+ "author" : [
+ "Daisuke Maki <daisuke at endeworks.jp>",
+ "Steffen Mueller <smueller at cpan.org>"
+ ],
+ "dynamic_config" : 0,
+ "generated_by" : "Module::Install version 1.04, CPAN::Meta::Converter version 2.112621",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "ZeroMQ",
+ "no_index" : {
+ "directory" : [
+ "inc",
+ "t",
+ "xt"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "Devel::CheckLib" : "0.4",
+ "Devel::PPPort" : "3.19",
+ "ExtUtils::MakeMaker" : "6.62",
+ "ExtUtils::ParseXS" : "2.21",
+ "Test::Fatal" : 0,
+ "Test::More" : "0.98",
+ "Test::Requires" : 0,
+ "Test::TCP" : "1.08"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "Devel::CheckLib" : "0.4",
+ "Devel::PPPort" : "3.19",
+ "ExtUtils::MakeMaker" : "6.62",
+ "ExtUtils::ParseXS" : "2.21"
+ }
+ },
+ "runtime" : {
+ "recommends" : {
+ "JSON" : "2.00"
+ },
+ "requires" : {
+ "Task::Weaken" : 0,
+ "XSLoader" : "0.02",
+ "perl" : "5.008"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ],
+ "repository" : {
+ "url" : "http://github.com/lestrrat/ZeroMQ-Perl"
+ }
+ },
+ "version" : "0.19",
+ "x_module_name" : "ZeroMQ"
+}
diff --git a/Makefile.PL b/Makefile.PL
index e598d66..b23d34a 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -43,9 +43,9 @@ assertlibs
repository 'http://github.com/lestrrat/ZeroMQ-Perl';
requires 'Task::Weaken';
test_requires 'Test::More', '0.98';
-test_requires 'Test::TCP';
+test_requires 'Test::TCP' => '1.08';
test_requires 'Test::Requires';
-test_requires 'Test::Exception' => '0.29';
+test_requires 'Test::Fatal';
recommends 'JSON' => '2.00';
use_xshelper '-clean';
diff --git a/README b/README
index 51beb78..05d6c1b 100644
--- a/README
+++ b/README
@@ -215,7 +215,7 @@ ASYNCHRONOUS I/O WITH ZEROMQ
my $socket = zmq_socket( $ctxt, ZMQ_REP );
my $fh = zmq_getsockopt( $socket, ZMQ_FD );
my $w; $w = AE::io $fh, 0, sub {
- while ( my $msg = zmq_recv( $socket, ZMQ_RECVMORE ) ) {
+ while ( my $msg = zmq_recv( $socket, ZMQ_RCVMORE ) ) {
# do something with $msg;
}
undef $w;
diff --git a/inc/Devel/CheckLib.pm b/inc/Devel/CheckLib.pm
index eb193ff..cf2b200 100644
--- a/inc/Devel/CheckLib.pm
+++ b/inc/Devel/CheckLib.pm
@@ -6,7 +6,7 @@ Devel::CheckLib;
use 5.00405; #postfix foreach
use strict;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.93';
+$VERSION = '0.95';
use Config qw(%Config);
use Text::ParseWords 'quotewords';
@@ -225,6 +225,8 @@ sub assert_lib {
my($ch, $cfile) = File::Temp::tempfile(
'assertlibXXXXXXXX', SUFFIX => '.c'
);
+ my $ofile = $cfile;
+ $ofile =~ s/\.c$/$Config{_o}/;
print $ch qq{#include <$_>\n} for @use_headers;
print $ch qq{int main(void) { return 0; }\n};
close($ch);
@@ -258,6 +260,7 @@ sub assert_lib {
my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
push @missing, $header if $rv != 0 || ! -x $exefile;
_cleanup_exe($exefile);
+ unlink $ofile if -e $ofile;
unlink $cfile;
}
@@ -265,6 +268,8 @@ sub assert_lib {
my($ch, $cfile) = File::Temp::tempfile(
'assertlibXXXXXXXX', SUFFIX => '.c'
);
+ my $ofile = $cfile;
+ $ofile =~ s/\.c$/$Config{_o}/;
print $ch qq{#include <$_>\n} foreach (@headers);
print $ch "int main(void) { ".($args{function} || 'return 0;')." }\n";
close($ch);
@@ -312,12 +317,13 @@ sub assert_lib {
my $absexefile = File::Spec->rel2abs($exefile);
$absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/;
push @wrongresult, $lib if $rv == 0 && -x $exefile && system($absexefile) != 0;
+ unlink $ofile if -e $ofile;
_cleanup_exe($exefile);
}
unlink $cfile;
my $miss_string = join( q{, }, map { qq{'$_'} } @missing );
- die("Can't link/include $miss_string\n") if @missing;
+ die("Can't link/include C library $miss_string, aborting.\n") if @missing;
my $wrong_string = join( q{, }, map { qq{'$_'} } @wrongresult);
die("wrong result: $wrong_string\n") if @wrongresult;
}
@@ -329,6 +335,15 @@ sub _cleanup_exe {
unlink $exefile if -f $exefile;
unlink $ofile if -f $ofile;
unlink "$exefile\.manifest" if -f "$exefile\.manifest";
+ if ( $Config{cc} eq 'cl' ) {
+ # MSVC also creates foo.ilk and foo.pdb
+ my $ilkfile = $exefile;
+ $ilkfile =~ s/$Config{_exe}$/.ilk/;
+ my $pdbfile = $exefile;
+ $pdbfile =~ s/$Config{_exe}$/.pdb/;
+ unlink $ilkfile if -f $ilkfile;
+ unlink $pdbfile if -f $pdbfile;
+ }
return
}
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 74caf9c..c685ca4 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -31,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '1.01';
+ $VERSION = '1.04';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -451,7 +451,7 @@ sub _version ($) {
}
sub _cmp ($$) {
- _version($_[0]) <=> _version($_[1]);
+ _version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index d3662c9..b520616 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.04';
}
# Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 276409a..a162ad4 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -9,7 +9,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.04';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 093cb7a..a412576 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.04';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 4c71003..035cef2 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.04';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -219,14 +219,14 @@ sub write {
# an underscore, even though its own version may contain one!
# Hence the funny regexp to get rid of it. See RT #35800
# for details.
- my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
+ my ($v) = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
$self->build_requires( 'ExtUtils::MakeMaker' => $v );
$self->configure_requires( 'ExtUtils::MakeMaker' => $v );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
- $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# Generate the MakeMaker params
@@ -241,7 +241,6 @@ in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
- $DB::single = 1;
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
@@ -412,4 +411,4 @@ sub postamble {
__END__
-#line 541
+#line 540
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 3b01e09..31c953e 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.04';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -151,15 +151,21 @@ sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
- my $self = shift;
- unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config\n";
- return $self;
+ my $self = shift;
+ my $value = @_ ? shift : 1;
+ if ( $self->{values}->{dynamic_config} ) {
+ # Once dynamic we never change to static, for safety
+ return 0;
}
- $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
+ $self->{values}->{dynamic_config} = $value ? 1 : 0;
return 1;
}
+# Convenience command
+sub static_config {
+ shift->dynamic_config(0);
+}
+
sub perl_version {
my $self = shift;
return $self->{values}->{perl_version} unless @_;
@@ -170,7 +176,7 @@ sub perl_version {
# Normalize the version
$version = $self->_perl_version($version);
- # We don't support the reall old versions
+ # We don't support the really old versions
unless ( $version >= 5.005 ) {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
@@ -582,7 +588,7 @@ sub bugtracker_from {
sub requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
diff --git a/inc/Module/Install/TestTarget.pm b/inc/Module/Install/TestTarget.pm
index abd85b6..a48e4a9 100644
--- a/inc/Module/Install/TestTarget.pm
+++ b/inc/Module/Install/TestTarget.pm
@@ -3,7 +3,7 @@ package Module::Install::TestTarget;
use 5.006_002;
use strict;
#use warnings; # XXX: warnings.pm produces a lot of 'redefine' warnings!
-our $VERSION = '0.18';
+our $VERSION = '0.19';
use base qw(Module::Install::Base);
use Config;
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 3139a63..99d9631 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.04';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 1f724a7..86bb25e 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.04';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
diff --git a/inc/Module/Install/XSUtil.pm b/inc/Module/Install/XSUtil.pm
index bc3966d..e21f9b0 100644
--- a/inc/Module/Install/XSUtil.pm
+++ b/inc/Module/Install/XSUtil.pm
@@ -3,7 +3,7 @@ package Module::Install::XSUtil;
use 5.005_03;
-$VERSION = '0.37';
+$VERSION = '0.42';
use Module::Install::Base;
@ISA = qw(Module::Install::Base);
@@ -18,11 +18,10 @@ use File::Find;
use constant _VERBOSE => $ENV{MI_VERBOSE} ? 1 : 0;
my %ConfigureRequires = (
- # currently nothing
+ 'ExtUtils::ParseXS' => 2.21,
);
my %BuildRequires = (
- 'ExtUtils::ParseXS' => 2.21, # the newer, the better
);
my %Requires = (
@@ -255,6 +254,17 @@ sub requires_c99 {
return;
}
+sub requires_cplusplus {
+ my($self) = @_;
+ if(!$self->cc_available) {
+ warn "This distribution requires a C++ compiler, but $Config{cc} seems not to support C++, stopped.\n";
+ exit;
+ }
+ $self->_xs_initialize();
+ $UseCplusplus = 1;
+ return;
+}
+
sub cc_append_to_inc{
my($self, @dirs) = @_;
@@ -448,9 +458,10 @@ sub cc_src_paths{
}
}, @dirs);
+ my $xs_to = $UseCplusplus ? '.cpp' : '.c';
foreach my $src_file(@src_files){
my $c = $src_file;
- if($c =~ s/ \.xs \z/.c/xms){
+ if($c =~ s/ \.xs \z/$xs_to/xms){
$XS_ref->{$src_file} = $c;
_verbose "xs: $src_file" if _VERBOSE;
@@ -565,7 +576,10 @@ sub _extract_functions_from_header_file{
map{ qq{$add_include "$_"} } qw(EXTERN.h perl.h XSUB.h);
my $cppcmd = qq{$Config{cpprun} $cppflags $h_file};
-
+ # remove all the -arch options to workaround gcc errors:
+ # "-E, -S, -save-temps and -M options are not allowed
+ # with multiple -arch flags"
+ $cppcmd =~ s/ -arch \s* \S+ //xmsg;
_verbose("extract functions from: $cppcmd") if _VERBOSE;
`$cppcmd`;
};
@@ -743,7 +757,7 @@ package
MY;
# XXX: We must append to PM inside ExtUtils::MakeMaker->new().
-sub init_PM{
+sub init_PM {
my $self = shift;
$self->SUPER::init_PM(@_);
@@ -770,7 +784,22 @@ sub const_cccmd {
return $cccmd
}
+
+sub xs_c {
+ my($self) = @_;
+ my $mm = $self->SUPER::xs_c();
+ $mm =~ s/ \.c /.cpp/xmsg if $UseCplusplus;
+ return $mm;
+}
+
+sub xs_o {
+ my($self) = @_;
+ my $mm = $self->SUPER::xs_o();
+ $mm =~ s/ \.c /.cpp/xmsg if $UseCplusplus;
+ return $mm;
+}
+
1;
__END__
-#line 984
+#line 1025
diff --git a/lib/ZeroMQ.pm b/lib/ZeroMQ.pm
index e831623..c2a8f1b 100644
--- a/lib/ZeroMQ.pm
+++ b/lib/ZeroMQ.pm
@@ -1,7 +1,7 @@
package ZeroMQ;
use strict;
BEGIN {
- our $VERSION = '0.18';
+ our $VERSION = '0.19';
our @ISA = qw(Exporter);
}
use ZeroMQ::Raw ();
@@ -258,7 +258,7 @@ descriptor, so use that to integrate ZeroMQ and AnyEvent:
my $socket = zmq_socket( $ctxt, ZMQ_REP );
my $fh = zmq_getsockopt( $socket, ZMQ_FD );
my $w; $w = AE::io $fh, 0, sub {
- while ( my $msg = zmq_recv( $socket, ZMQ_RECVMORE ) ) {
+ while ( my $msg = zmq_recv( $socket, ZMQ_RCVMORE ) ) {
# do something with $msg;
}
undef $w;
diff --git a/lib/ZeroMQ/Constants.pm b/lib/ZeroMQ/Constants.pm
index 4947193..42d653c 100644
--- a/lib/ZeroMQ/Constants.pm
+++ b/lib/ZeroMQ/Constants.pm
@@ -29,6 +29,12 @@ BEGIN {
}
}
+# XXX ZMQ_NOBLOCK needs to be deprecated, but doing this for compat
+# for now... we need to get rid of it when we release it
+if ( ZMQ_VERSION_MAJOR >= 3 ) {
+ *ZMQ_NOBLOCK = \&ZMQ_DONTWAIT;
+}
+
our %EXPORT_TAGS = (
# socket types
socket => [ qw(
diff --git a/lib/ZeroMQ/Raw.pm b/lib/ZeroMQ/Raw.pm
index 4c94653..8659ca9 100644
--- a/lib/ZeroMQ/Raw.pm
+++ b/lib/ZeroMQ/Raw.pm
@@ -7,7 +7,7 @@ BEGIN {
# XXX it's a hassle, but keep it in sync with ZeroMQ.pm
# by loading this here, we can make ZeroMQ::Raw independent
# of ZeroMQ while keeping the dist name as ZeroMQ
- XSLoader::load('ZeroMQ', '0.18');
+ XSLoader::load('ZeroMQ', '0.19');
}
our @EXPORT = qw(
diff --git a/t/001_context.t b/t/001_context.t
index 8505978..b6b7061 100644
--- a/t/001_context.t
+++ b/t/001_context.t
@@ -1,6 +1,6 @@
use strict;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
BEGIN {
use_ok "ZeroMQ::Raw", qw(
zmq_init
@@ -8,11 +8,11 @@ BEGIN {
);
}
-lives_ok {
+is exception {
my $context = zmq_init(5);
isa_ok $context, "ZeroMQ::Raw::Context";
zmq_term( $context );
-} "sane allocation / cleanup for context";
+}, undef, "sane allocation / cleanup for context";
# Should probably run this test under valgrind to make sure
# we're not leaking memory
diff --git a/t/002_socket.t b/t/002_socket.t
index ffcd31a..6b1ee66 100644
--- a/t/002_socket.t
+++ b/t/002_socket.t
@@ -1,6 +1,6 @@
use strict;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
BEGIN {
use_ok "ZeroMQ::Constants", qw(
@@ -17,22 +17,22 @@ BEGIN {
}
subtest 'simple creation and destroy' => sub {
- lives_ok {
+ is exception {
my $context = zmq_init(1);
my $socket = zmq_socket( $context, ZMQ_REP );
isa_ok $socket, "ZeroMQ::Raw::Socket";
- } "code lives";
+ }, undef, "socket creation OK";
- lives_ok {
+ is exception {
my $context = zmq_init(1);
my $socket = zmq_socket( $context, ZMQ_REP );
isa_ok $socket, "ZeroMQ::Raw::Socket";
zmq_close( $socket );
- } "code lives";
+ }, undef, "socket create, then zmq_close";
};
subtest 'connect to a non-existent addr' => sub {
- lives_ok {
+ is exception {
my $context = zmq_init(1);
my $socket = zmq_socket( $context, ZMQ_PUSH );
@@ -49,7 +49,7 @@ subtest 'connect to a non-existent addr' => sub {
} "connect should fail on a closed socket";
}
- } "check for proper handling of closed socket";
+ }, undef, "check for proper handling of closed socket";
};
done_testing;
diff --git a/t/003_message.t b/t/003_message.t
index a5061e0..de26165 100644
--- a/t/003_message.t
+++ b/t/003_message.t
@@ -1,6 +1,6 @@
use strict;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
BEGIN {
use_ok "ZeroMQ::Raw", qw(
zmq_msg_init
@@ -14,36 +14,36 @@ BEGIN {
}
subtest "sane allocation / cleanup for message" => sub {
- lives_ok {
+ is exception {
my $msg = ZeroMQ::Raw::zmq_msg_init();
isa_ok $msg, "ZeroMQ::Raw::Message";
is zmq_msg_data( $msg ), '', "no message data";
is zmq_msg_size( $msg ), 0, "data size is 0";
- } "code lives";
+ }, undef, "code lives";
};
subtest "sane allocation / cleanup for message (init_data)" => sub {
- lives_ok {
+ is exception {
my $data = "TESTTEST";
my $msg = zmq_msg_init_data( $data );
isa_ok $msg, "ZeroMQ::Raw::Message";
is zmq_msg_data( $msg ), $data, "data matches";
is zmq_msg_size( $msg ), length $data, "data size matches";
- } "code lives";
+ }, undef, "code lives";
};
subtest "sane allocation / cleanup for message (init_size)" => sub {
- lives_ok {
+ is exception {
my $msg = zmq_msg_init_size(100);
isa_ok $msg, "ZeroMQ::Raw::Message";
# don't check data(), as it will be populated with garbage
is zmq_msg_size( $msg ), 100, "data size is 100";
- } "code lives";
+ }, undef, "code lives";
};
subtest "copy / move" => sub {
- lives_ok {
+ is exception {
my $msg1 = zmq_msg_init_data( "foobar" );
my $msg2 = zmq_msg_init_data( "fogbaz" );
my $msg3 = zmq_msg_init_data( "figbun" );
@@ -51,7 +51,7 @@ subtest "copy / move" => sub {
is zmq_msg_copy( $msg1, $msg2 ), 0, "copy returns 0";
is zmq_msg_data( $msg1 ), zmq_msg_data( $msg2 ), "msg1 == msg2";
is zmq_msg_data( $msg1 ), "fogbaz", "... and msg2's data is in msg1";
- } "code lives";
+ }, undef, "code lives";
};
done_testing;
\ No newline at end of file
diff --git a/t/005_poll.t b/t/005_poll.t
index 4cd6f80..9341099 100644
--- a/t/005_poll.t
+++ b/t/005_poll.t
@@ -1,6 +1,6 @@
use strict;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
BEGIN {
use_ok "ZeroMQ::Raw";
@@ -10,7 +10,7 @@ BEGIN {
subtest 'basic poll with fd' => sub {
SKIP: {
skip "Can't poll using fds on Windows", 2 if ($^O eq 'MSWin32');
- lives_ok {
+ is exception {
my $called = 0;
zmq_poll([
{
@@ -20,7 +20,7 @@ subtest 'basic poll with fd' => sub {
}
], 1);
ok $called, "callback called";
- } "PollItem doesn't die";
+ }, undef, "PollItem doesn't die";
}
};
@@ -29,7 +29,7 @@ subtest 'poll with zmq sockets' => sub {
my $req = zmq_socket( $ctxt, ZMQ_REQ );
my $rep = zmq_socket( $ctxt, ZMQ_REP );
my $called = 0;
- lives_ok {
+ is exception {
zmq_bind( $rep, "inproc://polltest");
zmq_connect( $req, "inproc://polltest");
zmq_send( $req, "Test");
@@ -41,7 +41,7 @@ subtest 'poll with zmq sockets' => sub {
callback => sub { $called++ }
},
], 1);
- } "PollItem correctly handles callback";
+ }, undef, "PollItem correctly handles callback";
is $called, 1;
};
diff --git a/t/006_anyevent.t b/t/006_anyevent.t
index d066233..677a7b0 100644
--- a/t/006_anyevent.t
+++ b/t/006_anyevent.t
@@ -7,54 +7,59 @@ BEGIN {
use_ok "ZeroMQ::Constants", ":all";
}
-test_tcp(
- client => sub {
- my $port = shift;
- my $ctxt = zmq_init(1);
- my $sock = zmq_socket( $ctxt, ZMQ_REQ );
-
- zmq_connect( $sock, "tcp://127.0.0.1:$port" );
- my $data = join '.', time(), $$, rand, {};
- zmq_send( $sock, $data );
- my $msg = zmq_recv( $sock );
- is $data, zmq_msg_data( $msg ), "Got back same data";
- },
- server => sub {
- my $port = shift;
- my $ctxt = zmq_init(1);
- my $sock = zmq_socket( $ctxt, ZMQ_REP );
- zmq_bind( $sock, "tcp://127.0.0.1:$port" );
-
- my $msg;
- if ( $^O eq 'MSWin32' ) {
- my $timeout = time() + 5;
- do {
- zmq_poll([
- {
- socket => $sock,
- events => ZMQ_POLLIN,
- callback => sub {
- $msg = zmq_recv( $sock, ZMQ_RCVMORE );
- }
- },
- ], 5);
- } while (! $msg && time < $timeout );
- } else {
- my $cv = AE::cv;
- my $fh = zmq_getsockopt( $sock, ZMQ_FD );
- my $w; $w = AE::io $fh, 0, sub {
- if (my $msg = zmq_recv( $sock, ZMQ_RCVMORE )) {
- undef $w;
- $cv->send( $msg );
- }
- };
- note "Waiting...";
- $msg = $cv->recv;
- }
-
- zmq_send( $sock, zmq_msg_data( $msg ) );
- exit 0;
+my $server = Test::TCP->new(code => sub {
+ my $port = shift;
+ my $ctxt = zmq_init(1);
+ my $sock = zmq_socket( $ctxt, ZMQ_REP );
+ zmq_bind( $sock, "tcp://127.0.0.1:$port" );
+
+ my $msg;
+ if ( $^O eq 'MSWin32' ) {
+ note "Win32 server, using zmq_poll";
+ my $timeout = time() + 5;
+ do {
+ zmq_poll([
+ {
+ socket => $sock,
+ events => ZMQ_POLLIN,
+ callback => sub {
+ $msg = zmq_recv( $sock, ZMQ_RCVMORE );
+ }
+ },
+ ], 5);
+ } while (! $msg && time < $timeout );
+ } else {
+ note "Using zmq_getsockopt + AE";
+ my $cv = AE::cv;
+
+ note " + Extracting ZMQ_FD";
+ my $fh = zmq_getsockopt( $sock, ZMQ_FD );
+
+ note " + Creating AE::io for fd";
+ my $w; $w = AE::io $fh, 0, sub {
+ if (my $msg = zmq_recv( $sock, ZMQ_RCVMORE )) {
+ undef $w;
+ $cv->send( $msg );
+ }
+ };
+ note "Waiting...";
+ $msg = $cv->recv;
}
-);
+
+ zmq_send( $sock, zmq_msg_data( $msg ) );
+ exit 0;
+});
+
+my $port = $server->port;
+my $ctxt = zmq_init(1);
+my $sock = zmq_socket( $ctxt, ZMQ_REQ );
+
+zmq_connect( $sock, "tcp://127.0.0.1:$port" );
+my $data = join '.', time(), $$, rand, {};
+
+note "Sending data to server";
+zmq_send( $sock, $data );
+my $msg = zmq_recv( $sock );
+is $data, zmq_msg_data( $msg ), "Got back same data";
done_testing;
diff --git a/t/101_threads.t b/t/101_threads.t
index e8dec64..0e3323a 100644
--- a/t/101_threads.t
+++ b/t/101_threads.t
@@ -10,7 +10,7 @@ use strict;
use warnings;
use threads;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use ZeroMQ qw/:all/;
{
@@ -25,15 +25,15 @@ use ZeroMQ qw/:all/;
note "created thread " . threads->tid;
my $sock = $cxt->socket( ZMQ_PAIR );
ok $sock, "created server socket";
- lives_ok {
+ is exception {
$sock->bind("inproc://myPrivateSocket");
- } "bound server socket";
+ }, undef, "bound server socket";
my $client = $cxt->socket(ZMQ_PAIR); # sender
ok $client, "created client socket";
- lives_ok {
+ is exception {
$client->connect("inproc://myPrivateSocket");
- } "connected client socket";
+ }, undef, "connected client socket";
$client->send( "Wee Woo" );
my $data = $sock->recv();
diff --git a/t/rt64944.t b/t/rt64944.t
index 5e9fe2a..5e35798 100644
--- a/t/rt64944.t
+++ b/t/rt64944.t
@@ -13,156 +13,153 @@ BEGIN {
}
subtest 'blocking recv' => sub {
- test_tcp(
- client => sub {
- my $port = shift;
- my $ctxt = ZeroMQ::Context->new();
- my $sock = $ctxt->socket(ZMQ_SUB);
-
- $sock->connect("tcp://127.0.0.1:$port" );
- $sock->setsockopt(ZMQ_SUBSCRIBE, '');
-
- for(1..10) {
- my $msg = $sock->recv();
- is $msg->data(), $_;
- }
- },
- server => sub {
- my $port = shift;
- my $ctxt = ZeroMQ::Context->new();
- my $sock = $ctxt->socket(ZMQ_PUB);
-
- $sock->bind("tcp://127.0.0.1:$port");
- sleep 2;
- for (1..10) {
- $sock->send($_);
- }
- sleep 2;
+ my $server = Test::TCP->new(code => sub {
+ my $port = shift;
+ note "START blocking recv server on port $port";
+ my $ctxt = ZeroMQ::Context->new();
+ my $sock = $ctxt->socket(ZMQ_PUB);
+
+ $sock->bind("tcp://127.0.0.1:$port");
+ sleep 2;
+ for (1..10) {
+ $sock->send($_);
}
- );
+ sleep 2;
+ note "END blocking recv server";
+ $sock->close;
+
+ exit 0;
+ });
+
+ my $port = $server->port;
+ my $ctxt = ZeroMQ::Context->new();
+ my $sock = $ctxt->socket(ZMQ_SUB);
+
+ note "blocking recv client connecting to port $port";
+ $sock->connect("tcp://127.0.0.1:$port" );
+ $sock->setsockopt(ZMQ_SUBSCRIBE, '');
+
+ for(1..10) {
+ my $msg = $sock->recv();
+ is $msg->data(), $_;
+ }
};
-
+
subtest 'non-blocking recv (fail)' => sub {
- test_tcp(
- client => sub {
- my $port = shift;
- my $ctxt = ZeroMQ::Context->new();
- my $sock = $ctxt->socket(ZMQ_SUB);
-
- $sock->connect("tcp://127.0.0.1:$port" );
- $sock->setsockopt(ZMQ_SUBSCRIBE, '');
-
- for(1..10) {
- my $msg = $sock->recv(ZMQ_RCVMORE); # most of this call should really fail
- }
- ok(1); # dummy - this is just here to find leakage
- },
- server => sub {
- my $port = shift;
- my $ctxt = ZeroMQ::Context->new();
- my $sock = $ctxt->socket(ZMQ_PUB);
+ my $server = Test::TCP->new(code => sub {
+ my $port = shift;
+ my $ctxt = ZeroMQ::Context->new();
+ my $sock = $ctxt->socket(ZMQ_PUB);
- $sock->bind("tcp://127.0.0.1:$port");
- sleep 2;
- for (1..10) {
- $sock->send($_);
- }
- sleep 2;
+ $sock->bind("tcp://127.0.0.1:$port");
+ sleep 2;
+ for (1..10) {
+ $sock->send($_);
}
- );
+ sleep 2;
+ exit 0;
+ } );
+
+ my $port = $server->port;
+
+ note "non-blocking client connecting to port $port";
+ my $ctxt = ZeroMQ::Context->new();
+ my $sock = $ctxt->socket(ZMQ_SUB);
+
+ $sock->connect("tcp://127.0.0.1:$port" );
+ $sock->setsockopt(ZMQ_SUBSCRIBE, '');
+
+ for(1..10) {
+ my $msg = $sock->recv(ZMQ_RCVMORE); # most of this call should really fail
+ }
+ ok(1); # dummy - this is just here to find leakage
};
# Code excericising zmq_poll to do non-blocking recv()
subtest 'non-blocking recv (success)' => sub {
- test_tcp(
- client => sub {
- my $port = shift;
- my $ctxt = zmq_init();
- my $sock = zmq_socket( $ctxt, ZMQ_SUB);
-
- zmq_connect( $sock, "tcp://127.0.0.1:$port" );
- zmq_setsockopt( $sock, ZMQ_SUBSCRIBE, '');
- my $timeout = time() + 30;
- my $recvd = 0;
- while ( $timeout > time() && $recvd < 10 ) {
- zmq_poll( [ {
- socket => $sock,
- events => ZMQ_POLLIN,
- callback => sub {
- while (my $msg = zmq_recv( $sock, ZMQ_RCVMORE)) {
- is ( zmq_msg_data( $msg ), $recvd + 1 );
- $recvd++;
- }
- }
- } ], 1000000 ); # timeout in microseconds, so this is 1 sec
- }
- is $recvd, 10, "got all messages";
- },
- server => sub {
- my $port = shift;
- my $ctxt = ZeroMQ::Context->new();
- my $sock = $ctxt->socket(ZMQ_PUB);
-
- $sock->bind("tcp://127.0.0.1:$port");
- sleep 2;
- for (1..10) {
- $sock->send($_);
- }
- sleep 2;
+ my $server = Test::TCP->new( code => sub {
+ my $port = shift;
+ my $ctxt = ZeroMQ::Context->new();
+ my $sock = $ctxt->socket(ZMQ_PUB);
+
+ $sock->bind("tcp://127.0.0.1:$port");
+ sleep 2;
+ for (1..10) {
+ $sock->send($_);
}
- );
+ sleep 2;
+ exit 0;
+ } );
+
+ my $port = $server->port;
+ my $ctxt = zmq_init();
+ my $sock = zmq_socket( $ctxt, ZMQ_SUB);
+
+ zmq_connect( $sock, "tcp://127.0.0.1:$port" );
+ zmq_setsockopt( $sock, ZMQ_SUBSCRIBE, '');
+ my $timeout = time() + 30;
+ my $recvd = 0;
+ while ( $timeout > time() && $recvd < 10 ) {
+ zmq_poll( [ {
+ socket => $sock,
+ events => ZMQ_POLLIN,
+ callback => sub {
+ while (my $msg = zmq_recv( $sock, ZMQ_RCVMORE)) {
+ is ( zmq_msg_data( $msg ), $recvd + 1 );
+ $recvd++;
+ }
+ }
+ } ], 1000000 ); # timeout in microseconds, so this is 1 sec
+ }
+ is $recvd, 10, "got all messages";
};
# Code excercising AnyEvent + ZMQ_FD to do non-blocking recv
if ($^O ne 'MSWin32' && eval { require AnyEvent } && ! $@) {
AnyEvent->import; # want AE namespace
- subtest 'non-blocking recv with AnyEvent (success)' => sub {
- test_tcp(
- client => sub {
- my $port = shift;
- my $ctxt = zmq_init();
- my $sock = zmq_socket( $ctxt, ZMQ_SUB);
-
- zmq_connect( $sock, "tcp://127.0.0.1:$port" );
- zmq_setsockopt( $sock, ZMQ_SUBSCRIBE, '');
- my $timeout = time() + 30;
- my $recvd = 0;
- my $cv = AE::cv();
- my $t;
- my $fh = zmq_getsockopt( $sock, ZMQ_FD );
- my $w; $w = AE::io( $fh, 0, sub {
- while (my $msg = zmq_recv( $sock, ZMQ_RCVMORE)) {
- is ( zmq_msg_data( $msg ), $recvd + 1 );
- $recvd++;
- if ( $recvd >= 10 ) {
- undef $t;
- undef $w;
- $cv->send;
- }
- }
- } );
- $t = AE::timer( 30, 1, sub {
- undef $t;
- undef $w;
- $cv->send;
- } );
- $cv->recv;
- is $recvd, 10, "got all messages";
- },
- server => sub {
- my $port = shift;
- my $ctxt = ZeroMQ::Context->new();
- my $sock = $ctxt->socket(ZMQ_PUB);
-
- $sock->bind("tcp://127.0.0.1:$port");
- sleep 2;
- for (1..10) {
- $sock->send($_);
- }
- sleep 10;
+
+ my $server = Test::TCP->new( code => sub {
+ my $port = shift;
+ my $ctxt = ZeroMQ::Context->new();
+ my $sock = $ctxt->socket(ZMQ_PUB);
+
+ $sock->bind("tcp://127.0.0.1:$port");
+ sleep 2;
+ for (1..10) {
+ $sock->send($_);
+ }
+ sleep 10;
+ } );
+
+ my $port = $server->port;
+ my $ctxt = zmq_init();
+ my $sock = zmq_socket( $ctxt, ZMQ_SUB);
+
+ zmq_connect( $sock, "tcp://127.0.0.1:$port" );
+ zmq_setsockopt( $sock, ZMQ_SUBSCRIBE, '');
+ my $timeout = time() + 30;
+ my $recvd = 0;
+ my $cv = AE::cv();
+ my $t;
+ my $fh = zmq_getsockopt( $sock, ZMQ_FD );
+ my $w; $w = AE::io( $fh, 0, sub {
+ while (my $msg = zmq_recv( $sock, ZMQ_RCVMORE)) {
+ is ( zmq_msg_data( $msg ), $recvd + 1 );
+ $recvd++;
+ if ( $recvd >= 10 ) {
+ undef $t;
+ undef $w;
+ $cv->send;
}
- );
- };
+ }
+ } );
+ $t = AE::timer( 30, 1, sub {
+ undef $t;
+ undef $w;
+ $cv->send;
+ } );
+ $cv->recv;
+ is $recvd, 10, "got all messages";
}
-
+
done_testing;
diff --git a/xs/perl_zeromq.h b/xs/perl_zeromq.h
index 3a53067..10c425d 100644
--- a/xs/perl_zeromq.h
+++ b/xs/perl_zeromq.h
@@ -27,7 +27,12 @@ typedef struct {
void *ctxt;
} PerlZMQ_Raw_Context;
#endif
-typedef void PerlZMQ_Raw_Socket;
+
+typedef struct {
+ void *socket;
+ SV *assoc_ctxt; /* keep context around with sockets so we know */
+} PerlZMQ_Raw_Socket;
+
typedef zmq_msg_t PerlZMQ_Raw_Message;
typedef struct {
diff --git a/xs/perl_zeromq.xs b/xs/perl_zeromq.xs
index fe2db38..fe66288 100644
--- a/xs/perl_zeromq.xs
+++ b/xs/perl_zeromq.xs
@@ -63,6 +63,8 @@ STATIC_INLINE int
PerlZMQ_Raw_Context_mg_free( pTHX_ SV * const sv, MAGIC *const mg ) {
PerlZMQ_Raw_Context* const ctxt = (PerlZMQ_Raw_Context *) mg->mg_ptr;
PERL_UNUSED_VAR(sv);
+
+ PerlZMQ_trace("START mg_free (Context)");
if (ctxt != NULL) {
#ifdef USE_ITHREADS
if ( ctxt->interp == aTHX ) { /* is where I came from */
@@ -72,11 +74,13 @@ PerlZMQ_Raw_Context_mg_free( pTHX_ SV * const sv, MAGIC *const mg ) {
Safefree(ctxt);
}
#else
- PerlZMQ_trace("Context_free for zmq context %p", ctxt);
+ PerlZMQ_trace(" + zmq context %p", ctxt);
+ PerlZMQ_trace(" + are we in global destruction? %s", PL_dirty ? "YES" : "NO");
zmq_term( ctxt );
mg->mg_ptr = NULL;
#endif
}
+ PerlZMQ_trace("END mg_free (Context)");
return 1;
}
@@ -106,14 +110,38 @@ PerlZMQ_Raw_Context_mg_dup(pTHX_ MAGIC* const mg, CLONE_PARAMS* const param){
}
STATIC_INLINE int
+PerlZMQ_Raw_Socket_invalidate( PerlZMQ_Raw_Socket *sock )
+{
+ SV *ctxt_sv = sock->assoc_ctxt;
+ int rv;
+
+ PerlZMQ_trace("START socket_invalidate");
+ PerlZMQ_trace(" + zmq socket %p", sock->socket);
+ rv = zmq_close( sock->socket );
+
+ if ( SvOK(ctxt_sv) ) {
+ PerlZMQ_trace(" + associated context: %p", ctxt_sv);
+ SvREFCNT_dec(ctxt_sv);
+ sock->assoc_ctxt = NULL;
+ }
+
+ Safefree(sock);
+
+ PerlZMQ_trace("END socket_invalidate");
+ return rv;
+}
+
+STATIC_INLINE int
PerlZMQ_Raw_Socket_mg_free(pTHX_ SV* const sv, MAGIC* const mg)
{
PerlZMQ_Raw_Socket* const sock = (PerlZMQ_Raw_Socket *) mg->mg_ptr;
PERL_UNUSED_VAR(sv);
+ PerlZMQ_trace("START mg_free (Socket)");
if (sock) {
- PerlZMQ_trace("Socket_free %p", sock);
- zmq_close( sock );
+ PerlZMQ_Raw_Socket_invalidate( sock );
+ mg->mg_ptr = NULL;
}
+ PerlZMQ_trace("END mg_free (Socket)");
return 1;
}
@@ -338,12 +366,17 @@ PerlZMQ_Raw_zmq_socket (ctxt, type)
PREINIT:
SV *class_sv = sv_2mortal(newSVpvn( "ZeroMQ::Raw::Socket", 19 ));
CODE:
+ Newxz( RETVAL, 1, PerlZMQ_Raw_Socket );
+ RETVAL->assoc_ctxt = NULL;
+ RETVAL->socket = NULL;
#ifdef USE_ITHREADS
- RETVAL = zmq_socket( ctxt->ctxt, type );
+ RETVAL->socket = zmq_socket( ctxt->ctxt, type );
#else
- RETVAL = zmq_socket( ctxt, type );
+ RETVAL->socket = zmq_socket( ctxt, type );
#endif
- PerlZMQ_trace( "created socket %p", RETVAL );
+ RETVAL->assoc_ctxt = ST(0);
+ SvREFCNT_inc(RETVAL->assoc_ctxt);
+ PerlZMQ_trace( "zmq_socket: created socket %p for context %p", RETVAL, ctxt );
OUTPUT:
RETVAL
@@ -351,12 +384,14 @@ int
PerlZMQ_Raw_zmq_close(socket)
PerlZMQ_Raw_Socket *socket;
CODE:
- RETVAL = zmq_close(socket);
- if (RETVAL == 0) {
- /* Cancel the SV's mg attr so to not call zmq_term automatically */
+ RETVAL = PerlZMQ_Raw_Socket_invalidate( socket );
+ /* Cancel the SV's mg attr so to not call socket_invalidate again
+ during Socket_mg_free
+ */
+ {
MAGIC *mg =
- PerlZMQ_Raw_Socket_mg_find( aTHX_ SvRV(ST(0)), &PerlZMQ_Raw_Socket_vtbl );
- mg->mg_ptr = NULL;
+ PerlZMQ_Raw_Socket_mg_find( aTHX_ SvRV(ST(0)), &PerlZMQ_Raw_Socket_vtbl );
+ mg->mg_ptr = NULL;
}
OUTPUT:
RETVAL
@@ -366,7 +401,8 @@ PerlZMQ_Raw_zmq_connect(socket, addr)
PerlZMQ_Raw_Socket *socket;
char *addr;
CODE:
- RETVAL = zmq_connect( socket, addr );
+ PerlZMQ_trace( "zmq_connect: socket %p", socket );
+ RETVAL = zmq_connect( socket->socket, addr );
if (RETVAL != 0) {
croak( "%s", zmq_strerror( zmq_errno() ) );
}
@@ -378,7 +414,8 @@ PerlZMQ_Raw_zmq_bind(socket, addr)
PerlZMQ_Raw_Socket *socket;
char *addr;
CODE:
- RETVAL = zmq_bind( socket, addr );
+ PerlZMQ_trace( "zmq_bind: socket %p", socket );
+ RETVAL = zmq_bind( socket->socket, addr );
if (RETVAL != 0) {
croak( "%s", zmq_strerror( zmq_errno() ) );
}
@@ -394,21 +431,22 @@ PerlZMQ_Raw_zmq_recv(socket, flags = 0)
int rv;
zmq_msg_t msg;
CODE:
+ PerlZMQ_trace( "START zmq_recv" );
RETVAL = NULL;
zmq_msg_init(&msg);
- rv = zmq_recv(socket, &msg, flags);
- PerlZMQ_trace("zmq recv with flags %d", flags);
- PerlZMQ_trace("zmq_recv returned with rv '%d'", rv);
+ rv = zmq_recv(socket->socket, &msg, flags);
+ PerlZMQ_trace(" + zmq recv with flags %d", flags);
+ PerlZMQ_trace(" + zmq_recv returned with rv '%d'", rv);
if (rv != 0) {
SET_BANG;
zmq_msg_close(&msg);
- PerlZMQ_trace("zmq_recv got bad status, closing temporary message");
+ PerlZMQ_trace(" + zmq_recv got bad status, closing temporary message");
} else {
Newxz(RETVAL, 1, PerlZMQ_Raw_Message);
zmq_msg_init(RETVAL);
zmq_msg_copy( RETVAL, &msg );
zmq_msg_close(&msg);
- PerlZMQ_trace("zmq_recv created message %p", RETVAL );
+ PerlZMQ_trace(" + zmq_recv created message %p", RETVAL );
}
OUTPUT:
RETVAL
@@ -434,7 +472,7 @@ PerlZMQ_Raw_zmq_send(socket, message, flags = 0)
croak("Got invalid message object");
}
- RETVAL = zmq_send(socket, msg, flags);
+ RETVAL = zmq_send(socket->socket, msg, flags);
} else {
STRLEN data_len;
char *x_data;
@@ -444,7 +482,7 @@ PerlZMQ_Raw_zmq_send(socket, message, flags = 0)
Newxz(x_data, data_len, char);
Copy(data, x_data, data_len, char);
zmq_msg_init_data(&msg, x_data, data_len, PerlZMQ_free_string, NULL);
- RETVAL = zmq_send(socket, &msg, flags);
+ RETVAL = zmq_send(socket->socket, &msg, flags);
zmq_msg_close( &msg );
}
OUTPUT:
@@ -470,7 +508,7 @@ PerlZMQ_Raw_zmq_getsockopt(sock, option)
case ZMQ_BACKLOG:
case ZMQ_FD:
len = sizeof(i);
- status = zmq_getsockopt(sock, option, &i, &len);
+ status = zmq_getsockopt(sock->socket, option, &i, &len);
if(status == 0)
RETVAL = newSViv(i);
break;
@@ -481,7 +519,7 @@ PerlZMQ_Raw_zmq_getsockopt(sock, option)
case ZMQ_RECOVERY_IVL:
case ZMQ_MCAST_LOOP:
len = sizeof(i64);
- status = zmq_getsockopt(sock, option, &i64, &len);
+ status = zmq_getsockopt(sock->socket, option, &i64, &len);
if(status == 0)
RETVAL = newSViv(i64);
break;
@@ -491,21 +529,21 @@ PerlZMQ_Raw_zmq_getsockopt(sock, option)
case ZMQ_SNDBUF:
case ZMQ_RCVBUF:
len = sizeof(u64);
- status = zmq_getsockopt(sock, option, &u64, &len);
+ status = zmq_getsockopt(sock->socket, option, &u64, &len);
if(status == 0)
RETVAL = newSVuv(u64);
break;
case ZMQ_EVENTS:
len = sizeof(i32);
- status = zmq_getsockopt(sock, option, &i32, &len);
+ status = zmq_getsockopt(sock->socket, option, &i32, &len);
if(status == 0)
RETVAL = newSViv(i32);
break;
case ZMQ_IDENTITY:
len = sizeof(buf);
- status = zmq_getsockopt(sock, option, &buf, &len);
+ status = zmq_getsockopt(sock->socket, option, &buf, &len);
if(status == 0)
RETVAL = newSVpvn(buf, len);
break;
@@ -545,7 +583,7 @@ PerlZMQ_Raw_zmq_setsockopt(sock, option, value)
case ZMQ_SUBSCRIBE:
case ZMQ_UNSUBSCRIBE:
ptr = SvPV(value, len);
- RETVAL = zmq_setsockopt(sock, option, ptr, len);
+ RETVAL = zmq_setsockopt(sock->socket, option, ptr, len);
break;
case ZMQ_SWAP:
@@ -553,7 +591,7 @@ PerlZMQ_Raw_zmq_setsockopt(sock, option, value)
case ZMQ_RECOVERY_IVL:
case ZMQ_MCAST_LOOP:
i64 = SvIV(value);
- RETVAL = zmq_setsockopt(sock, option, &i64, sizeof(int64_t));
+ RETVAL = zmq_setsockopt(sock->socket, option, &i64, sizeof(int64_t));
break;
case ZMQ_HWM:
@@ -561,18 +599,18 @@ PerlZMQ_Raw_zmq_setsockopt(sock, option, value)
case ZMQ_SNDBUF:
case ZMQ_RCVBUF:
u64 = SvUV(value);
- RETVAL = zmq_setsockopt(sock, option, &u64, sizeof(uint64_t));
+ RETVAL = zmq_setsockopt(sock->socket, option, &u64, sizeof(uint64_t));
break;
case ZMQ_LINGER:
i = SvIV(value);
- RETVAL = zmq_setsockopt(sock, option, &i, sizeof(i));
+ RETVAL = zmq_setsockopt(sock->socket, option, &i, sizeof(i));
break;
default:
warn("Unknown sockopt type %d, assuming string. Send patch", option);
ptr = SvPV(value, len);
- RETVAL = zmq_setsockopt(sock, option, ptr, len);
+ RETVAL = zmq_setsockopt(sock->socket, option, ptr, len);
}
OUTPUT:
RETVAL
@@ -621,7 +659,8 @@ PerlZMQ_Raw_zmq_poll( list, timeout = 0 )
croak("Invalid 'socket' given for index %d", i);
}
mg = PerlZMQ_Raw_Socket_mg_find( aTHX_ SvRV(*svr), &PerlZMQ_Raw_Socket_vtbl );
- pollitems[i].socket = mg->mg_ptr;
+ pollitems[i].socket = ((PerlZMQ_Raw_Socket *) mg->mg_ptr)->socket;
+ PerlZMQ_trace( " + pollitem[%d].socket = %p", i, pollitems[i].socket );
} else {
svr = hv_fetch( elm, "fd", 2, NULL );
if (svr == NULL || ! SvOK(*svr) || SvTYPE(*svr) != SVt_IV) {
@@ -678,7 +717,7 @@ PerlZMQ_Raw_zmq_device( device, insocket, outsocket )
PerlZMQ_Raw_Socket *insocket;
PerlZMQ_Raw_Socket *outsocket;
CODE:
- RETVAL = zmq_device( device, insocket, outsocket );
+ RETVAL = zmq_device( device, insocket->socket, outsocket->socket );
OUTPUT:
RETVAL
diff --git a/xt/100_eg_hello_world.t b/xt/100_eg_hello_world.t
index 31a4755..157cf78 100644
--- a/xt/100_eg_hello_world.t
+++ b/xt/100_eg_hello_world.t
@@ -5,27 +5,25 @@ BEGIN {
use_ok "ZeroMQ", qw(ZMQ_REQ ZMQ_REP);
}
-test_tcp(
- client => sub {
- my $port = shift;
- my $ctxt = ZeroMQ::Context->new();
- my $sock = $ctxt->socket(ZMQ_REQ);
- $sock->connect( "tcp://127.0.0.1:$port" );
- $sock->send("hello");
+my $server = Test::TCP->new( code => sub {
+ my $port = shift;
+ my $ctxt = ZeroMQ::Context->new();
+ my $sock = $ctxt->socket(ZMQ_REP);
+ $sock->bind( "tcp://127.0.0.1:$port" );
- my $message = $sock->recv();
- is $message->data, "world", "client receives correct data";
- },
- server => sub {
- my $port = shift;
- my $ctxt = ZeroMQ::Context->new();
- my $sock = $ctxt->socket(ZMQ_REP);
- $sock->bind( "tcp://127.0.0.1:$port" );
+ my $message = $sock->recv();
+ is $message->data, "hello", "server receives correct data";
+ $sock->send("world");
+ exit 0;
+} );
- my $message = $sock->recv();
- is $message->data, "hello", "server receives correct data";
- $sock->send("world");
- }
-);
+my $port = $server->port;
+my $ctxt = ZeroMQ::Context->new();
+my $sock = $ctxt->socket(ZMQ_REQ);
+$sock->connect( "tcp://127.0.0.1:$port" );
+$sock->send("hello");
+
+my $message = $sock->recv();
+is $message->data, "world", "client receives correct data";
done_testing;
\ No newline at end of file
diff --git a/t/000_compile.t b/xt/compat_000_compile.t
similarity index 100%
copy from t/000_compile.t
copy to xt/compat_000_compile.t
diff --git a/t/001_context.t b/xt/compat_001_context.t
similarity index 100%
copy from t/001_context.t
copy to xt/compat_001_context.t
diff --git a/t/002_socket.t b/xt/compat_002_socket.t
similarity index 100%
copy from t/002_socket.t
copy to xt/compat_002_socket.t
diff --git a/t/003_message.t b/xt/compat_003_message.t
similarity index 100%
copy from t/003_message.t
copy to xt/compat_003_message.t
diff --git a/t/004_version.t b/xt/compat_004_version.t
similarity index 100%
copy from t/004_version.t
copy to xt/compat_004_version.t
diff --git a/t/005_poll.t b/xt/compat_005_poll.t
similarity index 100%
copy from t/005_poll.t
copy to xt/compat_005_poll.t
diff --git a/t/006_anyevent.t b/xt/compat_006_anyevent.t
similarity index 100%
copy from t/006_anyevent.t
copy to xt/compat_006_anyevent.t
diff --git a/t/100_basic.t b/xt/compat_100_basic.t
similarity index 100%
copy from t/100_basic.t
copy to xt/compat_100_basic.t
diff --git a/t/101_threads.t b/xt/compat_101_threads.t
similarity index 100%
copy from t/101_threads.t
copy to xt/compat_101_threads.t
diff --git a/t/103_json.t b/xt/compat_103_json.t
similarity index 100%
copy from t/103_json.t
copy to xt/compat_103_json.t
diff --git a/t/104_ipc.t b/xt/compat_104_ipc.t
similarity index 100%
copy from t/104_ipc.t
copy to xt/compat_104_ipc.t
diff --git a/t/105_poll.t b/xt/compat_105_poll.t
similarity index 100%
copy from t/105_poll.t
copy to xt/compat_105_poll.t
diff --git a/t/rt64944.t b/xt/compat_rt64944.t
similarity index 100%
copy from t/rt64944.t
copy to xt/compat_rt64944.t
--
Debian packaging of libzeromq-perl
More information about the Pkg-perl-cvs-commits
mailing list