summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Changes199
-rw-r--r--ext/B/B/Bblock.pm31
-rw-r--r--ext/B/B/C.pm4
-rw-r--r--ext/B/B/CC.pm72
-rw-r--r--ext/B/B/Stackobj.pm12
-rw-r--r--ext/GDBM_File/GDBM_File.xs1
-rw-r--r--lib/CGI/Pretty.pm175
-rw-r--r--mg.c8
-rw-r--r--op.c8
-rw-r--r--opcode.h2
-rwxr-xr-xopcode.pl2
-rw-r--r--pp_sys.c4
-rwxr-xr-xt/lib/io_udp.t20
-rw-r--r--thread.h2
-rw-r--r--toke.c9
-rw-r--r--vms/descrip_mms.template2
-rw-r--r--vms/subconfigure.com113
-rw-r--r--vms/vms.c65
-rw-r--r--vms/vmsish.h3
19 files changed, 650 insertions, 82 deletions
diff --git a/Changes b/Changes
index 0c3c4ab831..c1b80ca2ea 100644
--- a/Changes
+++ b/Changes
@@ -79,6 +79,205 @@ Version 5.005_58 Development release working toward 5.006
----------------
____________________________________________________________________________
+[ 3592] By: jhi on 1999/07/05 17:17:22
+ Log: AIX threaded build, plus few more on the side.
+ Branch: cfgperl
+ ! embed.h embed.pl ext/DynaLoader/dl_aix.xs
+ ! ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_rhapsody.xs
+ ! ext/DynaLoader/dl_vms.xs hints/aix.sh objXSUB.h perl.h
+ ! perl_exp.SH pp_ctl.c proto.h toke.c util.c
+____________________________________________________________________________
+[ 3591] By: gsar on 1999/07/05 16:52:34
+ Log: "\e" and "\a" didn't produce right escape under EBCDIC
+ From: pvhp@forte.com (Peter Prymmer)
+ Date: Fri, 4 Jun 99 12:00:27 PDT
+ Message-Id: <9906041900.AA28387@forte.com>
+ Subject: [PATCH 5.005_57]lingering ASCIIism in tokener
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 3590] By: gsar on 1999/07/05 16:40:01
+ Log: s/scalar ref constructor/single ref constructor/ (suggested
+ by Stephen McCamant)
+ Branch: perl
+ ! opcode.h opcode.pl
+____________________________________________________________________________
+[ 3589] By: gsar on 1999/07/05 16:34:06
+ Log: no such thing as gdbm_clearerr() (from Andy Dougherty)
+ Branch: perl
+ ! ext/GDBM_File/GDBM_File.xs
+____________________________________________________________________________
+[ 3588] By: gsar on 1999/07/05 16:29:39
+ Log: allow C<-foo> under C<use integer> (behavior of C<-$string>
+ is unchanged still)
+ Branch: perl
+ ! op.c
+____________________________________________________________________________
+[ 3587] By: jhi on 1999/07/05 10:31:43
+ Log: Make perl_exp.SH smarter about what to include and what to exclude.
+ Branch: cfgperl
+ ! perl_exp.SH
+____________________________________________________________________________
+[ 3586] By: jhi on 1999/07/05 09:29:31
+ Log: Remove unnecessary and extraneous my $i = 0.
+ Branch: cfgperl
+ ! bytecode.pl
+____________________________________________________________________________
+[ 3585] By: jhi on 1999/07/05 07:28:59
+ Log: Integrate with mainperl.
+ Branch: cfgperl
+ !> (integrate 30 files)
+____________________________________________________________________________
+[ 3584] By: gsar on 1999/07/05 05:36:28
+ Log: From: Vishal Bhatia <vishalb@hotmail.com>
+ Date: Thu, 03 Jun 1999 00:57:48 PDT
+ Message-ID: <19990603075749.86665.qmail@hotmail.com>
+ Subject: Re: [PATCH 5.005_57] pp_sort sorted out
+ Branch: perl
+ ! ext/B/B/Bblock.pm ext/B/B/C.pm ext/B/B/CC.pm
+____________________________________________________________________________
+[ 3583] By: gsar on 1999/07/05 05:31:19
+ Log: suppress fancy display when in verbose mode (suggested by
+ Paul Johnson <pjcj@transeda.com>)
+ Branch: perl
+ ! lib/Test/Harness.pm
+____________________________________________________________________________
+[ 3582] By: gsar on 1999/07/05 05:17:12
+ Log: cygwin32 update
+ From: "Fifer, Eric" <EFifer@sanwaint.com>
+ Date: Wed, 2 Jun 1999 15:16:05 +0100
+ Message-Id: <71E287AB0D94D111BBD600600849EC8185EDD9@POST>
+ Subject: [ID 19990602.003] perl5.005_03 (CORE) cygwin32 port
+ Branch: perl
+ ! Configure Makefile.SH README.cygwin32 cygwin32/Makefile.SHs
+ ! cygwin32/build-instructions.READFIRST
+ ! cygwin32/build-instructions.charles-wilson
+ ! cygwin32/build-instructions.sebastien-barre
+ ! cygwin32/build-instructions.steven-morlock
+ ! cygwin32/build-instructions.steven-morlock2 doio.c dosish.h
+ ! ext/POSIX/Makefile.PL ext/POSIX/POSIX.xs hints/cygwin32.sh
+ ! lib/Cwd.pm lib/ExtUtils/MM_Cygwin.pm perl.h pp_hot.c
+ ! t/op/magic.t util.c
+____________________________________________________________________________
+[ 3581] By: gsar on 1999/07/05 02:46:18
+ Log: NeXT doesn't have FD_CLOEXEC (suggested by Hans Mulder)
+ Branch: perl
+ ! util.c
+____________________________________________________________________________
+[ 3580] By: gsar on 1999/07/05 02:38:03
+ Log: From: "Ed Peschko" <ed_peschko@csgsystems.com>
+ Date: Mon, 31 May 1999 18:18:13 -0600
+ Message-ID: <19990601001813.AAA17834@csgsystems.com>
+ Subject: [ PATCH perl5.005_57 ] new perlcc + regression tests
+ Branch: perl
+ ! t/TEST t/UTEST t/harness utils/perlcc.PL
+____________________________________________________________________________
+[ 3579] By: gsar on 1999/07/05 01:20:58
+ Log: compatibility tweak for Class::Struct
+ Branch: perl
+ ! lib/Class/Struct.pm
+____________________________________________________________________________
+[ 3578] By: jhi on 1999/07/04 23:26:01
+ Log: Miscellaneus AIX fixes + SOCKS support.
+ Branch: cfgperl
+ ! Configure Makefile.SH Porting/Glossary Porting/config.sh
+ ! Porting/config_H config_h.SH doio.c ext/Socket/Socket.xs
+ ! hints/aix.sh pp_sys.c
+____________________________________________________________________________
+[ 3577] By: gsar on 1999/07/04 23:07:39
+ Log: test tweak
+ Branch: perl
+ ! t/io/openpid.t
+____________________________________________________________________________
+[ 3576] By: jhi on 1999/07/04 22:39:23
+ Log: Integrate with mainperl.
+ Branch: cfgperl
+ +> t/io/openpid.t
+ - win32/perlhost.h
+ !> (integrate 51 files)
+____________________________________________________________________________
+[ 3575] By: jhi on 1999/07/04 22:26:48
+ Log: Added 64-bit support for AIX 4.3 or better
+ based on Martin H. Rusoff's observations.
+ Branch: cfgperl
+ ! Configure config_h.SH hints/aix.sh
+____________________________________________________________________________
+[ 3574] By: jhi on 1999/07/04 21:34:47
+ Log: Do not throw away gccvers compilation errors.
+ From: Andy Dougherty <doughera@lafayette.edu>
+ To: Ron Seguin <rseguin@on.bell.ca>
+ Cc: Perl Porters <perl5-porters@perl.org>
+ Subject: [PATCH] Re: [ID 19990625.011] WHOA There
+ Date: Mon, 28 Jun 1999 12:36:38 -0400 (EDT)
+ Message-Id: <Pine.GSU.4.05.9906281230100.6265-100000@newton.phys>
+ Branch: cfgperl
+ ! Configure config_h.SH
+____________________________________________________________________________
+[ 3573] By: gsar on 1999/07/04 21:10:32
+ Log: adapted suggested tests for addition to testsuite
+ From: RonaldWS@aol.com
+ Date: Sun, 30 May 1999 16:27:28 EDT
+ Message-Id: <25cd799f.2482f930@aol.com>
+ Subject: [19990530.007] Open with pipe | does not return pid under win32
+ Branch: perl
+ + t/io/openpid.t
+ ! MANIFEST win32/win32.c
+____________________________________________________________________________
+[ 3572] By: gsar on 1999/07/04 20:29:32
+ Log: perl_run() should call my_exit(0) for normal completion
+ Branch: perl
+ ! perl.c
+____________________________________________________________________________
+[ 3571] By: jhi on 1999/07/04 20:10:44
+ Log: Add test for change #3568 plus general cleanup.
+ Branch: cfgperl
+ ! t/pragma/locale.t
+____________________________________________________________________________
+[ 3570] By: gsar on 1999/07/04 20:03:21
+ Log: make overload, Data::Dumper, and dumpvar understand qr// stringify
+ overloading
+ Branch: perl
+ ! ext/Data/Dumper/Dumper.pm ext/Data/Dumper/Dumper.xs
+ ! lib/Dumpvalue.pm lib/dumpvar.pl lib/overload.pm pp_ctl.c
+____________________________________________________________________________
+[ 3569] By: gsar on 1999/07/04 18:04:48
+ Log: make AIX dynaloading work when libperl is shared (and thus under
+ mod_perl etc.)
+ From: Jens-Uwe Mager <jum@helios.de>
+ Date: Sat, 29 May 1999 17:09:52 +0200
+ Message-Id: <199905291509.RAA43978@ans.helios.de>
+ Subject: [19990529.002] DynaLoader does not work properly if perl is not the main program (AIX)
+ Branch: perl
+ ! ext/DynaLoader/dl_aix.xs
+____________________________________________________________________________
+[ 3568] By: jhi on 1999/07/04 14:54:23
+ Log: pp_lc/pp_lcfirst/pp_quotemeta/pp_uc/pp_ucfirst were not calling mg_set().
+ This resulted for example in the 'o' magic not being cleared by
+ magic_setcollxfrm(), which resulted in strange cmp results.
+ The bug was reported originally in the message
+ Subject: Bug with locale
+ From: Jan Starzynski <jan@planet.de>
+ To: perlbug@perl.com
+ Date: Fri, 09 Apr 1999 13:23:07 +0200
+ Message-ID: <370DE31B.DAEE1332@planet.de>
+ Branch: cfgperl
+ ! pp.c
+____________________________________________________________________________
+[ 3567] By: gsar on 1999/07/04 02:38:34
+ Log: remove misleading info on defined(&func), unclutter deprecation
+ about defined(@array)
+ Branch: perl
+ ! op.c pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod
+ ! t/pragma/warn/op
+____________________________________________________________________________
+[ 3566] By: gsar on 1999/07/04 01:46:31
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Wed, 26 May 1999 22:07:17 +0200
+ Message-ID: <374c53ac.10322322@smtp1.ibm.net>
+ Subject: [PATCH 5.005_57] MINGW32 and EGCS 1.1.2 support
+ Branch: perl
+ ! Changes win32/win32.c win32/win32.h
+____________________________________________________________________________
[ 3565] By: gsar on 1999/07/04 01:26:02
Log: newer version of perlxstut from Jeff Okamoto (slightly edited
for win32 issues)
diff --git a/ext/B/B/Bblock.pm b/ext/B/B/Bblock.pm
index ba6293b1ff..df2a64214e 100644
--- a/ext/B/B/Bblock.pm
+++ b/ext/B/B/Bblock.pm
@@ -4,7 +4,9 @@ use Exporter ();
@EXPORT_OK = qw(find_leaders);
use B qw(peekop walkoptree walkoptree_exec
- main_root main_start svref_2object OPf_SPECIAL OPf_STACKED);
+ main_root main_start svref_2object
+ OPf_SPECIAL OPf_STACKED );
+
use B::Terse;
use strict;
@@ -17,19 +19,19 @@ sub mark_leader {
$bblock->{$$op} = $op;
}
}
-sub remove_sortblocks{
- foreach (keys %$bblock) {
- my $leader = $$bblock{$_};
- delete $$bblock{$_} if ( $leader == 0);
+
+sub remove_sortblock{
+ foreach (keys %$bblock){
+ my $leader=$$bblock{$_};
+ delete $$bblock{$_} if( $leader == 0);
}
}
-
sub find_leaders {
my ($root, $start) = @_;
$bblock = {};
mark_leader($start) if ( ref $start ne "B::NULL" );
walkoptree($root, "mark_if_leader") if ((ref $root) ne "B::NULL") ;
- remove_sortblocks();
+ remove_sortblock();
return $bblock;
}
@@ -104,18 +106,19 @@ sub B::CONDOP::mark_if_leader {
mark_leader($op->false);
}
+
sub B::LISTOP::mark_if_leader {
my $op = shift;
my $first=$op->first;
- $first=$first->next while ($first->ppaddr eq "pp_null"); #remove optimed
+ $first=$first->next while ($first->ppaddr eq "pp_null");
mark_leader($op->first) unless (exists( $bblock->{$$first}));
mark_leader($op->next);
- if ($op->ppaddr eq "pp_sort" && $op->flags
- & OPf_SPECIAL && $op->flags & OPf_STACKED){
- my $root=$op->first->sibling->first;
- my $leader=$root->first;
- $bblock->{$$leader} = 0;
-}
+ if ($op->ppaddr eq "pp_sort" and $op->flags & OPf_SPECIAL
+ and $op->flags & OPf_STACKED){
+ my $root=$op->first->sibling->first;
+ my $leader=$root->first;
+ $bblock->{$$leader} = 0;
+ }
}
sub B::PMOP::mark_if_leader {
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 7f2954354b..0385452ffc 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -551,7 +551,7 @@ sub B::PVMG::save_magic {
if ($len == HEf_SVKEY){
#The pointer is an SV*
$ptrsv=svref_2object($ptr)->save;
- $init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
+ $init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s,(char *) %s, %d);",
$$sv, $$obj, cchar($type),$ptrsv,$len));
}else{
$init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
@@ -1330,7 +1330,7 @@ sub save_main {
my $init_av = init_av->save;
$init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
sprintf("PL_main_start = s\\_%x;", ${main_start()}),
- "PL_initav = $init_av;");
+ "PL_initav = (AV *) $init_av;");
save_context();
warn "Writing output\n";
output_boilerplate();
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index 059491d354..5a143bc307 100644
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -92,9 +92,10 @@ sub init_hash { map { $_ => 1 } @_ }
#
%skip_lexicals = init_hash qw(pp_enter pp_enterloop);
%skip_invalidate = init_hash qw(pp_enter pp_enterloop);
-%need_curcop = init_hash qw(pp_rv2gv pp_bless pp_repeat pp_sort
- pp_caller pp_reset pp_rv2cv pp_entereval pp_require pp_dofile
- pp_entertry pp_enterloop pp_enteriter pp_entersub pp_enter);
+%need_curcop = init_hash qw(pp_rv2gv pp_bless pp_repeat pp_sort pp_caller
+ pp_reset pp_rv2cv pp_entereval pp_require pp_dofile
+ pp_entertry pp_enterloop pp_enteriter pp_entersub
+ pp_enter);
sub debug {
if ($debug_runtime) {
@@ -582,7 +583,6 @@ sub pp_dbstate {
}
#default_pp will handle this:
-#sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
#sub pp_bless { $curcop->write_back; default_pp(@_) }
#sub pp_repeat { $curcop->write_back; default_pp(@_) }
# The following subs need $curcop->write_back if we decide to support arybase:
@@ -590,41 +590,40 @@ sub pp_dbstate {
#sub pp_caller { $curcop->write_back; default_pp(@_) }
#sub pp_reset { $curcop->write_back; default_pp(@_) }
+sub pp_rv2gv{
+ my $op =shift;
+ $curcop->write_back;
+ write_back_lexicals() unless $skip_lexicals{$ppname};
+ write_back_stack() unless $skip_stack{$ppname};
+ my $sym=doop($op);
+ if ($op->private & OPpDEREF) {
+ $init->add(sprintf("((UNOP *)$sym)->op_first = $sym;"));
+ $init->add(sprintf("((UNOP *)$sym)->op_type = %d;",
+ $op->first->type));
+ }
+ return $op->next;
+}
sub pp_sort {
my $op = shift;
my $ppname = $op->ppaddr;
- if ($op->flags & OPf_SPECIAL && $op->flags & OPf_STACKED){
- #this indicates the "sort BLOCK Array" case
- #ugly optree surgery required.
- my $root=$op->first->sibling->first;
- my $start=$root->first;
+ if ( $op->flags & OPf_SPECIAL && $op->flags & OPf_STACKED){
+ #this indicates the sort BLOCK Array case
+ #ugly surgery required.
+ my $root=$op->first->sibling->first;
+ my $start=$root->first;
$op->first->save;
$op->first->sibling->save;
$root->save;
- $start->save;
- my $sym=objsym($start);
- my $fakeop=cc_queue("pp_sort".$$op,$root,$start);
- $init->add(sprintf("($sym)->op_next=%s;",$fakeop));
- }
+ my $sym=$start->save;
+ my $fakeop=cc_queue("pp_sort".$$op,$root,$start);
+ $init->add(sprintf("(%s)->op_next=%s;",$sym,$fakeop));
+ }
$curcop->write_back;
- write_back_lexicals();
- write_back_stack();
- doop($op);
- return $op->next;
-}
-
-sub pp_leavesub{
- my $op = shift;
- my $ppname = $op->ppaddr;
- write_back_lexicals() unless $skip_lexicals{$ppname};
- write_back_stack() unless $skip_stack{$ppname};
- runtime("if (PL_curstackinfo->si_type == PERLSI_SORT) {");
- runtime("\tPUTBACK;return 0;");
- runtime("}");
+ write_back_lexicals();
+ write_back_stack();
doop($op);
return $op->next;
-}
-
+}
sub pp_gv {
my $op = shift;
my $gvsym = $op->gv->save;
@@ -1071,7 +1070,16 @@ sub pp_enterwrite {
my $op = shift;
pp_entersub($op);
}
-
+sub pp_leavesub{
+ my $op = shift;
+ write_back_lexicals() unless $skip_lexicals{$ppname};
+ write_back_stack() unless $skip_stack{$ppname};
+ runtime("if (PL_curstackinfo->si_type == PERLSI_SORT){");
+ runtime("\tPUTBACK;return 0;");
+ runtime("}");
+ doop($op);
+ return $op->next;
+}
sub pp_leavewrite {
my $op = shift;
write_back_lexicals(REGISTER|TEMPORARY);
@@ -1535,7 +1543,7 @@ sub cc_main {
$init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
"PL_main_start = $start;",
"PL_curpad = AvARRAY($curpad_sym);",
- "PL_initav = $init_av;",
+ "PL_initav = (AV *) $init_av;",
"GvHV(PL_incgv) = $inc_hv;",
"GvAV(PL_incgv) = $inc_av;",
"av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm
index c6aa1ba925..123b2fcc5c 100644
--- a/ext/B/B/Stackobj.pm
+++ b/ext/B/B/Stackobj.pm
@@ -264,13 +264,21 @@ sub B::Stackobj::Const::write_back {
sub B::Stackobj::Const::load_int {
my $obj = shift;
- $obj->{iv} = int($obj->{sv}->PV);
+ if (ref($obj->{sv}) eq "B::RV"){
+ $obj->{iv} = int($obj->{sv}->RV->PV);
+ }else{
+ $obj->{iv} = int($obj->{sv}->PV);
+ }
$obj->{flags} |= VALID_INT;
}
sub B::Stackobj::Const::load_double {
my $obj = shift;
- $obj->{nv} = $obj->{sv}->PV + 0.0;
+ if (ref($obj->{sv}) eq "B::RV"){
+ $obj->{nv} = $obj->{sv}->RV->PV + 0.0;
+ }else{
+ $obj->{nv} = $obj->{sv}->PV + 0.0;
+ }
$obj->{flags} |= VALID_DOUBLE;
}
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
index 9cd71ce786..db28891b79 100644
--- a/ext/GDBM_File/GDBM_File.xs
+++ b/ext/GDBM_File/GDBM_File.xs
@@ -256,7 +256,6 @@ gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
croak("No write permission to gdbm file");
croak("gdbm store returned %d, errno %d, key \"%.*s\"",
RETVAL,errno,key.dsize,key.dptr);
- gdbm_clearerr(db);
}
#define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key)
diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm
new file mode 100644
index 0000000000..f8931fb16e
--- /dev/null
+++ b/lib/CGI/Pretty.pm
@@ -0,0 +1,175 @@
+package CGI::Pretty;
+
+# See the bottom of this file for the POD documentation. Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+use CGI ();
+
+$VERSION = '1.0';
+$CGI::DefaultClass = __PACKAGE__;
+$AutoloadClass = 'CGI';
+@ISA = 'CGI';
+
+# These tags should not be prettify'd. If we did prettify them, the
+# browser would output text that would have extraneous spaces
+@AS_IS = qw( A PRE );
+my $NON_PRETTIFY_ENDTAGS = join "", map { "</$_>" } @AS_IS;
+
+sub _make_tag_func {
+ my ($self,$tagname) = @_;
+ return $self->SUPER::_make_tag_func($tagname) if $tagname=~/^(start|end)_/;
+
+ return qq{
+ sub $tagname {
+ # handle various cases in which we're called
+ # most of this bizarre stuff is to avoid -w errors
+ shift if \$_[0] &&
+# (!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
+ (ref(\$_[0]) &&
+ (substr(ref(\$_[0]),0,3) eq 'CGI' ||
+ UNIVERSAL::isa(\$_[0],'CGI')));
+
+ my(\$attr) = '';
+ if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
+ my(\@attr) = make_attributes('',shift);
+ \$attr = " \@attr" if \@attr;
+ }
+
+ my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
+ return \$tag unless \@_;
+
+ my \@result;
+ if ( "$NON_PRETTIFY_ENDTAGS" =~ /\$untag/ ) {
+ \@result = map { "\$tag\$_\$untag\\n" }
+ (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+ }
+ else {
+ \@result = map {
+ chomp;
+ if ( \$_ !~ /<\\// ) {
+ s/\\n/\\n /g;
+ }
+ else {
+ my \$text = "";
+ my ( \$pretag, \$thistag, \$posttag );
+ while ( /<\\/.*>/si ) {
+ if ( (\$pretag, \$thistag, \$posttag ) =
+ /(.*?)<(.*?)>(.*)/si ) {
+ \$pretag =~ s/\\n/\\n /g;
+ \$text .= "\$pretag<\$thistag>";
+
+ ( \$thistag ) = split ' ', \$thistag;
+ my \$endtag = "</" . uc(\$thistag) . ">";
+ if ( "$NON_PRETTIFY_ENDTAGS" =~ /\$endtag/ ) {
+ if ( ( \$pretag, \$posttag ) =
+ \$posttag =~ /(.*?)\$endtag(.*)/si ) {
+ \$text .= "\$pretag\$endtag";
+ }
+ }
+
+ \$_ = \$posttag;
+ }
+ }
+ \$_ = \$text;
+ if ( defined \$posttag ) {
+ \$posttag =~ s/\\n/\\n /g;
+ \$_ .= \$posttag;
+ }
+ }
+ "\$tag\\n \$_\\n\$untag\\n" }
+ (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+ }
+ return "\@result";
+ }
+ };
+}
+
+sub new {
+ my $class = shift;
+ my $this = $class->SUPER::new( @_ );
+
+ return bless $this, $class;
+}
+
+1;
+
+=head1 NAME
+
+CGI::Pretty - module to produce nicely formatted HTML code
+
+=head1 SYNOPSIS
+
+ use CGI::Pretty qw( :html3 );
+
+ # Print a table with a single data element
+ print table( TR( td( "foo" ) ) );
+
+=head1 DESCRIPTION
+
+CGI::Pretty is a module that derives from CGI. It's sole function is to
+allow users of CGI to output nicely formatted HTML code.
+
+When using the CGI module, the following code:
+ print table( TR( td( "foo" ) ) );
+
+produces the following output:
+ <TABLE><TR><TD>foo</TD></TR></TABLE>
+
+If a user were to create a table consisting of many rows and many columns,
+the resultant HTML code would be quite difficult to read since it has no
+carriage returns or indentation.
+
+CGI::Pretty fixes this problem. What it does is add a carriage
+return and indentation to the HTML code so that one can easily read
+it.
+
+ print table( TR( td( "foo" ) ) );
+
+now produces the following output:
+ <TABLE>
+ <TR>
+ <TD>
+ foo
+ </TD>
+ </TR>
+ </TABLE>
+
+
+=head2 Tags that won't be formatted
+
+The <A> and <PRE> tags are not formatted. If these tags were formatted, the
+user would see the extra indentation on the web browser causing the page to
+look different than what would be expected. If you wish to add more tags to
+the list of tags that are not to be touched, push them onto the C<@AS_IS> array:
+
+ push @CGI::Pretty::AS_IS,qw(CODE XMP);
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 AUTHOR
+
+Brian Paulsen <bpaulsen@lehman.com>, with minor modifications by
+Lincoln Stein <lstein@cshl.org> for incorporation into the CGI.pm
+distribution.
+
+Copyright 1998, Brian Paulsen. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Bug reports and comments to bpaulsen@lehman.com. You can also write
+to lstein@cshl.org, but this code looks pretty hairy to me and I'm not
+sure I understand it!
+
+=head1 SEE ALSO
+
+L<CGI>
+
+=cut
+
diff --git a/mg.c b/mg.c
index 8175982b45..a21ea5730e 100644
--- a/mg.c
+++ b/mg.c
@@ -1704,12 +1704,14 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
#ifdef VMS
set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
#else
-#ifdef WIN32
+# ifdef WIN32
SetLastError( SvIV(sv) );
-#else
+# else
+# ifndef OS2
/* will anyone ever use this? */
SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
-#endif
+# endif
+# endif
#endif
break;
case '\006': /* ^F */
diff --git a/op.c b/op.c
index f0cd15f433..25b17dc1e1 100644
--- a/op.c
+++ b/op.c
@@ -1833,8 +1833,14 @@ Perl_fold_constants(pTHX_ register OP *o)
if (PL_opargs[type] & OA_TARGET)
o->op_targ = pad_alloc(type, SVs_PADTMP);
- if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER))
+ /* integerize op, unless it happens to be C<-foo>.
+ * XXX should pp_i_negate() do magic string negation instead? */
+ if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER)
+ && !(type == OP_NEGATE && cUNOPo->op_first->op_type == OP_CONST
+ && (cUNOPo->op_first->op_private & OPpCONST_BARE)))
+ {
o->op_ppaddr = PL_ppaddr[type = ++(o->op_type)];
+ }
if (!(PL_opargs[type] & OA_FOLDCONST))
goto nope;
diff --git a/opcode.h b/opcode.h
index 5cb5ae958d..fc09bd335d 100644
--- a/opcode.h
+++ b/opcode.h
@@ -740,7 +740,7 @@ EXT char *PL_op_desc[] = {
"anonymous subroutine",
"subroutine prototype",
"reference constructor",
- "scalar ref constructor",
+ "single ref constructor",
"reference-type operator",
"bless",
"backticks",
diff --git a/opcode.pl b/opcode.pl
index bf6734c53f..50a767b2fc 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -271,7 +271,7 @@ rv2cv subroutine deref ck_rvconst d1
anoncode anonymous subroutine ck_anoncode $
prototype subroutine prototype ck_null s% S
refgen reference constructor ck_spair m1 L
-srefgen scalar ref constructor ck_null fs1 S
+srefgen single ref constructor ck_null fs1 S
ref reference-type operator ck_fun stu% S?
bless bless ck_fun s@ S S?
diff --git a/pp_sys.c b/pp_sys.c
index b11259b450..483ddceab5 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1465,6 +1465,10 @@ PP(pp_sysread)
#else
bufsize = sizeof namebuf;
#endif
+#ifdef OS2 /* At least Warp3+IAK: only the first byte of bufsize set */
+ if (bufsize >= 256)
+ bufsize = 255;
+#endif
buffer = SvGROW(bufsv, length+1);
/* 'offset' means 'flags' here */
length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t
index 02112a27e3..8547024df3 100755
--- a/t/lib/io_udp.t
+++ b/t/lib/io_udp.t
@@ -19,9 +19,6 @@ BEGIN {
elsif ($Config{'extensions'} !~ /\bIO\b/) {
$reason = 'IO was not built';
}
- elsif ($^O eq 'os2') {
- $reason = "blocks on OS/2, not debugged yet";
- }
elsif ($^O eq 'apollo') {
$reason = "unknown *FIXME*";
}
@@ -36,6 +33,18 @@ BEGIN {
sub compare_addr {
my $a = shift;
my $b = shift;
+ if (length($a) != length $b) {
+ my $min = (length($a) < length $b) ? length($a) : length $b;
+ if ($min and substr($a, 0, $min) eq substr($b, 0, $min)) {
+ printf "# Apparently: %d bytes junk at the end of %s\n# %s\n",
+ abs(length($a) - length ($b)),
+ $_[length($a) < length ($b) ? 1 : 0],
+ "consider decreasing bufsize of recfrom.";
+ substr($a, $min) = "";
+ substr($b, $min) = "";
+ }
+ return 0;
+ }
my @a = unpack_sockaddr_in($a);
my @b = unpack_sockaddr_in($b);
"$a[0]$a[1]" eq "$b[0]$b[1]";
@@ -65,7 +74,8 @@ print "ok 2\n";
$udpa->send("ok 4\n",0,$udpb->sockname);
-print "not " unless compare_addr($udpa->peername,$udpb->sockname);
+print "not "
+ unless compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname');
print "ok 3\n";
my $where = $udpb->recv($buf="",5);
@@ -73,7 +83,7 @@ print $buf;
my @xtra = ();
-unless(compare_addr($where,$udpa->sockname)) {
+unless(compare_addr($where,$udpa->sockname, 'recv name', 'sockname')) {
print "not ";
@xtra = (0,$udpa->sockname);
}
diff --git a/thread.h b/thread.h
index f6c468c675..f09143d1eb 100644
--- a/thread.h
+++ b/thread.h
@@ -35,10 +35,8 @@ struct perl_thread *getTHR (void);
# define YIELD pthread_yield(NULL)
# endif
# endif
-# ifndef VMS
# define pthread_mutexattr_default NULL
# define pthread_condattr_default NULL
-# endif
#endif
#ifndef PTHREAD_CREATE
diff --git a/toke.c b/toke.c
index 1378d39ded..dd8742b02d 100644
--- a/toke.c
+++ b/toke.c
@@ -1147,12 +1147,21 @@ S_scan_const(pTHX_ char *start)
case 't':
*d++ = '\t';
break;
+#ifdef EBCDIC
+ case 'e':
+ *d++ = '\047'; /* CP 1047 */
+ break;
+ case 'a':
+ *d++ = '\057'; /* CP 1047 */
+ break;
+#else
case 'e':
*d++ = '\033';
break;
case 'a':
*d++ = '\007';
break;
+#endif
} /* end switch */
s++;
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index 206740890e..0bd08de57b 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -240,7 +240,7 @@ INSTPERL = perl
# Space-separated list of "dynamic" extensions which should be built for
# run-time dynamic loading.
-dynamic_ext = Fcntl Errno IO Opcode Data::Dumper attrs re VMS::Stdio VMS::DCLsym B SDBM_File POSIX
+dynamic_ext = $extensions
# Space-separated list of "static" extensions to build into perlshr (case counts).
MYEXT = DynaLoader
diff --git a/vms/subconfigure.com b/vms/subconfigure.com
index d96c845a80..6b6483a9a1 100644
--- a/vms/subconfigure.com
+++ b/vms/subconfigure.com
@@ -449,6 +449,8 @@ $ if ("''Use_Threads'".eqs."T")
$ THEN
$ perl_arch = "''perl_arch'-thread"
$ perl_archname = "''perl_archname'-thread"
+$ perl_d_old_pthread_create_joinable = "undef"
+$ perl_old_pthread_create_joinable = " "
$ ELSE
$ perl_d_old_pthread_create_joinable = "undef"
$ perl_old_pthread_create_joinable = " "
@@ -1097,11 +1099,11 @@ $ DEASSIGN SYS$ERROR
$ if (teststatus.nes."1")
$ THEN
$! Okay, off64_t failed. Must not exist
-$ perl_d_off64t = "undef"
+$ perl_d_off64_t = "undef"
$ ELSE
-$ perl_d_off64t="define"
+$ perl_d_off64_t="define"
$ ENDIF
-$ WRITE_RESULT "d_off64t is ''perl_d_off64t'"
+$ WRITE_RESULT "d_off64_t is ''perl_d_off64_t'"
$!
$! Check to see if gethostname exists
$!
@@ -1487,6 +1489,52 @@ $ ENDIF
$ ENDIF
$ WRITE_RESULT "d_fcntl is ''perl_d_fcntl'"
$!
+$! Check for memchr
+$!
+$ OS
+$ WS "#ifdef __DECC
+$ WS "#include <stdlib.h>
+$ WS "#endif
+$ WS "#include <string.h>
+$ WS "int main()
+$ WS "{"
+$ WS "char * place;
+$ WS "place = memchr(""foo"", 47, 3)
+$ WS "exit(0);
+$ WS "}"
+$ CS
+$ DEFINE SYS$ERROR _NLA0:
+$ DEFINE SYS$OUTPUT _NLA0:
+$ on error then continue
+$ on warning then continue
+$ 'Checkcc' temp.c
+$ savedstatus = $status
+$ teststatus = f$extract(9,1,savedstatus)
+$ if (teststatus.nes."1")
+$ THEN
+$ perl_d_memchr="undef"
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ ELSE
+$ If (Needs_Opt.eqs."Yes")
+$ THEN
+$ link temp.obj,temp.opt/opt
+$ else
+$ link temp.obj
+$ endif
+$ savedstatus = $status
+$ teststatus = f$extract(9,1,savedstatus)
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ if (teststatus.nes."1")
+$ THEN
+$ perl_d_memchr="undef"
+$ ELSE
+$ perl_d_memchr="define"
+$ ENDIF
+$ ENDIF
+$ WRITE_RESULT "d_memchr is ''perl_d_memchr'"
+$!
$! Check for access
$!
$ OS
@@ -1782,6 +1830,52 @@ $ perl_i_niin="undef"
$ ENDIF
$ WRITE_RESULT "i_niin is ''perl_i_niin'"
$!
+$! Check for <netinet/tcp.h>
+$!
+$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T")
+$ THEN
+$ OS
+$ WS "#ifdef __DECC
+$ WS "#include <stdlib.h>
+$ WS "#endif
+$ WS "#include <stdio.h>
+$ if ("''Has_Socketshr'".eqs."T")
+$ THEN
+$ WS "#include <socketshr.h>"
+$ else
+$ WS "#include <netdb.h>
+$ endif
+$ WS "#include <netinet/tcp.h>"
+$ WS "int main()
+$ WS "{"
+$ WS "exit(0);
+$ WS "}"
+$ CS
+$ DEFINE SYS$ERROR _NLA0:
+$ DEFINE SYS$OUTPUT _NLA0:
+$ on error then continue
+$ on warning then continue
+$ 'Checkcc' temp.c
+$ If (Needs_Opt.eqs."Yes")
+$ THEN
+$ link temp.obj,temp.opt/opt
+$ else
+$ link temp.obj
+$ endif
+$ teststatus = f$extract(9,1,$status)
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ if (teststatus.nes."1")
+$ THEN
+$ perl_i_netinettcp="undef"
+$ ELSE
+$ perl_i_netinettcp="define"
+$ ENDIF
+$ ELSE
+$ perl_i_netinettcp="undef"
+$ ENDIF
+$ WRITE_RESULT "i_netinettcp is ''perl_i_netinettcp'"
+$!
$! Check for endhostent
$!
$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T")
@@ -2396,13 +2490,17 @@ $ DEASSIGN SYS$ERROR
$ if (teststatus.nes."1")
$ THEN
$ perl_d_sched_yield="undef"
+$ perl_sched_yield = " "
$ ELSE
$ perl_d_sched_yield="define"
+$ perl_sched_yield = "sched_yield"
$ ENDIF
$ ELSE
$ perl_d_sched_yield="undef"
+$ perl_sched_yield = " "
$ ENDIF
$ WRITE_RESULT "d_sched_yield is ''perl_d_sched_yield'"
+$ WRITE_RESULT "sched_yield is ''perl_sched_yield'"
$!
$! Check for generic pointer size
$!
@@ -2736,6 +2834,7 @@ $!
$ WC "# This file generated by Configure.COM on a VMS system."
$ WC "# Time: " + perl_cf_time
$ WC ""
+$ WC "CONFIGDOTSH=true"
$ WC "package='" + perl_package + "'"
$ WC "CONFIG='" + perl_config + "'"
$ WC "cf_time='" + perl_cf_time + "'"
@@ -2788,6 +2887,7 @@ $ WC "d_gethent='" + perl_d_gethent + "'"
$ WC "d_getsent='" + perl_d_getsent + "'"
$ WC "d_select='" + perl_d_select + "'"
$ WC "i_niin='" + perl_i_niin + "'"
+$ WC "i_netinettcp='" + perl_i_netinettcp + "'"
$ WC "i_neterrno='" + perl_i_neterrno + "'"
$ WC "d_stdstdio='" + perl_d_stdstdio + "'"
$ WC "d_stdio_ptr_lval='" + perl_d_stdio_ptr_lval + "'"
@@ -3160,7 +3260,7 @@ $ WC "d_nextkey64='" + perl_d_nextkey64 + "'"
$ WC "i_poll='" + perl_i_poll + "'"
$ WC "i_inttypes='" + perl_i_inttypes + "'"
$ WC "d_int64t='" + perl_d_int64t + "'"
-$ WC "d_off64t='" + perl_d_off64t + "'"
+$ WC "d_off64_t='" + perl_d_off64_t + "'"
$ WC "d_fstat64='" + perl_d_fstat64 + "'"
$ WC "d_ftruncate64='" + perl_d_ftruncate64 + "'"
$ WC "d_lseek64='" + perl_d_lseek64 + "'"
@@ -3192,7 +3292,11 @@ $ WC "seedfunc='" + perl_seedfunc + "'"
$ WC "sig_num_init='" + perl_sig_num_with_commas + "'"
$ WC "i_sysmount='" + perl_i_sysmount + "'"
$ WC "d_fstatfs='" + perl_d_fstatfs + "'"
+$ WC "d_memchr='" + perl_d_memchr + "'"
$ WC "d_statfsflags='" + perl_d_statfsflags + "'"
+$ WC "fflushNULL='define'"
+$ WC "fflushall='undef'"
+$ WC "d_stdio_stream_array='undef'"
$ WC "i_sysstatvfs='" + perl_i_sysstatvfs + "'"
$ WC "i_machcthreads='" + perl_i_machcthreads + "'"
$ WC "i_pthread='" + perl_i_pthread + "'"
@@ -3210,6 +3314,7 @@ $ WC "i_sysmman='" + perl_i_sysmman + "'"
$ WC "installusrbinperl='" + perl_installusrbinperl + "'"
$ WC "crosscompile='" + perl_crosscompile + "'"
$ WC "multiarch='" + perl_multiarch + "'"
+$ WC "sched_yield='" + perl_sched_yield + "'"
$!
$! ##WRITE NEW CONSTANTS HERE##
$!
diff --git a/vms/vms.c b/vms/vms.c
index ebb05a142a..af35fbd62f 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -106,6 +106,18 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
{LNM$C_NAMLENGTH, LNM$_STRING, eqv, &eqvlen},
{0, 0, 0, 0}};
$DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM");
+#if defined(USE_THREADS)
+ /* We jump through these hoops because we can be called at */
+ /* platform-specific initialization time, which is before anything is */
+ /* set up--we can't even do a plain dTHR since that relies on the */
+ /* interpreter structure to be initialized */
+ struct perl_thread *thr;
+ if (PL_curinterp) {
+ thr = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv);
+ } else {
+ thr = NULL;
+ }
+#endif
if (!lnm || !eqv || idx > LNM$_MAX_INDEX) {
set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return 0;
@@ -159,8 +171,22 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
if (eqvlen > 1024) {
set_errno(EVMSERR); set_vaxc_errno(LIB$_STRTRU);
eqvlen = 1024;
- if (ckWARN(WARN_MISC))
- warner(WARN_MISC,"Value of CLI symbol \"%s\" too long",lnm);
+ /* Special hack--we might be called before the interpreter's */
+ /* fully initialized, in which case either thr or PL_curcop */
+ /* might be bogus. We have to check, since ckWARN needs them */
+ /* both to be valid if running threaded */
+#if defined(USE_THREADS)
+ if (thr && PL_curcop) {
+#endif
+ if (ckWARN(WARN_MISC)) {
+ warner(WARN_MISC,"Value of CLI symbol \"%s\" too long",lnm);
+ }
+#if defined(USE_THREADS)
+ } else {
+ warner(WARN_MISC,"Value of CLI symbol \"%s\" too long",lnm);
+ }
+#endif
+
}
strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen);
}
@@ -188,7 +214,6 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
} /* end of vmstrnenv */
/*}}}*/
-
/*{{{ int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)*/
/* Define as a function so we can access statics. */
int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)
@@ -260,9 +285,19 @@ my_getenv(const char *lnm, bool sys)
char *
my_getenv_len(const char *lnm, unsigned long *len, bool sys)
{
- char buf[LNM$C_NAMLENGTH+1], *cp1, *cp2;
+ char *buf, *cp1, *cp2;
unsigned long idx = 0;
-
+ static char __my_getenv_len_eqv[LNM$C_NAMLENGTH+1];
+ SV *tmpsv;
+
+ if (PL_curinterp) { /* Perl interpreter running -- may be threaded */
+ /* Set up a temporary buffer for the return value; Perl will
+ * clean it up at the next statement transition */
+ tmpsv = sv_2mortal(newSVpv("",LNM$C_NAMLENGTH+1));
+ if (!tmpsv) return NULL;
+ buf = SvPVX(tmpsv);
+ }
+ else buf = __my_getenv_len_eqv; /* Assume no interpreter ==> single thread */
for (cp1 = (char *)lnm, cp2 = buf; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
if (cp1 - lnm == 7 && !strncmp(buf,"DEFAULT",7)) {
getcwd(buf,LNM$C_NAMLENGTH);
@@ -285,7 +320,8 @@ my_getenv_len(const char *lnm, unsigned long *len, bool sys)
#endif
)))
return buf;
- else return Nullch;
+ else
+ return Nullch;
}
} /* end of my_getenv_len() */
@@ -1083,6 +1119,7 @@ Pid_t
my_waitpid(Pid_t pid, int *statusp, int flags)
{
struct pipe_details *info;
+ dTHR;
for (info = open_pipes; info != NULL; info = info->next)
if (info->pid == pid) break;
@@ -3381,6 +3418,7 @@ bool
vms_do_exec(char *cmd)
{
+ dTHR;
if (vfork_called) { /* this follows a vfork - act Unixish */
vfork_called--;
if (vfork_called < 0) {
@@ -3445,6 +3483,7 @@ unsigned long int
do_spawn(char *cmd)
{
unsigned long int sts, substs, hadcmd = 1;
+ dTHR;
TAINT_ENV();
TAINT_PROPER("spawn");
@@ -4499,17 +4538,19 @@ flex_fstat(int fd, Stat_t *statbufp)
} /* end of flex_fstat() */
/*}}}*/
-/*{{{ int flex_stat(char *fspec, Stat_t *statbufp)*/
+/*{{{ int flex_stat(const char *fspec, Stat_t *statbufp)*/
int
-flex_stat(char *fspec, Stat_t *statbufp)
+flex_stat(const char *fspec, Stat_t *statbufp)
{
dTHR;
char fileified[NAM$C_MAXRSS+1];
+ char temp_fspec[NAM$C_MAXRSS+300];
int retval = -1;
+ strcpy(temp_fspec, fspec);
if (statbufp == (Stat_t *) &PL_statcache)
- do_tovmsspec(fspec,namecache,0);
- if (is_null_device(fspec)) { /* Fake a stat() for the null device */
+ do_tovmsspec(temp_fspec,namecache,0);
+ if (is_null_device(temp_fspec)) { /* Fake a stat() for the null device */
memset(statbufp,0,sizeof *statbufp);
statbufp->st_dev = encode_dev("_NLA0:");
statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
@@ -4528,12 +4569,12 @@ flex_stat(char *fspec, Stat_t *statbufp)
* the file with null type, specify this by calling flex_stat() with
* a '.' at the end of fspec.
*/
- if (do_fileify_dirspec(fspec,fileified,0) != NULL) {
+ if (do_fileify_dirspec(temp_fspec,fileified,0) != NULL) {
retval = stat(fileified,(stat_t *) statbufp);
if (!retval && statbufp == (Stat_t *) &PL_statcache)
strcpy(namecache,fileified);
}
- if (retval) retval = stat(fspec,(stat_t *) statbufp);
+ if (retval) retval = stat(temp_fspec,(stat_t *) statbufp);
if (!retval) {
statbufp->st_dev = encode_dev(statbufp->st_devnam);
# ifdef RTL_USES_UTC
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 06ad647169..8f630189b7 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -66,6 +66,7 @@
/* Note that we do, in fact, have this */
#define HAS_GETENV_SV
+#define HAS_GETENV_LEN
#ifndef DONT_MASK_RTL_CALLS
# ifdef getenv
@@ -624,7 +625,7 @@ int my_sigprocmask (int, sigset_t *, sigset_t *);
#endif
I32 cando_by_name (I32, I32, char *);
int flex_fstat (int, Stat_t *);
-int flex_stat (char *, Stat_t *);
+int flex_stat (const char *, Stat_t *);
int trim_unixpath (char *, char*, int);
int my_vfork ();
bool vms_do_aexec (SV *, SV **, SV **);
View Lorry Controller Status