summaryrefslogtreecommitdiff
path: root/t/new
diff options
context:
space:
mode:
Diffstat (limited to 't/new')
-rw-r--r--t/new/00constants.t5
-rw-r--r--t/new/01basic.t13
-rw-r--r--t/new/02header-callback.t20
-rw-r--r--t/new/03body-callback.t20
-rw-r--r--t/new/04abort.t17
-rw-r--r--t/new/05progress.t25
-rw-r--r--t/new/06http-post.t26
-rw-r--r--t/new/07errbuf.t9
-rw-r--r--t/new/08duphandle.t14
-rw-r--r--t/new/09duphandle-callback.t21
-rw-r--r--t/new/10multi-callback.t54
-rw-r--r--t/new/README8
12 files changed, 232 insertions, 0 deletions
diff --git a/t/new/00constants.t b/t/new/00constants.t
new file mode 100644
index 0000000..2b41d1e
--- /dev/null
+++ b/t/new/00constants.t
@@ -0,0 +1,5 @@
+use strict;
+use Test::Simple tests => 1;
+use WWW::Curl::Easy;
+
+ok( CURLOPT_URL == 10000 + 2 );
diff --git a/t/new/01basic.t b/t/new/01basic.t
new file mode 100644
index 0000000..9a96d54
--- /dev/null
+++ b/t/new/01basic.t
@@ -0,0 +1,13 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ my @headers = ( 'Server: cURL', 'User-Agent: WWW::Curl/3.00' );
+ $curl->setopt( CURLOPT_HTTPHEADER, \@headers );
+ my $code = $curl->perform;
+ ok( $code == 0 );
+}
diff --git a/t/new/02header-callback.t b/t/new/02header-callback.t
new file mode 100644
index 0000000..497e2dd
--- /dev/null
+++ b/t/new/02header-callback.t
@@ -0,0 +1,20 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+my $header;
+
+sub header_callback {
+ my $chunk = shift;
+ $header .= $chunk;
+ return length $chunk;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_HEADERFUNCTION, \&header_callback );
+ $curl->perform;
+ ok($header);
+}
diff --git a/t/new/03body-callback.t b/t/new/03body-callback.t
new file mode 100644
index 0000000..c91d585
--- /dev/null
+++ b/t/new/03body-callback.t
@@ -0,0 +1,20 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+my $body;
+
+sub body_callback {
+ my ( $chunk, $handle ) = @_;
+ $body .= $chunk;
+ return length $chunk;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_WRITEFUNCTION, \&body_callback );
+ $curl->perform;
+ ok($body);
+}
diff --git a/t/new/04abort.t b/t/new/04abort.t
new file mode 100644
index 0000000..77b21c1
--- /dev/null
+++ b/t/new/04abort.t
@@ -0,0 +1,17 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+sub body_callback {
+ my ( $chunk, $handle ) = @_;
+ return -1;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_WRITEFUNCTION, \&body_callback );
+ my $code = $curl->perform;
+ ok($code);
+}
diff --git a/t/new/05progress.t b/t/new/05progress.t
new file mode 100644
index 0000000..a8f2ceb
--- /dev/null
+++ b/t/new/05progress.t
@@ -0,0 +1,25 @@
+use strict;
+use Test::More tests => 3;
+use WWW::Curl::Easy;
+
+my ( $progress, $last );
+
+sub progress_callback {
+ my ( $clientp, $dltotal, $dlnow, $ultotal, $ulnow ) = @_;
+ $last = $dlnow;
+ $progress++;
+ return 0;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 3 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_NOPROGRESS, 1 );
+ $curl->setopt( CURLOPT_NOPROGRESS, 0 );
+ $curl->setopt( CURLOPT_PROGRESSFUNCTION, \&progress_callback );
+ my $code = $curl->perform;
+ ok( $code == 0 );
+ ok($progress);
+ ok($last);
+}
diff --git a/t/new/06http-post.t b/t/new/06http-post.t
new file mode 100644
index 0000000..55990f2
--- /dev/null
+++ b/t/new/06http-post.t
@@ -0,0 +1,26 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+my $max = 1000;
+
+sub read_callback {
+ my ( $maxlen, $sv ) = @_;
+
+ # Create some random data
+ my $data = chr( ord('A') + rand(26) ) x ( int( $max / 3 ) + 1 );
+ $max = $max - length $data;
+ return $data;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_READFUNCTION, \&read_callback );
+ $curl->setopt( CURLOPT_INFILESIZE, $max );
+ $curl->setopt( CURLOPT_UPLOAD, 1 );
+ $curl->setopt( CURLOPT_CUSTOMREQUEST, 'POST' );
+ my $code = $curl->perform;
+ ok( $code == 0 );
+}
diff --git a/t/new/07errbuf.t b/t/new/07errbuf.t
new file mode 100644
index 0000000..9ecd4f4
--- /dev/null
+++ b/t/new/07errbuf.t
@@ -0,0 +1,9 @@
+use strict;
+use Test::Simple tests => 1;
+use WWW::Curl::Easy;
+
+my $curl = new WWW::Curl::Easy;
+$curl->setopt( CURLOPT_URL, 'badprotocol://127.0.0.1:2' );
+$curl->perform;
+my $err = $curl->errbuf;
+ok($err);
diff --git a/t/new/08duphandle.t b/t/new/08duphandle.t
new file mode 100644
index 0000000..39381e8
--- /dev/null
+++ b/t/new/08duphandle.t
@@ -0,0 +1,14 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ my @headers = ( 'Server: cURL', 'User-Agent: WWW::Curl/3.00' );
+ $curl->setopt( CURLOPT_HTTPHEADER, \@headers );
+ my $curl2 = $curl->duphandle;
+ my $code = $curl2->perform;
+ ok( $code == 0 );
+}
diff --git a/t/new/09duphandle-callback.t b/t/new/09duphandle-callback.t
new file mode 100644
index 0000000..db7d368
--- /dev/null
+++ b/t/new/09duphandle-callback.t
@@ -0,0 +1,21 @@
+use strict;
+use Test::More tests => 1;
+use WWW::Curl::Easy;
+
+my $body;
+
+sub body_callback {
+ my ( $chunk, $handle ) = @_;
+ $body .= $chunk;
+ return length $chunk;
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 1 unless $ENV{CURL_TEST_URL};
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_WRITEFUNCTION, \&body_callback );
+ my $curl2 = $curl->duphandle;
+ $curl2->perform;
+ ok($body);
+}
diff --git a/t/new/10multi-callback.t b/t/new/10multi-callback.t
new file mode 100644
index 0000000..ee887ad
--- /dev/null
+++ b/t/new/10multi-callback.t
@@ -0,0 +1,54 @@
+use strict;
+use Test::More tests => 4;
+use WWW::Curl::Easy;
+use WWW::Curl::Multi;
+
+my ( $header, $body, $header2, $body2 );
+
+sub header_callback {
+ my $chunk = shift;
+ $header .= $chunk;
+ return length($chunk);
+}
+
+sub body_callback {
+ my ( $chunk, $handle ) = @_;
+ $body .= $chunk;
+ return length($chunk);
+}
+
+sub header_callback2 {
+ my $chunk = shift;
+ $header2 .= $chunk;
+ return length($chunk);
+}
+
+sub body_callback2 {
+ my ( $chunk, $handle ) = @_;
+ $body2 .= $chunk;
+ return length($chunk);
+}
+
+SKIP: {
+ skip 'You need to set CURL_TEST_URL', 4 unless $ENV{CURL_TEST_URL};
+
+ my $curl = new WWW::Curl::Easy;
+ $curl->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl->setopt( CURLOPT_HEADERFUNCTION, \&header_callback );
+ $curl->setopt( CURLOPT_WRITEFUNCTION, \&body_callback );
+
+ my $curl2 = new WWW::Curl::Easy;
+ $curl2->setopt( CURLOPT_URL, $ENV{CURL_TEST_URL} );
+ $curl2->setopt( CURLOPT_HEADERFUNCTION, \&header_callback2 );
+ $curl2->setopt( CURLOPT_WRITEFUNCTION, \&body_callback2 );
+
+ my $curlm = new WWW::Curl::Multi;
+ $curlm->add_handle($curl);
+ $curlm->add_handle($curl2);
+ $curlm->perform;
+
+ ok($header);
+ ok($body);
+ ok($header2);
+ ok($body2);
+}
diff --git a/t/new/README b/t/new/README
new file mode 100644
index 0000000..7879eb1
--- /dev/null
+++ b/t/new/README
@@ -0,0 +1,8 @@
+These test scripts have been updated by Sebastian Riedel to use modern
+features of the Test::Harness suite, such as Test::Simple and Test::More,
+which makes them cleaner and more maintainable, but which are unfortunately
+not natively supported by older perl versions. They are placed here reference,
+and will become the standard test scripts once we drop support for perl5.005.
+
+
+