testsvncopy.pl.in

subversion-1.4.3-1.tar.gz 配置svn的源码

  # And commit
  if ( 0 != SVNCall( "commit", "-m",
                     "\"Testing svncopy --update_externals - adding svncopyTest property\"",
                     "$test_temp_dir/$testsubdir/$pinnedDir" ) )
    {
      error( "svn commit failed" );
      $failed = 1;
      return;
    }

  # Having done all the set-up, get our revision numbers.
  foreach my $dir ( @testdirs )
    {
      $revisions{ "$testURL/$dir" } = CurrentRevision( "$testURL/$dir" );
    }
    
  print( "...Source directory structure complete\n" );
    
  # Script parameters
  my $message = "\"Testing svncopy.pl\"";
    
  TEST: foreach my $testtype ( "HEAD", "-r" )
    {
      my @copy_options = @svn_options;
      my $testno = 1;
        
      # Do extra setup for -r
      if ( "-r" eq $testtype )
        {
          $testRev = $revisions{ "$testURL/$pinnedDir" };
          print "Updating repository to run --revision tests against revision ".
                "$testRev...\n";
                  
          #
          # Copy the same revision we did before
          # The last thing we changed was the pinned directory, so
          # take its revision as the one we want to copy.
          #
          push( @copy_options, "--revision", "$testRev" );
            
          #
          # Now add a file to each directory.
          #
          foreach my $dir ( @testdirs )
            {
              if ( !UpdateTestDirectory( "$test_temp_dir/$testsubdir/$dir" ) )
                {
                  $failed = 1;
                  return;
                }
            }
        
          # And commit
          if ( 0 != SVNCall( "commit", "-m",
                             "\"Testing svncopy --update_externals".
                             " - updating directories for '--revision' test\"",
                             "$test_temp_dir/$testsubdir" ) )
            {
              error( "svn commit of updated directories failed" );
              $failed = 1;
              return;
            }
            
          print "...update done.  Now re-running tests against new repository\n";
        }
        
      foreach my $test ( @tests )
        {
          my @cmd_options = @copy_options;
            
          print "\n################################################################\n";
          print "### test number $testno\n";
            
          # Kill the destination directory if it's there
          $verbose = 0;
          SVNCall( 'delete', '-m', '"Preparing to test svncopy --update-externals"', $dest );
          $verbose = $old_verbose;
            
          my @sources = @{$test->{sources}};
          my @expected_externals = @{$test->{expected_externals}};
          my @expected_tree = @{$test->{expected_tree}};
            
          # Update global parameters
          push( @cmd_options, "--message", "$message" );
          push( @cmd_options, "--tag" ) if ( $test->{pin} );
          push( @cmd_options, "--branch" ) if ( $test->{update} );
            
          # Now do the copy
          my @cmdline = ( "perl", "svncopy.pl", @cmd_options, @sources, $dest );
          info( "\n=> Calling ", join( " ", @cmdline ), "\n\n" );
          if ( system( @cmdline ) )
            {
              error( "Copy failed" );
              $failed = 1;
            }
            
          # Check that the generated tree is as expected.
          if ( !CheckTree( $dest, @expected_tree ) )
            {
              # CheckTree outputs an error message if it fails
              $failed = 1;
            }
            
          # And check the externals
          my $ext_dir = "$dest/$test->{ext_dir}";
          if ( !CheckExternals( $ext_dir, \%revisions, $pinnedRev, @expected_externals ) )
            {
              # CheckExternals outputs an error message if it fails
              $failed = 1;
            }
            
          # Bomb out if we had an error
          if ( $failed )
            {
              print "\n*** '$testtype' test $testno failed ***\n";
              print "****************************************************************\n";
              last TEST;
            }
                        
          print "\n### '$testtype' test $testno passed\n";
          print "################################################################\n";
          $testno++;
        }
    }

  if ( $failed ) { error( "*** svncopy tests failed\n" ); }
  else { print "... svncopy tests passed\n"; }
}


#------------------------------------------------------------------------------
# Function:    CreateTestDirectory
#
# Creates a directory in svn.
#
# Parameters:
#       svnpath    directory to create
#
# Returns:     non-zero on success
#------------------------------------------------------------------------------
sub CreateTestDirectory
{
  my $svnpath = $_[0];
    
  my $test_uri = URI->new( "$svnpath" );
  info( "Creating '$test_uri'\n" );
  if ( !CreateSVNDirectories( $test_uri, "Testing svncopy --update_externals" ) )
    {
      error( "CreateSVNDirectories on '$test_uri' failed" );
      return 0;
    }

  return 1;
}


#------------------------------------------------------------------------------
# Function:    UpdateTestDirectory
#
# Modifies the directory in the working copy so that we can check the version
# copied is correct.
#
# Parameters:
#       dir        directory to modify (on file system)
#
# Returns:     non-zero on success
#------------------------------------------------------------------------------
sub UpdateTestDirectory
{
  my $dir = $_[0];
  my $testfile = "$dir/test.txt";
    
  # Create a file in the directory
  if ( !open FILE, ">$testfile" )
    {
      error( "Couldn't create test file '$testfile'" );
      return 0;
    }
  print FILE "Test file in '$dir'\n";
  close FILE;
    
  # Now add it to Subversion
  if ( 0 != SVNCall( "add", $testfile ) )
    {
      error( "svn add '$testfile' failed" );
      return 0;
    }
    
  # We're done
  return 1;
}


#------------------------------------------------------------------------------
# Function:    CheckTree
#
# Checks that directory structure in the subversion location matches
# the given tree.
#
# Parameters:
#       svnpath    Subversion location to check.
#       expected   Expected response - list of files and dirs as returned
#                  by svn list.
#
# Returns:     non-zero on success
#------------------------------------------------------------------------------
sub CheckTree
{
  my ( $svnpath, @expected ) = @_;
    
  my ( $retval, @output ) = SVNCall( "list", "--recursive", $svnpath );
  if ( 0 != $retval )
    {
      error( "svn list on '$svnpath' failed" );
      return 0;
    }
    
  # Remove any blank lines and carriage returns
  @output = grep( { chomp($_); $_ !~ m"^\s*$"} @output );
    
  # Now compare with expected
  my $compare_ctx = { list1 => [@expected], list2 => [@output] };
    
  if ( 0 != CompareLists( $compare_ctx ) )
    {
      my $addedtext;
      my $removedtext;
        
      if ( @{$compare_ctx->{added}} )
        {
          $addedtext = "\n   +".join( "\n   +", @{$compare_ctx->{added}} );
        }
      if ( @{$compare_ctx->{removed}} )
        {
          $removedtext = "\n   -".join( "\n   -", @{$compare_ctx->{removed}} );
        }
      error( "'$svnpath' doesn't match expected$addedtext$removedtext\n" );
        
      return 0;
    }
    
  return 1;
}


#------------------------------------------------------------------------------
# Function:    CheckExternals
#
# Checks that the subversion location matches the given tree.
#
# Parameters:
#       svnpath    Subversion location to check.
#       revisions  Hash containing the revisions for externals.
#       pinnedRev  Revision of pinned directory.
#       expected   Expected response - list of externals as returned
#                  by svn propget svn:externals.
#
# Returns:     non-zero on success
#------------------------------------------------------------------------------
sub CheckExternals
{
  my ( $svnpath, $revisions, $pinnedRev, @expected ) = @_;
  my @new_externals;

  ( $retval, @new_externals ) =  SVNCall( "propget", "svn:externals", $svnpath );
  if ( 0 != $retval )
    {
      error( "svn propget on '$svnpath' failed" );
      return 0;
    }
    
  # Update @expected with revisions
  @expected = grep
    {
      $_ =~ s|__PINREV__|$pinnedRev|g;
      if ( $_ =~ m"(.*)\s+-r __REV__\s+(.*)" )
        {
          my $path = $1;
          my $svnpath = $2;
          my $rev = $revisions->{$svnpath};
          $_ =~ s|__REV__|$rev|g;
        }
      1;
    } @expected;
        
  # Remove any blank lines and carriage returns from the output
  @new_externals = grep( { chomp($_); $_ !~ m"^\s*$"} @new_externals );
    
  # Now compare with expected
  my $compare_ctx = { list1 => [@expected], list2 => [@new_externals] };
    
  if ( 0 != CompareLists( $compare_ctx ) )
    {
      error( "Externals on '$svnpath' don't match expected\n".
             " - expected:\n    ".
             join( "\n    ", @expected ) .
             "\n - actual:\n    ".
             join( "\n    ", @new_externals )
           );
        
      return 0;
    }
    
  return 1;
}


#------------------------------------------------------------------------------
# Function:    CurrentRevision
#
# Returns the repository revision of the last change to the given object.
#
# Parameters:
#       source      The URL to check
#
# Returns:     The relevant revision number
#------------------------------------------------------------------------------
sub CurrentRevision
{
  my $source = shift;
    
  my $old_verbose = $verbose;
  $verbose = 0;
  my ( $retval, @output ) = SVNCall( "log -q", $source );
  $verbose = $old_verbose;

  if ( 0 != $retval )
    {
      error( "CurrentRevision: log -q on '$source' failed" );
      return -1;
    }
    
  #
  # The second line should give us the info we need: e.g.
  #
  # >svn log -q http://subversion/svn/scratch/ianb/svncopy-update/source/dirA
  # ------------------------------------------------------------------------
  # r1429 | ib | 2004-06-14 17:39:36 +0100 (Mon, 14 Jun 2004)
  # ------------------------------------------------------------------------
  # r1423 | ib | 2004-06-14 17:39:26 +0100 (Mon, 14 Jun 2004)
  # ------------------------------------------------------------------------
  # r1422 | ib | 2004-06-14 17:39:23 +0100 (Mon, 14 Jun 2004)
  # ------------------------------------------------------------------------
  # r1421 | ib | 2004-06-14 17:39:22 +0100 (Mon, 14 Jun 2004)
  # ------------------------------------------------------------------------
  #
  # The second line starts with the latest revision number.
  #
  if ( $output[1] =~ m"^r(\d+) \|" )
    {
      return $1;
    }
    
  error( "CurrentRevision: log output not formatted as expected\n" );
    
  return -1;
}


#------------------------------------------------------------------------------
# Function:    SVNCall
#
# Makes a call to subversion.
#
# Parameters: