In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/04ce8649990a4784cc3ad0b83a45ccf6a005b1be?hp=a9ccbcd7e3e4416b46c5c8cd5e61e7930776a83e>
- Log ----------------------------------------------------------------- commit 04ce8649990a4784cc3ad0b83a45ccf6a005b1be Author: Craig A. Berry <[email protected]> Date: Thu Jan 29 22:06:44 2015 -0600 Externalize decc$ungetc prototype. Otherwise the VMS C++ compiler mangles it and we get a link failure. And while we're there we can eliminate some PerlIO workarounds for problems in long-defunct versions of the CRTL. M iperlsys.h M perlsdio.h commit e6ad046acdf21cf68937902df307a767e93a3340 Author: Craig A. Berry <[email protected]> Date: Thu Jan 29 21:50:53 2015 -0600 TODO Peek.t test on VMS. DumpProg() works just fine but when piped through the broken pipe implementation produces spurious newlines. So mark it TODO on VMS. M ext/Devel-Peek/t/Peek.t ----------------------------------------------------------------------- Summary of changes: ext/Devel-Peek/t/Peek.t | 22 ++++++++++++---------- iperlsys.h | 2 ++ perlsdio.h | 33 +++++++++------------------------ 3 files changed, 23 insertions(+), 34 deletions(-) diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 062aa2e..f5127b6 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -1474,7 +1474,9 @@ for my $test ( test_DumpProg(@$test); } -my $e = <<'EODUMP'; +{ + local $TODO = 'This gets mangled by the current pipe implementation' if $^O eq 'VMS'; + my $e = <<'EODUMP'; dumpindent is 4 at -e line 1. { 1 TYPE = leave ===> NULL @@ -1521,13 +1523,13 @@ dumpindent is 4 at -e line 1. } EODUMP -$e =~ s/GV_OR_PADIX/$threads ? "PADIX = 2" : "GV = t::DumpProg"/e; -$e =~ s/.*PRIVATE = \(0x1\).*\n// if $] < 5.021004; -my $out = t::runperl - switches => ['-Ilib'], - prog => 'package t; use Devel::Peek q-DumpProg-; DumpProg();', - stderr=>1; -$out =~ s/ *SEQ = .*\n//; -is $out, $e, "DumpProg() has no 'Attempt to free X prematurely' warning"; - + $e =~ s/GV_OR_PADIX/$threads ? "PADIX = 2" : "GV = t::DumpProg"/e; + $e =~ s/.*PRIVATE = \(0x1\).*\n// if $] < 5.021004; + my $out = t::runperl + switches => ['-Ilib'], + prog => 'package t; use Devel::Peek q-DumpProg-; DumpProg();', + stderr=>1; + $out =~ s/ *SEQ = .*\n//; + is $out, $e, "DumpProg() has no 'Attempt to free X prematurely' warning"; +} done_testing(); diff --git a/iperlsys.h b/iperlsys.h index 9604ad4..39999b0 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -318,7 +318,9 @@ struct IPerlStdIOInfo #if defined(__VMS) /* Unusual definition of ungetc() here to accommodate fast_sv_gets()' * belief that it can mix getc/ungetc with reads from stdio buffer */ +START_EXTERN_C int decc$ungetc(int __c, FILE *__stream); +END_EXTERN_C # define PerlSIO_ungetc(c,f) ((c) == EOF ? EOF : \ ((*(f) && !((*(f))->_flag & _IONBF) && \ ((*(f))->_ptr > (*(f))->_base)) ? \ diff --git a/perlsdio.h b/perlsdio.h index 29e8176..7dcd394 100644 --- a/perlsdio.h +++ b/perlsdio.h @@ -36,45 +36,30 @@ #define PerlIO_close(f) PerlSIO_fclose(f) #define PerlIO_puts(f,s) PerlSIO_fputs(s,f) #define PerlIO_putc(f,c) PerlSIO_fputc(c,f) -#if defined(VMS) -# if defined(__DECC) +#if defined(__VMS) /* Unusual definition of ungetc() here to accommodate fast_sv_gets()' * belief that it can mix getc/ungetc with reads from stdio buffer */ +START_EXTERN_C int decc$ungetc(int __c, FILE *__stream); +END_EXTERN_C # define PerlIO_ungetc(f,c) ((c) == EOF ? EOF : \ ((*(f) && !((*(f))->_flag & _IONBF) && \ ((*(f))->_ptr > (*(f))->_base)) ? \ ((*(f))->_cnt++, *(--(*(f))->_ptr) = (c)) : decc$ungetc(c,f))) -# else -# define PerlIO_ungetc(f,c) ungetc(c,f) -# endif - /* Work around bug in DECCRTL/AXP (DECC v5.x) and some versions of old - * VAXCRTL which causes read from a pipe after EOF has been returned - * once to hang. - */ -# define PerlIO_getc(f) \ - (feof(f) ? EOF : getc(f)) -# define PerlIO_read(f,buf,count) \ - (feof(f) ? 0 : (SSize_t)fread(buf,1,count,f)) -# define PerlIO_tell(f) ftell(f) #else -# define PerlIO_getc(f) PerlSIO_fgetc(f) -# define PerlIO_ungetc(f,c) PerlSIO_ungetc(c,f) -# define PerlIO_read(f,buf,count) (SSize_t)PerlSIO_fread(buf,1,count,f) -# define PerlIO_tell(f) PerlSIO_ftell(f) +# define PerlIO_ungetc(f,c) ungetc(c,f) #endif +#define PerlIO_getc(f) PerlSIO_fgetc(f) +#define PerlIO_ungetc(f,c) PerlSIO_ungetc(c,f) +#define PerlIO_read(f,buf,count) (SSize_t)PerlSIO_fread(buf,1,count,f) +#define PerlIO_tell(f) PerlSIO_ftell(f) #define PerlIO_eof(f) PerlSIO_feof(f) #define PerlIO_getname(f,b) fgetname(f,b) #define PerlIO_error(f) PerlSIO_ferror(f) #define PerlIO_fileno(f) PerlSIO_fileno(f) #define PerlIO_clearerr(f) PerlSIO_clearerr(f) #define PerlIO_flush(f) PerlSIO_fflush(f) -#if defined(VMS) && !defined(__DECC) -/* Old VAXC RTL doesn't reset EOF on seek; Perl folk seem to expect this */ -#define PerlIO_seek(f,o,w) (((f) && (*f) && ((*f)->_flag &= ~_IOEOF)),fseek(f,o,w)) -#else -# define PerlIO_seek(f,o,w) PerlSIO_fseek(f,o,w) -#endif +#define PerlIO_seek(f,o,w) PerlSIO_fseek(f,o,w) #define PerlIO_rewind(f) PerlSIO_rewind(f) #define PerlIO_tmpfile() PerlSIO_tmpfile() -- Perl5 Master Repository
