[SV 41758]: Fix archive support for VMS.

Upated to match change to run_make_tests and some future fixes to
make on VMS.

* arscan.c: Use ANSI compatible pragmas instead of VAX C extensions.
* tests/scripts/features/archives: Fix tests to use VMS rules and
answers when running on VMS and using DCL as a shell.
* tests/scripts/features/vpath3: Fix epected answer on test when
run on VMS.
* tests/scripts/vms/library: (New) Test the VMS library rules that
are not tested by existing tests.

4 files changed, 220 insertions, 26 deletions

diff --git a/arscan.c b/arscan.c
index 24286fd..a3c2b8b 100644
--- a/arscan.c
+++ b/arscan.c
@@ -38,12 +38,18 @@ this program.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <ssdef.h>
 #include <stsdef.h>
 #include <rmsdef.h>
-globalvalue unsigned int LBR$_HDRTRUNC;
 
-#if __DECC
+/* This symbol should be present in lbrdef.h. */
+#ifndef LBR$_HDRTRUNC
+#pragma extern_model save
+#pragma extern_model globalvalue
+extern unsigned int LBR$_HDRTRUNC;
+#pragma extern_model restore
+#endif
+
 #include <unixlib.h>
 #include <lbr$routines.h>
-#endif
+
 const char *
 vmsify (const char *name, int type);
 
diff --git a/tests/scripts/features/archives b/tests/scripts/features/archives
index b0acfec..f037d2f 100644
--- a/tests/scripts/features/archives
+++ b/tests/scripts/features/archives
@@ -9,68 +9,161 @@ This only works on systems that support it.";
 exists $FEATURES{archives} or return -1;
 
 # Create some .o files to work with
-utouch(-60, qw(a1.o a2.o a3.o));
+if ($osname eq 'VMS') {
+  use Cwd;
+  my $pwd = getcwd;
+  # VMS AR needs real object files at this time.
+  foreach $afile ('a1', 'a2', 'a3') {
+    # Use non-standard extension to prevent implicit rules from recreating
+    # objects when the test tampers with the timestamp.
+    1 while unlink "$afile.c1";
+    1 while unlink "$afile.o";
+    open (MYFILE, ">$afile.c1");
+    print MYFILE "int $afile(void) {return 1;}\n";
+    close MYFILE;
+    system("cc $afile.c1 /object=$afile.o");
+  }
+} else {
+  utouch(-60, qw(a1.o a2.o a3.o));
+}
 
 my $ar = $CONFIG_FLAGS{AR};
 
+# Fallback if configure did not find AR, such as VMS
+# which does not run configure.
+$ar = 'ar' if $ar eq '';
+
+my $redir = " 2>&1";
+$redir = "" if $osname eq 'VMS';
+
 # Some versions of ar print different things on creation.  Find out.
-my $created = `$ar rv libxx.a a1.o 2>&1`;
+my $created = `$ar rv libxx.a a1.o $redir`;
 
 # Some versions of ar print different things on add.  Find out.
-my $add = `$ar rv libxx.a a2.o 2>&1`;
+my $add = `$ar rv libxx.a a2.o $redir`;
 $add =~ s/a2\.o/#OBJECT#/g;
 
 # Some versions of ar print different things on replacement.  Find out.
-my $repl = `$ar rv libxx.a a2.o 2>&1`;
+my $repl = `$ar rv libxx.a a2.o $redir`;
 $repl =~ s/a2\.o/#OBJECT#/g;
 
 unlink('libxx.a');
 
 # Very simple
+my $answer = "$ar rv libxx.a a1.o\n$created";
+if ($port_type eq 'VMS-DCL') {
+  $answer = 'library /replace libxx.a a1.o';
+}
 run_make_test('all: libxx.a(a1.o)',
-              '', "$ar rv libxx.a a1.o\n$created");
+              '', $answer);
 
 # Multiple .o's.  Add a new one to the existing library
 ($_ = $add) =~ s/#OBJECT#/a2.o/g;
+
+$answer = "$ar rv libxx.a a2.o\n$_";
+if ($port_type eq 'VMS-DCL') {
+  $answer = 'library /replace libxx.a a2.o';
+}
 run_make_test('all: libxx.a(a1.o a2.o)',
-              '', "$ar rv libxx.a a2.o\n$_");
+              '', $answer);
 
 # Touch one of the .o's so it's rebuilt
-utouch(-40, 'a1.o');
+if ($port_type eq 'VMS-DCL') {
+  # utouch is not changing what VMS library compare is testing for.
+  # So do a real change by regenerating the file.
+  1 while unlink('a1.o');
+  # Later time stamp than last insertion.
+  sleep(2);
+  system('cc a1.c1 /object=a1.o');
+  # Next insertion will have a later timestamp.
+  sleep(2);
+} else {
+  utouch(-40, 'a1.o');
+}
+
 ($_ = $repl) =~ s/#OBJECT#/a1.o/g;
-run_make_test(undef, '', "$ar rv libxx.a a1.o\n$_");
+$answer = "$ar rv libxx.a a1.o\n$_";
+if ($port_type eq 'VMS-DCL') {
+  $answer = 'library /replace libxx.a a1.o';
+}
+run_make_test(undef, '', $answer);
 
 # Use wildcards
+$answer = "#MAKE#: Nothing to be done for 'all'.\n";
 run_make_test('all: libxx.a(*.o)',
-              '', "#MAKE#: Nothing to be done for 'all'.\n");
+              '', $answer);
 
 # Touch one of the .o's so it's rebuilt
-utouch(-30, 'a1.o');
+if ($port_type eq 'VMS-DCL') {
+  # utouch is not changing what VMS library compare is testing for.
+  # So do a real change by regenerating the file.
+  1 while unlink('a1.o');
+  # Make timestamp later than last insertion.
+  sleep(2);
+  system('cc a1.c1 /object=a1.o');
+} else {
+  utouch(-30, 'a1.o');
+}
 ($_ = $repl) =~ s/#OBJECT#/a1.o/g;
-run_make_test(undef, '', "$ar rv libxx.a a1.o\n$_");
+$answer = "$ar rv libxx.a a1.o\n$_";
+if ($port_type eq 'VMS-DCL') {
+  $answer = 'library /replace libxx.a a1.o';
+}
+run_make_test(undef, '', $answer);
 
 # Use both wildcards and simple names
-utouch(-50, 'a2.o');
+if ($port_type eq 'VMS-DCL') {
+  # utouch is not changing what VMS library compare is testing for.
+  # So do a real change by regenerating the file.
+  1 while unlink('a2.o');
+  sleep(2);
+  system('cc a2.c1 /object=a2.o');
+} else {
+  utouch(-50, 'a2.o');
+}
 ($_ = $add) =~ s/#OBJECT#/a3.o/g;
 $_ .= "$ar rv libxx.a a2.o\n";
 ($_ .= $repl) =~ s/#OBJECT#/a2.o/g;
+$answer = "$ar rv libxx.a a3.o\n$_";
+if ($port_type eq 'VMS-DCL') {
+  $answer = 'library /replace libxx.a a3.o';
+}
+
 run_make_test('all: libxx.a(a3.o *.o)', '',
-              "$ar rv libxx.a a3.o\n$_");
+              $answer);
 
 # Check whitespace handling
-utouch(-40, 'a2.o');
+if ($port_type eq 'VMS-DCL') {
+  # utouch is not changing what VMS library compare is testing for.
+  # So do a real change by regenerating the file.
+  1 while unlink('a2.o');
+  sleep(2);
+  system('cc a2.c1 /object=a2.o');
+} else {
+  utouch(-40, 'a2.o');
+}
 ($_ = $repl) =~ s/#OBJECT#/a2.o/g;
+$answer = "$ar rv libxx.a a2.o\n$_";
+if ($port_type eq 'VMS-DCL') {
+  $answer = 'library /replace libxx.a a2.o';
+}
 run_make_test('all: libxx.a(  a3.o    *.o     )', '',
-              "$ar rv libxx.a a2.o\n$_");
+              $answer);
 
-rmfiles(qw(a1.o a2.o a3.o libxx.a));
+rmfiles(qw(a1.c1 a2.c1 a3.c1 a1.o a2.o a3.o libxx.a));
 
 # Check non-archive targets
 # See Savannah bug #37878
-run_make_test(q!
+$mk_string = q!
 all: foo(bar).baz
 foo(bar).baz: ; @echo '$@'
-!,
+!;
+
+if ($port_type eq 'VMS-DCL') {
+    $mk_string =~ s/echo/write sys\$\$output/;
+    $mk_string =~ s/\'/\"/g;
+}
+run_make_test($mk_string,
               '', "foo(bar).baz\n");
 
 # Check renaming of archive targets.
@@ -78,20 +171,36 @@ foo(bar).baz: ; @echo '$@'
 
 mkdir('artest', 0777);
 touch('foo.vhd');
-
-run_make_test(q!
+$mk_string = q!
 DIR = artest
 vpath % $(DIR)
 default: lib(foo)
 (%): %.vhd ; @cd $(DIR) && touch $(*F) && $(AR) $(ARFLAGS) $@ $(*F) >/dev/null 2>&1 && rm $(*F)
 .PHONY: default
-!,
+!;
+if ($port_type eq 'VMS-DCL') {
+  $mk_string =~ s#= artest#= sys\$\$disk:\[.artest\]#;
+  $mk_string =~ s#lib\(foo\)#lib.tlb\(foo\)#;
+  $mk_string =~ s#; \@cd#; pipe SET DEFAULT#;
+  $mk_string =~
+    s#touch \$\(\*F\)#touch \$\(\*F\) && library/create/text sys\$\$disk:\$\@#;
+  $mk_string =~
+    s#library#if f\$\$search(\"\$\@\") \.eqs\. \"\" then library#;
+  # VMS needs special handling for null extension
+  $mk_string =~ s#\@ \$\(\*F\)#\@ \$\(\*F\)\.#;
+  $mk_string =~ s#>/dev/null 2>&1 ##;
+}
+run_make_test($mk_string,
               '', "");
 
 run_make_test(undef, '', "#MAKE#: Nothing to be done for 'default'.\n");
 
 unlink('foo.vhd');
-remove_directory_tree('artest');
+if ($osname eq 'VMS') {
+  remove_directory_tree("$pwd/artest");
+} else {
+  remove_directory_tree('artest');
+}
 
 # This tells the test driver that the perl test script executed properly.
 1;
diff --git a/tests/scripts/features/vpath3 b/tests/scripts/features/vpath3
index c6ede28..839fb72 100644
--- a/tests/scripts/features/vpath3
+++ b/tests/scripts/features/vpath3
@@ -17,6 +17,12 @@ my @files_to_touch = ("a1${pathsep}lib1.a",
                       "b3${pathsep}lib3.so");
 &touch(@files_to_touch);
 
+my $answer = "a1${pathsep}lib1.a a1${pathsep}libc.a " .
+             "a2${pathsep}lib2.a lib3.a\n";
+if ($port_type eq 'VMS-DCL') {
+    $answer =~ s/ /,/g;
+}
+
 run_make_test('
 vpath %.h b3
 vpath %.a a1
@@ -25,7 +31,7 @@ vpath % a2 b2
 vpath % b3
 all: -l1 -lc -l2 -l3; @echo $^
 ',
-              '', "a1${pathsep}lib1.a a1${pathsep}libc.a a2${pathsep}lib2.a lib3.a\n");
+              '', $answer);
 
 unlink(@files_to_touch);
 for my $d (@dirs_to_make) {
diff --git a/tests/scripts/vms/library b/tests/scripts/vms/library
new file mode 100644
index 0000000..9a64951
--- /dev/null
+++ b/tests/scripts/vms/library
@@ -0,0 +1,73 @@
+#                                                              -*-mode: perl-*-
+
+$description = "Test GNU make's VMS Library management features.";
+
+$details = "\
+This only works on VMS systems.";
+
+return -1 if $osname ne 'VMS';
+
+# Help library
+$mk_string = "help : help.hlb(file1.hlp)\n\n" .
+"file1.hlp :\n" .
+"\t\@pipe open/write xxx file1.hlp ; write xxx \"1 help\" ; close xxx\n";
+
+my $answer = "library /replace help.hlb file1.hlp";
+
+run_make_test($mk_string,
+              '', $answer);
+
+unlink('help.hlb');
+unlink('file1.hlp');
+
+#Text library
+$mk_string = "text : text.tlb(file1.txt)\n\n" .
+"file1.txt :\n" .
+"\t\@pipe open/write xxx file1.txt ; write xxx \"text file\" ; close xxx\n";
+
+my $answer = "library /replace text.tlb file1.txt";
+
+run_make_test($mk_string,
+              '', $answer);
+
+unlink('text.tlb');
+unlink('file1.txt');
+
+
+#Macro library
+$mk_string = "macro : macro.mlb(file1.mar)\n\n" .
+"file1.mar :\n" .
+"\t\pipe open/write xxx file1.mar ; " .
+"write xxx \".macro a b\" ; write xxx \".endm\" ; close xxx\n";
+
+my $answer = "library /replace macro.mlb file1.mar";
+
+run_make_test($mk_string,
+              '', $answer);
+
+unlink('macro.mlb');
+unlink('file1.mar');
+
+$mk_string =
+"all:imagelib.olb(file2.exe)\n" .
+"file2.exe : file2.obj file2.opt\n" .
+"\t\@link /share=\$\@ \$\*,\$\*/opt\n\n" .
+"file2.opt :\n" .
+"\t\@pipe open/write xxx file2.opt ; " .
+"write xxx \"CASE_SENSITIVE=YES\" ; close xxx\n" .
+"file2.c :\n" .
+"\t\@pipe open/write xxx file2.c ; write xxx \"file2(){}\" ; close xxx\n";
+
+my $answer = "library /replace imagelib.olb file2.exe";
+
+run_make_test($mk_string,
+              '', $answer);
+
+unlink('imagelib.olb');
+unlink('file2.c');
+unlink('file2.obj');
+unlink('file2.exe');
+unlink('file2.opt');
+
+# This tells the test driver that the perl test script executed properly.
+1;