diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_aix.xs | 2 | ||||
| -rw-r--r-- | ext/DynaLoader/hints/aix.pl | 4 | ||||
| -rw-r--r-- | ext/IO/lib/IO/Socket.pm | 2 | ||||
| -rw-r--r-- | ext/XS/Typemap/Typemap.pm | 2 | ||||
| -rw-r--r-- | ext/XS/Typemap/Typemap.xs | 8 | ||||
| -rw-r--r-- | ext/XS/Typemap/typemap | 1 | ||||
| -rw-r--r-- | gv.c | 3 | ||||
| -rw-r--r-- | makedef.pl | 1 | ||||
| -rw-r--r-- | pp.c | 6 | ||||
| -rw-r--r-- | t/lib/cwd.t | 88 | ||||
| -rw-r--r-- | t/lib/xs-typemap.t | 2 | ||||
| -rw-r--r-- | t/op/utf8decode.t | 15 | ||||
| -rw-r--r-- | t/pragma/warn/perl | 15 |
14 files changed, 142 insertions, 8 deletions
@@ -1432,6 +1432,7 @@ t/lib/checktree.t See if File::CheckTree works t/lib/class-struct.t See if Class::Struct works t/lib/complex.t See if Math::Complex works t/lib/compmod.pl Helper for 1_compile.t +t/lib/cwd.t See if Cwd works t/lib/db-btree.t See if DB_File works t/lib/db-hash.t See if DB_File works t/lib/db-recno.t See if DB_File works diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index 1f51961259..e29c0f85f7 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -72,7 +72,7 @@ # include "/usr/ibmcxx/include/load.h" # elif defined(USE_xlC_load_h) # include "/usr/lpp/xlC/include/load.h" -# else +# elif defined(USE_load_h) # include "/usr/include/load.h" # endif #else diff --git a/ext/DynaLoader/hints/aix.pl b/ext/DynaLoader/hints/aix.pl index b80ba651fa..d4231ccb3e 100644 --- a/ext/DynaLoader/hints/aix.pl +++ b/ext/DynaLoader/hints/aix.pl @@ -8,7 +8,7 @@ if ($Config{libs} =~ /-lC/ && -f '/lib/libC.a') { $self->{CCFLAGS} .= ' -DUSE_ibmcxx_load_h'; } elsif (-f '/usr/lpp/xlC/include/load.h') { $self->{CCFLAGS} .= ' -DUSE_xlC_load_h'; - } elsif (!-f '/usr/include/load.h') { - $self->{CCFLAGS} = $Config{ccflags}; # Remove again, no <load.h> + } elsif (-f '/usr/include/load.h') { + $self->{CCFLAGS} .= ' -DUSE_load_h'; } } diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm index 4199da2a14..8d53136ea7 100644 --- a/ext/IO/lib/IO/Socket.pm +++ b/ext/IO/lib/IO/Socket.pm @@ -29,7 +29,7 @@ $VERSION = "1.27"; sub import { my $pkg = shift; - if ($_[0] eq 'sockatmark') { # not very extensible but for now, fast + if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark'); } else { my $callpkg = caller; diff --git a/ext/XS/Typemap/Typemap.pm b/ext/XS/Typemap/Typemap.pm index f14a0d20fa..ccfdfb1a81 100644 --- a/ext/XS/Typemap/Typemap.pm +++ b/ext/XS/Typemap/Typemap.pm @@ -67,7 +67,7 @@ $VERSION = '0.01'; T_REF_IV_PTR_IN T_REF_IV_PTR_OUT T_PTROBJ_IN T_PTROBJ_OUT T_OPAQUE_IN T_OPAQUE_array - T_OPAQUEPTR_IN T_OPAQUEPTR_OUT + T_OPAQUEPTR_IN T_OPAQUEPTR_OUT T_OPAQUEPTR_OUT_short T_ARRAY T_STDIO_open T_STDIO_close T_STDIO_print /); diff --git a/ext/XS/Typemap/Typemap.xs b/ext/XS/Typemap/Typemap.xs index 7c24c447c1..ce8bb7cccd 100644 --- a/ext/XS/Typemap/Typemap.xs +++ b/ext/XS/Typemap/Typemap.xs @@ -584,6 +584,14 @@ T_OPAQUEPTR_OUT( ptr ) OUTPUT: RETVAL +short +T_OPAQUEPTR_OUT_short( ptr ) + shortOPQ * ptr + CODE: + RETVAL = *ptr; + OUTPUT: + RETVAL + =item T_OPAQUE This can be used to store pointers to non-pointer types in an SV. It diff --git a/ext/XS/Typemap/typemap b/ext/XS/Typemap/typemap index 909221d059..12928c4dc2 100644 --- a/ext/XS/Typemap/typemap +++ b/ext/XS/Typemap/typemap @@ -15,3 +15,4 @@ intArray * T_ARRAY intOpq T_IV intOpq * T_OPAQUEPTR shortOPQ T_OPAQUE +shortOPQ * T_OPAQUEPTR @@ -731,7 +731,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) gv_init(gv, stash, name, len, add & GV_ADDMULTI); gv_init_sv(gv, sv_type); - if (isLEXWARN_on && isALPHA(name[0]) && ! ckWARN(WARN_ONCE)) + if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE) + : (PL_dowarn & G_WARN_ON ) ) ) GvMULTI_on(gv) ; /* set up magic where warranted */ diff --git a/makedef.pl b/makedef.pl index 583eada584..18712a39c4 100644 --- a/makedef.pl +++ b/makedef.pl @@ -550,6 +550,7 @@ my @layer_syms = qw( PerlIOBase_setlinebuf PerlIOBase_pushed PerlIOBase_read + PerlIOBase_unread PerlIOBuf_bufsiz PerlIOBuf_fill PerlIOBuf_flush @@ -1714,6 +1714,12 @@ PP(pp_ge) PP(pp_ne) { dSP; tryAMAGICbinSET(ne,0); +#ifndef NV_PRESERVES_UV + if (SvROK(TOPs) && SvROK(TOPm1s)) { + SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s))); + RETURN; + } +#endif #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { diff --git a/t/lib/cwd.t b/t/lib/cwd.t new file mode 100644 index 0000000000..adc57f6efb --- /dev/null +++ b/t/lib/cwd.t @@ -0,0 +1,88 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use Config; +use Cwd; +use strict; +use warnings; + +print "1..14\n"; + +# check imports +print +(defined(&cwd) && + defined(&getcwd) && + defined(&fastcwd) && + defined(&fastgetcwd) ? + "" : "not "), "ok 1\n"; +print +(!defined(&chdir) && + !defined(&abs_path) && + !defined(&fast_abs_path) ? + "" : "not "), "ok 2\n"; + +# XXX these tests rely on a working pwd program or shell command +chomp(my $start = `pwd 2>/dev/null`); +if ($?) { + print "ok 3 # skipped\n"; + print "ok 4 # skipped\n"; + print "ok 5 # skipped\n"; + print "ok 6 # skipped\n"; +} else { + my $cwd = cwd; + my $getcwd = getcwd; + my $fastcwd = fastcwd; + my $fastgetcwd = fastgetcwd; + print +($cwd eq $start ? "" : "not "), "ok 3\n"; + print +($getcwd eq $start ? "" : "not "), "ok 4\n"; + print +($fastcwd eq $start ? "" : "not "), "ok 5\n"; + print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n"; +} + +mkdir "pteerslt", 0777; +mkdir "pteerslt/path", 0777; +mkdir "pteerslt/path/to", 0777; +mkdir "pteerslt/path/to/a", 0777; +mkdir "pteerslt/path/to/a/dir", 0777; +Cwd::chdir "pteerslt/path/to/a/dir"; +my $cwd = cwd; +my $getcwd = getcwd; +my $fastcwd = fastcwd; +my $fastgetcwd = fastgetcwd; +my $want = "t/pteerslt/path/to/a/dir"; +print +($cwd =~ m|$want$| ? "" : "not "), "ok 7\n"; +print +($getcwd =~ m|$want$| ? "" : "not "), "ok 8\n"; +print +($fastcwd =~ m|$want$| ? "" : "not "), "ok 9\n"; +print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n"; + +# Cwd::chdir should also update $ENV{PWD} +print +($ENV{PWD} =~ m|$want$| ? "" : "not "), "ok 11\n"; +Cwd::chdir ".."; rmdir "dir"; +Cwd::chdir ".."; rmdir "a"; +Cwd::chdir ".."; rmdir "to"; +Cwd::chdir ".."; rmdir "path"; +Cwd::chdir ".."; rmdir "pteerslt"; +print +($ENV{PWD} =~ m|\bt$| ? "" : "not "), "ok 12\n"; + +if ($Config{d_symlink}) { + my @dirs = split " " => $Config{libpth}; + my $target = pop @dirs; + symlink $target => "linktest"; + mkdir "pteerslt"; + chdir "pteerslt"; + my $rel = "../../t/linktest"; + + my $abs_path = Cwd::abs_path($rel); + my $fast_abs_path = Cwd::fast_abs_path($rel); + print +($abs_path eq $target ? "" : "not "), "ok 13\n"; + print +($fast_abs_path eq $target ? "" : "not "), "ok 14\n"; + + chdir ".."; + rmdir "pteerslt"; + unlink "linktest"; +} else { + print "ok 13 # skipped\n"; + print "ok 14 # skipped\n"; +} diff --git a/t/lib/xs-typemap.t b/t/lib/xs-typemap.t index a3e85da17b..131c32ec83 100644 --- a/t/lib/xs-typemap.t +++ b/t/lib/xs-typemap.t @@ -240,7 +240,7 @@ print "# T_OPAQUE\n"; $t = 48; $ptr = T_OPAQUE_IN( $t ); -ok(T_OPAQUEPTR_OUT( $ptr ), $t); +ok(T_OPAQUEPTR_OUT_short( $ptr ), $t); # T_OPAQUE_array my @opq = (2,4,8); diff --git a/t/op/utf8decode.t b/t/op/utf8decode.t index 824805d5df..2893ffc62b 100644 --- a/t/op/utf8decode.t +++ b/t/op/utf8decode.t @@ -3,7 +3,6 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; - } { @@ -19,6 +18,20 @@ BEGIN { } } +{ + my $wide = v256; + use bytes; + my $ordwide = ord($wide); + printf "# under use bytes ord(v256) = 0x%02x\n", $ordwide; + if ($ordwide == 140) { + print "1..0 # Skip: UTF-EBCDIC (not UTF-8) used here\n"; + exit 0; + } + elsif ($ordwide != 196) { + printf "# v256 starts with 0x%02x\n", $ordwide; + } +} + no utf8; print "1..78\n"; diff --git a/t/pragma/warn/perl b/t/pragma/warn/perl index 7070dd447c..512ee7fb65 100644 --- a/t/pragma/warn/perl +++ b/t/pragma/warn/perl @@ -54,4 +54,19 @@ Name "main::x" used only once: possible typo at - line 4. use warnings 'once' ; $x = 3 ; EXPECT +######## +# perl.c +{ use warnings 'once' ; $x = 3 ; } +$y = 3 ; +EXPECT +Name "main::x" used only once: possible typo at - line 3. +######## + +# perl.c +$z = 3 ; +BEGIN { $^W = 1 } +{ no warnings 'once' ; $x = 3 ; } +$y = 3 ; +EXPECT +Name "main::y" used only once: possible typo at - line 6. |