From 36d3acb91d5d2f0308ab93be9ce5609f784f95a2 Mon Sep 17 00:00:00 2001
From: Richard Levitte <levitte@openssl.org>
Date: Fri, 5 Oct 2018 00:10:35 +0200
Subject: [PATCH] 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)
---
 Configurations/descrip.mms.tmpl |  5 +-
 util/mkdef.pl                   | 83 +++++++++++++++++++++------------
 2 files changed, 57 insertions(+), 31 deletions(-)

diff --git a/Configurations/descrip.mms.tmpl b/Configurations/descrip.mms.tmpl
index 39d9159c0c..44b22edf61 100644
--- 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 ff36da8e9f..635e3e904b 100755
--- 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 <<"_____";
 )
-- 
2.25.1