>From f05a202fcb1fca6f7cbafd98f997c160f3c70ec9 Mon Sep 17 00:00:00 2001 From: John Malmberg Date: Thu, 11 Sep 2014 22:39:34 -0500 Subject: [PATCH] vms_archive_fixes_with_tests_oct 6 Bug 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. --- arscan.c | 12 +++- tests/scripts/features/archives | 153 ++++++++++++++++++++++++++++++++------- tests/scripts/features/vpath3 | 8 ++- tests/scripts/vms/library | 73 +++++++++++++++++++ 4 files changed, 217 insertions(+), 29 deletions(-) create mode 100644 tests/scripts/vms/library 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 . */ #include #include #include -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 #include -#endif + const char * vmsify (const char *name, int type); diff --git a/tests/scripts/features/archives b/tests/scripts/features/archives index b0acfec..b3cb6bd 100644 --- a/tests/scripts/features/archives +++ b/tests/scripts/features/archives @@ -9,68 +9,155 @@ 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)); - -my $ar = $CONFIG_FLAGS{AR}; +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 $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"; +$_ .= "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 +165,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#; address@hidden; pipe SET DEFAULT#; + $mk_string =~ + s#touch \$\(\*F\)#touch \$\(\*F\) && library/create/text sys\$\$disk:address@hidden; + $mk_string =~ + s#library#if f\$\$search(\"address@hidden") \.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" . +"address@hidden 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" . +"address@hidden 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" . +"address@hidden /share=\$\@ \$\*,\$\*/opt\n\n" . +"file2.opt :\n" . +"address@hidden open/write xxx file2.opt ; " . +"write xxx \"CASE_SENSITIVE=YES\" ; close xxx\n" . +"file2.c :\n" . +"address@hidden 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; -- 1.7.9