Skip to content
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

do'.\dir\file' fails under -T (Win32) #9661

Closed
p5pRT opened this issue Feb 25, 2009 · 5 comments
Closed

do'.\dir\file' fails under -T (Win32) #9661

p5pRT opened this issue Feb 25, 2009 · 5 comments
Labels

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Feb 25, 2009

Migrated from rt.perl.org#63492 (status was 'resolved')

Searchable as RT63492$

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 25, 2009

From ch.l.ngre@online.de

Created by ch.l.ngre@online.de

To​: perlbug@​perl.org
Subject​: do'.\dir\file' fails under -T (Win32)
Reply-To​: ch.l.ngre@​online.de
Message-Id​: <5.8.8_1552_1235589937@​CHRIS>

This is a bug report for perl from ch.l.ngre@​online.de,
generated with the help of perlbug 1.35 running under perl v5.8.8.

-----------------------------------------------------------------

Dear porters,

I came across a somewhat strange behavior of 'do()' on strawberry-perl
when I examined a failing test in Scalar-List-Utils​:
http​://rt.cpan.org/Public/Bug/Display.html?id=25430

When running under -T,
do './t/t.pl'
and
do '.\t\t.pl'
behave differently.
The first expression succeeds (like it does with 5.8.8 under Linux),
the second will produce a 'No such file or directory' error.

Testcase attached, output as follows​:

E​:\devel\ngre>perl test-do.pl
1..4
ok 1 - executed [./t/t.pl]
ok 2 - [do ./t/t.pl] returned 1
ok 3 - executed [.\t/t.pl]
ok 4 - [do .\t/t.pl] returned 1

E​:\devel\ngre>perl -T test-do.pl
1..4
ok 1 - executed [./t/t.pl]
ok 2 - [do ./t/t.pl] returned 1
not ok 3 - executed [.\t/t.pl] No such file or directory
# Failed test 'executed [.\t/t.pl] No such file or directory'
# at test-do.pl line 12.
not ok 4 - [do .\t/t.pl] returned 1
# Failed test '[do .\t/t.pl] returned 1'
# at test-do.pl line 13.
# got​: undef
# expected​: '1'
# Looks like you failed 2 tests of 4.

I know, the build of perl I am running is a bit 'outdated'. I posted
this on perlmonks and it seems, that others could confirm this on different
versions as well.

Best regards, Christoph

Perl Info

Flags:
     category=core
     severity=low

Site configuration information for perl v5.8.8:

Configured by DGolden at Sun Aug 27 17:17:26 2006.

Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
   Platform:
     osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
     uname=''
     config_args='undef'
     hint=recommended, useposix=true, d_sigaction=undef
     usethreads=define use5005threads=undef useithreads=define 
usemultiplicity=define
     useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
     use64bitint=undef use64bitall=undef uselongdouble=undef
     usemymalloc=n, bincompat5005=undef
   Compiler:
     cc='gcc', ccflags =' -s -O2 -DWIN32 -DHAVE_DES_FCRYPT 
-DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -fno-strict-aliasing 
-DPERL_MSVCRT_READFIX',
     optimize='-s -O2',
     cppflags='-DWIN32'
     ccversion='', gccversion='3.4.5', gccosandvers=''
     intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
     d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=12
     ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='long long', 
lseeksize=8
     alignbytes=8, prototype=define
   Linker and Libraries:
     ld='g++', ldflags ='-s -L"c:\strawberry-perl\perl\lib\CORE" 
-L"c:\strawberry-perl\mingw\lib"'
     libpth=c:\strawberry-perl\mingw\lib
     libs= -lmsvcrt -lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32 
-ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lwinmm 
-lversion -lodbc32 -lodbccp32
     perllibs= -lmsvcrt -lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool 
-lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 
-lmpr -lwinmm -lversion -lodbc32 -lodbccp32
     libc=-lmsvcrt, so=dll, useshrplib=yes, libperl=libperl58.a
     gnulibc_version=''
   Dynamic Linking:
     dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
     cccdlflags=' ', lddlflags='-mdll -s -L"c:\strawberry-perl\perl\lib\CORE" 
-L"c:\strawberry-perl\mingw\lib"'

Locally applied patches:



@INC for perl v5.8.8:
     C:/strawberry-perl/perl/lib
     C:/strawberry-perl/perl/site/lib
     .


Environment for perl v5.8.8:
     HOME (unset)
     LANG=de
     LANGUAGE (unset)
     LD_LIBRARY_PATH (unset)
     LOGDIR (unset)
 
PATH=C:\PROGRAMME\THINKPAD\UTILITIES;C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\System32\Wbem;C:\IBMTOOLS\Python22;C:\Programme\PC-Doctor 
for Windows\services;C:\Program 
Files\gs\gs8.51\bin;C:\Programme\PostgreSQL\8.1\bin;C:\Programme\Gemeinsame 
Dateien\GTK\2.0\bin;C:\Programme\QuickTime\QTSystem\;C:\Programme\TortoiseSVN\bin;C:\strawberry-perl\perl\bin;C:\strawberry-perl\dmake\bin;C:\strawberry-perl\mingw;C:\strawberry-perl\mingw\bin;C:\cygwin\bin
     PERL_BADLANG (unset)
     SHELL (unset)


@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 25, 2009

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 3, 2009

From ch.l.ngre@online.de

Dear porters,

below are patches to pp_ctl.c and t/run/switcht.t which pass tests on WinXP
using 5.10.0 sources and strawberry-perls mingw. I don't know the perl internals
  and therefore I'm not sure about the correctness.

Regards, Christoph Lamprecht

C​:\devel\perl-5.10.0-mod>perl.exe -V
Summary of my perl5 (revision 5 version 10 subversion 0) configuration​:
  Platform​:
  osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
  uname=''
  config_args='undef'
  hint=recommended, useposix=true, d_sigaction=undef
  useithreads=define, usemultiplicity=define
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=undef, use64bitall=undef, uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='gcc', ccflags =' -s -O2 -DWIN32 -DHAVE_DES_FCRYPT -DPERL_IMPLICIT_CONTE
XT -DPERL_IMPLICIT_SYS -fno-strict-aliasing -DPERL_MSVCRT_READFIX',
  optimize='-s -O2',
  cppflags='-DWIN32'
  ccversion='', gccversion='3.4.5', gccosandvers=''
  intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
  d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=12
  ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='long long', lseek
size=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='g++', ldflags ='-s -L"c​:\perl-build1\lib\CORE" -L"C​:\strawberry-perl\min
gw\lib"'
  libpth=C​:\strawberry-perl\mingw\lib
  libs= -lmsvcrt -lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32
-ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lwinmm
  -lversion -lodbc32 -lodbccp32
  perllibs= -lmsvcrt -lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdl
g32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lw
inmm -lversion -lodbc32 -lodbccp32
  libc=-lmsvcrt, so=dll, useshrplib=true, libperl=libperl510.a
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags='-mdll -s -L"c​:\perl-build1\lib\CORE" -L"C​:\strawb
erry-perl\mingw\lib"'

Characteristics of this binary (from libperl)​:
  Compile-time options​: MULTIPLICITY PERL_DONT_CREATE_GVSV
  PERL_IMPLICIT_CONTEXT PERL_IMPLICIT_SYS
  PERL_MALLOC_WRAP PL_OP_SLAB_ALLOC USE_ITHREADS
  USE_LARGE_FILES USE_PERLIO
  Built under MSWin32
  Compiled at Apr 2 2009 07​:57​:46
  @​INC​:
  C​:/devel/perl-5.10.0-mod/lib
  .

Inline Patch
--- perl-5.10.0/pp_ctl.c	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0-mod/pp_ctl.c	2009-04-02 16:22:52.515625000 +0200
@@ -4783,10 +4783,17 @@
  S_path_is_absolute(const char *name)
  {
      if (PERL_FILE_IS_ABSOLUTE(name)
  #ifdef MACOS_TRADITIONAL
  	|| (*name == ':')
+#endif
+#ifdef WIN32
+	|| (*name == '.' && ((name[1] == '/' ||
+			     (name[1] == '.' && name[2] == '/'))
+			 || (name[1] == '\\' ||
+			     ( name[1] == '.' && name[2] == '\\')))
+	    )
  #else
  	|| (*name == '.' && (name[1] == '/' ||
  			     (name[1] == '.' && name[2] == '/')))
  #endif
  	 )




--- perl-5.10.0/t/run/switcht.t	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0-mod/t/run/switcht.t	2009-04-02 16:04:46.796875000 +0200
@@ -4,11 +4,11 @@
      chdir 't';
      @INC = '../lib';
      require './test.pl';
  }

-plan tests => 11;
+plan tests => 13;

  my $Perl = which_perl();

  my $warning;
  local $SIG{__WARN__} = sub { $warning = join "\n", @_; };
@@ -41,5 +41,25 @@
  like( $warning, qr/^Insecure dependency in unlink $Tmsg/,
                                                    'unlink() taint warn' );
  ok( !-e $file,  'unlink worked' );

  ok( !$^W,   "-t doesn't enable regular warnings" );
+
+
+mkdir('tt');
+open(FH,'>','tt/ttest.pl')or DIE $!;
+print FH 'return 42';
+close FH or DIE $!;
+
+my $test;
+SKIP: {
+    ($^O eq 'MSWin32') || skip('skip tainted do test with \ seperator');
+    $test = 0;
+    $test =  do '.\tt/ttest.pl';
+    is($test, 42, 'Could "do" .\tt/ttest.pl');
+}
+
+$test = 0;
+$test =  do './tt/ttest.pl';
+is($test, 42, 'Could "do" ./tt/ttest.pl');
+
+unlink ('./tt/ttest.pl');
+rmdir ('tt');
@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 13, 2009

From @jandubois

Patches submitted in change 36f064b

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 13, 2009

@jandubois - Status changed from 'new' to 'resolved'

@p5pRT p5pRT closed this May 13, 2009
@p5pRT p5pRT added the Severity Low label Oct 18, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant
You can’t perform that action at this time.