1use strict; 2use warnings; 3 4use Test; 5use Win32; 6use Config; 7use File::Temp; 8 9plan tests => 7; 10 11ok(ref(Win32::GetProcessPrivileges()) eq 'HASH'); 12ok(ref(Win32::GetProcessPrivileges(Win32::GetCurrentProcessId())) eq 'HASH'); 13 14# All Windows PIDs are divisible by 4. It's an undocumented implementation 15# detail, but it means it's extremely unlikely that the PID below is valid. 16ok(!Win32::GetProcessPrivileges(3423237)); 17 18my $whoami = `whoami /priv 2>&1`; 19my $skip = ($? == -1 || $? >> 8) ? '"whoami" command is missing' : 0; 20 21skip($skip, sub{ 22 my $privs = Win32::GetProcessPrivileges(); 23 24 while ($whoami =~ /^(Se\w+)/mg) { 25 return 0 unless exists $privs->{$1}; 26 } 27 28 return 1; 29}); 30 31# there isn't really anything to test, we just want to make sure that the 32# function doesn't segfault 33Win32::IsDeveloperModeEnabled(); 34ok(1); 35 36Win32::IsSymlinkCreationAllowed(); 37ok(1); 38 39$skip = $^O ne 'MSWin32' ? 'MSWin32-only test' : 0; 40$skip ||= !$Config{d_symlink} ? 'this perl doesn\'t have symlink()' : 0; 41 42skip($skip, sub { 43 my $tmpdir = File::Temp->newdir; 44 my $dirname = $tmpdir->dirname; 45 46 if (Win32::IsSymlinkCreationAllowed()) { 47 # we expect success 48 return symlink("foo", $tmpdir->dirname . "/new_symlink") == 1; 49 } 50 else { 51 # we expect failure 52 return symlink("foo", $tmpdir->dirname . "/new_symlink") == 0; 53 } 54}); 55 56