diff options
Diffstat (limited to 't/new')
-rw-r--r-- | t/new/00constants.t | 5 | ||||
-rw-r--r-- | t/new/01basic.t | 13 | ||||
-rw-r--r-- | t/new/02header-callback.t | 20 | ||||
-rw-r--r-- | t/new/03body-callback.t | 20 | ||||
-rw-r--r-- | t/new/04abort.t | 17 | ||||
-rw-r--r-- | t/new/05progress.t | 25 | ||||
-rw-r--r-- | t/new/06http-post.t | 26 | ||||
-rw-r--r-- | t/new/07errbuf.t | 9 | ||||
-rw-r--r-- | t/new/08duphandle.t | 14 | ||||
-rw-r--r-- | t/new/09duphandle-callback.t | 21 | ||||
-rw-r--r-- | t/new/10multi-callback.t | 54 | ||||
-rw-r--r-- | t/new/README | 8 |
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. + + + |