Support case-sensitive symbols usage in linker

p4raw-id: //depot/vmsperl@5302

4 files changed, 24 insertions, 9 deletions

diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL
index 5cc5aead11..8341b36130 100644
--- a/ext/DynaLoader/DynaLoader_pm.PL
+++ b/ext/DynaLoader/DynaLoader_pm.PL
@@ -198,6 +198,7 @@ sub bootstrap {
     croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")
 	unless $file;	# wording similar to error from 'require'
 
+    $file = uc($file) if $Is_VMS && $Config{d_vms_case_sensitive_symbols};
     my $bootname = "boot_$module";
     $bootname =~ s/\W/_/g;
     @dl_require_symbols = ($bootname);
diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs
index 29ab7c31e2..d7a1f863f3 100644
--- a/ext/DynaLoader/dl_vms.xs
+++ b/ext/DynaLoader/dl_vms.xs
@@ -65,6 +65,12 @@ static AV *dl_require_symbols = Nullav;
 #include <ssdef.h>
 #include <starlet.h>
 
+#if defined(VMS_WE_ARE_CASE_SENSITIVE)
+#define DL_CASE_SENSITIVE 1<<4
+#else
+#define DL_CASE_SENSITIVE 0
+#endif
+
 typedef unsigned long int vmssts;
 
 struct libref {
@@ -142,7 +148,7 @@ my_find_image_symbol(struct dsc$descriptor_s *imgname,
 {
   unsigned long int retsts;
   VAXC$ESTABLISH(findsym_handler);
-  retsts = lib$find_image_symbol(imgname,symname,entry,defspec);
+  retsts = lib$find_image_symbol(imgname,symname,entry,defspec,DL_CASE_SENSITIVE);
   return retsts;
 }
 
diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm
index 44fa7e2496..5f54b10083 100644
--- a/lib/ExtUtils/MM_VMS.pm
+++ b/lib/ExtUtils/MM_VMS.pm
@@ -1182,12 +1182,18 @@ $(BASEEXT).opt : Makefile.PL
 
     push @m, '	$(PERL) -e "print ""$(INST_STATIC)/Include=';
     if ($self->{OBJECT} =~ /\bBASEEXT\b/ or
-        $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { push @m, '$(BASEEXT)'; }
+        $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { 
+        push @m, ($Config{d_vms_case_sensitive_symbols}
+	           ? uc($self->{BASEEXT}) :'$(BASEEXT)');
+    }
     else {  # We don't have a "main" object file, so pull 'em all in
+       # Upcase module names if linker is being case-sensitive
+       my($upcase) = $Config{d_vms_case_sensitive_symbols};
 	my(@omods) = map { s/\.[^.]*$//;         # Trim off file type
 	                   s[\$\(\w+_EXT\)][];   # even as a macro
 	                   s/.*[:>\/\]]//;       # Trim off dir spec
-	                   $_; } split ' ', $self->eliminate_macros($self->{OBJECT});
+			   $upcase ? uc($_) : $_;
+	                 } split ' ', $self->eliminate_macros($self->{OBJECT});
 	my($tmp,@lines,$elt) = '';
 	my $tmp = shift @omods;
 	foreach $elt (@omods) {
diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
index caba95c04b..35cab2f819 100644
--- a/vms/gen_shrfls.pl
+++ b/vms/gen_shrfls.pl
@@ -76,6 +76,7 @@ if ($docc) {
     $use_mymalloc++ if /define\s+MYMALLOC/;
     $hide_mymalloc++ if /define\s+EMBEDMYMALLOC/;
     $use_threads++ if /define\s+USE_THREADS/;
+    $care_about_case++ if /define\s+VMS_WE_ARE_CASE_SENSITIVE/;
   }
   
   # put quotes back onto defines - they were removed by DCL on the way in
@@ -195,16 +196,16 @@ sub scan_func {
     if ($1 eq 'main' || $1 eq 'perl_init_ext') {
       print "\tskipped\n" if $debug > 1;
     }
-    else { $fcns{uc($1)}++ }
+    else { $fcns{$1}++ }
   }
 }
 
 # Go add some right up front if we need 'em
 if ($use_mymalloc) {
-  $fcns{uc('Perl_malloc')}++;
-  $fcns{uc('Perl_calloc')}++;
-  $fcns{uc('Perl_realloc')}++;
-  $fcns{uc('Perl_mfree')}++;
+  $fcns{'Perl_malloc'}++;
+  $fcns{'Perl_calloc'}++;
+  $fcns{'Perl_realloc'}++;
+  $fcns{'Perl_mfree'}++;
 }
 
 $used_expectation_enum = $used_opcode_enum = 0; # avoid warnings
@@ -313,6 +314,7 @@ unless ($isgcc) {
   print OPTBLD "PSECT_ATTR=\$GLOBAL_RO_VARS,PIC,NOEXE,RD,NOWRT,SHR\n";
   print OPTBLD "PSECT_ATTR=\$GLOBAL_RW_VARS,PIC,NOEXE,RD,WRT,NOSHR\n";
 }
+print OPTBLD "case_sensitive=yes\n" if $care_about_case;
 foreach $var (sort (keys %vars,keys %cvars)) {
   if ($isvax) { print OPTBLD "UNIVERSAL=$var\n"; }
   else { print OPTBLD "SYMBOL_VECTOR=($var=DATA)\n"; }
@@ -364,7 +366,7 @@ else {
 }
 close OPTATTR;
 
-$incstr = 'perl,globals';
+$incstr = 'PERL,GLOBALS';
 if ($isvax) {
   $drvrname = "Compile_shrmars.tmp_".time;
   open (DRVR,">$drvrname") or die "$0: Can't write to $drvrname: $!\n";