-
Notifications
You must be signed in to change notification settings - Fork 580
Win32API::File crateFile[D[D[D[D[D[D[De[C[C[C[D[D[Da[2~teFile "r" sets $create to OPEN_EXISTING #8941
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Comments
From [email protected]This is a bug report for perl from cygwin@cygwin.com, I inspected my cygwin ext/Win32API/File/t/file.t failures further. I added the german cases in the attached patch, but we really should $^E is always english BTW on cygwin, but we want to catch the API error. Flags: Site configuration information for perl 5.9.5: Configured by rurban at Thu Jun 21 19:08:38 GMT 2007. Summary of my perl5 (revision 5 version 9 subversion 5 patch 31441) configuration: Locally applied patches: @INC for perl 5.9.5: Environment for perl 5.9.5: |
From @rurbanSorry 'bout the subject. Please change to Attached is a patch to add german. And to beautify the output by adding We should check for the system locale and if not english or german (new) |
From @rurbanpl-Win32API-File-t.patch--- perl-current/ext/Win32API/File/t/file.t.orig 2007-02-28 09:14:09.000000000 +0000
+++ perl-current/ext/Win32API/File/t/file.t 2007-06-21 21:37:02.593750000 +0000
@@ -2,6 +2,8 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
+# These test will only work on an english or german Windows!
+
######################### We start with some black magic to print on failure.
BEGIN {
@@ -23,7 +25,9 @@
# Win32API::File does an implicit "require Win32", but
# the ../lib directory in @INC will no longer work once
# we chdir() into the TEMP directory.
+
use Win32;
+use File::Spec;
use Carp;
use Carp::Heavy;
@@ -37,19 +41,16 @@
use strict qw(subs);
-$temp= $ENV{"TMP"};
-$temp= $ENV{"TEMP"} unless -d $temp;
-$temp= "C:/Temp" unless -d $temp;
-$temp= "." unless -d $temp;
+$temp= File::Spec->tmpdir();
$dir= "W32ApiF.tmp";
$ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR};
chdir( $temp )
or die "# Can't cd to temp directory, $temp: $!\n";
-
+$tempdir = File::Spec->catdir($temp,$dir);
if( -d $dir ) {
- print "# deleting $temp\\$dir\\*\n" if glob "$dir/*";
+ print "# deleting ",File::Spec->catdir($temp,$dir,'*'),"\n" if glob "$dir/*";
for (glob "$dir/*") {
chmod 0777, $_;
@@ -58,13 +59,13 @@
rmdir $dir or die "Could not rmdir $dir: $!";
}
mkdir( $dir, 0777 )
- or die "# Can't create temp dir, $temp/$dir: $!\n";
-print "# chdir $temp\\$dir\n";
+ or die "# Can't create temp dir, $tempdir: $!\n";
+print "# chdir $tempdir\n";
chdir( $dir )
- or die "# Can't cd to my dir, $temp/$dir: $!\n";
-
+ or die "# Can't cd to my dir, $tempdir: $!\n";
$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } );
-$ok= ! $h1 && fileLastError() =~ /not find the file?/i;
+# $^E is always english: "No such file or directory"
+$ok= ! $h1 && fileLastError() =~ /(not find the file|kann die angegebene Datei nicht finden)/i;
$ok or print "# ","".fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 2
if( ! $ok ) { CloseHandle($h1); unlink("ReadOnly.txt"); }
@@ -78,13 +79,13 @@
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 4
$h2= createFile( "ReadOnly.txt", "rcn" );
-$ok= ! $h2 && fileLastError() =~ /file exists?/i;
+$ok= ! $h2 && fileLastError() =~ /(file exists|Datei ist vorhanden)/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 5
if( ! $ok ) { CloseHandle($h2); }
$h2= createFile( "ReadOnly.txt", "rwke" );
-$ok= ! $h2 && fileLastError() =~ /access is denied?/i;
+$ok= ! $h2 && fileLastError() =~ /(access is denied|Zugriff verweigert)/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 6
if( ! $ok ) { CloseHandle($h2); }
@@ -121,7 +122,7 @@
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 12
$ok= ! ReadFile( $h2, $text, 80, $len, [] )
- && fileLastError() =~ /handle is invalid?/i;
+ && fileLastError() =~ /handle is invalid|Handle ist ung�ltig/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 13
@@ -184,37 +185,37 @@
CloseHandle( $h1 );
$ok= ! DeleteFile( "ReadOnly.txt" )
- && fileLastError() =~ /access is denied?/i;
+ && fileLastError() =~ /access is denied|Zugriff verweigert/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23
$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 )
- && fileLastError() =~ /file exists?/i;
+ && fileLastError() =~ /file exists|Datei ist vorhanden/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24
$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 )
- && fileLastError() =~ /access is denied?/i;
+ && fileLastError() =~ /access is denied|Zugriff verweigert/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25
$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" )
- && fileLastError() =~ /not find the file/i;
+ && fileLastError() =~ /not find the file|kann die angegebene Datei nicht finden/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26
$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 )
- && fileLastError() =~ /not find the file/i;
+ && fileLastError() =~ /not find the file|kann die angegebene Datei nicht finden/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27
$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" )
- && fileLastError() =~ /file already exists?/i;
+ && fileLastError() =~ /file already exists?|kann nicht erstellt werden, wenn sie bereits vorhanden/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28
$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 )
- && fileLastError() =~ /file already exists?/i;
+ && fileLastError() =~ /file already exists?|kann nicht erstellt werden, wenn sie bereits vorhanden/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 29
@@ -224,7 +225,7 @@
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 30
$ok= ! MoveFileEx( "CanWrite.txt", "ReadOnly.cp", MOVEFILE_REPLACE_EXISTING )
- && fileLastError() =~ /access is denied?|cannot create/i;
+ && fileLastError() =~ /access is denied?|cannot create|Zugriff verweigert/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 31
@@ -244,7 +245,7 @@
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 34
$ok= ! DeleteFile( "Moved.cp" )
- && fileLastError() =~ /access is denied?/i;
+ && fileLastError() =~ /access is denied|Zugriff verweigert/i;
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35
|
From [Unknown Contact. See original ticket]Sorry 'bout the subject. Please change to Attached is a patch to add german. And to beautify the output by adding We should check for the system locale and if not english or german (new) |
From @rgsOn 21/06/07, via RT cygwin @ cygwin. com <perlbug-followup@perl.org> wrote:
I think that we should instead force the test to run in an english |
The RT System itself - Status changed from 'new' to 'open' |
From [email protected]-----BEGIN PGP SIGNED MESSAGE----- Moin, On Thursday 21 June 2007 23:54:58 Reini Urban via RT wrote:
That patch seems to be a bit garbled (at least my Kwrite shows it as this): $ok= ! ReadFile( $h2, $text, 80, $len, [] ) it should be "ungültig" or better "ung.ltig" if you want to avoid writing All the best, Tels - -- "TT: If I go to Blockbuster and rent a movie and watch it, am I a bad -- Keith J. Winstein (TT) vs. Jack Valenty (JV) in iQEVAwUBRnuswHcLPEOTuEwVAQJUuAf+Iuzpph8EuaqrGWW6wKscd6QS873kRkuV |
From @demerphqOn 6/21/07, Reini Urban via RT <perlbug-comment@perl.org> wrote:
Actually id like to switch to using error numbers only. Theres no So id prefer to see this patch changed to just use error codes and cheers, -- |
From @rurbanAttached patch switches to error numbers to handle On Fri Jun 22 05:25:57 2007, demerphq wrote:
|
From @rurbanpl-#43285-Win32API-File-t.patch--- ext/Win32API/File/t/file.t.orig 2007-02-28 09:14:09.000000000 +0000
+++ ext/Win32API/File/t/file.t 2007-06-23 18:09:27.468750000 +0000
@@ -2,6 +2,8 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
+# These test will only work on an english or german Windows!
+
######################### We start with some black magic to print on failure.
BEGIN {
@@ -23,7 +25,9 @@
# Win32API::File does an implicit "require Win32", but
# the ../lib directory in @INC will no longer work once
# we chdir() into the TEMP directory.
+
use Win32;
+use File::Spec;
use Carp;
use Carp::Heavy;
@@ -37,19 +41,16 @@
use strict qw(subs);
-$temp= $ENV{"TMP"};
-$temp= $ENV{"TEMP"} unless -d $temp;
-$temp= "C:/Temp" unless -d $temp;
-$temp= "." unless -d $temp;
+$temp= File::Spec->tmpdir();
$dir= "W32ApiF.tmp";
$ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR};
chdir( $temp )
or die "# Can't cd to temp directory, $temp: $!\n";
-
+$tempdir = File::Spec->catdir($temp,$dir);
if( -d $dir ) {
- print "# deleting $temp\\$dir\\*\n" if glob "$dir/*";
+ print "# deleting ",File::Spec->catdir($temp,$dir,'*'),"\n" if glob "$dir/*";
for (glob "$dir/*") {
chmod 0777, $_;
@@ -58,13 +59,12 @@
rmdir $dir or die "Could not rmdir $dir: $!";
}
mkdir( $dir, 0777 )
- or die "# Can't create temp dir, $temp/$dir: $!\n";
-print "# chdir $temp\\$dir\n";
+ or die "# Can't create temp dir, $tempdir: $!\n";
+print "# chdir $tempdir\n";
chdir( $dir )
- or die "# Can't cd to my dir, $temp/$dir: $!\n";
-
+ or die "# Can't cd to my dir, $tempdir: $!\n";
$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } );
-$ok= ! $h1 && fileLastError() =~ /not find the file?/i;
+$ok= ! $h1 && Win32API::File::_fileLastError() == 2; # could not find the file
$ok or print "# ","".fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 2
if( ! $ok ) { CloseHandle($h1); unlink("ReadOnly.txt"); }
@@ -78,13 +78,13 @@
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 4
$h2= createFile( "ReadOnly.txt", "rcn" );
-$ok= ! $h2 && fileLastError() =~ /file exists?/i;
+$ok= ! $h2 && Win32API::File::_fileLastError() == 80; # file exists
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 5
if( ! $ok ) { CloseHandle($h2); }
$h2= createFile( "ReadOnly.txt", "rwke" );
-$ok= ! $h2 && fileLastError() =~ /access is denied?/i;
+$ok= ! $h2 && Win32API::File::_fileLastError() == 5; # access is denied
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 6
if( ! $ok ) { CloseHandle($h2); }
@@ -121,7 +121,7 @@
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 12
$ok= ! ReadFile( $h2, $text, 80, $len, [] )
- && fileLastError() =~ /handle is invalid?/i;
+ && Win32API::File::_fileLastError() == 6; # handle is invalid
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 13
@@ -174,7 +174,7 @@
}
else {
unlink("CanWrite.txt");
- $ok= -e "CanWrite.txt" && $! =~ /permission denied/i;
+ $ok = -e "CanWrite.txt" && $! =~ /permission denied/i;
$ok or print "# $!\n";
}
print $ok ? "" : "not ", "ok ", ++$test, "$skip\n"; # ok 22
@@ -184,37 +184,37 @@
CloseHandle( $h1 );
$ok= ! DeleteFile( "ReadOnly.txt" )
- && fileLastError() =~ /access is denied?/i;
+ && Win32API::File::_fileLastError() == 5; # access is denied
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23
$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 )
- && fileLastError() =~ /file exists?/i;
+ && Win32API::File::_fileLastError() == 80; # file exists
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24
$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 )
- && fileLastError() =~ /access is denied?/i;
+ && Win32API::File::_fileLastError() == 5; # access is denied
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25
$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" )
- && fileLastError() =~ /not find the file/i;
+ && Win32API::File::_fileLastError() == 2; # not find the file
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26
$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 )
- && fileLastError() =~ /not find the file/i;
+ && Win32API::File::_fileLastError() == 2; # not find the file
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27
$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" )
- && fileLastError() =~ /file already exists?/i;
+ && Win32API::File::_fileLastError() == 183; # file already exists
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28
$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 )
- && fileLastError() =~ /file already exists?/i;
+ && Win32API::File::_fileLastError() == 183; # file already exists
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 29
@@ -224,7 +224,7 @@
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 30
$ok= ! MoveFileEx( "CanWrite.txt", "ReadOnly.cp", MOVEFILE_REPLACE_EXISTING )
- && fileLastError() =~ /access is denied?|cannot create/i;
+ && Win32API::File::_fileLastError() == 5; # access is denied
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 31
@@ -244,7 +244,7 @@
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 34
$ok= ! DeleteFile( "Moved.cp" )
- && fileLastError() =~ /access is denied?/i;
+ && Win32API::File::_fileLastError() == 5; # access is denied
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35
|
From @rgsOn 23/06/07, Reini Urban via RT <perlbug-followup@perl.org> wrote:
Thanks, applied as #31458, removed an irrelevant comment as #31459. |
@rgs - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#43285 (status was 'resolved')
Searchable as RT43285$
The text was updated successfully, but these errors were encountered: