tests/check-translatable-options.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
  10 #
  11 # This software is licensed as described in the file COPYING, which
  12 # you should have received as part of this distribution. The terms
  13 # are also available at https://curl.se/docs/copyright.html.
  14 #
  15 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  16 # copies of the Software, and permit persons to whom the Software is
  17 # furnished to do so, under the terms of the COPYING file.
  18 #
  19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  20 # KIND, either express or implied.
  21 #
  22 # SPDX-License-Identifier: curl
  23 #
  24 #
  25 ###########################################################################
  26 #
  27 # Check the OS/400 translating wrapper properly handles all translatable
  28 # string options.
  29
  30 use strict;
  31 use warnings;
  32
  33 my $root=$ARGV[0] || ".";
  34 my $incdir = "$root/include/curl";
  35 my $os400dir = "$root/packages/OS400";
  36 my $errcount = 0;
  37
  38 # Scan header file for string option definitions.
  39 sub scan_header {
  40     my ($f)=@_;
  41     my $line = "";
  42     my $incomment = 0;
  43     my @stringopts;
  44
  45     open(my $h, "<", "$f");
  46     while(<$h>) {
  47       s/^\s*(.*?)\s*$/$1/;      # Trim.
  48       # Remove multi-line comment trail.
  49       if($incomment) {
  50         if($_ !~ /.*?\*\/\s*(.*)$/) {
  51           next;
  52         }
  53         $_ = $1;
  54         $incomment = 0;
  55       }
  56       if($line ne "") {
  57         # Unfold line.
  58         $_ = "$line $1";
  59         $line = "";
  60       }
  61       if($_ =~ /^(.*)\\$/) {
  62         $line = "$1 ";
  63         next;
  64       }
  65       # Remove comments.
  66       while($_ =~ /^(.*?)\/\*.*?\*\/(.*)$/) {
  67         $_ = "$1 $2";
  68       }
  69       if($_ =~ /^(.*)\/\*/) {
  70         $_ = "$1 ";
  71         $incomment = 1;
  72       }
  73       s/^\s*(.*?)\s*$/$1/;      # Trim again.
  74       # Ignore preprocessor directives and blank lines.
  75       if($_ =~ /^(?:#|$)/) {
  76         next;
  77       }
  78       # Handle lines that may be continued as if they were folded.
  79       if($_ !~ /[;,{}]$/ || $_ =~ /[^)],$/) {
  80         # Folded line.
  81         $line = $_;
  82         next;
  83       }
  84       # Keep string options only.
  85       if($_ =~ /CURLOPT(?:DEPRECATED)?\s*\(\s*([^, \t]+)\s*,\s*CURLOPTTYPE_STRINGPOINT/) {
  86         push(@stringopts, $1);
  87       }
  88     }
  89     close $h;
  90     return @stringopts;
  91 }
  92
  93 # Scan packages/OS400/ccsidcurl.c for translatable string option cases.
  94 sub scan_wrapper_for_strings {
  95     my ($f)=@_;
  96     my $inarmor = 0;
  97     my @stringopts;
  98
  99     open(my $h, "<", "$f");
 100     while(<$h>) {
 101       if($_ =~ /(BEGIN|END) TRANSLATABLE STRING OPTIONS/) {
 102         $inarmor = $1 eq "BEGIN";
 103       }
 104       elsif($inarmor && $_ =~ /case\s+([^:]+):/) {
 105         push(@stringopts, $1);
 106       }
 107     }
 108     close $h;
 109     return @stringopts;
 110 }
 111
 112 # Get translatable string options from header file.
 113 my @stringdefs = scan_header("$incdir/curl.h");
 114
 115 # Get translated string options.
 116 my @stringrefs = scan_wrapper_for_strings("$os400dir/ccsidcurl.c");
 117
 118 # Lists should be equal: check differences.
 119 my %diff;
 120 @diff{@stringdefs} = 0..$#stringdefs;
 121 delete @diff{@stringrefs};
 122
 123 foreach(keys %diff) {
 124   print "$_ is not translated\n";
 125   delete $diff{$_};
 126   $errcount++;
 127 }
 128
 129 @diff{@stringrefs} = 0..$#stringrefs;
 130 delete @diff{@stringdefs};
 131
 132 foreach(keys %diff) {
 133   print "translated option $_ does not exist\n";
 134   $errcount++;
 135 }
 136
 137 # Check translated string option cases are sorted alphanumerically.
 138 foreach(my $i = 1; $i < $#stringrefs; $i++) {
 139   if($stringrefs[$i] lt $stringrefs[$i - 1]) {
 140     print("Translated string options are not sorted (" . $stringrefs[$i - 1] .
 141           "/" . $stringrefs[$i] . ")\n");
 142     $errcount++;
 143     last;
 144   }
 145 }
 146
 147 exit !!$errcount;