util/mkdef.pl: for VMS, allow generation of case insensitive symbol vector

Some modules are built with case insensitive (uppercase) symbols on
VMS.  This needs to be reflected in the export symbol vector.

Reviewed-by: Tim Hudson <tjh@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/7347)

diff --git a/Configurations/descrip.mms.tmpl b/Configurations/descrip.mms.tmpl
index 39d9159c0c4b445d21f6170560f9aa859c74c154..44b22edf61971c7aeb448b1bc7c42e0c228ac392 100644 (file)
--- a/Configurations/descrip.mms.tmpl
+++ b/Configurations/descrip.mms.tmpl
@@ -761,9 +761,12 @@ reconfigure reconf :
           my $ord_ver = $args{intent} eq 'lib' ? ' --version $(VERSION)' : '';
           my $ord_name =
               $args{generator}->[1] || basename($args{product}, '.EXE');
+          my $case_insensitive =
+              $target{$args{intent}.'_cflags'} =~ m|/NAMES=[^/]*AS_IS|i
+              ? '' : ' --case-insensitive';
           return <<"EOF";
 $target : $args{generator}->[0] $deps $mkdef
-       \$(PERL) $mkdef$ord_ver --ordinals $args{generator}->[0] --name $ord_name "--OS" "VMS" > $target
+       \$(PERL) $mkdef$ord_ver --ordinals $args{generator}->[0] --name $ord_name "--OS" "VMS"$case_insensitive > $target
 EOF
       } elsif ($target !~ /\.[sS]$/) {
           my $target = $args{src};

diff --git a/util/mkdef.pl b/util/mkdef.pl
index ff36da8e9fe6518302be3a9daab7bff1176d8b72..635e3e904b9854c905735c905210decdb366329d 100755 (executable)
--- a/util/mkdef.pl
+++ b/util/mkdef.pl
@@ -28,12 +28,17 @@ my $OS = undef;                 # the operating system family
 my $verbose = 0;
 my $ctest = 0;
 
+# For VMS, some modules may have case insensitive names
+my $case_insensitive = 0;
+
 GetOptions('name=s'     => \$name,
            'ordinals=s' => \$ordinals_file,
            'version=s'  => \$version,
            'OS=s'       => \$OS,
            'ctest'      => \$ctest,
-           'verbose'    => \$verbose)
+           'verbose'    => \$verbose,
+           # For VMS
+           'case-insensitive' => \$case_insensitive)
     or die "Error in command line arguments\n";
 
 die "Please supply arguments\n"
@@ -289,38 +294,51 @@ _____
     }
 }
 
+sub collect_VMS_mixedcase {
+    return [ 'SPARE', 'SPARE' ] unless @_;
+
+    my $s = shift;
+    my $s_uc = uc($s);
+    my $type = shift;
+
+    return [ "$s=$type", 'SPARE' ] if $s_uc eq $s;
+    return [ "$s_uc/$s=$type", "$s=$type" ];
+}
+
+sub collect_VMS_uppercase {
+    return [ 'SPARE' ] unless @_;
+
+    my $s = shift;
+    my $s_uc = uc($s);
+    my $type = shift;
+
+    return [ "$s_uc=$type" ];
+}
+
 sub writer_VMS {
     my @slot_collection = ();
-    my $write_vector_slot_pair =
-        sub {
-            my $slot1 = shift;
-            my $slot2 = shift;
-            my $slotpair_text = " $slot1, -\n  $slot2, -\n"
-        };
+    my $collector =
+        $case_insensitive ? \&collect_VMS_uppercase : \&collect_VMS_mixedcase;
 
     my $last_num = 0;
     foreach (@_) {
         while (++$last_num < $_->number()) {
-            push @slot_collection, [ 'SPARE', 'SPARE' ];
+            push @slot_collection, $collector->(); # Just occupy a slot
         }
         my $type = {
             FUNCTION    => 'PROCEDURE',
             VARIABLE    => 'DATA'
            } -> {$_->type()};
-        my $s = $_->name();
-        my $s_uc = uc($s);
-        if ($s_uc eq $s) {
-            push @slot_collection, [ "$s=$type", 'SPARE' ];
-        } else {
-            push @slot_collection, [ "$s_uc/$s=$type", "$s=$type" ];
-        }
+        push @slot_collection, $collector->($_->name(), $type);
     }
 
     print <<"_____" if defined $version;
 IDENTIFICATION=$version
 _____
-    print <<"_____";
+    print <<"_____" unless $case_insensitive;
 CASE_SENSITIVE=YES
+_____
+    print <<"_____";
 SYMBOL_VECTOR=(-
 _____
     # It's uncertain how long aggregated lines the linker can handle,
@@ -330,18 +348,19 @@ _____
     # can have more than one of those...
     my $symvtextcount = 16;     # The length of "SYMBOL_VECTOR=("
     while (@slot_collection) {
-        my $pair = shift @slot_collection;
-        my $pairtextlength =
-            2                   # one space indentation and comma
-            + length($pair->[0])
-            + 1                 # postdent
-            + 3                 # two space indentation and comma
-            + length($pair->[1])
-            + 1                 # postdent
-            ;
+        my $set = shift @slot_collection;
+        my $settextlength = 0;
+        foreach (@$set) {
+            $settextlength +=
+                + 3             # two space indentation and comma
+                + length($_)
+                + 1             # postdent
+                ;
+        }
+        $settextlength--;       # only one space indentation on the first one
         my $firstcomma = ',';
 
-        if ($symvtextcount + $pairtextlength > 1024) {
+        if ($symvtextcount + $settextlength > 1024) {
             print <<"_____";
 )
 SYMBOL_VECTOR=(-
@@ -351,11 +370,15 @@ _____
         if ($symvtextcount == 16) {
             $firstcomma = '';
         }
-        print <<"_____";
- $firstcomma$pair->[0] -
-  ,$pair->[1] -
+
+        my $indent = ' '.$firstcomma;
+        foreach (@$set) {
+            print <<"_____";
+$indent$_ -
 _____
-        $symvtextcount += $pairtextlength;
+            $symvtextcount += length($indent) + length($_) + 1;
+            $indent = '  ,';
+        }
     }
     print <<"_____";
 )