test1544.pl (4110B)
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;