| #!/usr/bin/perl -w | |
| # | |
| # This script tests regedit functionality | |
| # | |
| # Copyright 2002 Andriy Palamarchuk | |
| # | |
| # This library is free software; you can redistribute it and/or | |
| # modify it under the terms of the GNU Lesser General Public | |
| # License as published by the Free Software Foundation; either | |
| # version 2.1 of the License, or (at your option) any later version. | |
| # | |
| # This library is distributed in the hope that it will be useful, | |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| # Lesser General Public License for more details. | |
| # | |
| # You should have received a copy of the GNU Lesser General Public | |
| # License along with this library; if not, write to the Free Software | |
| # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
| # | |
| use strict; | |
| use diagnostics; | |
| use winetest; | |
| $main::orig_reg = './tests/orig.reg'; | |
| test_regedit(); | |
| # Imitation of test framework "ok". | |
| # Uncomment when running on Windows without testing framework | |
| # sub ok($;$) | |
| # { | |
| # my ($condition, $message) = @_; | |
| # if (!$condition) | |
| # { | |
| # die $message; | |
| # } | |
| # } | |
| # Checks if the files are equal regardless of the end-of-line encoding. | |
| # Returns 0 if the files are different, otherwise returns 1 | |
| # params - list of file names | |
| sub files_are_equal | |
| { | |
| my @file_names = @_; | |
| my @files = (); | |
| die "At least 2 file names expected" unless ($#file_names); | |
| #compare file contents | |
| foreach my $file_name (@file_names) | |
| { | |
| my $file; | |
| open($file, "<$file_name") || die "Error! can't open file $file_name"; | |
| push(@files, $file); | |
| } | |
| my $first_file = shift(@files); | |
| my $line1; | |
| my $line2; | |
| while ($line1 = <$first_file>) | |
| { | |
| $line1 =~ s/\r//; | |
| chomp($line1); | |
| foreach my $file (@files) | |
| { | |
| $line2 = <$file>; | |
| $line2 =~ s/\r//; | |
| chomp($line2); | |
| return 0 if $line1 ne $line2; | |
| } | |
| } | |
| return 1; | |
| } | |
| #removes all test output files | |
| sub clear_output | |
| { | |
| unlink "${main::orig_reg}.exported"; | |
| unlink "${main::orig_reg}.exported2"; | |
| } | |
| #tests compatibility with regedit | |
| sub test_regedit | |
| { | |
| my $error_no_file_name = "regedit: No file name is specified"; | |
| my $error_undefined_switch = "regedit: Undefined switch /"; | |
| my $error_no_registry_key = "regedit: No registry key is specified"; | |
| my $error_file_not_found = 'regedit: Can\'t open file "dummy_file_name"'; | |
| my $error_bad_reg_class_name = 'regedit: Incorrect registry class specification in'; | |
| my $error_dont_delete_class = 'regedit: Can\'t delete registry class'; | |
| my $test_reg_key = 'HKEY_CURRENT_USER\Test Regedit'; | |
| my $s; | |
| my $regedit = -e "./regedit.exe" ? ".\\regedit.exe" : "./regedit"; | |
| #no parameters | |
| my $command = "$regedit 2>&1"; | |
| $s = qx/$command/; | |
| ok($?, "regedit.exe return code check"); | |
| ok($s =~ /$error_no_file_name/, | |
| 'Should raise an error on missed file name'); | |
| #ignored parameters | |
| $command = "$regedit /S /V /R:1.reg /L:ss_ss.reg 2>&1"; | |
| $s = qx/$command/; | |
| ok($?, "regedit.exe return code check"); | |
| ok($s =~ /$error_no_file_name/, | |
| 'Should raise an error on missed file name'); | |
| #incorrect form for /L, /R parameters | |
| for my $switch ('L', 'R') | |
| { | |
| $command = "$regedit /$switch 2>&1"; | |
| $s = qx/$command/; | |
| ok($?, "regedit.exe return code check"); | |
| ok($s =~ /$error_undefined_switch/, "Incorrect switch format check"); | |
| #with ':' | |
| $command = "$regedit /$switch: 2>&1"; | |
| $s = qx/$command/; | |
| ok($?, "regedit.exe return code check"); | |
| ok($s =~ /$error_no_file_name/, "Incorrect switch format check"); | |
| } | |
| #file does not exist | |
| $command = "$regedit dummy_file_name 2>&1"; | |
| $s = qx/$command/; | |
| ok($?, "regedit.exe return code check"); | |
| ok($s =~ /$error_file_not_found/, 'Incorrect processing of not-existing file'); | |
| #incorrect registry class is specified | |
| $command = "$regedit /e ${main::orig_reg}.exported \"BAD_CLASS_HKEY\" 2>&1"; | |
| $s = qx/$command/; | |
| ok($?, "regedit.exe return code check"); | |
| ok($s =~ /$error_bad_reg_class_name/, 'Incorrect processing of not-existing file'); | |
| #import registry file, export registry file, compare the files | |
| $command = "$regedit ${main::orig_reg} 2>&1"; | |
| $s = qx/$command/; | |
| ok(!$?, "regedit.exe return code check"); | |
| $command = "$regedit /e ${main::orig_reg}.exported \"$test_reg_key\" 2>&1"; | |
| $s = qx/$command/; | |
| ok(!$?, "regedit.exe return code check"); | |
| ok(files_are_equal("${main::orig_reg}.exported", $main::orig_reg), | |
| "Original and generated registry files " . | |
| "(${main::orig_reg}.exported and ${main::orig_reg}) " . | |
| "are different"); | |
| clear_output(); | |
| #export bare registry class (2 formats of command line parameter) | |
| #XXX works fine under wine, but commented out because does not handle all key types | |
| #existing on Windows and Windows registry is *very* big | |
| # $command = "$regedit /e ${main::orig_reg}.exported HKEY_CURRENT_USER 2>&1"; | |
| # $s = qx/$command/; | |
| # print("DEBUG\t result: $s, return code - $?\n"); | |
| # ok(!$?, "regedit.exe return code check"); | |
| # $command = "$regedit /e ${main::orig_reg}.exported2 HKEY_CURRENT_USER 2>&1"; | |
| # qx/$command/; | |
| # ok(!$?, "regedit.exe return code check"); | |
| # ok(files_are_equal("${main::orig_reg}.exported", "${main::orig_reg}.exported2"), | |
| # "Original and generated registry files " . | |
| # "(${main::orig_reg}.exported and ${main::orig_reg}.exported2) " . | |
| # "are different"); | |
| ##test removal | |
| #incorrect format | |
| $command = "$regedit /d 2>&1"; | |
| $s = qx/$command/; | |
| ok($?, "regedit.exe return code check"); | |
| ok($s =~ /$error_no_registry_key/, | |
| 'No registry key name is specified for removal'); | |
| #try to delete class | |
| $command = "$regedit /d HKEY_CURRENT_USER 2>&1"; | |
| $s = qx/$command/; | |
| ok($?, "regedit.exe return code check"); | |
| ok($s =~ /$error_dont_delete_class/, 'Try to remove registry class'); | |
| #try to delete registry key with incorrect name | |
| $command = "$regedit /d BAD_HKEY 2>&1"; | |
| $s = qx/$command/; | |
| ok($?, "regedit.exe return code check"); | |
| #should not export anything after removal because the key does not exist | |
| clear_output(); | |
| ok(!-e("${main::orig_reg}.exported"), "Be sure the file is deleted"); | |
| $command = "$regedit /d \"$test_reg_key\" 2>&1"; | |
| $s = qx/$command/; | |
| $command = "$regedit /e ${main::orig_reg}.exported \"$test_reg_key\" 2>&1"; | |
| $s = qx/$command/; | |
| ok(!-e("${main::orig_reg}.exported"), | |
| "File ${main::orig_reg}.exported should not exist"); | |
| ok($?, "regedit.exe return code check"); | |
| clear_output(); | |
| } |