1#!/usr/bin/env perl 2use strict; 3use warnings; 4use 5.0100; 5 6# script to translate some bits of the git configuration test suite into a perl 7# test suite 8 9my $prepend = 1; 10 11while (<>) { 12 if ($prepend) { 13 # header test stuff 14 say "use File::Copy;"; 15 say "use Test::More tests => 75;"; 16 $prepend = 0; 17 } 18 # translate lines like: 19 # test_expect_success 'mixed case' 'cmp .git/config expect' 20 # leaves more complicated test_expect_success lines alone 21 elsif (/test_expect_success ('[^']+') 'cmp ([^\s]+) ([^\s]+)'/) { 22 my $config = $2 eq '.git/config'? 'gitconfig' : $2; 23 say "is(slurp(\$${config}), \$${3}, ${1});"; 24 } 25 # translate cat'ing text into the 'expect' file into uninterpolated 26 # heredocs in the $expect var 27 elsif (/cat (>+) ?(expect|\.git\/config) << ?\\?EOF/) { 28 given ($2) { 29 when ('expect') { 30 say "\$expect = <<'EOF'"; 31 } 32 when ('.git/config') { 33 say "open FH, '$1', \$config_filename or die \"Could not open \${config_filename}: \$!\";"; 34 say "print FH <<'EOF'"; 35 } 36 } 37 } 38 # add semicolon after heredocs 39 elsif (/^EOF$/) { print; say ';'; } 40 # echoing into expect puts that string into $expect 41 elsif (/^echo (?:'([a-zA-Z0-9. ]+)'|([^\s]+)) > expect/) { 42 say "\$expect = '$1';"; 43 } 44 # translate some git config commands into Config::GitLike code 45 elsif (s/^git config//) { 46 if (/--unset ([a-zA-Z0-9.]+)(?: ["']?([a-zA-Z0-9 \$]+)["']?)?$/) { 47 # filter can be empty 48 my($key,$filter) = ($1, $2); 49 50 say "\$config->set(key => $key, filter => '$filter', filename => \$config_filename);" 51 } elsif (/([a-zA-Z0-9.]+) ["']?([a-zA-Z0-9 ]+)["']?(?: ["']?([a-zA-Z0-9 \$]+)["']?)?$/) { 52 # filter can be empty 53 my($key,$val,$filter) = ($1, $2, $3); 54 55 print "\$config->set(key => '$key', value => '$val', "; 56 print "filter => '$filter', " if $filter; 57 say "filename => \$config_filename);"; 58 } 59 } 60 # translate cp commands into copy()s 61 elsif (/^cp .git\/([^\s]+) .git\/([^\s]+)/) { 62 say "copy(File::Spec->catfile(\$config_dirname, '$1'),"; 63 say " File::Spec->catfile(\$config_dirname, '$2'))"; 64 say " or die \"File cannot be copied: \$!\";"; 65 } 66 # translate rm into unlink 67 elsif (/^rm .git\/(.+)$/) { 68 say "unlink File::Spec->catfile(\$config_dirname, '$1');"; 69 } 70 # translate test description into a diag 71 elsif (/^test_description=('.+')$/) { 72 say "diag($1);" 73 } 74 # this really means "load this other config file that is not 75 # $config_filename" and then compare it to $expect 76 elsif (/^GIT_CONFIG=([^ ]+) git config ([^ ]+)(?:(?: > (output))?| ([^ ]+))/) { 77 78 my($conffile, $cmd) = ($1, $2); 79 say "my \$$conffile = TestConfig->new(confname => '$conffile');"; 80 if ($3 eq 'output') { 81 # like git config -l (though the output won't be exactly the same 82 # in cases where there's more than one var in the file since 83 # dump is sorted and -l isn't) 84 say "my \$$3 = \$$conffile->dump;"; 85 } else { 86 say "\$${conffile}->set(key => '$cmd', value => '$3', file => File::Spec->catfile(\$config_dirname, ${conffile}));"; 87 } 88 } 89 # stuff that can just be canned 90 elsif (/^(?:#!\/bin\/sh|#|# Copyright|\. \.\/test-lib.sh|test -f .git\/config && rm \.git\/config|test_done)/) { } 91 # print any unknown stuff for manual frobbing 92 else { print; } 93} 94 95