1#!/usr/bin/perl -w 2# 3# 4# Licensed to the Apache Software Foundation (ASF) under one 5# or more contributor license agreements. See the NOTICE file 6# distributed with this work for additional information 7# regarding copyright ownership. The ASF licenses this file 8# to you under the Apache License, Version 2.0 (the 9# "License"); you may not use this file except in compliance 10# with the License. You may obtain a copy of the License at 11# 12# http://www.apache.org/licenses/LICENSE-2.0 13# 14# Unless required by applicable law or agreed to in writing, 15# software distributed under the License is distributed on an 16# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 17# KIND, either express or implied. See the License for the 18# specific language governing permissions and limitations 19# under the License. 20# 21# 22 23use Test::More tests => 302; 24use strict; 25 26# shut up about variables that are only used once. 27# these come from constants and variables used 28# by the bindings but not elsewhere in perl space. 29no warnings 'once'; 30 31# TEST 32use_ok('SVN::Core'); 33# TEST 34use_ok('SVN::Repos'); 35# TEST 36use_ok('SVN::Client'); 37# TEST 38use_ok('SVN::Wc'); # needed for status 39use File::Spec::Functions; 40use File::Temp qw(tempdir); 41use File::Path qw(rmtree); 42 43# do not use cleanup because it will fail, some files we 44# will not have write perms to. 45my $testpath = tempdir('svn-perl-test-XXXXXX', TMPDIR => 1, CLEANUP => 0); 46 47my $repospath = catdir($testpath,'repo'); 48my $reposurl = 'file://' . (substr($repospath,0,1) ne '/' ? '/' : '') 49 . $repospath; 50my $wcpath = catdir($testpath,'wc'); 51my $importpath = catdir($testpath,'import'); 52 53# Use internal style paths on Windows 54$reposurl =~ s/\\/\//g; 55$wcpath =~ s/\\/\//g; 56$importpath =~ s/\\/\//g; 57 58# track current rev ourselves to test against 59my $current_rev = 0; 60 61# We want to trap errors ourself 62$SVN::Error::handler = undef; 63 64# Get username we are running as 65my $username; 66if ($^O eq 'MSWin32') { 67 $username = getlogin(); 68} else { 69 $username = getpwuid($>) || getlogin(); 70} 71 72# This is ugly to create the test repo with SVN::Repos, but 73# it seems to be the most reliable way. 74# TEST 75ok(SVN::Repos::create("$repospath", undef, undef, undef, undef), 76 "create repository at $repospath"); 77 78my ($ctx) = SVN::Client->new; 79# TEST 80isa_ok($ctx,'SVN::Client','Client Object'); 81 82my $uuid_from_url = $ctx->uuid_from_url($reposurl); 83# TEST 84ok($uuid_from_url,'Valid return from uuid_from_url method form'); 85 86# test non method invocation passing a SVN::Client 87# TEST 88ok(SVN::Client::uuid_from_url($reposurl,$ctx), 89 'Valid return from uuid_from_url function form with SVN::Client object'); 90 91# test non method invocation passing a _p_svn_client_ctx_t 92# TEST 93ok(SVN::Client::uuid_from_url($reposurl,$ctx->{'ctx'}), 94 'Valid return from uuid_from_url function form with _p_svn_client_ctx object'); 95 96 97my ($ci_dir1) = $ctx->mkdir(["$reposurl/dir1"]); 98# TEST 99isa_ok($ci_dir1,'_p_svn_client_commit_info_t'); 100$current_rev++; 101# TEST 102is($ci_dir1->revision,$current_rev,"commit info revision equals $current_rev"); 103 104my ($ci_dir2) = $ctx->mkdir2(["$reposurl/dir2"]); 105# TEST 106isa_ok($ci_dir2,'_p_svn_commit_info_t'); 107$current_rev++; 108# TEST 109is($ci_dir2->revision,$current_rev,"commit info revision equals $current_rev"); 110 111my ($ci_dir3) = $ctx->mkdir3(["$reposurl/dir3"],0,undef); 112# TEST 113isa_ok($ci_dir3,'_p_svn_commit_info_t'); 114$current_rev++; 115# TEST 116is($ci_dir3->revision,$current_rev,"commit info revision equals $current_rev"); 117 118# TEST 119is($ctx->mkdir4(["$reposurl/dir4"],0,undef,sub { 120 my ($commit_info) = @_; 121 122 # TEST 123 isa_ok($commit_info,'_p_svn_commit_info_t','commit_info type check'); 124 125 # TEST 126 is($commit_info->revision(),$current_rev + 1, 'commit info revision'); 127 128 # TEST 129 like($commit_info->date(), 130 qr/^\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}\.\d{6}Z$/, 131 'commit info date'); 132 133 # TEST 134 is($commit_info->post_commit_err(),undef,'commit info post_commit_error'); 135 136 # TEST 137 is($commit_info->repos_root(),$reposurl,'commit info repos_root'); 138 }), 139 undef,'Returned undef from mkdir4 operation.'); 140$current_rev++; 141 142 143my ($rpgval,$rpgrev) = $ctx->revprop_get('svn:author',$reposurl,$current_rev); 144# TEST 145is($rpgval,$username,'svn:author set to expected username from revprop_get'); 146# TEST 147is($rpgrev,$current_rev,'Returned revnum of current rev from revprop_get'); 148 149if ($^O eq 'MSWin32') { 150 # TEST 151 ok(open(NEW, ">$repospath/hooks/pre-revprop-change.bat"), 152 'Open pre-revprop-change hook for writing'); 153 # TEST 154 ok(print(NEW 'exit 0'), 'Print to hook'); 155 # TEST 156 ok(close(NEW), 'Close hook'); 157} else { 158 # TEST 159 ok(rename("$repospath/hooks/pre-revprop-change.tmpl", 160 "$repospath/hooks/pre-revprop-change"), 161 'Rename pre-revprop-change hook'); 162 # TEST 163 ok(chmod(0700,"$repospath/hooks/pre-revprop-change"), 164 'Change permissions on pre-revprop-change hook'); 165 # TEST 166 is(1, 1, '-') 167} 168my ($rps_rev) = $ctx->revprop_set('svn:log','mkdir dir1', 169 $reposurl, $current_rev, 0); 170# TEST 171is($rps_rev,$current_rev, 172 'Returned revnum of current rev from revprop_set'); 173 174my ($rph, $rplrev) = $ctx->revprop_list($reposurl,$current_rev); 175# TEST 176isa_ok($rph,'HASH','Returned hash reference form revprop_list'); 177# TEST 178is($rplrev,$current_rev,'Returned current rev from revprop_list'); 179# TEST 180is($rph->{'svn:author'},$username, 181 'svn:author is expected user from revprop_list'); 182# TEST 183is($rph->{'svn:log'},'mkdir dir1', 184 'svn:log is expected value from revprop_list'); 185 186# TEST 187ok($rph->{'svn:date'},'svn:date is set from revprop_list'); 188 189# TEST 190is($ctx->checkout($reposurl,$wcpath,'HEAD',1),$current_rev, 191 'Returned current rev from checkout'); 192 193# TEST 194is($ctx->checkout2($reposurl,$wcpath . '2',undef,'HEAD',1,0),$current_rev, 195 'Returned current rev from checkout2'); 196 197# TEST 198is($ctx->checkout3($reposurl,$wcpath . '3',undef,'HEAD',$SVN::Depth::infinity, 199 0,0),$current_rev, 'Returned current rev from checkout3'); 200 201# TEST 202is(SVN::Client::url_from_path($wcpath),$reposurl, 203 "Returned $reposurl from url_from_path"); 204 205# TEST 206ok(open(NEW, ">$wcpath/dir1/new"),'Open new file for writing'); 207# TEST 208ok(print(NEW 'addtest'), 'Print to new file'); 209# TEST 210ok(close(NEW),'Close new file'); 211 212# no return means success 213# TEST 214is($ctx->add("$wcpath/dir1/new",0),undef, 215 'Returned undef from add schedule operation'); 216 217# TEST 218ok(open(NEW2, ">$wcpath/dir1/new2"),'Open new2 file for writing'); 219# TEST 220ok(print(NEW2 'addtest2'), 'Print to new2 file'); 221# TEST 222ok(close(NEW2),'Close new2 file'); 223 224# no return means success 225# TEST 226is($ctx->add2("$wcpath/dir1/new2",0,0),undef, 227 'Returned undef from add2 schedule operation'); 228 229# TEST 230ok(open(NEW3, ">$wcpath/dir1/new3"),'Open new3 file for writing'); 231# TEST 232ok(print(NEW3 'addtest3'), 'Print to new3 file'); 233# TEST 234ok(close(NEW3),'Close new3 file'); 235 236# no return means success 237# TEST 238is($ctx->add3("$wcpath/dir1/new3",0,0,0),undef, 239 'Returned undef from add3 schedule operation'); 240 241# TEST 242ok(open(NEW4, ">$wcpath/dir1/new4"),'Open new4 file for writing'); 243# TEST 244ok(print(NEW4 'addtest4'), 'Print to new4 file'); 245# TEST 246ok(close(NEW4),'Close new4 file'); 247 248# no return means success 249# TEST 250is($ctx->add4("$wcpath/dir1/new4",$SVN::Depth::empty,0,0,0),undef, 251 'Returned undef from add4 schedule operation'); 252 253 254# test the log_msg callback 255$ctx->log_msg( 256 sub 257 { 258 my ($log_msg,$tmp_file,$commit_items,$pool) = @_; 259 # TEST 260 isa_ok($log_msg,'SCALAR','log_msg param to callback is a SCALAR'); 261 # TEST 262 isa_ok($tmp_file,'SCALAR','tmp_file param to callback is a SCALAR'); 263 # TEST 264 isa_ok($commit_items,'ARRAY', 265 'commit_items param to callback is a SCALAR'); 266 # TEST 267 isa_ok($pool,'_p_apr_pool_t', 268 'pool param to callback is a _p_apr_pool_t'); 269 my $commit_item = shift @$commit_items; 270 # TEST 271 isa_ok($commit_item,'_p_svn_client_commit_item3_t', 272 'commit_item element is a _p_svn_client_commit_item3_t'); 273 # TEST 274 is($commit_item->path(),"$wcpath/dir1/new", 275 "commit_item has proper path for committed file"); 276 # TEST 277 is($commit_item->kind(),$SVN::Node::file, 278 "kind() shows the node as a file"); 279 # TEST 280 is($commit_item->url(),"$reposurl/dir1/new", 281 'URL matches our repos url'); 282 # revision is INVALID because the commit has not happened yet 283 # and this is not a copy 284 # TEST 285 is($commit_item->revision(),$SVN::Core::INVALID_REVNUM, 286 'Revision is INVALID since commit has not happened yet'); 287 # TEST 288 is($commit_item->copyfrom_url(),undef, 289 'copyfrom_url is undef since file is not a copy'); 290 # TEST 291 is($commit_item->state_flags(),$SVN::Client::COMMIT_ITEM_ADD | 292 $SVN::Client::COMMIT_ITEM_TEXT_MODS, 293 'state_flags are ADD and TEXT_MODS'); 294 my $prop_changes = $commit_item->incoming_prop_changes(); 295 # TEST 296 isa_ok($prop_changes, 'ARRAY', 297 'incoming_prop_changes returns an ARRAY'); 298 # TEST 299 is(scalar(@$prop_changes), 0, 300 'No elements in the incoming_prop_changes array because ' . 301 ' we did not make any'); 302 $prop_changes = $commit_item->outgoing_prop_changes(); 303 # TEST 304 is($prop_changes, undef, 305 'No outgoing_prop_changes array because we did not create one'); 306 $$log_msg = 'Add new'; 307 return 0; 308 } ); 309 310 311my ($ci_commit1) = $ctx->commit($wcpath,0); 312# TEST 313isa_ok($ci_commit1,'_p_svn_client_commit_info_t', 314 'Commit returns a _p_svn_client_commit_info'); 315$current_rev++; 316# TEST 317is($ci_commit1->revision,$current_rev, 318 "commit info revision equals $current_rev"); 319 320# get rid of log_msg callback 321# TEST 322is($ctx->log_msg(undef),undef, 323 'Clearing the log_msg callback works'); 324 325# test info() on WC 326# TEST 327is($ctx->info("$wcpath/dir1/new", undef, 'WORKING', 328 sub 329 { 330 my($infopath,$svn_info_t,$pool) = @_; 331 # TEST 332 is($infopath,"new",'path passed to receiver is same as WC'); 333 # TEST 334 isa_ok($svn_info_t,'_p_svn_info_t'); 335 # TEST 336 isa_ok($pool,'_p_apr_pool_t', 337 'pool param is _p_apr_pool_t'); 338 }, 0), 339 undef, 340 'info should return undef'); 341 342my $svn_error = $ctx->info("$wcpath/dir1/newxyz", undef, 'WORKING', sub {}, 0); 343# TEST 344isa_ok($svn_error, '_p_svn_error_t', 345 'info should return _p_svn_error_t for a nonexistent file'); 346$svn_error->clear(); #don't leak this 347 348# test getting the log 349 350sub test_log_message_receiver { 351 my ($changed_paths,$revision, 352 $author,$date,$message,$pool) = @_; 353 # TEST 354 isa_ok($changed_paths,'HASH', 355 'changed_paths param is a HASH'); 356 # TEST 357 isa_ok($changed_paths->{'/dir1/new'}, 358 '_p_svn_log_changed_path_t', 359 'Hash value is a _p_svn_log_changed_path_t'); 360 # TEST 361 is($changed_paths->{'/dir1/new'}->action(),'A', 362 'action returns A for add'); 363 # TEST 364 is($changed_paths->{'/dir1/new'}->copyfrom_path(),undef, 365 'copyfrom_path returns undef as it is not a copy'); 366 # TEST 367 is($changed_paths->{'/dir1/new'}->copyfrom_rev(), 368 $SVN::Core::INVALID_REVNUM, 369 'copyfrom_rev is set to INVALID as it is not a copy'); 370 # TEST 371 is($revision,$current_rev, 372 'revision param matches current rev'); 373 # TEST 374 is($author,$username, 375 'author param matches expected username'); 376 # TEST 377 ok($date,'date param is defined'); 378 # TEST 379 is($message,'Add new', 380 'message param is the expected value'); 381 # TEST 382 isa_ok($pool,'_p_apr_pool_t', 383 'pool param is _p_apr_pool_t'); 384} 385 386# TEST log range $current_rev:$current_rev 387is($ctx->log("$reposurl/dir1/new",$current_rev,$current_rev,1,0, 388 \&test_log_message_receiver), 389 undef, 390 'log returns undef'); 391# TEST log2 range $current_rev:0 limit=1 392is($ctx->log2("$reposurl/dir1/new",$current_rev,0,1,1,0, 393 \&test_log_message_receiver), 394 undef, 395 'log2 returns undef'); 396# TEST log3 range $current_rev:0 limit=1 397is($ctx->log3("$reposurl/dir1/new",'HEAD',$current_rev,0,1,1,0, 398 \&test_log_message_receiver), 399 undef, 400 'log3 returns undef'); 401 402my @new_paths = qw( dir1/new dir1/new2 dir1/new3 dir1/new4 ); 403$ctx->log3([ $reposurl, @new_paths ], 404 'HEAD',$current_rev,0,1,1,0, sub { 405 my ($changed_paths,$revision,$author,$date,$message,$pool) = @_; 406 # TEST 407 is_deeply([sort keys %$changed_paths], 408 [sort map { "/$_" } @new_paths], 409 "changed_paths for multiple targets"); 410}); 411 412sub get_full_log { 413 my ($start, $end) = @_; 414 my @log; 415 $ctx->log($reposurl, $start, $end, 1, 0, sub { 416 my ($changed_paths, $revision, $author, $date, $msg, undef) = @_; 417 # "unpack" the values of the $changed_paths hash 418 # (_p_svn_log_changed_path_t objects) so that 419 # we can use is_deeply() to compare results 420 my %hash; 421 while (my ($path, $changed) = each %$changed_paths) { 422 foreach (qw( action copyfrom_path copyfrom_rev )) { 423 $hash{$path}{$_} = $changed->$_() 424 } 425 } 426 push @log, [ \%hash, $revision, $author, $date, $msg ]; 427 }); 428 return \@log; 429} 430 431# TEST 432my $full_log = get_full_log('HEAD',1); 433is(scalar @$full_log, $current_rev, "history up to 'HEAD'"); 434 435# TEST 436my $opt_revision_head = SVN::_Core::new_svn_opt_revision_t(); 437$opt_revision_head->kind($SVN::Core::opt_revision_head); 438is_deeply(get_full_log($opt_revision_head,1), # got 439 $full_log, # expected 440 "history up to svn_opt_revision_t of kind head"); 441 442# TEST 443is_deeply(get_full_log($current_rev,1), # got 444 $full_log, # expected 445 "history up to number $current_rev"); 446 447# TEST 448my $opt_revision_number = SVN::_Core::new_svn_opt_revision_t(); 449$opt_revision_number->kind($SVN::Core::opt_revision_number); 450$opt_revision_number->value->number($current_rev); 451is_deeply(get_full_log($opt_revision_number,1), # got 452 $full_log, # expected 453 "history up to svn_opt_revision_t of kind number and value $current_rev"); 454 455sub test_log_entry_receiver { 456 my ($log_entry,$pool) = @_; 457 # TEST 458 isa_ok($log_entry, '_p_svn_log_entry_t', 459 'log_entry param'); 460 # TEST 461 isa_ok($pool,'_p_apr_pool_t', 462 'pool param'); 463 # TEST 464 is($log_entry->revision,$current_rev, 465 'log_entry->revision matches current rev'); 466 467 my $revprops = $log_entry->revprops; 468 # TEST 469 isa_ok($revprops,'HASH', 470 'log_entry->revprops'); 471 # TEST 472 is($revprops->{"svn:author"},$username, 473 'svn:author revprop matches expected username'); 474 # TEST 475 ok($revprops->{"svn:date"},'svn:date revprop is defined'); 476 # TEST 477 is($revprops->{"svn:log"},'Add new', 478 'svn:log revprop is the expected value'); 479 480 my $changed_paths = $log_entry->changed_paths2; 481 # TEST 482 isa_ok($changed_paths,'HASH', 483 'log_entry->changed_paths2'); 484 # TEST 485 isa_ok($changed_paths->{'/dir1/new'}, 486 '_p_svn_log_changed_path2_t', 487 'log_entry->changed_paths2 value'); 488 # TEST 489 is($changed_paths->{'/dir1/new'}->action(),'A', 490 'action returns A for add'); 491 # TEST 492 is($changed_paths->{'/dir1/new'}->node_kind(),$SVN::Node::file, 493 'node_kind returns $SVN::Node::file'); 494 # TEST 495 is($changed_paths->{'/dir1/new'}->text_modified(),$SVN::Tristate::true, 496 'text_modified returns true'); 497 # TEST 498 is($changed_paths->{'/dir1/new'}->props_modified(),$SVN::Tristate::false, 499 'props_modified returns false'); 500 # TEST 501 is($changed_paths->{'/dir1/new'}->copyfrom_path(),undef, 502 'copyfrom_path returns undef as it is not a copy'); 503 # TEST 504 is($changed_paths->{'/dir1/new'}->copyfrom_rev(), 505 $SVN::Core::INVALID_REVNUM, 506 'copyfrom_rev is set to INVALID as it is not a copy'); 507} 508 509# TEST 510is($ctx->log4("$reposurl/dir1/new", 511 'HEAD',$current_rev,0,1, # peg rev, start rev, end rev, limit 512 1,1,0, # discover_changed_paths, strict_node_history, include_merged_revisions 513 undef, # revprops 514 \&test_log_entry_receiver), 515 undef, 516 'log4 returns undef'); 517 518# TEST 519is($ctx->log5("$reposurl/dir1/new", 520 'HEAD',[$current_rev,0],1, # peg rev, rev ranges, limit 521 1,1,0, # discover_changed_paths, strict_node_history, include_merged_revisions 522 undef, # revprops 523 \&test_log_entry_receiver), 524 undef, 525 'log5 returns undef'); 526 527# test the different forms to specify revision ranges 528sub get_revs { 529 my ($rev_ranges) = @_; 530 my @revs; 531 $ctx->log5($reposurl, 'HEAD', $rev_ranges, 0, 0, 0, 0, undef, sub { 532 my ($log_entry,$pool) = @_; 533 push @revs, $log_entry->revision; 534 }); 535 return \@revs; 536} 537 538my $top = SVN::_Core::new_svn_opt_revision_range_t(); 539$top->start('HEAD'); 540$top->end('HEAD'); 541my $bottom = SVN::_Core::new_svn_opt_revision_range_t(); 542$bottom->start(1); 543$bottom->end($current_rev-1); 544 545# TEST 546is_deeply(get_revs($top), 547 [ $current_rev ], 'single svn_opt_revision_range_t'); 548# TEST 549is_deeply(get_revs([$top]), 550 [ $current_rev ], 'list of svn_opt_revision_range_t'); 551# TEST 552is_deeply(get_revs(['HEAD', 'HEAD']), 553 [ $current_rev ], 'single [start, end]'); 554# TEST 555is_deeply(get_revs([['HEAD', 'HEAD']]), 556 [ $current_rev ], 'list of [start, end]'); 557# TEST 558is_deeply(get_revs([$current_rev, $current_rev]), 559 [ $current_rev ], 'single [start, end]'); 560# TEST 561is_deeply(get_revs([[$current_rev, $current_rev]]), 562 [ $current_rev ], 'list of [start, end]'); 563# TEST 564is_deeply(get_revs([1, 'HEAD']), 565 [ 1..$current_rev ], 'single [start, end]'); 566# TEST 567is_deeply(get_revs([[1, 'HEAD']]), 568 [ 1..$current_rev ], 'list of [start, end]'); 569# TEST 570is_deeply(get_revs([1, $opt_revision_head]), 571 [ 1..$current_rev ], 'single [start, end]'); 572# TEST 573is_deeply(get_revs([[1, $opt_revision_head]]), 574 [ 1..$current_rev ], 'list of [start, end]'); 575# TEST 576is_deeply(get_revs($bottom), 577 [ 1..$current_rev-1 ], 'single svn_opt_revision_range_t'); 578# TEST 579is_deeply(get_revs([$bottom]), 580 [ 1..$current_rev-1 ], 'list of svn_opt_revision_range_t'); 581# TEST 582is_deeply(get_revs([1, $current_rev-1]), 583 [ 1..$current_rev-1 ], 'single [start, end]'); 584# TEST 585is_deeply(get_revs([[1, $current_rev-1]]), 586 [ 1..$current_rev-1 ], 'list of [start, end]'); 587# TEST 588is_deeply(get_revs([[1, $current_rev-1], $top]), 589 [ 1..$current_rev ], 'mixed list of ranges'); 590# TEST 591is_deeply(get_revs([$bottom, ['HEAD', 'HEAD']]), 592 [ 1..$current_rev ], 'mixed list of ranges'); 593# TEST 594is_deeply(get_revs([$bottom, $top]), 595 [ 1..$current_rev ], 'mixed list of ranges'); 596 597 598# TEST 599is($ctx->update($wcpath,'HEAD',1),$current_rev, 600 'Return from update is the current rev'); 601 602my $update2_result = $ctx->update2([$wcpath],'HEAD',1,0); 603# TEST 604isa_ok($update2_result,'ARRAY','update2 returns a list'); 605# TEST 606is(scalar(@$update2_result),1,'update2 member count'); 607# TEST 608is($update2_result->[0],$current_rev,'return from update2 is the current rev'); 609 610my $update3_result = $ctx->update3([$wcpath],'HEAD',$SVN::Depth::infinity, 611 0,0,0); 612# TEST 613isa_ok($update3_result,'ARRAY','update3 returns a list'); 614# TEST 615is(scalar(@$update3_result),1,'update3 member count'); 616# TEST 617is($update3_result->[0],$current_rev,'return from update3 is the current rev'); 618 619my $update4_result = $ctx->update4([$wcpath],'HEAD',$SVN::Depth::infinity, 620 0,0,0,1,0); 621# TEST 622isa_ok($update4_result,'ARRAY','update4 returns a list'); 623# TEST 624is(scalar(@$update4_result),1,'update4 member count'); 625# TEST 626is($update4_result->[0],$current_rev,'return from update4 is the current rev'); 627 628# no return so we should get undef as the result 629# we will get a _p_svn_error_t if there is an error. 630# TEST 631is($ctx->propset('perl-test','test-val',"$wcpath/dir1",0),undef, 632 'propset on a working copy path returns undef'); 633 634my ($ph) = $ctx->propget('perl-test',"$wcpath/dir1",undef,0); 635# TEST 636isa_ok($ph,'HASH','propget returns a hash'); 637# TEST 638is($ph->{"$wcpath/dir1"},'test-val','perl-test property has the correct value'); 639 640# No revnum for the working copy so we should get INVALID_REVNUM 641# TEST 642is($ctx->status($wcpath, undef, sub { 643 my ($path,$wc_status) = @_; 644 # TEST 645 is($path,"$wcpath/dir1", 646 'path param to status callback is' . 647 ' the correct path.'); 648 # TEST 649 isa_ok($wc_status,'_p_svn_wc_status_t', 650 'wc_stats param'); 651 # TEST 652 is($wc_status->text_status(), 653 $SVN::Wc::Status::normal, 654 'text_status param to status' . 655 ' callback'); 656 # TEST 657 is($wc_status->prop_status(), 658 $SVN::Wc::Status::modified, 659 'prop_status param to status' . 660 ' callback'); 661 # TEST 662 is($wc_status->locked(), 0, 663 'locked param to status callback'); 664 # TEST 665 is($wc_status->copied(), 0, 666 'copied param to status callback'); 667 # TEST 668 is($wc_status->switched(), 0, 669 'switched param to status callback'); 670 # TEST 671 is($wc_status->repos_text_status(), 672 $SVN::Wc::Status::none, 673 'repos_text_status param to status' . 674 ' callback'); 675 # TEST 676 is($wc_status->repos_prop_status(), 677 $SVN::Wc::Status::none, 678 'repos_prop_status param to status' . 679 ' callback'); 680 }, 681 1, 0, 0, 0), 682 $SVN::Core::INVALID_REVNUM, 683 'status returns INVALID_REVNUM when run against a working copy'); 684 685# No revnum for the working copy so we should get INVALID_REVNUM 686# TEST 687is($ctx->status2($wcpath, undef, sub { 688 my ($path,$wc_status) = @_; 689 # TEST 690 is($path,"$wcpath/dir1", 691 'path param to status2 callback'); 692 # TEST 693 isa_ok($wc_status,'_p_svn_wc_status2_t', 694 'wc_stats param to the status2' . 695 ' callback'); 696 # TEST 697 is($wc_status->text_status(), 698 $SVN::Wc::Status::normal, 699 'text_status param to status2' . 700 ' callback'); 701 # TEST 702 is($wc_status->prop_status(), 703 $SVN::Wc::Status::modified, 704 'prop_status param to status2' . 705 ' callback'); 706 # TEST 707 is($wc_status->locked(), 0, 708 'locked param to status2' . 709 ' callback'); 710 # TEST 711 is($wc_status->copied(), 0, 712 'copied param to status2' . 713 ' callback'); 714 # TEST 715 is($wc_status->switched(), 0, 716 'switched param to status2' . 717 ' callback'); 718 # TEST 719 is($wc_status->repos_text_status(), 720 $SVN::Wc::Status::none, 721 'repos_text_status param to status2' . 722 ' callback'); 723 # TEST 724 is($wc_status->repos_prop_status(), 725 $SVN::Wc::Status::none, 726 'repos_prop_status param to status2' . 727 ' callback'); 728 # TEST 729 is($wc_status->repos_lock(), undef, 730 'repos_lock param to status2 callback'); 731 # TEST 732 is($wc_status->url(),"$reposurl/dir1", 733 'url param to status2 callback'); 734 # TEST 735 is($wc_status->ood_last_cmt_rev(), 736 $SVN::Core::INVALID_REVNUM, 737 'ood_last_cmt_rev to status2' . 738 ' callback'); 739 # TEST 740 is($wc_status->ood_last_cmt_date(), 0, 741 'ood_last_cmt_date to status2' . 742 ' callback'); 743 # TEST 744 is($wc_status->ood_kind(), 745 $SVN::Node::none, 746 'ood_kind param to status2 callback'); 747 # TEST 748 is($wc_status->ood_last_cmt_author(), 749 undef, 750 'ood_last_cmt_author to status2' . 751 ' callback'); 752 # TEST 753 is($wc_status->tree_conflict(), undef, 754 'tree_conflict to status2 callback'); 755 # TEST 756 is($wc_status->file_external(), 0, 757 'file_external to status2 callback'); 758 # TEST 759 is($wc_status->pristine_text_status(), 760 $SVN::Wc::Status::normal, 761 'pristine_text_status param to' . 762 ' status2 callback'); 763 # TEST 764 is($wc_status->pristine_prop_status(), 765 $SVN::Wc::Status::modified, 766 'pristine_prop_status param to' . 767 ' status2 callback'); 768 }, 769 1, 0, 0, 0, 0), 770 $SVN::Core::INVALID_REVNUM, 771 'status2 returns INVALID_REVNUM when run against a working copy'); 772 773# No revnum for the working copy so we should get INVALID_REVNUM 774# TEST 775is($ctx->status3($wcpath, undef, sub { 776 my ($path,$wc_status) = @_; 777 # TEST 778 is($path,"$wcpath/dir1", 779 'path param to status3 callback'); 780 # TEST 781 isa_ok($wc_status,'_p_svn_wc_status2_t', 782 'wc_stats param to the status3' . 783 ' callback'); 784 # TEST 785 is($wc_status->text_status(), 786 $SVN::Wc::Status::normal, 787 'text_status param to status3' . 788 ' callback'); 789 # TEST 790 is($wc_status->prop_status(), 791 $SVN::Wc::Status::modified, 792 'prop_status param to status3' . 793 ' callback'); 794 # TEST 795 is($wc_status->locked(), 0, 796 'locked param to status3' . 797 ' callback'); 798 # TEST 799 is($wc_status->copied(), 0, 800 'copied param to status3' . 801 ' callback'); 802 # TEST 803 is($wc_status->switched(), 0, 804 'switched param to status3' . 805 ' callback'); 806 # TEST 807 is($wc_status->repos_text_status(), 808 $SVN::Wc::Status::none, 809 'repos_text_status param to status3' . 810 ' callback'); 811 # TEST 812 is($wc_status->repos_prop_status(), 813 $SVN::Wc::Status::none, 814 'repos_prop_status param to status3' . 815 ' callback'); 816 # TEST 817 is($wc_status->repos_lock(), undef, 818 'repos_lock param to status3 callback'); 819 # TEST 820 is($wc_status->url(),"$reposurl/dir1", 821 'url param to status3 callback'); 822 # TEST 823 is($wc_status->ood_last_cmt_rev(), 824 $SVN::Core::INVALID_REVNUM, 825 'ood_last_cmt_rev to status3' . 826 ' callback'); 827 # TEST 828 is($wc_status->ood_last_cmt_date(), 0, 829 'ood_last_cmt_date to status3' . 830 ' callback'); 831 # TEST 832 is($wc_status->ood_kind(), 833 $SVN::Node::none, 834 'ood_kind param to status3 callback'); 835 # TEST 836 is($wc_status->ood_last_cmt_author(), 837 undef, 838 'ood_last_cmt_author to status3' . 839 ' callback'); 840 # TEST 841 is($wc_status->tree_conflict(), undef, 842 'tree_conflict to status3 callback'); 843 # TEST 844 is($wc_status->file_external(), 0, 845 'file_external to status3 callback'); 846 # TEST 847 is($wc_status->pristine_text_status(), 848 $SVN::Wc::Status::normal, 849 'pristine_text_status param to' . 850 ' status3 callback'); 851 # TEST 852 is($wc_status->pristine_prop_status(), 853 $SVN::Wc::Status::modified, 854 'pristine_prop_status param to' . 855 ' status3 callback'); 856 }, 857 $SVN::Depth::infinity, 0, 0, 0, 0, undef), 858 $SVN::Core::INVALID_REVNUM, 859 'status3 returns INVALID_REVNUM when run against a working copy'); 860 861# No revnum for the working copy so we should get INVALID_REVNUM 862# TEST 863is($ctx->status4($wcpath, undef, sub { 864 my ($path,$wc_status, $pool) = @_; 865 # TEST 866 is($path,"$wcpath/dir1", 867 'path param to status4 callback'); 868 # TEST 869 isa_ok($wc_status,'_p_svn_wc_status2_t', 870 'wc_stats param to the status4' . 871 ' callback'); 872 # TEST 873 is($wc_status->text_status(), 874 $SVN::Wc::Status::normal, 875 'text_status param to status4' . 876 ' callback'); 877 # TEST 878 is($wc_status->prop_status(), 879 $SVN::Wc::Status::modified, 880 'prop_status param to status4' . 881 ' callback'); 882 # TEST 883 is($wc_status->locked(), 0, 884 'locked param to status4' . 885 ' callback'); 886 # TEST 887 is($wc_status->copied(), 0, 888 'copied param to status4' . 889 ' callback'); 890 # TEST 891 is($wc_status->switched(), 0, 892 'switched param to status4' . 893 ' callback'); 894 # TEST 895 is($wc_status->repos_text_status(), 896 $SVN::Wc::Status::none, 897 'repos_text_status param to status4' . 898 ' callback'); 899 # TEST 900 is($wc_status->repos_prop_status(), 901 $SVN::Wc::Status::none, 902 'repos_prop_status param to status4' . 903 ' callback'); 904 # TEST 905 is($wc_status->repos_lock(), undef, 906 'repos_lock param to status4 callback'); 907 # TEST 908 is($wc_status->url(),"$reposurl/dir1", 909 'url param to status4 callback'); 910 # TEST 911 is($wc_status->ood_last_cmt_rev(), 912 $SVN::Core::INVALID_REVNUM, 913 'ood_last_cmt_rev to status4' . 914 ' callback'); 915 # TEST 916 is($wc_status->ood_last_cmt_date(), 0, 917 'ood_last_cmt_date to status4' . 918 ' callback'); 919 # TEST 920 is($wc_status->ood_kind(), 921 $SVN::Node::none, 922 'ood_kind param to status4 callback'); 923 # TEST 924 is($wc_status->ood_last_cmt_author(), 925 undef, 926 'ood_last_cmt_author to status4' . 927 ' callback'); 928 # TEST 929 is($wc_status->tree_conflict(), undef, 930 'tree_conflict to status4 callback'); 931 # TEST 932 is($wc_status->file_external(), 0, 933 'file_external to status4 callback'); 934 # TEST 935 is($wc_status->pristine_text_status(), 936 $SVN::Wc::Status::normal, 937 'pristine_text_status param to' . 938 ' status4 callback'); 939 # TEST 940 is($wc_status->pristine_prop_status(), 941 $SVN::Wc::Status::modified, 942 'pristine_prop_status param to' . 943 ' status4 callback'); 944 # TEST 945 isa_ok($pool, '_p_apr_pool_t', 946 'pool param to status4' . 947 ' callback'); 948 }, 949 $SVN::Depth::infinity, 0, 0, 0, 0, undef), 950 $SVN::Core::INVALID_REVNUM, 951 'status4 returns INVALID_REVNUM when run against a working copy'); 952 953 954my ($ci_commit2) = $ctx->commit($wcpath,0); 955# TEST 956isa_ok($ci_commit2,'_p_svn_client_commit_info_t', 957 'commit returns a _p_svn_client_commit_info_t'); 958$current_rev++; 959# TEST 960is($ci_commit2->revision(),$current_rev, 961 "commit info revision equals $current_rev"); 962 963my $dir1_rev = $current_rev; 964 965 966my($pl) = $ctx->proplist($reposurl,$current_rev,1); 967# TEST 968isa_ok($pl,'ARRAY','proplist returns an ARRAY'); 969# TEST 970isa_ok($pl->[0], '_p_svn_client_proplist_item_t', 971 'proplist array element'); 972# TEST 973is($pl->[0]->node_name(),"$reposurl/dir1", 974 'node_name is the expected value'); 975my $plh = $pl->[0]->prop_hash(); 976# TEST 977isa_ok($plh,'HASH', 978 'prop_hash returns a HASH'); 979# TEST 980is_deeply($plh, {'perl-test' => 'test-val'}, 'test prop list prop_hash values'); 981 982# add a dir to test update 983my ($ci_dir5) = $ctx->mkdir(["$reposurl/dir5"]); 984# TEST 985isa_ok($ci_dir5,'_p_svn_client_commit_info_t', 986 'mkdir returns a _p_svn_client_commit_info_t'); 987$current_rev++; 988# TEST 989is($ci_dir5->revision(),$current_rev, 990 "commit info revision equals $current_rev"); 991 992# Use explicit revnum to test that instead of just HEAD. 993# TEST 994is($ctx->update($wcpath,$current_rev,$current_rev),$current_rev, 995 'update returns current rev'); 996 997# commit action against a repo returns undef 998# TEST 999is($ctx->delete(["$wcpath/dir2"],0),undef, 1000 'delete returns undef'); 1001 1002# no return means success 1003# TEST 1004is($ctx->revert($wcpath,1),undef, 1005 'revert returns undef'); 1006 1007my ($ci_copy) = $ctx->copy("$reposurl/dir1",2,"$reposurl/dir3"); 1008# TEST 1009isa_ok($ci_copy,'_p_svn_client_commit_info_t', 1010 'copy returns a _p_svn_client_commitn_info_t when run against repo'); 1011$current_rev++; 1012# TEST 1013is($ci_copy->revision,$current_rev, 1014 "commit info revision equals $current_rev"); 1015 1016# TEST 1017ok(mkdir($importpath),'Make import path dir'); 1018# TEST 1019ok(open(FOO, ">$importpath/foo"),'Open file for writing in import path dir'); 1020# TEST 1021ok(print(FOO 'foobar'),'Print to the file in import path dir'); 1022# TEST 1023ok(close(FOO),'Close file in import path dir'); 1024 1025my ($ci_import) = $ctx->import($importpath,$reposurl,0); 1026# TEST 1027isa_ok($ci_import,'_p_svn_client_commit_info_t', 1028 'Import returns _p_svn_client_commint_info_t'); 1029$current_rev++; 1030# TEST 1031is($ci_import->revision,$current_rev, 1032 "commit info revision equals $current_rev"); 1033 1034# TEST 1035is($ctx->blame("$reposurl/foo",'HEAD','HEAD', sub { 1036 my ($line_no,$rev,$author, 1037 $date, $line,$pool) = @_; 1038 # TEST 1039 is($line_no,0, 1040 'line_no param is zero'); 1041 # TEST 1042 is($rev,$current_rev, 1043 'rev param is current rev'); 1044 # TEST 1045 is($author,$username, 1046 'author param is expected' . 1047 'value'); 1048 # TEST 1049 ok($date,'date is defined'); 1050 if ($^O eq 'MSWin32') { 1051 #### Why two \r-s? 1052 # TEST 1053 is($line,"foobar\r\r", 1054 'line is expected value'); 1055 } else { 1056 # TEST 1057 is($line,'foobar', 1058 'line is expected value'); 1059 } 1060 # TEST 1061 isa_ok($pool,'_p_apr_pool_t', 1062 'pool param'); 1063 }), 1064 undef, 1065 'blame returns undef'); 1066 1067# TEST 1068ok(open(CAT, "+>$testpath/cattest"),'open file for cat output'); 1069# TEST 1070is($ctx->cat(\*CAT, "$reposurl/foo", 'HEAD'),undef, 1071 'cat returns undef'); 1072# TEST 1073ok(seek(CAT,0,0), 1074 'seek the beginning of the cat file'); 1075# TEST 1076is(readline(*CAT),'foobar', 1077 'read the first line of the cat file'); 1078# TEST 1079ok(close(CAT),'close cat file'); 1080 1081# the string around the $current_rev exists to expose a past 1082# bug. In the past we did not accept values that simply 1083# had not been converted to a number yet. 1084my ($dirents) = $ctx->ls($reposurl,"$current_rev", 1); 1085# TEST 1086isa_ok($dirents, 'HASH','ls returns a HASH'); 1087# TEST 1088isa_ok($dirents->{'dir1'},'_p_svn_dirent_t', 1089 'dirents hash value'); 1090# TEST 1091is($dirents->{'dir1'}->kind(),$SVN::Core::node_dir, 1092 'kind() returns a dir node'); 1093# TEST 1094is($dirents->{'dir1'}->size(), -1, 1095 'size() returns -1 for a directory'); 1096# TEST 1097is($dirents->{'dir1'}->has_props(),1, 1098 'has_props() returns true'); 1099# TEST 1100is($dirents->{'dir1'}->created_rev(),$dir1_rev, 1101 'created_rev() returns expected rev'); 1102# TEST 1103ok($dirents->{'dir1'}->time(), 1104 'time is defined'); 1105#diag(scalar(localtime($dirents->{'dir1'}->time() / 1000000))); 1106# TEST 1107is($dirents->{'dir1'}->last_author(),$username, 1108 'last_auth() returns expected username'); 1109 1110# test removing a property 1111# TEST 1112is($ctx->propset('perl-test', undef, "$wcpath/dir1", 0),undef, 1113 'propset returns undef'); 1114 1115my ($ph2) = $ctx->propget('perl-test', "$wcpath/dir1", 'WORKING', 0); 1116# TEST 1117isa_ok($ph2,'HASH','propget returns HASH'); 1118# TEST 1119is(scalar(keys %$ph2),0, 1120 'No properties after deleting a property'); 1121 1122# test cancel callback 1123my $cancel_cb_called = 0; 1124$ctx->cancel(sub { $cancel_cb_called++; 0 }); 1125my $log_entries_received = 0; 1126$ctx->log5($reposurl, 1127 'HEAD',['HEAD',1],0, # peg rev, rev ranges, limit 1128 1,1,0, # discover_changed_paths, strict_node_history, include_merged_revisions 1129 undef, # revprops 1130 sub { $log_entries_received++ }); 1131# TEST 1132ok($cancel_cb_called, 'cancel callback was called'); 1133# TEST 1134is($log_entries_received, $current_rev, 'log entries received'); 1135 1136my $cancel_msg = "stop the presses"; 1137$ctx->cancel(sub { $cancel_msg }); 1138$svn_error = $ctx->log5($reposurl, 1139 'HEAD',['HEAD',1],0, # peg rev, rev ranges, limit 1140 1,1,0, # discover_changed_paths, strict_node_history, include_merged_revisions 1141 undef, # revprops 1142 sub { }); 1143# TEST 1144isa_ok($svn_error, '_p_svn_error_t', 'return of a cancelled operation'); 1145# TEST 1146is($svn_error->apr_err, $SVN::Error::CANCELLED, "SVN_ERR_CANCELLED"); 1147{ 1148 # If we're running a debug build, $svn_error may be the top of a 1149 # chain of svn_error_t's (all with message "traced call"), we need 1150 # to get to the bottom svn_error_t to check for the original message. 1151 my $chained = $svn_error; 1152 $chained = $chained->child while $chained->child; 1153 # TEST 1154 is($chained->message, $cancel_msg, 'cancellation message'); 1155} 1156 1157$svn_error->clear(); # don't leak this 1158$ctx->cancel(undef); # reset cancel callback 1159 1160 1161SKIP: { 1162 # This is ugly. It is included here as an aide to understand how 1163 # to test this and because it makes my life easier as I only have 1164 # one command to run to test it. If you want to use this you need 1165 # to change the usernames, passwords, and paths to the client cert. 1166 # It assumes that there is a repo running on localhost port 443 at 1167 # via SSL. The repo cert should trip a client trust issue. The 1168 # client cert should be encrypted and require a pass to use it. 1169 # Finally uncomment the skip line below. 1170 1171 # Before shipping make sure the following line is uncommented. 1172 skip 'Impossible to test without external effort to setup https', 7; 1173 1174 sub simple_prompt { 1175 my $cred = shift; 1176 my $realm = shift; 1177 my $username_passed = shift; 1178 my $may_save = shift; 1179 my $pool = shift; 1180 1181 ok(1,'simple_prompt called'); 1182 $cred->username('breser'); 1183 $cred->password('foo'); 1184 } 1185 1186 sub ssl_server_trust_prompt { 1187 my $cred = shift; 1188 my $realm = shift; 1189 my $failures = shift; 1190 my $cert_info = shift; 1191 my $may_save = shift; 1192 my $pool = shift; 1193 1194 ok(1,'ssl_server_trust_prompt called'); 1195 $cred->may_save(0); 1196 $cred->accepted_failures($failures); 1197 } 1198 1199 sub ssl_client_cert_prompt { 1200 my $cred = shift; 1201 my $realm = shift; 1202 my $may_save = shift; 1203 my $pool = shift; 1204 1205 ok(1,'ssl_client_cert_prompt called'); 1206 $cred->cert_file('/home/breser/client-pass.p12'); 1207 } 1208 1209 sub ssl_client_cert_pw_prompt { 1210 my $cred = shift; 1211 my $may_save = shift; 1212 my $pool = shift; 1213 1214 ok(1,'ssl_client_cert_pw_prompt called'); 1215 $cred->password('test'); 1216 } 1217 1218 my $oldauthbaton = $ctx->auth(); 1219 1220 # TEST 1221 isa_ok($ctx->auth(SVN::Client::get_simple_prompt_provider( 1222 sub { simple_prompt(@_,'x') },2), 1223 SVN::Client::get_ssl_server_trust_prompt_provider( 1224 \&ssl_server_trust_prompt), 1225 SVN::Client::get_ssl_client_cert_prompt_provider( 1226 \&ssl_client_cert_prompt,2), 1227 SVN::Client::get_ssl_client_cert_pw_prompt_provider( 1228 \&ssl_client_cert_pw_prompt,2) 1229 ),'_p_svn_auth_baton_t', 1230 'auth() accessor returns _p_svn_auth_baton'); 1231 1232 # if this doesn't work we will get an svn_error_t so by 1233 # getting a hash we know it worked. 1234 my ($dirents) = $ctx->ls('https://localhost/svn/test','HEAD',1); 1235 # TEST 1236 isa_ok($dirents,'HASH','ls returns a HASH'); 1237 1238 # return the auth baton to its original setting 1239 # TEST 1240 isa_ok($ctx->auth($oldauthbaton),'_p_svn_auth_baton_t', 1241 'Successfully set auth_baton back to old value'); 1242} 1243 1244# Keep track of the ok-ness ourselves, since we need to know the exact 1245# number of tests at the start of this file. The 'subtest' feature of 1246# Test::More would be perfect for this, but it's only available in very 1247# recent perl versions, it seems. 1248my $ok = 1; 1249# Get a list of platform specific providers, using the default 1250# configuration and pool. 1251my @providers = @{SVN::Core::auth_get_platform_specific_client_providers(undef, undef)}; 1252foreach my $p (@providers) { 1253 $ok &= defined($p) && $p->isa('_p_svn_auth_provider_object_t'); 1254} 1255# TEST 1256ok($ok, 'svn_auth_get_platform_specific_client_providers returns _p_svn_auth_provider_object_t\'s'); 1257 1258SKIP: { 1259 skip 'Gnome-Keyring support not compiled in', 1 1260 unless defined &SVN::Core::auth_set_gnome_keyring_unlock_prompt_func; 1261 1262 # Test setting gnome_keyring prompt function. This just sets the proper 1263 # attributes in the auth baton and checks the return value (which should 1264 # be a reference to the passed function reference). This does not 1265 # actually try the prompt, since that would require setting up a 1266 # gnome-keyring-daemon... 1267 sub gnome_keyring_unlock_prompt { 1268 my $keyring_name = shift; 1269 my $pool = shift; 1270 1271 'test'; 1272 } 1273 1274 my $callback = \&gnome_keyring_unlock_prompt; 1275 my $result = SVN::Core::auth_set_gnome_keyring_unlock_prompt_func( 1276 $ctx->auth(), $callback); 1277 # TEST 1278 is(${$result}, $callback, 'auth_set_gnome_keyring_unlock_prompt_func result equals parameter'); 1279} 1280 1281END { 1282diag('cleanup'); 1283rmtree($testpath); 1284} 1285