[PATCH 5.004_60] Fix to MM_VMS.PM

Date: Thu, 26 Feb 1998 11:09:55 -0800
Subject: [PATCH 5.004_60] Get SDBM_File working on VMS
Date: Thu, 26 Feb 1998 11:15:24 -0800

p4raw-id: //depot/perl@594

diff --git a/ext/SDBM_File/Makefile.PL b/ext/SDBM_File/Makefile.PL
index 02dfd7d..c0daa06 100644 (file)
--- a/ext/SDBM_File/Makefile.PL
+++ b/ext/SDBM_File/Makefile.PL
@@ -6,21 +6,37 @@ use ExtUtils::MakeMaker;
 # which perform the corresponding actions in the subdirectory.
 
 $define = ($^O eq 'MSWin32') ? '-DMSDOS' : '';
+if ($^O eq 'MSWin32') {
+  $myextlib = 'sdbm\\libsdbm$(LIB_EXT)';
+} elsif ($^O eq 'VMS') {
+  $myextlib = 'sdbm/libsdbm$(LIB_EXT)';
+} else {
+  $myextlib = 'sdbm/libsdbm$(LIB_EXT)';  
+}
 
 WriteMakefile(
-    NAME       => 'SDBM_File',
-    MYEXTLIB => 'sdbm'.($^O eq 'MSWin32' ? '\\' : '/').'libsdbm$(LIB_EXT)',
-    MAN3PODS   => ' ',         # Pods will be built by installman.
-    XSPROTOARG => '-noprototypes',             # XXX remove later?
-    VERSION_FROM => 'SDBM_File.pm',
-    DEFINE => $define,
-);
-
+              NAME     => 'SDBM_File',
+              MYEXTLIB => $myextlib,
+              MAN3PODS         => ' ',         # Pods will be built by installman.
+              XSPROTOARG => '-noprototypes',           # XXX remove later?
+              VERSION_FROM => 'SDBM_File.pm',
+              DEFINE => $define,
+#              NORECURS => $^O eq 'VMS',
+#              SKIP => $^O eq 'VMS' ? 'subdirs' : '', # Don't do the subdirs section for VMS
+             );
 
 sub MY::postamble {
+  if ($^O ne 'VMS') {
     '
 $(MYEXTLIB): sdbm/Makefile
        cd sdbm && $(MAKE) all
 ';
+  } else {
+  '   
+$(MYEXTLIB): [.sdbm]descrip.mms
+       set def [.sdbm]
+    $(MMS) all
+    set def [-]
+';  
+  }
 }
-

diff --git a/ext/SDBM_File/sdbm/Makefile.PL b/ext/SDBM_File/sdbm/Makefile.PL
index 50fd83e..e9d4dcd 100644 (file)
--- a/ext/SDBM_File/sdbm/Makefile.PL
+++ b/ext/SDBM_File/sdbm/Makefile.PL
@@ -5,11 +5,11 @@ $define .= ' -DWIN32' if ($^O eq 'MSWin32');
 
 WriteMakefile(
     NAME      => 'sdbm', # (doesn't matter what the name is here) oh yes it does
-    LINKTYPE  => 'static',
+#    LINKTYPE  => 'static',
     DEFINE    => $define,
     INC       => '-I$(PERL_INC)', # force PERL_INC dir ahead of system -I's
     SKIP      => [qw(dynamic dynamic_lib)],
-    OBJECT    => '$(O_FILES)',
+    OBJECT    => ($^O eq 'VMS') ? 'sdbm.obj pair.obj hash.obj' : '$(O_FILES)',
     clean     => {'FILES' => 'dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag'},
     H         => [qw(tune.h sdbm.h pair.h $(PERL_INC)/config.h)],
     C         => [qw(sdbm.c pair.c hash.c)]

diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h
index ac2dc36..b3ed2d4 100644 (file)
--- a/ext/SDBM_File/sdbm/sdbm.h
+++ b/ext/SDBM_File/sdbm/sdbm.h
@@ -9,7 +9,11 @@
 #define PAIRMAX 1008                   /* arbitrary on PBLKSIZ-N */
 #define SPLTMAX        10                      /* maximum allowed splits */
                                        /* for a single insertion */
+#ifdef VMS
+#define DIRFEXT        ".sdbm_dir"
+#else
 #define DIRFEXT        ".dir"
+#endif
 #define PAGFEXT        ".pag"
 
 typedef struct {
@@ -116,11 +120,15 @@ extern long sdbm_hash proto((char *, int));
 #include <ctype.h>
 #include <setjmp.h>
 
-#ifdef I_UNISTD
+#if defined(I_UNISTD) || defined(VMS)
 #include <unistd.h>
 #endif
 
-#if !defined(MSDOS) && !defined(WIN32)
+#ifdef VMS
+# include <fcntl.h>
+#endif
+
+#if !defined(MSDOS) && !defined(WIN32) && !defined(VMS)
 #   ifdef PARAM_NEEDS_TYPES
 #      include <sys/types.h>
 #   endif
@@ -237,7 +245,7 @@ extern long sdbm_hash proto((char *, int));
 #  endif
 #else
 #   ifndef memcmp
-#      /* maybe we should have included the full embedding header... */
+       /* maybe we should have included the full embedding header... */
 #      ifdef NO_EMBED
 #          define memcmp my_memcmp
 #      else
@@ -264,7 +272,11 @@ extern long sdbm_hash proto((char *, int));
 #endif
 
 #ifdef I_NETINET_IN
-#   include <netinet/in.h>
+#  ifdef VMS
+#    include <in.h>
+#  else
+#    include <netinet/in.h>
+#  endif
 #endif
 
 #endif /* Include guard */

diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm
index dc3b4ce..954f612 100644 (file)
--- a/lib/ExtUtils/MM_VMS.pm
+++ b/lib/ExtUtils/MM_VMS.pm
@@ -1422,7 +1422,21 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
 
     push(@m,'
        If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
+');
+    # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
+    # 'cause it's a library and you can't stick them in other libraries.
+    # In that case, we use $OBJECT instead and hope for the best
+    if ($self->{MYEXTLIB}) {
+      push(@m,'
+       Library/Object/Replace $(MMS$TARGET) $(OBJECT)
+'); 
+    } else {
+      push(@m,'
        Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
+'); 
+    }
+    
+    push(@m, '
        $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"
 ');
     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');

diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t
index ce3003e..3ab609c 100755 (executable)
--- a/t/lib/anydbm.t
+++ b/t/lib/anydbm.t
@@ -12,15 +12,15 @@ use Fcntl;
 
 print "1..12\n";
 
-unlink <Op.dbmx*>;
+unlink <Op_dbmx.*>;
 
 umask(0);
-print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640)
+print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
        ? "ok 1\n" : "not ok 1\n");
 
-$Dfile = "Op.dbmx.pag";
+$Dfile = "Op_dbmx.pag";
 if (! -e $Dfile) {
-       ($Dfile) = <Op.dbmx*>;
+       ($Dfile) = <Op_dbmx.*>;
 }
 if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
     print "ok 2 # Skipped: different file permission semantics\n";
@@ -55,7 +55,7 @@ $h{'goner2'} = 'snork';
 delete $h{'goner2'};
 
 untie(%h);
-print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
 
 $h{'j'} = 'J';
 $h{'k'} = 'K';
@@ -118,4 +118,8 @@ print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
 print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
 untie %h;
-unlink 'Op.dbmx.dir', $Dfile;
+if ($^O eq 'VMS') {
+  unlink 'Op_dbmx.sdbm_dir', $Dfile;
+} else {
+  unlink 'Op_dbmx.dir', $Dfile;  
+}

diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t
index c2952ec..591fe14 100755 (executable)
--- a/t/lib/sdbm.t
+++ b/t/lib/sdbm.t
@@ -6,7 +6,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require Config; import Config;
-    if ($Config{'extensions'} !~ /\bSDBM_File\b/) {
+    if (($Config{'extensions'} !~ /\bSDBM_File\b/) && ($^O ne 'VMS')){
        print "1..0\n";
        exit 0;
     }
@@ -17,15 +17,15 @@ use Fcntl;
 
 print "1..18\n";
 
-unlink <Op.dbmx*>;
+unlink <Op_dbmx.*>;
 
 umask(0);
-print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640)
+print (tie(%h,SDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
        ? "ok 1\n" : "not ok 1\n");
 
-$Dfile = "Op.dbmx.pag";
+$Dfile = "Op_dbmx.pag";
 if (! -e $Dfile) {
-       ($Dfile) = <Op.dbmx*>;
+       ($Dfile) = <Op_dbmx.*>;
 }
 if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
     print "ok 2 # Skipped: different file permission semantics\n";
@@ -60,7 +60,7 @@ $h{'goner2'} = 'snork';
 delete $h{'goner2'};
 
 untie(%h);
-print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+print (tie(%h,SDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
 
 $h{'j'} = 'J';
 $h{'k'} = 'K';
@@ -123,7 +123,12 @@ print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
 print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
 untie %h;
-unlink 'Op.dbmx.dir', $Dfile;
+if ($^O eq 'VMS') {
+  unlink 'Op_dbmx.sdbm_dir', $Dfile;
+} else {
+  unlink 'Op_dbmx.dir', $Dfile;
+}
+
 
 sub ok
 {
@@ -187,7 +192,7 @@ EOM
     my %h ;
     my $X ;
     eval '
-       $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+       $X = tie(%h, "SubDB","dbhash_tmp", O_RDWR|O_CREAT, 0640 );
        ' ;
 
     main::ok(14, $@ eq "") ;
@@ -202,6 +207,6 @@ EOM
 
     undef $X;
     untie(%h);
-    unlink "SubDB.pm", <dbhash.tmp*> ;
+    unlink "SubDB.pm", <dbhash_tmp.*> ;
 
 }

diff --git a/vms/descrip.mms b/vms/descrip.mms
index adbcb1c..5f05509 100644 (file)
--- a/vms/descrip.mms
+++ b/vms/descrip.mms
@@ -74,7 +74,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O)
 .endif
 
 # Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00456#
+PERL_VERSION = 5_00460#
 
 .ifdef DECC_SOCKETS
 SOCKET=1
@@ -345,7 +345,7 @@ all : base extras x2p archcorefiles preplibrary perlpods
 .endif
 base : miniperl perl
        @ $(NOOP)
-extras : Fcntl IO Opcode attrs $(POSIX) $(THREAD) libmods utils podxform
+extras : Fcntl IO Opcode attrs $(POSIX) $(THREAD) SDBM_File libmods utils podxform
        @ $(NOOP)
 libmods : $(LIBPREREQ)
        @ $(NOOP)
@@ -556,6 +556,26 @@ THREAD : [.lib]THREAD.pm [.lib.auto.THREAD]THREAD$(E)
 [.ext.THREAD]Descrip.MMS : [.ext.THREAD]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
        $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.THREAD]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
 
+SDBM_File : [.lib]SDBM_File.pm [.lib.auto.SDBM_File]SDBM_File$(E) 
+       @ $(NOOP)
+
+[.lib]SDBM_File.pm : [.ext.SDBM_File]Descrip.MMS
+       @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+       @ If F$Search("[.lib.auto]sdbm.dir").eqs."" Then Create/Directory [.lib.auto.sdbm]
+       @ Set Default [.ext.SDBM_File]
+       $(MMS)
+       @ Set Default [--]
+
+[.lib.auto.SDBM_File]SDBM_File$(E) : [.ext.SDBM_File]Descrip.MMS
+       @ Set Default [.ext.SDBM_File]
+       $(MMS)
+       @ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.SDBM_File]Descrip.MMS : [.ext.SDBM_File]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
+       $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.SDBM_File]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
 IO : [.lib]IO.pm [.lib.IO]File.pm [.lib.IO]Handle.pm [.lib.IO]Pipe.pm [.lib.IO]Seekable.pm [.lib.IO]Socket.pm [.lib.auto.IO]IO$(E)
        @ $(NOOP)
 
@@ -1172,6 +1192,9 @@ clean : tidy
        - $(MMS) clean
        Set Default [--]
 .endif
+    Set Default [.ext.SDBM_File]
+    - $(MMS) clean
+    Set Default [--]
        - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt
        - If F$Search("[...]*$(O);*") .nes."" Then Delete/NoConfirm/Log [...]*$(O);*
        - If F$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;*
@@ -1215,6 +1238,9 @@ realclean : clean
        - $(MMS) realclean
        Set Default [--]
 .endif
+    Set Default [.ext.SDBM_File]
+    - $(MMS) realclean
+    Set Default [--]
        - If F$Search("*$(OLB)").nes."" Then Delete/NoConfirm/Log *$(OLB);*
        - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*
        - $(MINIPERL) -e "use File::Path; rmtree(['lib/auto','lib/VMS','lib/$(ARCH)'],1,0);"

diff --git a/vms/perlvms.pod b/vms/perlvms.pod
index c599e58..4aa6800 100644 (file)
--- a/vms/perlvms.pod
+++ b/vms/perlvms.pod
@@ -329,7 +329,12 @@ undefined behavior (rarely, we hope):
     getgrnam, setgrent, endgrent, ioctl, link, lstat,
     msgctl, msgget, msgsend, msgrcv, readlink, semctl,
     semget, semop, setpgrp, setpriority, shmctl, shmget,
-    shmread, shmwrite, socketpair, symlink, syscall, truncate
+    shmread, shmwrite, socketpair, symlink, syscall
+
+The following functions are available on Perls compiled with Dec C 5.2 or
+greater and running VMS 7.0 or greater
+
+    truncate
 
 The following functions may or may not be implemented, 
 depending on what type of socket support you've built into 
@@ -749,12 +754,23 @@ it's equivalent to calling fflush() and fsync() from C.
 
 =back
 
+=head1 Standard modules with VMS-specific differences
+
+=head2 SDBM_File
+
+SDBM_File works peroperly on VMS. It has, however, one minor
+difference. The database directory file created has a L<.sdbm_dir>
+extension rather than a L<.dir> extension. L<.dir> files are VMS filesystem
+directory files, and using them for other purposes could cause unacceptable
+problems.
+
 =head1 Revision date
 
-This document was last updated on 28-Feb-1996, for Perl 5, 
-patchlevel 2.
+This document was last updated on 26-Feb-1998, for Perl 5, 
+patchlevel 5.
 
 =head1 AUTHOR
 
-Charles Bailey  bailey@genetics.upenn.edu
+Charles Bailey  bailey@cor.newman.upenn.edu
 
+Last revision by Dan Sugalski  sugalskd@ous.edu

diff --git a/vms/test.com b/vms/test.com
index 201b5f5..7786a17 100644 (file)
--- a/vms/test.com
+++ b/vms/test.com
@@ -91,10 +91,9 @@ use Config;
 
 @compexcl=('cpp.t');
 @ioexcl=('argv.t','dup.t','fs.t','inplace.t','pipe.t');
-@libexcl=('anydbm.t','db-btree.t','db-hash.t','db-recno.t',
+@libexcl=('db-btree.t','db-hash.t','db-recno.t',
           'gdbm.t','io_dup.t', 'io_pipe.t', 'io_sel.t', 'io_sock.t',
-          'ndbm.t','odbm.t','open2.t','open3.t','posix.t',
-          'sdbm.t');
+          'ndbm.t','odbm.t','open2.t','open3.t','posix.t');
 
 # Note: POSIX is not part of basic build, but can be built
 # separately if you're using DECC