From: Jarkko Hietaniemi Date: Sat, 17 Oct 1998 13:17:19 +0000 (+0000) Subject: Integrate mainperl. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b56ec34489067f612a4e5d2fecae86c5bbfffd5c;p=p5sagit%2Fp5-mst-13.2.git Integrate mainperl. p4raw-id: //depot/cfgperl@2005 --- diff --git a/Porting/genlog b/Porting/genlog index 5c3e905..b8bd1d6 100755 --- a/Porting/genlog +++ b/Porting/genlog @@ -107,8 +107,9 @@ EOT my $files = $files{$branch}{$kind}; # don't show large branches and integrations $files = ["($kind " . scalar(@$files) . ' files)'] - if (@$files > 25 - && ( $kind eq 'integrate' || $kind eq 'branch')); + if (@$files > 25 && ($kind eq 'integrate' + || $kind eq 'branch')) + || @$files > 100; print wrap(sprintf("%12s ", $editkind{$kind}), sprintf("%12s ", $editkind{$kind}), "@$files\n"); diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm index 9991d8e..7194819 100644 --- a/ext/B/B/CC.pm +++ b/ext/B/B/CC.pm @@ -878,7 +878,7 @@ sub pp_sassign { } runtime("SvSETMAGIC(TOPs);"); } else { - my $dst = pop @stack; + my $dst = $stack[-1]; my $type = $dst->{type}; runtime("sv = POPs;"); runtime("MAYBE_TAINT_SASSIGN_SRC(sv);"); diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 5d3ef5c..8687eb8 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -268,25 +268,25 @@ sub toupper { sub closedir { usage "closedir(dirhandle)" if @_ != 1; - closedir($_[0]); + CORE::closedir($_[0]); } sub opendir { usage "opendir(directory)" if @_ != 1; my $dirhandle = gensym; - opendir($dirhandle, $_[0]) + CORE::opendir($dirhandle, $_[0]) ? $dirhandle : undef; } sub readdir { usage "readdir(dirhandle)" if @_ != 1; - readdir($_[0]); + CORE::readdir($_[0]); } sub rewinddir { usage "rewinddir(dirhandle)" if @_ != 1; - rewinddir($_[0]); + CORE::rewinddir($_[0]); } sub errno { @@ -301,42 +301,42 @@ sub creat { sub fcntl { usage "fcntl(filehandle, cmd, arg)" if @_ != 3; - fcntl($_[0], $_[1], $_[2]); + CORE::fcntl($_[0], $_[1], $_[2]); } sub getgrgid { usage "getgrgid(gid)" if @_ != 1; - getgrgid($_[0]); + CORE::getgrgid($_[0]); } sub getgrnam { usage "getgrnam(name)" if @_ != 1; - getgrnam($_[0]); + CORE::getgrnam($_[0]); } sub atan2 { usage "atan2(x,y)" if @_ != 2; - atan2($_[0], $_[1]); + CORE::atan2($_[0], $_[1]); } sub cos { usage "cos(x)" if @_ != 1; - cos($_[0]); + CORE::cos($_[0]); } sub exp { usage "exp(x)" if @_ != 1; - exp($_[0]); + CORE::exp($_[0]); } sub fabs { usage "fabs(x)" if @_ != 1; - abs($_[0]); + CORE::abs($_[0]); } sub log { usage "log(x)" if @_ != 1; - log($_[0]); + CORE::log($_[0]); } sub pow { @@ -346,22 +346,22 @@ sub pow { sub sin { usage "sin(x)" if @_ != 1; - sin($_[0]); + CORE::sin($_[0]); } sub sqrt { usage "sqrt(x)" if @_ != 1; - sqrt($_[0]); + CORE::sqrt($_[0]); } sub getpwnam { usage "getpwnam(name)" if @_ != 1; - getpwnam($_[0]); + CORE::getpwnam($_[0]); } sub getpwuid { usage "getpwuid(uid)" if @_ != 1; - getpwuid($_[0]); + CORE::getpwuid($_[0]); } sub longjmp { @@ -382,12 +382,12 @@ sub sigsetjmp { sub kill { usage "kill(pid, sig)" if @_ != 2; - kill $_[1], $_[0]; + CORE::kill $_[1], $_[0]; } sub raise { usage "raise(sig)" if @_ != 1; - kill $_[0], $$; # Is this good enough? + CORE::kill $_[0], $$; # Is this good enough? } sub offsetof { @@ -480,12 +480,12 @@ sub fwrite { sub getc { usage "getc(handle)" if @_ != 1; - getc($_[0]); + CORE::getc($_[0]); } sub getchar { usage "getchar()" if @_ != 0; - getc(STDIN); + CORE::getc(STDIN); } sub gets { @@ -500,7 +500,7 @@ sub perror { sub printf { usage "printf(pattern, args...)" if @_ < 1; - printf STDOUT @_; + CORE::printf STDOUT @_; } sub putc { @@ -517,17 +517,17 @@ sub puts { sub remove { usage "remove(filename)" if @_ != 1; - unlink($_[0]); + CORE::unlink($_[0]); } sub rename { usage "rename(oldfilename, newfilename)" if @_ != 2; - rename($_[0], $_[1]); + CORE::rename($_[0], $_[1]); } sub rewind { usage "rewind(filehandle)" if @_ != 1; - seek($_[0],0,0); + CORE::seek($_[0],0,0); } sub scanf { @@ -536,7 +536,7 @@ sub scanf { sub sprintf { usage "sprintf(pattern,args)" if @_ == 0; - sprintf(shift,@_); + CORE::sprintf(shift,@_); } sub sscanf { @@ -565,7 +565,7 @@ sub vsprintf { sub abs { usage "abs(x)" if @_ != 1; - abs($_[0]); + CORE::abs($_[0]); } sub atexit { @@ -598,7 +598,7 @@ sub div { sub exit { usage "exit(status)" if @_ != 1; - exit($_[0]); + CORE::exit($_[0]); } sub free { @@ -640,7 +640,7 @@ sub srand { sub system { usage "system(command)" if @_ != 1; - system($_[0]); + CORE::system($_[0]); } sub memchr { @@ -719,7 +719,7 @@ sub strspn { sub strstr { usage "strstr(big, little)" if @_ != 2; - index($_[0], $_[1]); + CORE::index($_[0], $_[1]); } sub strtok { @@ -728,71 +728,71 @@ sub strtok { sub chmod { usage "chmod(mode, filename)" if @_ != 2; - chmod($_[0], $_[1]); + CORE::chmod($_[0], $_[1]); } sub fstat { usage "fstat(fd)" if @_ != 1; local *TMP; open(TMP, "<&$_[0]"); # Gross. - my @l = stat(TMP); + my @l = CORE::stat(TMP); close(TMP); @l; } sub mkdir { usage "mkdir(directoryname, mode)" if @_ != 2; - mkdir($_[0], $_[1]); + CORE::mkdir($_[0], $_[1]); } sub stat { usage "stat(filename)" if @_ != 1; - stat($_[0]); + CORE::stat($_[0]); } sub umask { usage "umask(mask)" if @_ != 1; - umask($_[0]); + CORE::umask($_[0]); } sub wait { usage "wait()" if @_ != 0; - wait(); + CORE::wait(); } sub waitpid { usage "waitpid(pid, options)" if @_ != 2; - waitpid($_[0], $_[1]); + CORE::waitpid($_[0], $_[1]); } sub gmtime { usage "gmtime(time)" if @_ != 1; - gmtime($_[0]); + CORE::gmtime($_[0]); } sub localtime { usage "localtime(time)" if @_ != 1; - localtime($_[0]); + CORE::localtime($_[0]); } sub time { usage "time()" if @_ != 0; - time; + CORE::time; } sub alarm { usage "alarm(seconds)" if @_ != 1; - alarm($_[0]); + CORE::alarm($_[0]); } sub chdir { usage "chdir(directory)" if @_ != 1; - chdir($_[0]); + CORE::chdir($_[0]); } sub chown { usage "chown(filename, uid, gid)" if @_ != 3; - chown($_[0], $_[1], $_[2]); + CORE::chown($_[0], $_[1], $_[2]); } sub execl { @@ -821,7 +821,7 @@ sub execvp { sub fork { usage "fork()" if @_ != 0; - fork; + CORE::fork; } sub getcwd @@ -861,12 +861,12 @@ sub getgroups { sub getlogin { usage "getlogin()" if @_ != 0; - getlogin(); + CORE::getlogin(); } sub getpgrp { usage "getpgrp()" if @_ != 0; - getpgrp($_[0]); + CORE::getpgrp($_[0]); } sub getpid { @@ -876,7 +876,7 @@ sub getpid { sub getppid { usage "getppid()" if @_ != 0; - getppid; + CORE::getppid; } sub getuid { @@ -891,12 +891,12 @@ sub isatty { sub link { usage "link(oldfilename, newfilename)" if @_ != 2; - link($_[0], $_[1]); + CORE::link($_[0], $_[1]); } sub rmdir { usage "rmdir(directoryname)" if @_ != 1; - rmdir($_[0]); + CORE::rmdir($_[0]); } sub setgid { @@ -911,16 +911,16 @@ sub setuid { sub sleep { usage "sleep(seconds)" if @_ != 1; - sleep($_[0]); + CORE::sleep($_[0]); } sub unlink { usage "unlink(filename)" if @_ != 1; - unlink($_[0]); + CORE::unlink($_[0]); } sub utime { usage "utime(filename, atime, mtime)" if @_ != 3; - utime($_[1], $_[2], $_[0]); + CORE::utime($_[1], $_[2], $_[0]); } diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm index cc85e87..4070b2e 100644 --- a/lib/ExtUtils/MM_Win32.pm +++ b/lib/ExtUtils/MM_Win32.pm @@ -473,7 +473,7 @@ sub perl_archive { my ($self) = @_; if($OBJ) { - if ($self->{CAPI} eq 'TRUE') { + if ($self->{CAPI}) { return '$(PERL_INC)\perlCAPI$(LIB_EXT)'; } } diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index 7439e83..0482534 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -1190,7 +1190,7 @@ architecture. For example: perl Makefile.PL BINARY_LOCATION=x86/Agent.tar.gz builds a PPD package that references a binary of the C package, -located in the C directory. +located in the C directory relative to the PPD itself. =item C @@ -1594,7 +1594,7 @@ Defining PM in the Makefile.PL will override PMLIBDIRS. =item PPM_INSTALL_EXEC -Name of the executable used to run C below. +Name of the executable used to run C below. (e.g. perl) =item PPM_INSTALL_SCRIPT diff --git a/lib/Term/Complete.pm b/lib/Term/Complete.pm index 275aade..f26be77 100644 --- a/lib/Term/Complete.pm +++ b/lib/Term/Complete.pm @@ -13,8 +13,8 @@ Term::Complete - Perl word completion module =head1 SYNOPSIS - $input = complete('prompt_string', \@completion_list); - $input = complete('prompt_string', @completion_list); + $input = Complete('prompt_string', \@completion_list); + $input = Complete('prompt_string', @completion_list); =head1 DESCRIPTION @@ -74,6 +74,9 @@ CONFIG: { sub Complete { my($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r); + $return = ""; + $r = 0; + $prompt = shift; if (ref $_[0] || $_[0] =~ /^\*/) { @cmp_lst = sort @{$_[0]}; @@ -113,8 +116,8 @@ sub Complete { # (^U) kill $_ eq $kill && do { if ($r) { - undef $r; - undef $return; + $r = 0; + $return = ""; print("\r\n"); redo LOOP; } diff --git a/op.c b/op.c index 3e21271..c04f082 100644 --- a/op.c +++ b/op.c @@ -219,6 +219,12 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s SvNVX(namesv) = (double)PL_curcop->cop_seq; SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */ SvFAKE_on(namesv); /* A ref, not a real var */ + if (SvOBJECT(sv)) { /* A typed var */ + SvOBJECT_on(namesv); + (void)SvUPGRADE(namesv, SVt_PVMG); + SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(sv)); + PL_sv_objcount++; + } if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) { /* "It's closures all the way down." */ CvCLONE_on(PL_compcv); @@ -1917,7 +1923,7 @@ append_list(I32 type, LISTOP *first, LISTOP *last) first->op_last = last->op_last; first->op_children += last->op_children; if (first->op_children) - last->op_flags |= OPf_KIDS; + first->op_flags |= OPf_KIDS; Safefree(last); return (OP*)first; @@ -2071,7 +2077,7 @@ newBINOP(I32 type, I32 flags, OP *first, OP *last) if (binop->op_next) return (OP*)binop; - binop->op_last = last = binop->op_first->op_sibling; + binop->op_last = binop->op_first->op_sibling; return fold_constants((OP *)binop); } diff --git a/opcode.h b/opcode.h index 37b0516..2abaa47 100644 --- a/opcode.h +++ b/opcode.h @@ -2385,7 +2385,7 @@ EXT U32 opargs[] = { 0x09116504, /* sysopen */ 0x00116504, /* sysseek */ 0x0917651d, /* sysread */ - 0x0911651d, /* syswrite */ + 0x0991651d, /* syswrite */ 0x0911651d, /* send */ 0x0117651d, /* recv */ 0x0000ec14, /* eof */ diff --git a/opcode.pl b/opcode.pl index f9c7503..92330a6 100755 --- a/opcode.pl +++ b/opcode.pl @@ -519,7 +519,7 @@ print print ck_listiob ims@ F? L sysopen sysopen ck_fun s@ F S S S? sysseek sysseek ck_fun s@ F S S sysread sysread ck_fun imst@ F R S S? -syswrite syswrite ck_fun imst@ F S S S? +syswrite syswrite ck_fun imst@ F S S? S? send send ck_fun imst@ F S S S? recv recv ck_fun imst@ F R S S diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index aaeed53..8fd7bfb 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -18,7 +18,7 @@ $spitshell >>Makefile <= sizeof scrbuf) { + Safefree(scr); + longbuf: + croak("Size of scriptname too big: %d", l); + } + strcpy(scrbuf, scr); + Safefree(scr); + scr = scrbuf; if (scr) { FILE *file = fopen(scr, "r"); @@ -555,7 +565,6 @@ char *inicmd; if (!file) goto panic_file; if (!fgets(buf, sizeof buf, file)) { /* Empty... */ - int l = strlen(scr); buf[0] = 0; fclose(file); @@ -564,18 +573,18 @@ char *inicmd; documentation, DosQueryAppType sometimes (?) does not append ".exe", so we could have reached this place). */ - if (l + 5 < 512) { /* size of buffer in find_script */ - strcpy(scr + l, ".exe"); - if (PerlLIO_stat(scr,&PL_statbuf) >= 0 + if (l + 5 < sizeof scrbuf) { + strcpy(scrbuf + l, ".exe"); + if (PerlLIO_stat(scrbuf,&PL_statbuf) >= 0 && !S_ISDIR(PL_statbuf.st_mode)) { /* Found */ tmps = scr; pass++; goto reread; - } else { - scr[l] = 0; - } - } + } else + scrbuf[l] = 0; + } else + goto longbuf; } if (fclose(file) != 0) { /* Failure */ panic_file: diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 92a9532..c23aa14 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3988,8 +3988,11 @@ See L and L for details. =item syswrite FILEHANDLE,SCALAR,LENGTH +=item syswrite FILEHANDLE,SCALAR + Attempts to write LENGTH bytes of data from variable SCALAR to the -specified FILEHANDLE, using the system call write(2). It bypasses +specified FILEHANDLE, using the system call write(2). If LENGTH is +not specified, writes whole SCALAR. It bypasses stdio, so mixing this with reads (other than C, C, C, C, or C may cause confusion because stdio usually buffers data. Returns the number of bytes actually written, or C diff --git a/pod/perlxs.pod b/pod/perlxs.pod index c578a2e..2e02247 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -1212,13 +1212,15 @@ getnetconfigent() XSUB and an object created by a normal Perl subroutine. The typemap is a collection of code fragments which are used by the B compiler to map C function parameters and values to Perl values. The typemap file may consist of three sections labeled C, C, and -C. The INPUT section tells the compiler how to translate Perl values +C. Any unlabelled initial section is assumed to be a C +section if a name is not explicitly specified. The INPUT section tells +the compiler how to translate Perl values into variables of certain C types. The OUTPUT section tells the compiler how to translate the values from certain C types into values Perl can understand. The TYPEMAP section tells the compiler which of the INPUT and OUTPUT code fragments should be used to map a given C type to a Perl value. -Each of the sections of the typemap must be preceded by one of the TYPEMAP, -INPUT, or OUTPUT keywords. +The section labels C, C, or C must begin +in the first column on a line by themselves, and must be in uppercase. The default typemap in the C directory of the Perl source contains many useful types which can be used by Perl extensions. Some extensions define diff --git a/pp.c b/pp.c index 998cf93..9d9ad5c 100644 --- a/pp.c +++ b/pp.c @@ -3416,7 +3416,10 @@ PP(pp_unpack) while (len-- > 0 && s < strend) { auint = utf8_to_uv((U8*)s, &along); s += along; - culong += auint; + if (checksum > 32) + cdouble += (double)auint; + else + culong += auint; } } else { @@ -3852,7 +3855,7 @@ PP(pp_unpack) if (checksum) { sv = NEWSV(42, 0); if (strchr("fFdD", datumtype) || - (checksum > 32 && strchr("iIlLN", datumtype)) ) { + (checksum > 32 && strchr("iIlLNU", datumtype)) ) { double trouble; adouble = 1.0; diff --git a/sv.c b/sv.c index ec224a3..97a0790 100644 --- a/sv.c +++ b/sv.c @@ -3134,12 +3134,16 @@ sv_pos_u2b(register SV *sv, I32* offsetp, I32* lenp) send = s + len; while (s < send && uoffset--) s += UTF8SKIP(s); + if (s >= send) + s = send; *offsetp = s - start; if (lenp) { I32 ulen = *lenp; start = s; while (s < send && ulen--) s += UTF8SKIP(s); + if (s >= send) + s = send; *lenp = s - start; } return; @@ -3957,12 +3961,18 @@ sv_reset(register char *s, HV *stash) } for (i = 0; i <= (I32) HvMAX(stash); i++) { for (entry = HvARRAY(stash)[i]; - entry; - entry = HeNEXT(entry)) { + entry; + entry = HeNEXT(entry)) + { if (!todo[(U8)*HeKEY(entry)]) continue; gv = (GV*)HeVAL(entry); sv = GvSV(gv); + if (SvTHINKFIRST(sv)) { + if (!SvREADONLY(sv) && SvROK(sv)) + sv_unref(sv); + continue; + } (void)SvOK_off(sv); if (SvTYPE(sv) >= SVt_PV) { SvCUR_set(sv, 0); diff --git a/t/op/grent.t b/t/op/grent.t index 70b4ce0..48698e8 100755 --- a/t/op/grent.t +++ b/t/op/grent.t @@ -30,6 +30,8 @@ while () { if (@s == 4) { my ($name_s,$passwd_s,$gid_s,$members_s) = @s; $members_s =~ s/\s*,\s*/,/g; + $members_s =~ s/\s+$//; + $members_s =~ s/^\s+//; @n = getgrgid($gid_s); # 'nogroup' et al. next unless @n; diff --git a/t/op/sysio.t b/t/op/sysio.t index 826cf38..0318fed 100755 --- a/t/op/sysio.t +++ b/t/op/sysio.t @@ -1,6 +1,6 @@ #!./perl -print "1..36\n"; +print "1..39\n"; chdir('op') || die "sysio.t: cannot look for myself: $!"; @@ -151,6 +151,21 @@ if ($reopen) { # must close file to update EOF marker for stat print 'not ' unless (-s $outfile == 7); print "ok 28\n"; +# with implicit length argument +print 'not ' unless (syswrite(O, $x) == 3); +print "ok 29\n"; + +# $a still intact +print 'not ' unless ($x eq "abc"); +print "ok 30\n"; + +# $outfile should have grown now +if ($reopen) { # must close file to update EOF marker for stat + close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!"; +} +print 'not ' unless (-s $outfile == 10); +print "ok 31\n"; + close(O); open(I, $outfile) || die "sysio.t: cannot read $outfile: $!"; @@ -158,30 +173,30 @@ open(I, $outfile) || die "sysio.t: cannot read $outfile: $!"; $b = 'xyz'; # reading too much only return as much as available -print 'not ' unless (sysread(I, $b, 100) == 7); -print "ok 29\n"; +print 'not ' unless (sysread(I, $b, 100) == 10); +print "ok 32\n"; # this we should have -print 'not ' unless ($b eq '#!ererl'); -print "ok 30\n"; +print 'not ' unless ($b eq '#!ererlabc'); +print "ok 33\n"; # test sysseek print 'not ' unless sysseek(I, 2, 0) == 2; -print "ok 31\n"; +print "ok 34\n"; sysread(I, $b, 3); print 'not ' unless $b eq 'ere'; -print "ok 32\n"; +print "ok 35\n"; print 'not ' unless sysseek(I, -2, 1) == 3; -print "ok 33\n"; +print "ok 36\n"; sysread(I, $b, 4); print 'not ' unless $b eq 'rerl'; -print "ok 34\n"; +print "ok 37\n"; print 'not ' unless sysseek(I, 0, 0) eq '0 but true'; -print "ok 35\n"; +print "ok 38\n"; print 'not ' if defined sysseek(I, -1, 1); -print "ok 36\n"; +print "ok 39\n"; close(I); diff --git a/t/op/tiehandle.t b/t/op/tiehandle.t index e3d2472..d7e6a78 100755 --- a/t/op/tiehandle.t +++ b/t/op/tiehandle.t @@ -64,7 +64,7 @@ sub READ { sub WRITE { compare(WRITE => @_); $data = substr($_[1],$_[3] || 0, $_[2]); - 4; + length($data); } sub CLOSE { @@ -77,7 +77,7 @@ package main; use Symbol; -print "1..23\n"; +print "1..29\n"; my $fh = gensym; @@ -132,6 +132,20 @@ $r = syswrite $fh,$buf,4,1; ok($r == 4); ok($data eq "wert"); +$buf = "qwerty"; +@expect = (WRITE => $ob, $buf, 4); +$data = ""; +$r = syswrite $fh,$buf,4; +ok($r == 4); +ok($data eq "qwer"); + +$buf = "qwerty"; +@expect = (WRITE => $ob, $buf, 6); +$data = ""; +$r = syswrite $fh,$buf; +ok($r == 6); +ok($data eq "qwerty"); + @expect = (CLOSE => $ob); $r = close $fh; ok($r == 5); diff --git a/toke.c b/toke.c index 88933de..8664b8f 100644 --- a/toke.c +++ b/toke.c @@ -1076,8 +1076,10 @@ scan_const(char *start) if (*s == '{') { char* e = strchr(s, '}'); - if (!e) + if (!e) { yyerror("Missing right brace on \\x{}"); + e = s; + } if (!utf) { dTHR; if (ckWARN(WARN_UTF8)) diff --git a/utils/perldoc.PL b/utils/perldoc.PL index b680b90..4fff934 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -91,7 +91,7 @@ Options: -F Arguments are file names, not modules -v Verbosely describe what's going on -X use index if present (looks for pod.idx at $Config{archlib}) - + -q Search the text of questions (not answers) in perlfaq[1-9] PageName|ModuleName... is the name of a piece of documentation that you want to look at. You @@ -459,7 +459,7 @@ if ($opt_q) { my @pod; while (<>) { - if (/^=head2\s+.*$opt_q/oi) { + if (/^=head2\s+.*(?:$opt_q)/oi) { $found = 1; push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++; } elsif (/^=head2/) { diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm index ea5d907..04b3397 100644 --- a/vms/ext/Stdio/Stdio.pm +++ b/vms/ext/Stdio/Stdio.pm @@ -3,6 +3,7 @@ # Author: Charles Bailey bailey@genetics.upenn.edu # Version: 2.1 # Revised: 24-Mar-1998 +# Docs revised: 13-Oct-1998 Dan Sugalski package VMS::Stdio; @@ -81,24 +82,25 @@ VMS::Stdio - standard I/O functions via VMS extensions =head1 SYNOPSIS -use VMS::Stdio qw( &flush &getname &remove &rewind &setdef &sync &tmpnam - &vmsopen &vmssysopen &waitfh &writeof ); -setdef("new:[default.dir]"); -$uniquename = tmpnam; -$fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!; -$name = getname($fh); -print $fh "Hello, world!\n"; -flush($fh); -sync($fh); -rewind($fh); -$line = <$fh>; -undef $fh; # closes file -$fh = vmssysopen("another.file", O_RDONLY | O_NDELAY, 0, "ctx=bin"); -sysread($fh,$data,128); -waitfh($fh); -close($fh); -remove("another.file"); -writeof($pipefh); + use VMS::Stdio qw( &flush &getname &remove &rewind &setdef &sync &tmpnam + &vmsopen &vmssysopen &waitfh &writeof ); + setdef("new:[default.dir]"); + $uniquename = tmpnam; + $fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!; + $name = getname($fh); + print $fh "Hello, world!\n"; + flush($fh); + sync($fh); + rewind($fh); + $line = <$fh>; + undef $fh; # closes file + $fh = vmssysopen("another.file", O_RDONLY | O_NDELAY, 0, "ctx=bin"); + sysread($fh,$data,128); + waitfh($fh); + close($fh); + remove("another.file"); + writeof($pipefh); + =head1 DESCRIPTION This package gives Perl scripts access via VMS extensions to several @@ -221,6 +223,373 @@ as a normal Perl file handle only. When the scalar containing a VMS::Stdio file handle is overwritten, Cd, or goes out of scope, the associated file is closed automatically. +=over 4 + +=head2 File characteristic options + +=over 2 + +=item alq=INTEGER + +Sets the allocation quantity for this file + +=item bls=INTEGER + +File blocksize + +=item ctx=STRING + +Sets the context for the file. Takes one of these arguments: + +=over 4 + +=item bin + +Disables LF to CRLF translation + +=item cvt + +Negates previous setting of C + +=item nocvt + +Disables conversion of FORTRAN carriage control + +=item rec + +Force record-mode access + +=item stm + +Force stream mode + +=item xplct + +Causes records to be flushed I when the file is closed, or when an +explicit flush is done + +=back + +=item deq=INTEGER + +Sets the default extension quantity + +=item dna=FILESPEC + +Sets the default filename string. Used to fill in any missing pieces of the +filename passed. + +=item fop=STRING + +File processing option. Takes one or more of the following (in a +comma-separated list if there's more than one) + +=over 4 + +=item ctg + +Contiguous. + +=item cbt + +Contiguous-best-try. + +=item dfw + +Deferred write; only applicable to files opened for shared access. + +=item dlt + +Delete file on close. + +=item tef + +Truncate at end-of-file. + +=item cif + +Create if nonexistent. + +=item sup + +Supersede. + +=item scf + +Submit as command file on close. + +=item spl + +Spool to system printer on close. + +=item tmd + +Temporary delete. + +=item tmp + +Temporary (no file directory). + +=item nef + +Not end-of-file. + +=item rck + +Read check compare operation. + +=item wck + +Write check compare operation. + +=item mxv + +Maximize version number. + +=item rwo + +Rewind file on open. + +=item pos + +Current position. + +=item rwc + +Rewind file on close. + +=item sqo + +File can only be processed in a sequential manner. + +=back + +=item fsz=INTEGER + +Fixed header size + +=item gbc=INTEGER + +Global buffers requested for the file + +=item mbc=INTEGER + +Multiblock count + +=item mbf=INTEGER + +Bultibuffer count + +=item mrs=INTEGER + +Maximum record size + +=item rat=STRING + +File record attributes. Takes one of the following: + +=over 4 + +=item cr + +Carriage-return control. + +=item blk + +Disallow records to span block boundaries. + +=item ftn + +FORTRAN print control. + +=item none + +Explicitly forces no carriage control. + +=item prn + +Print file format. + +=back + +=item rfm=STRING + +File record format. Takes one of the following: + +=over 4 + +=item fix + +Fixed-length record format. + +=item stm + +RMS stream record format. + +=item stmlf + +Stream format with line-feed terminator. + +=item stmcr + +Stream format with carriage-return terminator. + +=item var + +Variable-length record format. + +=item vfc + +Variable-length record with fixed control. + +=item udf + +Undefined format + +=back + +=item rop=STRING + +Record processing operations. Takes one or more of the following in a +comma-separated list: + +=over 4 + +=item asy + +Asynchronous I/O. + +=item cco + +Cancel Ctrl/O (used with Terminal I/O). + +=item cvt + +Capitalizes characters on a read from the terminal. + +=item eof + +Positions the record stream to the end-of-file for the connect operation +only. + +=item nlk + +Do not lock record. + +=item pmt + +Enables use of the prompt specified by pmt=usr-prmpt on input from the +terminal. + +=item pta + +Eliminates any information in the type-ahead buffer on a read from the +terminal. + +=item rea + +Locks record for a read operation for this process, while allowing other +accessors to read the record. + +=item rlk + +Locks record for write. + +=item rne + +Suppresses echoing of input data on the screen as it is entered on the +keyboard. + +=item rnf + +Indicates that Ctrl/U, Ctrl/R, and DELETE are not to be considered control +commands on terminal input, but are to be passed to the application +program. + +=item rrl + +Reads regardless of lock. + +=item syncsts + +Returns success status of RMS$_SYNCH if the requested service completes its +task immediately. + +=item tmo + +Timeout I/O. + +=item tpt + +Allows put/write services using sequential record access mode to occur at +any point in the file, truncating the file at that point. + +=item ulk + +Prohibits RMS from automatically unlocking records. + +=item wat + +Wait until record is available, if currently locked by another stream. + +=item rah + +Read ahead. + +=item wbh + +Write behind. + +=back + +=item rtv=INTEGER + +The number of retrieval pointers that RMS has to maintain (0 to 127255) + +=item shr=STRING + +File sharing options. Choose one of the following: + +=over 4 + +=item del + +Allows users to delete. + +=item get + +Allows users to read. + +=item mse + +Allows mainstream access. + +=item nil + +Prohibits file sharing. + +=item put + +Allows users to write. + +=item upd + +Allows users to update. + +=item upi + +Allows one or more writers. + +=back + +=item tmo=INTEGER + +I/O timeout value + +=back + +=back + =item vmssysopen This function bears the same relationship to the CORE function @@ -250,6 +619,7 @@ it encounters an error. =head1 REVISION -This document was last revised on 10-Dec-1996, for Perl 5.004. +This document was last revised on 13-Oct-1998, for Perl 5.004, 5.005, and +5.006. =cut diff --git a/win32/Makefile b/win32/Makefile index 2ffcb52..2e01729 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -49,6 +49,15 @@ INST_VER = \5.00552 #CFG = Debug # +# uncomment next option if you want to use the VC++ compiler optimization. +# Warning: This is known to produce incorrect code for compiler versions +# earlier than VC++ 98 (Visual Studio 6.0). VC++ 98 generates code that +# successfully passes the Perl regression test suite. It hasn't yet been +# widely tested with real applications though. +# +#CFG = Optimize + +# # uncomment to enable use of PerlCRT.DLL when using the Visual C compiler. # Highly recommended. It has patches that fix known bugs in MSVCRT.DLL. # This currently requires VC 5.0 with Service Pack 3. @@ -206,8 +215,8 @@ OPTIMIZE = -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING ! ENDIF LINK_DBG = -debug -pdb:none !ELSE -! IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -Od $(RUNTIME) -DNDEBUG +! IF "$(CFG)" == "Optimize" +OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG ! ELSE OPTIMIZE = -Od $(RUNTIME) -DNDEBUG ! ENDIF diff --git a/win32/makefile.mk b/win32/makefile.mk index 12ac0a9..07fcad0 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -57,6 +57,18 @@ CCTYPE *= BORLAND #CFG *= Debug # +# uncomment next option if you want to use the VC++ compiler optimization. +# This option is only relevant for the Microsoft compiler; we automatically +# use maximum optimization with the other compilers (unless you specify a +# DEBUGGING build). +# Warning: This is known to produce incorrect code for compiler versions +# earlier than VC++ 98 (Visual Studio 6.0). VC++ 98 generates code that +# successfully passes the Perl regression test suite. It hasn't yet been +# widely tested with real applications though. +# +#CFG *= Optimize + +# # uncomment to enable use of PerlCRT.DLL when using the Visual C compiler. # Highly recommended. It has patches that fix known bugs in MSVCRT.DLL. # This currently requires VC 5.0 with Service Pack 3. @@ -293,8 +305,8 @@ OPTIMIZE = -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING .ENDIF LINK_DBG = -debug -pdb:none .ELSE -.IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -Od $(RUNTIME) -DNDEBUG +.IF "$(CFG)" == "Optimize" +OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG .ELSE OPTIMIZE = -Od $(RUNTIME) -DNDEBUG .ENDIF