This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate vmsperl changes into mainline (change#5693 denied)
authorGurusamy Sarathy <gsar@cpan.org>
Tue, 14 Mar 2000 21:26:33 +0000 (21:26 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Tue, 14 Mar 2000 21:26:33 +0000 (21:26 +0000)
p4raw-link: @5693 on //depot/vmsperl: 925fd5a3f200998584b0c9f5f508f038863055cb

p4raw-id: //depot/perl@5742
p4raw-integrated: from //depot/vmsperl@5741 'copy in'
vms/ext/filespec.t (@5564..) t/lib/filespec.t vms/vms.c
(@5689..) configure.com (@5690..) 'edit in'
lib/File/Spec/VMS.pm (@5690..) 'ignore' t/lib/complex.t
(@5690..)

configure.com
lib/File/Spec/VMS.pm
t/lib/filespec.t
vms/ext/filespec.t
vms/subconfigure.com
vms/vms.c

index 84ac265..8c65d77 100644 (file)
@@ -134,12 +134,17 @@ $ use_5005_threads = "N"
 $ use_ithreads = "N"
 $!
 $!: option parsing
+$ config_args = ""
 $ IF (P1 .NES. "")
 $ THEN            !one or more switches was thrown
 $   i = 1
 $   bang = 0
 $Param_loop:
-$   IF (P'i'.NES."") THEN bang = bang + 1
+$   IF (P'i'.NES."") 
+$   THEN
+$     bang = bang + 1
+$     config_args = config_args + F$FAO(" !AS",P'i')
+$   ENDIF
 $   i = i + 1
 $   IF (i.LT.9) THEN GOTO Param_loop !DCL allows P1..P8
 $!
@@ -300,6 +305,7 @@ $   i = i + 1
 $   IF (i .LT. (bang + 1)) THEN GOTO Opt_loop
 $!
 $ ENDIF  ! (P1 .NES. "")
+$ config_args = F$EDIT(config_args,"TRIM")
 $!
 $ IF (error)
 $ THEN
@@ -766,7 +772,7 @@ $!: who configured the system
 $! see 'user' above.
 $ cf_by = F$EDIT(user,"LOWERCASE")
 $! cf_time = F$CVTIME()                 !superceded by procedure below
-$ osvers = F$GETSYI("VERSION")
+$ osvers = F$EDIT(F$GETSYI("VERSION"),"TRIM")
 $!
 $! Peter Prymmer has seen:
 $!  "SYS$TIMEZONE_DIFFERENTIAL" = "-46800"  (sic)
@@ -899,9 +905,13 @@ $ IF (F$GETSYI("HW_MODEL") .LT. 1024)
 $ THEN 
 $   archname = "VMS_VAX"
 $   otherarch = "an Alpha"
+$   alignbytes="8"
+$   arch_type = "ARCH-TYPE=__VAX__"
 $ ELSE
 $   archname = "VMS_AXP"
 $   otherarch = "a VAX"
+$   alignbytes="8"
+$   arch_type = "ARCH-TYPE=__AXP__"
 $ ENDIF
 $ rp = "What is your architecture name? [''archname'] "
 $ GOSUB myread
@@ -970,7 +980,7 @@ $!
 $ vms_skip_install = "true"
 $ dflt = "y"
 $! echo ""
-$ rp = "%Config-I-VMS, Do you wish to skip the remaining """"where install"""" questions? [''dflt'] "
+$ rp = "%Config-I-VMS, Skip the remaining """"where install"""" questions? [''dflt'] "
 $ GOSUB myread
 $ IF (.NOT.ans).AND.(ans.NES."") THEN vms_skip_install = "false"
 $ IF (.NOT.vms_skip_install)
@@ -1032,7 +1042,8 @@ $   ENDIF
 $ ENDIF ! (.NOT.perl_symbol)
 $!
 $!: set the base revision
-$ baserev="5"
+$ baserev="5.0"
+$ revision = baserev - ".0"
 $!: get the patchlevel
 $ echo ""
 $ echo4 "Getting the current patchlevel..." !>&4
@@ -1041,6 +1052,9 @@ $ IF (patchlevel_h.NES."")
 $ THEN
 $   got_patch = "false"
 $   got_sub   = "false"
+$   got_api_revision   = "false"
+$   got_api_version    = "false"
+$   got_api_subversion = "false"
 $   OPEN/READONLY CONFIG 'patchlevel_h' 
 $Patchlevel_h_loop:
 $   READ/END_Of_File=Close_patch CONFIG line
@@ -1056,6 +1070,24 @@ $     line = F$EDIT(line,"COMPRESS, TRIM")
 $     subversion = F$ELEMENT(2," ",line)
 $     got_sub = "true"
 $   ENDIF
+$   IF ((F$LOCATE("#define PERL_API_REVISION",line).NE.F$LENGTH(line)).AND.(.NOT.got_api_revision))
+$   THEN
+$     line = F$EDIT(line,"COMPRESS, TRIM")
+$     api_revision = F$ELEMENT(2," ",line)
+$     got_api_revision = "true"
+$   ENDIF
+$   IF ((F$LOCATE("#define PERL_API_VERSION",line).NE.F$LENGTH(line)).AND.(.NOT.got_api_version))
+$   THEN
+$     line = F$EDIT(line,"COMPRESS, TRIM")
+$     api_version = F$ELEMENT(2," ",line)
+$     got_api_version = "true"
+$   ENDIF
+$   IF ((F$LOCATE("#define PERL_API_SUBVERSION",line).NE.F$LENGTH(line)).AND.(.NOT.got_api_subversion))
+$   THEN
+$     line = F$EDIT(line,"COMPRESS, TRIM")
+$     api_subversion = F$ELEMENT(2," ",line)
+$     got_api_subversion = "true"
+$   ENDIF
 $   IF (.NOT.got_patch).OR.(.NOT.got_sub) THEN GOTO Patchlevel_h_loop
 $Close_patch:
 $   CLOSE CONFIG
@@ -1063,24 +1095,14 @@ $   ELSE
 $     patchlevel="0"
 $     subversion="0"
 $ ENDIF
-$ echo "(You have ''package' ''baserev' PL''patchlevel' sub''subversion'.)"
-$! This whole thing needs replacing w/ F$FAO() calls:
-$ patchlevel = F$INTEGER(patchlevel)
-$ IF patchlevel.LT.10
-$ THEN patchlevel = "00" + F$STRING(patchlevel)
-$ ELSE patchlevel = "0" + F$STRING(patchlevel)
-$ ENDIF
-$ subversion = F$INTEGER(subversion)
-$ IF subversion.GT.0
+$ IF (F$STRING(subversion) .NES. "0")
 $ THEN
-$   IF subversion.LT.10
-$   THEN subversion = "0" + F$STRING(subversion)
-$   ELSE subversion = F$STRING(subversion)
-$   ENDIF
-$ ELSE subversion = ""
+$   echo "(You have ''package' revision ''revision' patchlevel ''patchlevel' subversion ''subversion'.)"
+$ ELSE
+$   echo "(You have ''package' revision ''revision' patchlevel ''patchlevel'.)"
 $ ENDIF
 $!
-$ version = baserev + "_" + patchlevel + "_" + subversion
+$ version = revision + "_" + patchlevel + "_" + subversion
 $!
 $ IF (.NOT.vms_skip_install)
 $ THEN
@@ -1902,7 +1924,7 @@ $ echo "default file types, however, you can configure Perl to try default"
 $ echo "file types of nothing, .pl, and .com, in that order (e.g. typing"
 $ echo """$ perl foo"" would cause Perl to look for foo., then foo.pl, and"
 $ echo "finally foo.com)."
-$ dflt = "n"
+$ dflt = "y"
 $ rp = "Always use default file types? [''dflt'] "
 $ GOSUB myread
 $ if ans.eqs."" then ans="''dflt'"
@@ -2122,13 +2144,13 @@ $! echo4 "Updating makefile..."
 $!
 $ IF (make .EQS. "MMS").OR.(make .EQS. "MMK")
 $ THEN 
-$   makefile    = ""            !wrt MANIFEST dir
-$   UUmakefile  = "DESCRIP.MMS"  !wrt CWD dir
-$   DEFmakefile = "DESCRIP.MMS"  !wrt DEF dir (?)
+$   makefile    = ""              !wrt MANIFEST dir
+$   UUmakefile  = "[-]DESCRIP.MMS" !wrt CWD dir
+$   DEFmakefile = "DESCRIP.MMS"    !wrt DEF dir (?)
 $ ELSE
-$   makefile    = " -f [.VMS]Makefile." !wrt MANIFEST dir
-$   UUmakefile  = "[-.VMS]Makefile."    !wrt CWD dir
-$   DEFmakefile = "[-.VMS]Makefile."    !wrt DEF dir (?)
+$   makefile    = " -f Makefile."  !wrt MANIFEST dir
+$   UUmakefile  = "[-]Makefile."   !wrt CWD dir
+$   DEFmakefile = "Makefile."      !wrt DEF dir (?)
 $ ENDIF
 $!
 $ IF macros.NES."" 
index d3f6018..28c1050 100644 (file)
@@ -128,7 +128,7 @@ sub fixpath {
 
 =item canonpath (override)
 
-Removes redundant portions of file specifications according to VMS syntax
+Removes redundant portions of file specifications according to VMS syntax.
 
 =cut
 
@@ -142,8 +142,13 @@ sub canonpath {
       else          { return vmsify($path);  }
     }
     else {
-      $path =~ s-\]\[--g;  $path =~ s/><//g;    # foo.][bar       ==> foo.bar
-      $path =~ s/([\[<])000000\./$1/;           # [000000.foo     ==> foo
+      $path =~ s-\]\[--g;  $path =~ s/><//g;            # foo.][bar       ==> foo.bar
+      $path =~ s/([\[<])000000\./$1/;                   # [000000.foo     ==> foo
+      1 while $path =~ s{-\.-}{--};                     # -.-             ==> --
+      $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/;            # bar.foo.-]      ==> bar]
+      $path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s
+      $path =~ s/([\[<\.])([^\[<\.\cx]+)\.-\.?/$1/g;    # bar.-.foo       ==> foo
+      $path =~ s/([\[<])(\cx+)/$1 . '-' x length($2)/e; # then decode
       return $path;
     }
 }
@@ -168,15 +173,16 @@ sub catdir {
        $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\z/s;
        $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
 
-    # Special case for VMS absolute directory specs: these will have had device
-    # prepended during trip through Unix syntax in eliminate_macros(), since
-    # Unix syntax has no way to express "absolute from the top of this device's
-    # directory tree".
-    if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; }
+       # Special case for VMS absolute directory specs: these will have had device
+       # prepended during trip through Unix syntax in eliminate_macros(), since
+       # Unix syntax has no way to express "absolute from the top of this device's
+       # directory tree".
+       if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; }
     }
     else {
-       if ($dir =~ /^\$\([^\)]+\)\z/s) { $rslt = $dir; }
-       else                            { $rslt = vmspath($dir); }
+       if    (not defined $dir or not length $dir) { $rslt = ''; }
+       elsif ($dir =~ /^\$\([^\)]+\)\z/s)          { $rslt = $dir; }
+       else                                        { $rslt = vmspath($dir); }
     }
     return $rslt;
 }
@@ -205,7 +211,7 @@ sub catfile {
            $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
        }
     }
-    else { $rslt = vmsify($file); }
+    else { $rslt = (defined($file) && length($file)) ? vmsify($file) : ''; }
     return $rslt;
 }
 
@@ -245,7 +251,7 @@ sub rootdir {
 Returns a string representation of the first writable directory
 from the following list or '' if none are writable:
 
-    /sys$scratch
+    sys$scratch
     $ENV{TMPDIR}
 
 =cut
@@ -253,7 +259,7 @@ from the following list or '' if none are writable:
 my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
-    foreach ('/sys$scratch', $ENV{TMPDIR}) {
+    foreach ('sys$scratch', $ENV{TMPDIR}) {
        next unless defined && -d && -w _;
        $tmpdir = $_;
        last;
@@ -333,6 +339,7 @@ Split dirspec using VMS syntax.
 sub splitdir {
     my($self,$dirspec) = @_;
     $dirspec =~ s/\]\[//g;  $dirspec =~ s/\-\-/-.-/g;
+    $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal
     my(@dirs) = split('\.', vmspath($dirspec));
     $dirs[0] =~ s/^[\[<]//s;  $dirs[-1] =~ s/[\]>]\z//s;
     @dirs;
@@ -347,17 +354,25 @@ Construct a complete filespec using VMS syntax
 
 sub catpath {
     my($self,$dev,$dir,$file) = @_;
-    if ($dev =~ m|^/+([^/]+)|) { $dev =~ "$1:"; }
+    if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; }
     else { $dev .= ':' unless $dev eq '' or $dev =~ /:\z/; }
-    $dir = vmspath($dir);
+    if (length($dev) or length($dir)) {
+      $dir = "[$dir]" unless $dir =~ /[\[<\/]/;
+      $dir = vmspath($dir);
+    }
     "$dev$dir$file";
 }
 
+=item abs2rel (override)
+
+Use VMS syntax when converting filespecs.
+
+=cut
 
 sub abs2rel {
     my $self = shift;
 
-    return File::Spec::Unix::abs2rel( $self, @_ )
+    return vmspath(File::Spec::Unix::abs2rel( $self, @_ ))
         if ( join( '', @_ ) =~ m{/} ) ;
 
     my($path,$base) = @_;
@@ -413,13 +428,19 @@ sub abs2rel {
     # @pathchunks now has the directories to descend in to.
     $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ;
     $path_directories =~ s{\.\z}{} ;
-    return $self->catpath( '', $path_directories, $path_file ) ;
+    return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
 }
 
 
+=item rel2abs (override)
+
+Use VMS syntax when converting filespecs.
+
+=cut
+
 sub rel2abs($;$;) {
     my $self = shift ;
-    return File::Spec::Unix::rel2abs( $self, @_ )
+    return vmspath(File::Spec::Unix::rel2abs( $self, @_ ))
         if ( join( '', @_ ) =~ m{/} ) ;
 
     my ($path,$base ) = @_;
@@ -443,12 +464,15 @@ sub rel2abs($;$;) {
         my ( $base_volume, $base_directories, undef ) =
             $self->splitpath( $base ) ;
 
+        $path_directories = '' if $path_directories eq '[]' ||
+                                  $path_directories eq '<>';
         my $sep = '' ;
         $sep = '.'
-            if ( $base_directories =~ m{[^.]\z} &&
-                 $path_directories =~ m{^[^.]}s
+            if ( $base_directories =~ m{[^.\]>]\z} &&
+                 $path_directories =~ m{^[^.\[<]}s
             ) ;
-        $base_directories = "$base_directories$sep$path_directories" ;
+        $base_directories = "$base_directories$sep$path_directories";
+        $base_directories =~ s{\.?[\]>][\[<]\.?}{.};
 
         $path = $self->catpath( $base_volume, $base_directories, $path_file );
    }
index e44648a..da52ec5 100755 (executable)
@@ -181,24 +181,24 @@ BEGIN {
 [ "Win32->rel2abs('../','//prague_main/work')",         '\\\\prague_main\\work\\..'       ],
 
 [ "VMS->splitpath('file')",                                       ',,file'                                   ],
-[ "VMS->splitpath('[d1.d2.d3]')",                                 ',d1.d2.d3,'                               ],
-[ "VMS->splitpath('[.d1.d2.d3]')",                                ',.d1.d2.d3,'                              ],
-[ "VMS->splitpath('[d1.d2.d3]file')",                             ',d1.d2.d3,file'                           ],
-[ "VMS->splitpath('d1/d2/d3/file')",                              ',d1/d2/d3/,file'                          ],
-[ "VMS->splitpath('/d1/d2/d3/file')",                             '/d1,/d2/d3/,file'                         ],
-[ "VMS->splitpath('[.d1.d2.d3]file')",                            ',.d1.d2.d3,file'                          ],
-[ "VMS->splitpath('node::volume:[d1.d2.d3]')",                    'node::volume:,d1.d2.d3,'                  ],
-[ "VMS->splitpath('node::volume:[d1.d2.d3]file')",                'node::volume:,d1.d2.d3,file'              ],
-[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')",     'node"access_spec"::volume:,d1.d2.d3,'     ],
-[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,d1.d2.d3,file' ],
+[ "VMS->splitpath('[d1.d2.d3]')",                                 ',[d1.d2.d3],'                               ],
+[ "VMS->splitpath('[.d1.d2.d3]')",                                ',[.d1.d2.d3],'                              ],
+[ "VMS->splitpath('[d1.d2.d3]file')",                             ',[d1.d2.d3],file'                           ],
+[ "VMS->splitpath('d1/d2/d3/file')",                              ',[.d1.d2.d3],file'                          ],
+[ "VMS->splitpath('/d1/d2/d3/file')",                             'd1:,[d2.d3],file'                         ],
+[ "VMS->splitpath('[.d1.d2.d3]file')",                            ',[.d1.d2.d3],file'                          ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]')",                    'node::volume:,[d1.d2.d3],'                  ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]file')",                'node::volume:,[d1.d2.d3],file'              ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')",     'node"access_spec"::volume:,[d1.d2.d3],'     ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,[d1.d2.d3],file' ],
 
 [ "VMS->catpath('','','file')",                                       'file'                                     ],
 [ "VMS->catpath('','[d1.d2.d3]','')",                                 '[d1.d2.d3]'                               ],
 [ "VMS->catpath('','[.d1.d2.d3]','')",                                '[.d1.d2.d3]'                              ],
 [ "VMS->catpath('','[d1.d2.d3]','file')",                             '[d1.d2.d3]file'                           ],
 [ "VMS->catpath('','[.d1.d2.d3]','file')",                            '[.d1.d2.d3]file'                          ],
-[ "VMS->catpath('','d1/d2/d3','file')",                               'd1/d2/d3/file'                            ],
-[ "VMS->catpath('v','d1/d2/d3','file')",                              'd1/d2/d3/file'                            ],
+[ "VMS->catpath('','d1/d2/d3','file')",                               '[.d1.d2.d3]file'                            ],
+[ "VMS->catpath('v','d1/d2/d3','file')",                              'v:[.d1.d2.d3]file'                            ],
 [ "VMS->catpath('node::volume:','[d1.d2.d3]','')",                    'node::volume:[d1.d2.d3]'                  ],
 [ "VMS->catpath('node::volume:','[d1.d2.d3]','file')",                'node::volume:[d1.d2.d3]file'              ],
 [ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')",     'node"access_spec"::volume:[d1.d2.d3]'     ],
@@ -206,7 +206,7 @@ BEGIN {
 
 [ "VMS->canonpath('')",                                    ''                        ],
 [ "VMS->canonpath('volume:[d1]file')",                     'volume:[d1]file'         ],
-[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')",              'volume:[d1.-.d2.d3.d4.-]'  ],
+[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')",              'volume:[d2.d3]'          ],
 [ "VMS->canonpath('volume:[000000.d1]d2.dir;1')",                 'volume:[d1]d2.dir;1'   ],
 
 [ "VMS->splitdir('')",            ''          ],
@@ -218,20 +218,15 @@ BEGIN {
 [ "VMS->splitdir('.-.d2.d3')",    ',-,d2,d3'  ],
 [ "VMS->splitdir('[.-.d2.d3]')",  ',-,d2,d3'  ],
 
-# these appear to need VMS::Filespec, which won't work on other platforms
-[ "VMS->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c', 'VMS'   ],
-[ "VMS->catdir('d1','d2','d3')",                           '[.d1.d2.d3]', 'VMS' ],
-[ "VMS->catdir('d1','d2/','d3')",                          '[.d1.d2.d3]', 'VMS' ],
-[ "VMS->catdir('','d1','d2','d3')",                        '[.d1.d2.d3]', 'VMS' ],
-[ "VMS->catdir('','-','d2','d3')",                         '[-.d2.d3]',   'VMS' ],
-[ "VMS->catdir('','-','','d3')",                           '[-.d3]',      'VMS' ],
-[ "VMS->catdir('[]','<->','[]','[d3]')",                   '[-.d3]',      'VMS' ],
-[ "VMS->catdir('dir.dir','d2.dir','d3.dir')",              '[.dir.d2.d3]','VMS' ],
-[ "VMS->catdir('[.name]')",                                '[.name]',     'VMS' ],
-[ "VMS->catdir('[.name]','[.name]')",                      '[.name.name]','VMS' ],    
-
-#[ "VMS->catdir('')",                                      '[]'                 ],
-#[ "VMS->catdir('a:[.name]','b:[.name]')",                 '[.name.name]'       ],
+[ "VMS->catdir('')",                                                      ''                 ],
+[ "VMS->catdir('d1','d2','d3')",                                          '[.d1.d2.d3]'         ],
+[ "VMS->catdir('d1','d2/','d3')",                                         '[.d1.d2.d3]'         ],
+[ "VMS->catdir('','d1','d2','d3')",                                       '[.d1.d2.d3]'        ],
+[ "VMS->catdir('','-','d2','d3')",                                        '[-.d2.d3]'         ],
+[ "VMS->catdir('','-','','d3')",                                          '[-.d3]'            ],
+[ "VMS->catdir('dir.dir','d2.dir','d3.dir')",                             '[.dir.d2.d3]'        ],
+[ "VMS->catdir('[.name]')",                                               '[.name]'            ],
+[ "VMS->catdir('[.name]','[.name]')",                                     '[.name.name]'],    
 
 [  "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", ''                 ],
 [  "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]'           ],
@@ -240,19 +235,16 @@ BEGIN {
 [  "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')",              '[-.t4]'           ],
 [  "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')",             '[-]file'          ],
 [  "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')",           '[t4]'             ],
-[  "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')",              '[-.-.-.t4.t5.t6]' ],
-#[ "VMS->abs2rel('[]','[t1.t2.t3]')",                      '[-.-.-]'          ],
-#[ "VMS->abs2rel('[..]','[t1.t2.t3]')",                    '[-.-.-]'          ],
-#[ "VMS->abs2rel('[.]','[t1.t2.t3]')",                     '[-.-.-]'          ],
-#[ "VMS->abs2rel('[..]','[t1.t2.t3]')",                    '[-.-.-]'          ],
-#[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')",            '[-.t4]'           ],
-#[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')",             '[-.-.-.b]'        ],
+[  "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')",              '[---.t4.t5.t6]'   ],
+[ "VMS->abs2rel('[000000]','[t1.t2.t3]')",                 '[---.000000]'     ],
+[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')",             '[-.t4]'           ],
+[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')",              '[---.b]'          ],
 
 [ "VMS->rel2abs('[.t4]','[t1.t2.t3]')",          '[t1.t2.t3.t4]'    ],
 [ "VMS->rel2abs('[.t4.t5]','[t1.t2.t3]')",       '[t1.t2.t3.t4.t5]' ],
 [ "VMS->rel2abs('[]','[t1.t2.t3]')",             '[t1.t2.t3]'       ],
-[ "VMS->rel2abs('[-]','[t1.t2.t3]')",            '[t1.t2.t3.-]'     ],
-[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')",         '[t1.t2.t3.-.t4]'  ],
+[ "VMS->rel2abs('[-]','[t1.t2.t3]')",            '[t1.t2]'          ],
+[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')",         '[t1.t2.t4]'       ],
 [ "VMS->rel2abs('[t1]','[t1.t2.t3]')",           '[t1]'             ],
 
 [ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ],
index 31c476a..779396b 100644 (file)
@@ -86,7 +86,7 @@ some:[where.over]the.rainbow  unixify /some/where/over/the.rainbow
 /some/where/over/the.rainbow   vmsify  some:[where.over]the.rainbow
 some/where/over/the.rainbow    vmsify  [.some.where.over]the.rainbow
 ../some/where/over/the.rainbow vmsify  [-.some.where.over]the.rainbow
-some/../../where/over/the.rainbow      vmsify  [.some.--.where.over]the.rainbow
+some/../../where/over/the.rainbow      vmsify  [-.where.over]the.rainbow
 .../some/where/over/the.rainbow        vmsify  [...some.where.over]the.rainbow
 some/.../where/over/the.rainbow        vmsify  [.some...where.over]the.rainbow
 /some/.../where/over/the.rainbow       vmsify  some:[...where.over]the.rainbow
@@ -139,7 +139,7 @@ path        vmspath [.path]
 /      vmspath sys$disk:[000000]
 
 # Redundant characters in Unix paths
-//some/where//over/../the.rainbow      vmsify  some:[where.over.-]the.rainbow
+//some/where//over/../the.rainbow      vmsify  some:[where]the.rainbow
 /some/where//over/./the.rainbow        vmsify  some:[where.over]the.rainbow
 ..//../        vmspath [--]
 ./././ vmspath []
index d9231e7..af900a0 100644 (file)
@@ -1,4 +1,7 @@
-$! SUBCONFIGURE.COM - build a config.sh for VMS Perl.
+$! SUBCONFIGURE.COM
+$!  - build a config.sh for VMS Perl.
+$!  - use built config.sh to take config_h.SH -> config.h
+$!  - also take vms/descrip_mms.template -> descrip.mms (VMS Makefile)
 $!
 $! Note for folks from other platforms changing things in here:
 $!   Fancy changes (based on compiler capabilities or VMS version or
@@ -9,12 +12,12 @@ $!   or something like that) are straightforward. Adding a new item for the
 $!   ultimately created config.sh requires adding two lines to this file.
 $!
 $!   First, a line in the format:
-$!     $ perl_foo = "bar"
+$!     $ foo = "bar"
 $!   after the line tagged ##ADD NEW CONSTANTS HERE##. Replace foo with the
 $!   variable name as it appears in config.sh.
 $!
 $!   Second, add a line in the format:
-$!     $ WC "foo='" + perl_foo + "'"
+$!     $ WC "foo='" + foo + "'"
 $!   after the line tagged ##WRITE NEW CONSTANTS HERE##. Careful of the
 $!   quoting, as it can be tricky. 
 $! 
@@ -38,33 +41,32 @@ $ Dec_C_Version := "''Dec_C_Version'"
 $ Dec_C_Version = Dec_C_Version + 0
 $ Vms_Ver := "''f$extract(1,3, f$getsyi(""version""))'"
 $ perl_extensions := "''extensions'"
-$ if f$length(Mcc) .eq. 0 then Mcc := "cc"
+$ IF F$LENGTH(Mcc) .EQ. 0 THEN Mcc := "cc"
 $ MCC = f$edit(mcc, "UPCASE")
 $ C_Compiler_Replace := "CC=CC=''Mcc'''CC_flags'"
-$ if "''Using_Dec_C'" .eqs. "Yes"
+$ IF Using_Dec_C
 $ THEN
 $   Checkcc := "''Mcc'/prefix=all"
 $ ELSE
 $   Checkcc := "''Mcc'"
 $ ENDIF
 $ cc_flags = cc_flags + extra_flags
-$ if be_case_sensitive
-$ then
-$ d_vms_be_case_sensitive = "define"
-$ else
-$ d_vms_be_case_sensitive = "undef"
-$ endif
-$ if use_multiplicity .eqs. "Y"
+$ IF be_case_sensitive
+$ THEN
+$   d_vms_be_case_sensitive = "define"
+$ ELSE
+$   d_vms_be_case_sensitive = "undef"
+$ ENDIF
+$ IF use_multiplicity
 $ THEN
 $   perl_usemultiplicity = "define"
 $ ELSE
 $   perl_usemultiplicity = "undef"
 $ ENDIF
 $! Some constant defaults.
-$
 $ hwname = f$getsyi("HW_NAME")
 $ myname = myhostname
-$ if "''myname'" .eqs. "" THEN myname = f$trnlnm("SYS$NODE")
+$ IF myname .EQS. "" THEN myname = F$TRNLNM("SYS$NODE")
 $!
 $! ##ADD NEW CONSTANTS HERE##
 $ perl_shmattype = ""
@@ -135,7 +137,6 @@ $ perl_d_writev="undef"
 $ perl_i_machcthr="undef"
 $ perl_i_netdb="undef"
 $ perl_d_gnulibc="undef"
-$ perl_cf_by="unknown"
 $ perl_ccdlflags=""
 $ perl_cccdlflags=""
 $ perl_mab=""
@@ -221,7 +222,7 @@ $ perl_d_mknod="undef"
 $ perl_d_union_semun="undef"
 $ perl_d_semctl_semun="undef"
 $ perl_d_semctl_semid_ds="undef"
-$ IF (sharedperl.EQS."Y" .AND. F$GETSYI("HW_MODEL").GE.1024)
+$ IF (sharedperl .AND. F$GETSYI("HW_MODEL") .GE. 1024)
 $ THEN
 $ perl_obj_ext=".abj"
 $ perl_so="axe"
@@ -396,12 +397,12 @@ $ perl_lseektype="int"
 $ perl_i_values="undef"
 $ perl_malloctype="void *"
 $ perl_freetype="void"
-$ if "''mymalloc'".eqs."Y"
+$ IF mymalloc
 $ THEN
 $ perl_d_mymalloc="define"
 $ ELSE
 $ perl_d_mymalloc="undef"
-$ENDIF
+$ ENDIF
 $ perl_sh="MCR"
 $ perl_modetype="unsigned int"
 $ perl_ssizetype="int"
@@ -448,25 +449,23 @@ $ perl_defvoidused="15"
 $ perl_voidflags="15"
 $ perl_d_eunice="undef"
 $ perl_d_pwgecos="define"
-$ IF ("''Use_Threads'".eqs."T").and.("''VMS_VER'".LES."6.2")
+$ IF ((Use_Threads) .AND. (VMS_VER .LES. "6.2"))
 $ THEN
 $ perl_libs="SYS$SHARE:CMA$LIB_SHR.EXE/SHARE SYS$SHARE:CMA$RTL.EXE/SHARE SYS$SHARE:CMA$OPEN_LIB_SHR.exe/SHARE SYS$SHARE:CMA$OPEN_RTL.exe/SHARE"
 $ ELSE
 $ perl_libs=" "
 $ ENDIF
-$ IF ("''Using_Dec_C'".eqs."Yes")
+$ IF Using_Dec_C
 $ THEN
-$ perl_libc="(DECCRTL)"
+$   perl_libc="(DECCRTL)"
 $ ELSE
-$ perl_libc=" "
+$   perl_libc=" "
 $ ENDIF
-$ perl_PATCHLEVEL="''patchlevel'"
-$ perl_SUBVERSION="''subversion'"
 $ perl_pager="most"
 $!
 $! Are we 64 bit?
 $!
-$ if (use64bitint)
+$ IF (use64bitint)
 $ THEN
 $   perl_d_PRIfldbl = "define"
 $   perl_d_PRIgldbl = "define"
@@ -505,34 +504,19 @@ $ ENDIF
 $!
 $! Now some that we build up
 $!
-$ LocalTime = f$time()
-$ perl_cf_time= f$extract(0, 3, f$cvtime(LocalTime,, "WEEKDAY")) + " " + - 
-                f$edit(f$cvtime(LocalTime, "ABSOLUTE", "MONTH"), "LOWERCASE") + -
-                " " + f$cvtime(LocalTime,, "DAY") + " " + f$cvtime(LocalTime,, "TIME") + -
-                " " + f$cvtime(LocalTime,, "YEAR")
-$ if f$getsyi("HW_MODEL").ge.1024
-$ THEN
-$ perl_arch="VMS_AXP"
-$ perl_archname="VMS_AXP"
-$ perl_alignbytes="8"
-$ ELSE
-$ perl_arch="VMS_VAX"
-$ perl_archname="VMS_VAX"
-$ perl_alignbytes="8"
-$ ENDIF
-$ if ("''Use_Threads'".eqs."T")
+$ IF Use_Threads
 $ THEN
 $   if use_5005_threads
 $   THEN
-$     perl_arch = "''perl_arch'-thread"
-$     perl_archname = "''perl_archname'-thread"
+$     arch = "''arch'-thread"
+$     archname = "''archname'-thread"
 $     perl_d_old_pthread_create_joinable = "undef"
 $     perl_old_pthread_create_joinable = " "
 $     perl_use5005threads = "define"
 $     perl_useithreads = "undef"
 $   ELSE
-$     perl_arch = "''perl_arch'-ithread"
-$     perl_archname = "''perl_archname'-ithread"
+$     arch = "''arch'-ithread"
+$     archname = "''archname'-ithread"
 $     perl_d_old_pthread_create_joinable = "undef"
 $     perl_old_pthread_create_joinable = " "
 $     perl_use5005threads = "undef"
@@ -544,27 +528,20 @@ $   perl_old_pthread_create_joinable = " "
 $   perl_use5005threads = "undef"
 $   perl_useithreads = "undef"
 $ ENDIF
-$ perl_osvers=f$edit(osvers, "TRIM")
-$ if (perl_subversion + 0).eq.0
-$ THEN
-$ LocalPerlVer = "5_" + Perl_PATCHLEVEL
-$ ELSE
-$ LocalPerlVer = "5_" + Perl_PATCHLEVEL + perl_subversion
-$ ENDIF
 $!
 $! Some that we need to invoke the compiler for
 $ OS := "open/write SOURCECHAN []temp.c"
 $ WS := "write SOURCECHAN"
 $ CS := "close SOURCECHAN"
 $ DS := "delete/nolog []temp.*;*"
-$ Needs_Opt := "No"
-$ if ("''using_gnu_c'".eqs."Yes")
+$ Needs_Opt := N
+$ IF using_gnu_c
 $ THEN
 $   open/write OPTCHAN []temp.opt
 $   write OPTCHAN "Gnu_CC:[000000]gcclib.olb/library"
 $   write OPTCHAN "Sys$Share:VAXCRTL/Share"
 $   Close OPTCHAN
-$   Needs_Opt := "Yes"
+$   Needs_Opt := Y
 $ ENDIF
 $!
 $! Check for __STDC__
@@ -589,7 +566,7 @@ $   DEFINE SYS$OUTPUT _NLA0:
 $   ON ERROR THEN CONTINUE
 $   ON WARNING THEN CONTINUE
 $   'Checkcc' temp.c
-$   If (Needs_Opt.eqs."Yes")
+$   If Needs_Opt
 $   THEN
 $     link temp.obj,temp.opt/opt
 $   else
@@ -608,7 +585,6 @@ $   OPEN/READ TEMPOUT [-.uu]tempout.lis
 $   READ TEMPOUT line
 $   CLOSE TEMPOUT
 $   DELETE/NOLOG [-.uu]tempout.lis;
-$ 
 $ perl_cpp_stuff=line
 $ WRITE_RESULT "cpp_stuff is ''perl_cpp_stuff'"
 $!
@@ -632,7 +608,7 @@ $   DEFINE SYS$OUTPUT _NLA0:
 $   ON ERROR THEN CONTINUE
 $   ON WARNING THEN CONTINUE
 $   'Checkcc' temp.c
-$   If (Needs_Opt.eqs."Yes")
+$   If Needs_Opt
 $   THEN
 $     link temp.obj,temp.opt/opt
 $   else
@@ -681,16 +657,16 @@ $     perl_d_longdbl="undef"
 $   ELSE
 $     ON ERROR THEN CONTINUE
 $     ON WARNING THEN CONTINUE
-$     If (Needs_Opt.eqs."Yes")
+$     IF Needs_Opt
 $     THEN
-$     link temp.obj,temp.opt/opt
-$     else
+$       link temp.obj,temp.opt/opt
+$     ELSE
 $       link temp.obj
-$     endif
+$     ENDIF
 $     teststatus = f$extract(9,1,$status)
 $     DEASSIGN SYS$OUTPUT
 $     DEASSIGN SYS$ERROR
-$     if (teststatus.nes."1")
+$     IF (teststatus.nes."1")
 $     THEN
 $       perl_longdblsize="0"
 $       perl_d_longdbl="undef"
@@ -706,7 +682,6 @@ $       OPEN/READ TEMPOUT [-.uu]tempout.lis
 $       READ TEMPOUT line
 $       CLOSE TEMPOUT
 $       DELETE/NOLOG [-.uu]tempout.lis;
-$ 
 $       perl_longdblsize=line
 $       perl_d_longdbl="define"
 $     ENDIF
@@ -732,12 +707,12 @@ $   DEFINE SYS$OUTPUT _NLA0:
 $   on error then continue
 $   on warning then continue
 $   'Checkcc' temp.c
-$   If (Needs_Opt.eqs."Yes")
+$   IF Needs_Opt
 $   THEN
 $     link temp.obj,temp.opt/opt
-$   else
+$   ELSE
 $     link temp.obj
-$   endif
+$   ENDIF
 $   teststatus = f$extract(9,1,$status)
 $   DEASSIGN SYS$OUTPUT
 $   DEASSIGN SYS$ERROR
@@ -853,7 +828,6 @@ $!   Okay, failed. Must not have it
 $     perl_i_unistd = "undef"
 $   ELSE
 $     perl_i_unistd = "define"
-
 $   ENDIF
 $ WRITE_RESULT "i_unistd is ''perl_i_unistd'"
 $!
@@ -883,7 +857,6 @@ $!   Okay, failed. Must not have it
 $     perl_i_shadow = "undef"
 $   ELSE
 $     perl_i_shadow = "define"
-
 $   ENDIF
 $ WRITE_RESULT "i_shadow is ''perl_i_shadow'"
 $!
@@ -913,13 +886,12 @@ $!   Okay, failed. Must not have it
 $     perl_i_socks = "undef"
 $   ELSE
 $     perl_i_socks = "define"
-
 $   ENDIF
 $ WRITE_RESULT "i_socks is ''perl_i_socks'"
 $!
 $! Check the prototype for select
 $!
-$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T")
+$ IF Has_Dec_C_Sockets .OR. Has_Socketshr
 $ THEN
 $ OS
 $ WS "#ifdef __DECC
@@ -928,13 +900,13 @@ $ WS "#endif
 $ WS "#include <stdio.h>
 $ WS "#include <types.h>
 $ WS "#include <unistd.h>
-$ if ("''Has_Socketshr'".eqs."T")
+$ IF Has_Socketshr
 $ THEN
-$  WS "#include <socketshr.h>"
-$ else
-$  WS "#include <time.h>
-$  WS "#include <socket.h>
-$ endif
+$   WS "#include <socketshr.h>"
+$ ELSE
+$   WS "#include <time.h>
+$   WS "#include <socket.h>
+$ ENDIF
 $ WS "int main()
 $ WS "{"
 $ WS "fd_set *foo;
@@ -974,15 +946,15 @@ $ WS "#endif
 $ WS "#include <stdio.h>
 $ WS "#include <types.h>
 $ WS "#include <unistd.h>
-$ if ("''Has_Socketshr'".eqs."T")
+$ IF Has_Socketshr
 $ THEN
-$  WS "#include <socketshr.h>"
+$   WS "#include <socketshr.h>"
 $ ENDIF
-$ IF ("''Has_Dec_C_Sockets'".eqs."T")
+$ IF Has_Dec_C_Sockets
 $ THEN
-$  WS "#include <time.h>
-$  WS "#include <socket.h>
-$ endif
+$   WS "#include <time.h>
+$   WS "#include <socket.h>
+$ ENDIF
 $ WS "int main()
 $ WS "{"
 $ WS "fd_set *foo;
@@ -1034,12 +1006,12 @@ $     perl_i_inttypes="undef"
 $     DEASSIGN SYS$OUTPUT
 $     DEASSIGN SYS$ERROR
 $   ELSE
-$     If (Needs_Opt.eqs."Yes")
+$     IF Needs_Opt
 $     THEN
 $       link temp.obj,temp.opt/opt
-$     else
+$     ELSE
 $       link temp.obj
-$     endif
+$     ENDIF
 $     savedstatus = $status
 $     teststatus = f$extract(9,1,savedstatus)
 $     DEASSIGN SYS$OUTPUT
@@ -1081,12 +1053,12 @@ $     perl_d_herrno="undef"
 $     DEASSIGN SYS$OUTPUT
 $     DEASSIGN SYS$ERROR
 $   ELSE
-$     If (Needs_Opt)
+$     IF Needs_Opt
 $     THEN
 $       link temp.obj,temp.opt/opt
-$     else
+$     ELSE
 $       link temp.obj
-$     endif
+$     ENDIF
 $     savedstatus = $status
 $     teststatus = f$extract(9,1,savedstatus)
 $     DEASSIGN SYS$OUTPUT
@@ -1210,7 +1182,7 @@ $ WRITE_RESULT "d_fpos64_t is ''perl_d_fpos64_t'"
 $!
 $! Check to see if gethostname exists
 $!
-$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T")
+$ IF (Has_Dec_C_Sockets .OR. Has_Socketshr)
 $ THEN
 $ OS
 $ WS "#ifdef __DECC
@@ -1219,13 +1191,13 @@ $ WS "#endif
 $ WS "#include <stdio.h>
 $ WS "#include <types.h>
 $ WS "#include <unistd.h>
-$ if ("''Has_Socketshr'".eqs."T")
+$ IF Has_Socketshr
 $ THEN
-$  WS "#include <socketshr.h>"
-$ else
-$  WS "#include <time.h>
-$  WS "#include <socket.h>
-$ endif
+$   WS "#include <socketshr.h>"
+$ ELSE
+$   WS "#include <time.h>
+$   WS "#include <socket.h>
+$ ENDIF
 $ WS "int main()
 $ WS "{"
 $ WS "char name[100];
@@ -1248,12 +1220,12 @@ $   THEN
 $!   Okay, compile failed. Must not have it
 $     perl_d_gethname = "undef"
 $   ELSE
-$     If (Needs_Opt.eqs."Yes")
+$     IF Needs_Opt
 $     THEN
 $       link temp.obj,temp.opt/opt
-$     else
+$     ELSE
 $       link temp.obj
-$     endif
+$     ENDIF
 $     savedstatus = $status
 $     teststatus = f$extract(9,1,savedstatus)
 $     if (teststatus.nes."1")
@@ -1296,12 +1268,12 @@ $     perl_i_sysfile="undef"
 $     DEASSIGN SYS$OUTPUT
 $     DEASSIGN SYS$ERROR
 $   ELSE
-$     If (Needs_Opt.eqs."Yes")
+$     IF Needs_Opt
 $     THEN
 $       link temp.obj,temp.opt/opt
-$     else
+$     ELSE
 $       link temp.obj
-$     endif
+$     ENDIF
 $     savedstatus = $status
 $     teststatus = f$extract(9,1,savedstatus)
 $     DEASSIGN SYS$OUTPUT
@@ -1342,12 +1314,12 @@ $     perl_i_sysutsname="undef"
 $     DEASSIGN SYS$OUTPUT
 $     DEASSIGN SYS$ERROR
 $   ELSE
-$     If (Needs_Opt.eqs."Yes")
+$     IF Needs_Opt
 $     THEN
 $       link temp.obj,temp.opt/opt
-$     else
+$     ELSE
 $       link temp.obj
-$     endif
+$     ENDIF
 $     savedstatus = $status
 $     teststatus = f$extract(9,1,savedstatus)
 $     DEASSIGN SYS$OUTPUT
@@ -1388,12 +1360,12 @@ $     perl_i_syslog="undef"
 $     DEASSIGN SYS$OUTPUT
 $     DEASSIGN SYS$ERROR
 $   ELSE
-$     If (Needs_Opt.eqs."Yes")
+$     IF Needs_Opt
 $     THEN
 $       link temp.obj,temp.opt/opt
-$     else
+$     ELSE
 $       link temp.obj
-$     endif
+$     ENDIF
 $     savedstatus = $status
 $     teststatus = f$extract(9,1,savedstatus)
 $     DEASSIGN SYS$OUTPUT
@@ -1434,12 +1406,12 @@ $     perl_i_poll="undef"
 $     DEASSIGN SYS$OUTPUT
 $     DEASSIGN SYS$ERROR
 $   ELSE
-$     If (Needs_Opt.eqs."Yes")
+$     IF Needs_Opt
 $     THEN
 $       link temp.obj,temp.opt/opt
-$     else
+$     ELSE
 $       link temp.obj
-$     endif
+$     ENDIF
 $     savedstatus = $status
 $     teststatus = f$extract(9,1,savedstatus)
 $     DEASSIGN SYS$OUTPUT
@@ -1480,7 +1452,7 @@ $     perl_i_sysuio="undef"
 $     DEASSIGN SYS$OUTPUT
 $     DEASSIGN SYS$ERROR
 $   ELSE
-$     If (Needs_Opt.eqs."Yes")
+$     IF Needs_Opt
 $     THEN
 $       link temp.obj,temp.opt/opt
 $     else
@@ -3323,7 +3295,7 @@ $   perl_d_attribut="undef"
 $ ENDIF
 $
 $! Dec C >= 5.2 and VMS ver >= 7.0
-$ IF ("''Using_Dec_C'".EQS."Yes").AND.(F$INTEGER(Dec_C_Version).GE.50200000).AND.("''VMS_VER'".GES."7.0")
+$ IF (Using_Dec_C).AND.(F$INTEGER(Dec_C_Version).GE.50200000).AND.(VMS_VER .GES. "7.0")
 $ THEN
 $ perl_d_bcmp="define"
 $ perl_d_gettimeod="define"
@@ -3459,11 +3431,11 @@ $ perl_d_getservprotos="undef"
 $ perl_socksizetype="undef"
 $ ENDIF
 $! Threads
-$ if ("''use_threads'".eqs."T")
+$ IF use_threads
 $ THEN
 $   perl_usethreads="define"
 $   perl_d_pthreads_created_joinable="define"
-$   if ("''VMS_VER'".ges."7.0")
+$   if (VMS_VER .GES. "7.0")
 $   THEN
 $     perl_d_oldpthreads="undef"
 $   ELSE
@@ -3627,20 +3599,19 @@ $ perl_uvoformat="""lo"""
 $ perl_uvxformat="""lx"""
 $! 
 $! Finally the composite ones. All config
-$ perl_installarchlib="''perl_prefix':[lib.''perl_arch'.''localperlver']"
-$ perl_installsitearch="''perl_prefix':[lib.site_perl.''perl_arch']"
+$ perl_installarchlib="''perl_prefix':[lib.''archname'.''version']"
+$ perl_installsitearch="''perl_prefix':[lib.site_perl.''archname']"
 $ perl_myhostname="''myhostname'"
 $ perl_mydomain="''mydomain'"
 $ perl_perladmin="''perladmin'"
-$ perl_cf_email="''cf_email'"
-$ perl_myuname:="VMS ''myname' ''f$edit(perl_osvers, "TRIM")' ''f$edit(hwname, "TRIM")'"
-$ perl_archlibexp="''perl_prefix':[lib.''perl_arch'.''localperlver']"
-$ perl_archlib="''perl_prefix':[lib.''perl_arch'.''lovalperlver']"
-$ perl_oldarchlibexp="''perl_prefix':[lib.''perl_arch']"
-$ perl_oldarchlib="''perl_prefix':[lib.''perl_arch']"
-$ perl_sitearchexp="''perl_prefix':[lib.site_perl.''perl_arch']"
-$ perl_sitearch="''perl_prefix':[lib.site_perl.''perl_arch']"
-$ if "''Using_Dec_C'" .eqs. "Yes"
+$ perl_myuname:="''osname' ''myname' ''osvers' ''f$edit(hwname, "TRIM")'"
+$ perl_archlibexp="''perl_prefix':[lib.''archname'.''version']"
+$ perl_archlib="''perl_prefix':[lib.''archname'.''version']"
+$ perl_oldarchlibexp="''perl_prefix':[lib.''archname']"
+$ perl_oldarchlib="''perl_prefix':[lib.''archname']"
+$ perl_sitearchexp="''perl_prefix':[lib.site_perl.''archname']"
+$ perl_sitearch="''perl_prefix':[lib.site_perl.''archname']"
+$ IF Using_Dec_C
 $ THEN
 $ perl_ccflags="/Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=''perl_obj_ext'/NoList''cc_flags'"
 $ ENDIF
@@ -3653,25 +3624,23 @@ $     perl_optimize= ""
 $     perl_dbgprefix = ""
 $ endif
 $!
-$! Finally clean off any leading zeros from the patchlevel or subversion
-$ perl_patchlevel = perl_patchlevel + 0
-$ perl_subversion = perl_subversion + 0
-$!
 $! Okay, we've got everything configured. Now go write out a config.sh.
-$ open/write CONFIGSH [-]config.sh
-$ WC := "write CONFIGSH"
+$ echo4 "Creating config.sh..."
+$ open/write CONFIG [-]config.sh
+$ WC := "write CONFIG"
 $!
 $ WC "# This file generated by Configure.COM on a VMS system."
-$ WC "# Time: " + perl_cf_time
+$ WC "# Time: " + cf_time
 $ WC ""
 $ WC "CONFIGDOTSH=true"
 $ WC "package='" + perl_package + "'"
+$ WC "config_args='" + config_args + "'"
 $ WC "d_nv_preserves_uv='" + perl_d_nv_preserves_uv + "'"
 $ WC "use5005threads='" + perl_use5005threads + "'"
 $ WC "useithreads='" + perl_useithreads + "'"
 $ WC "CONFIG='" + perl_config + "'"
-$ WC "cf_time='" + perl_cf_time + "'"
-$ WC "cf_by='" + perl_cf_by+ "'"
+$ WC "cf_time='" + cf_time + "'"
+$ WC "cf_by='" + cf_by + "'"
 $ WC "cpp_stuff='" + perl_cpp_stuff + "'"
 $ WC "ccdlflags='" + perl_ccdlflags + "'"
 $ WC "cccdlflags='" + perl_cccdlflags + "'"
@@ -3694,9 +3663,8 @@ $ WC "dlsrc='dl_vms.c'"
 $ WC "binexp='" + perl_binexp + "'"
 $ WC "man1ext='" + perl_man1ext + "'"
 $ WC "man3ext='" + perl_man3ext + "'"
-$ WC "arch='" + perl_arch + "'"
-$ WC "archname='" + perl_archname + "'"
-$ WC "osvers='" + perl_osvers + "'"
+$ WC "archname='" + archname + "'"
+$ WC "osvers='" + osvers + "'"
 $ WC "prefix='" + perl_prefix + "'"
 $ WC "builddir='" + perl_builddir + "'"
 $ WC "installbin='" + perl_installbin + "'"
@@ -3749,14 +3717,14 @@ $ WC "lib_ext='" + perl_lib_ext + "'"
 $ WC "myhostname='" + perl_myhostname + "'"
 $ WC "mydomain='" + perl_mydomain + "'"
 $ WC "perladmin='" + perl_perladmin + "'"
-$ WC "cf_email='" + perl_cf_email + "'"
+$ WC "cf_email='" + cf_email + "'"
 $ WC "myuname='" + perl_myuname + "'"
-$ WC "alignbytes='" + perl_alignbytes + "'"
+$ WC "alignbytes='" + alignbytes + "'"
 $ WC "osname='" + perl_osname + "'"
 $ WC "d_archlib='" + perl_d_archlib + "'"
 $ WC "archlibexp='" + perl_archlibexp + "'"
 $ WC "archlib='" + perl_archlib + "'"
-$ WC "archname='" + perl_archname + "'"
+$ WC "archname='" + archname + "'"
 $ WC "d_bincompat3='" + perl_d_bincompat3 + "'"
 $ WC "cppstdin='" + perl_cppstdin + "'"
 $ WC "cppminus='" + perl_cppminus + "'"
@@ -3993,14 +3961,6 @@ $ WC "voidflags='" + perl_voidflags + "'"
 $ WC "d_eunice='" + perl_d_eunice + "'"
 $ WC "libs='" + perl_libs + "'"
 $ WC "libc='" + perl_libc + "'"
-$ tempstring = "PERL_VERSION='" + "''perl_patchlevel'" + "'"
-$ WC tempstring
-$ tempstring = "PERL_SUBVERSION='" + "''perl_patchlevel'" + "'"
-$ WC tempstring
-$ tempstring = "PATCHLEVEL='" + "''perl_patchlevel'" + "'"
-$ WC tempstring
-$ tempstring = "SUBVERSION='" + "''perl_SUBVERSION'" + "'"
-$ WC tempstring
 $ WC "xs_apiversion='" + localperlver + "'"
 $ WC "pm_apiversion='" + localperlver + "'"
 $ WC "pager='" + perl_pager + "'"
@@ -4238,7 +4198,7 @@ $ WC "d_vms_case_sensitive_symbols='" + d_vms_be_case_sensitive + "'"
 $!
 $! ##WRITE NEW CONSTANTS HERE##
 $!
-$ Close CONFIGSH
+$ Close CONFIG
 $
 $! Okay, we've gotten here. Build munchconfig and run it
 $ 'Perl_CC' munchconfig.c
@@ -4257,7 +4217,8 @@ $ else
 $   link munchconfig.obj
 $ endif
 $ echo ""
-$ echo "Writing config.h"
+$ echo "Doing variable substitutions on .SH files..."
+$ echo "Extracting config.h (with variable substitutions)"
 $ !
 $ ! we need an fdl file
 $ CREATE [-]CONFIG.FDL
@@ -4267,72 +4228,36 @@ $ CREATE /FDL=[-]CONFIG.FDL [-]CONFIG.LOCAL
 $ ! First spit out the header info with the local defines (to get
 $ ! around the 255 character command line limit)
 $ OPEN/APPEND CONFIG [-]config.local
-$ if use_debugging_perl.eqs."Y"
-$ THEN
-$   WRITE CONFIG "#define DEBUGGING"
-$ ENDIF
-$ if use_two_pot_malloc.eqs."Y"
-$ THEN
-$    WRITE CONFIG "#define TWO_POT_OPTIMIZE"
-$ endif
-$ if mymalloc.eqs."Y"
-$ THEN
-$    WRITE CONFIG "#define EMBEDMYMALLOC"
-$ ENDIF
-$ if use_pack_malloc.eqs."Y"
-$ THEN
-$    WRITE CONFIG "#define PACK_MALLOC"
-$ endif
-$ if use_debugmalloc.eqs."Y"
-$ THEN
-$    write config "#define DEBUGGING_MSTATS"
-$ ENDIF
-$ if "''Using_Gnu_C'" .eqs."Yes"
-$ THEN
-$   WRITE CONFIG "#define GNUC_ATTRIBUTE_CHECK"
-$ ENDIF
-$ if "''Has_Dec_C_Sockets'".eqs."T"
-$ THEN
-$    WRITE CONFIG "#define VMS_DO_SOCKETS"
-$    WRITE CONFIG "#define DECCRTL_SOCKETS"
-$ ENDIF
-$ if "''Has_Socketshr'".eqs."T"
+$ IF use_debugging_perl THEN WC "#define DEBUGGING"
+$ IF use_two_pot_malloc THEN WC "#define TWO_POT_OPTIMIZE"
+$ IF mymalloc THEN WC "#define EMBEDMYMALLOC"
+$ IF use_pack_malloc THEN WC "#define PACK_MALLOC"
+$ IF use_debugmalloc THEN WC "#define DEBUGGING_MSTATS"
+$ IF Using_Gnu_C THEN WC "#define GNUC_ATTRIBUTE_CHECK"
+$ IF (Has_Dec_C_Sockets)
 $ THEN
-$    WRITE CONFIG "#define VMS_DO_SOCKETS"
-$ ENDIF
-$! This is VMS-specific for now
-$ WRITE CONFIG "#''perl_d_setenv' HAS_SETENV"
-$ if d_alwdeftype.eqs."Y"
-$ THEN
-$    WRITE CONFIG "#define SECURE_INTERNAL_GETENV"
-$ ELSE
-$    WRITE CONFIG "#undef SECURE_INTERNAL_GETENV"
-$ ENDIF
-$ if d_secintgenv.eqs."Y"
-$ THEN
-$    WRITE CONFIG "#define ALWAYS_DEFTYPES"
+$    WC "#define VMS_DO_SOCKETS"
+$    WC "#define DECCRTL_SOCKETS"
 $ ELSE
-$    WRITE CONFIG "#undef ALWAYS_DEFTYPES"
+$    IF Has_Socketshr THEN WC "#define VMS_DO_SOCKETS"
 $ ENDIF
+$! This is VMS-specific for now
+$ WC "#''perl_d_setenv' HAS_SETENV"
+$ IF d_secintgenv THEN WC "#define SECURE_INTERNAL_GETENV"
+$ if d_alwdeftype THEN WC "#define ALWAYS_DEFTYPES"
 $ IF (use64bitint)
 $ THEN
-$    WRITE CONFIG "#define USE_64_BIT_INT"
-$    WRITE CONFIG "#define USE_LONG_DOUBLE"
+$    WC "#define USE_64_BIT_INT"
+$    WC "#define USE_LONG_DOUBLE"
 $ ENDIF
-$ IF (use64bitall)
-$ THEN
-$    WRITE CONFIG "#define USE_64_BIT_ALL"
-$ ENDIF
-$ if be_case_sensitive
-$ then
-$    write config "#define VMS_WE_ARE_CASE_SENSITIVE"
-$ endif
+$ IF use64bitall THEN WC "#define USE_64_BIT_ALL"
+$ IF be_case_sensitive THEN WC "#define VMS_WE_ARE_CASE_SENSITIVE"
 $ if perl_d_herrno .eqs. "undef"
 $ THEN
-$    write config "#define NEED_AN_H_ERRNO"
+$    WC "#define NEED_AN_H_ERRNO"
 $ ENDIF
-$ WRITE CONFIG "#define HAS_ENVGETENV"
-$ WRITE CONFIG "#define PERL_EXTERNAL_GLOB"
+$ WC "#define HAS_ENVGETENV"
+$ WC "#define PERL_EXTERNAL_GLOB"
 $ CLOSE CONFIG
 $!
 $! Now build the normal config.h
@@ -4345,32 +4270,32 @@ $ DELETE/NOLOG [-]CONFIG.MAIN;*
 $ DELETE/NOLOG [-]CONFIG.LOCAL;*
 $ DELETE/NOLOG [-]CONFIG.FDL;*
 $!
-$ if "''Using_Dec_C'" .eqs."Yes"
+$ IF Using_Dec_C
 $ THEN
-$ DECC_REPLACE = "DECC=decc=1"
+$   DECC_REPLACE = "DECC=decc=1"
 $ ELSE
-$ DECC_REPLACE = "DECC=" 
+$   DECC_REPLACE = "DECC=" 
 $ ENDIF
-$ if "''Using_Gnu_C'" .eqs."Yes"
+$ IF Using_Gnu_C
 $ THEN
-$ GNUC_REPLACE = "GNUC=gnuc=1"
+$   GNUC_REPLACE = "GNUC=gnuc=1"
 $ ELSE
-$ GNUC_REPLACE = "GNUC=" 
+$   GNUC_REPLACE = "GNUC=" 
 $ ENDIF
-$ if "''Has_Dec_C_Sockets'" .eqs."T"
+$ IF Has_Dec_C_Sockets
 $ THEN
 $   SOCKET_REPLACE = "SOCKET=DECC_SOCKETS=1"
 $ ELSE
-$   if "''Has_Socketshr'" .eqs."T"
+$   IF Has_Socketshr
 $   THEN
 $     SOCKET_REPLACE = "SOCKET=SOCKETSHR_SOCKETS=1"
 $   ELSE
 $     SOCKET_REPLACE = "SOCKET="
 $   ENDIF
 $ ENDIF
-$ IF ("''Use_Threads'".eqs."T")
+$ IF (Use_Threads)
 $ THEN
-$   if ("''VMS_VER'".LES."6.2")
+$   IF (VMS_VER .LES. "6.2")
 $   THEN
 $     THREAD_REPLACE = "THREAD=OLDTHREADED=1"
 $   ELSE
@@ -4379,24 +4304,18 @@ $   ENDIF
 $ ELSE
 $   THREAD_REPLACE = "THREAD="
 $ ENDIF
-$ if mymalloc.eqs."Y"
+$ IF mymalloc
 $ THEN
 $   MALLOC_REPLACE = "MALLOC=MALLOC=1"
 $ ELSE
 $   MALLOC_REPLACE = "MALLOC="
 $ ENDIF
-$ if f$getsyi("HW_MODEL").ge.1024
-$ THEN
-$ ARCH_TYPE = "ARCH-TYPE=__AXP__"
-$ ELSE
-$ ARCH_TYPE = "ARCH-TYPE=__VAX__"
-$ ENDIF
-$ echo "Writing DESCRIP.MMS"
+$ echo "Extracting ''defmakefile' (with variable substitutions)"
 $!set ver
-$ define/user sys$output [-]descrip.mms
+$ define/user sys$output 'UUmakefile 
 $ mcr []munchconfig [-]config.sh descrip_mms.template "''DECC_REPLACE'" "''ARCH_TYPE'" "''GNUC_REPLACE'" "''SOCKET_REPLACE'" "''THREAD_REPLACE'" -
-"''C_Compiler_Replace'" "''MALLOC_REPLACE'" "''Thread_Live_Dangerously'" "PV=''LocalPerlVer'" "FLAGS=FLAGS=''extra_flags'"
-$ echo "Extracting Build_Ext.Com"
+"''C_Compiler_Replace'" "''MALLOC_REPLACE'" "''Thread_Live_Dangerously'" "PV=''version'" "FLAGS=FLAGS=''extra_flags'"
+$ echo "Extracting Build_Ext.Com (without variable substitutions)"
 $ Create Sys$Disk:[-]Build_Ext.Com
 $ Deck/Dollar="$EndOfTpl$"
 $!++ Build_Ext.Com
@@ -4456,5 +4375,5 @@ $
 $! set nover
 $!
 $! Clean up after ourselves
-$ delete/nolog munchconfig.exe;*
-$ delete/nolog munchconfig.obj;*
+$ DELETE/NOLOG/NOCONFIRM munchconfig.exe;
+$ DELETE/NOLOG/NOCONFIRM munchconfig.obj;
index e063e7f..c18ca49 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -106,7 +106,7 @@ int
 vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
   struct dsc$descriptor_s **tabvec, unsigned long int flags)
 {
-    char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2;
+    char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2;
     unsigned short int eqvlen, curtab, ivlnm = 0, ivsym = 0, ivenv = 0, secure;
     unsigned long int retsts, attr = LNM$M_CASE_BLIND;
     unsigned char acmode;
@@ -141,6 +141,7 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
     }
     lnmdsc.dsc$w_length = cp1 - lnm;
     lnmdsc.dsc$a_pointer = uplnm;
+    uplnm[lnmdsc.dsc$w_length] = '\0';
     secure = flags & PERL__TRNENV_SECURE;
     acmode = secure ? PSL$C_EXEC : PSL$C_USER;
     if (!tabvec || !*tabvec) tabvec = env_tables;
@@ -210,6 +211,19 @@ vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
         retsts = sys$trnlnm(&attr,tabvec[curtab],&lnmdsc,&acmode,lnmlst);
         if (retsts == SS$_IVLOGNAM) { ivlnm = 1; continue; }
         if (retsts == SS$_NOLOGNAM) continue;
+        /* PPFs have a prefix */
+        if (
+#if INTSIZE == 4
+             *((int *)uplnm) == *((int *)"SYS$")                    &&
+#endif
+             eqvlen >= 4 && eqv[0] == 0x1b && eqv[1] == 0x00        &&
+             ( (uplnm[4] == 'O' && !strcmp(uplnm,"SYS$OUTPUT"))  ||
+               (uplnm[4] == 'I' && !strcmp(uplnm,"SYS$INPUT"))   ||
+               (uplnm[4] == 'E' && !strcmp(uplnm,"SYS$ERROR"))   ||
+               (uplnm[4] == 'C' && !strcmp(uplnm,"SYS$COMMAND")) )  ) {
+          memcpy(eqv,eqv+4,eqvlen-4);
+          eqvlen -= 4;
+        }
         break;
       }
     }
@@ -2163,12 +2177,16 @@ static char *do_tovmsspec(char *path, char *buf, int ts) {
     else if (!infront && *cp2 == '.') {
       if (cp2+1 == dirend || *(cp2+1) == '\0') { cp2++; break; }
       else if (*(cp2+1) == '/') cp2++;   /* skip over "./" - it's redundant */
-      else if (*(cp2+1) == '.' && (*(cp2+2) == '/' || *(cp2+2) == '\0')) { /* handle "../" */
-        if (*(cp1-1) == '-' || *(cp1-1) == '[') *(cp1++) = '-'; 
+      else if (*(cp2+1) == '.' && (*(cp2+2) == '/' || *(cp2+2) == '\0')) {
+        if (*(cp1-1) == '-' || *(cp1-1) == '[') *(cp1++) = '-'; /* handle "../" */
         else if (*(cp1-2) == '[') *(cp1-1) = '-';
-        else {
-/*          if (*(cp1-1) != '.') *(cp1++) = '.'; */
-          *(cp1++) = '-';
+        else {  /* back up over previous directory name */
+          cp1--;
+          while (*(cp1-1) != '.' && *(cp1-1) != '[') cp1--;
+          if (*(cp1-1) == '[') {
+            memcpy(cp1,"000000.",7);
+            cp1 += 7;
+          }
         }
         cp2 += 2;
         if (cp2 == dirend) break;