From: Hans Mulder Date: Thu, 26 Feb 1998 11:09:55 +0000 (-0800) Subject: [PATCH 5.004_60] Fix to MM_VMS.PM X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf99883da2fbc1b4d546abddb96990a37466b881;p=p5sagit%2Fp5-mst-13.2.git [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 --- 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 --- 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 --- 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 #include -#ifdef I_UNISTD +#if defined(I_UNISTD) || defined(VMS) #include #endif -#if !defined(MSDOS) && !defined(WIN32) +#ifdef VMS +# include +#endif + +#if !defined(MSDOS) && !defined(WIN32) && !defined(VMS) # ifdef PARAM_NEEDS_TYPES # include # 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 +# ifdef VMS +# include +# else +# include +# endif #endif #endif /* Include guard */ diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index dc3b4ce..954f612 100644 --- 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 --- a/t/lib/anydbm.t +++ b/t/lib/anydbm.t @@ -12,15 +12,15 @@ use Fcntl; print "1..12\n"; -unlink ; +unlink ; 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) = ; + ($Dfile) = ; } 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 --- 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 ; +unlink ; 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) = ; + ($Dfile) = ; } 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", ; + unlink "SubDB.pm", ; } diff --git a/vms/descrip.mms b/vms/descrip.mms index adbcb1c..5f05509 100644 --- 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 +# ${@} 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 --- 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 --- 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