xref: /petsc/lib/petsc/bin/maint/abi-compliance-checker/modules/Internals/Basic.pm (revision e8b6250908b962c387f7ab2e7b38caaa661b5fa1) 
1###########################################################################
2# A module with simple functions
3#
4# Copyright (C) 2015-2018 Andrey Ponomarenko's ABI Laboratory
5#
6# Written by Andrey Ponomarenko
7#
8# This library is free software; you can redistribute it and/or
9# modify it under the terms of the GNU Lesser General Public
10# License as published by the Free Software Foundation; either
11# version 2.1 of the License, or (at your option) any later version.
12#
13# This library is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16# Lesser General Public License for more details.
17#
18# You should have received a copy of the GNU Lesser General Public
19# License along with this library; if not, write to the Free Software
20# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
21# MA  02110-1301 USA
22###########################################################################
23use strict;
24use Config;
25use Fcntl;
26
27my %Cache;
28
29my %OS_LibExt = (
30    "dynamic" => {
31        "linux"=>"so",
32        "macos"=>"dylib",
33        "windows"=>"dll",
34        "symbian"=>"dso",
35        "default"=>"so"
36    },
37    "static" => {
38        "linux"=>"a",
39        "windows"=>"lib",
40        "symbian"=>"lib",
41        "default"=>"a"
42    }
43);
44
45sub appendFile($$)
46{
47    my ($Path, $Content) = @_;
48
49    if(my $Dir = getDirname($Path)) {
50        mkpath($Dir);
51    }
52
53    open(FILE, ">>", $Path) || die ("can't open file \'$Path\': $!\n");
54    print FILE $Content;
55    close(FILE);
56}
57
58sub writeFile($$)
59{
60    my ($Path, $Content) = @_;
61
62    if(my $Dir = getDirname($Path)) {
63        mkpath($Dir);
64    }
65
66    open(FILE, ">", $Path) || die ("can't open file \'$Path\': $!\n");
67    print FILE $Content;
68    close(FILE);
69}
70
71sub readFile($)
72{
73    my $Path = $_[0];
74
75    open(FILE, $Path);
76    local $/ = undef;
77    my $Content = <FILE>;
78    close(FILE);
79
80    if($Path!~/\.(tu|class|abi)\Z/) {
81        $Content=~s/\r/\n/g;
82    }
83
84    return $Content;
85}
86
87sub getFilename($)
88{ # much faster than basename() from File::Basename module
89    if(defined $Cache{"getFilename"}{$_[0]}) {
90        return $Cache{"getFilename"}{$_[0]};
91    }
92    if($_[0] and $_[0]=~/([^\/\\]+)[\/\\]*\Z/) {
93        return ($Cache{"getFilename"}{$_[0]}=$1);
94    }
95    return ($Cache{"getFilename"}{$_[0]}="");
96}
97
98sub getDirname($)
99{ # much faster than dirname() from File::Basename module
100    if(defined $Cache{"getDirname"}{$_[0]}) {
101        return $Cache{"getDirname"}{$_[0]};
102    }
103    if($_[0] and $_[0]=~/\A(.*?)[\/\\]+[^\/\\]*[\/\\]*\Z/) {
104        return ($Cache{"getDirname"}{$_[0]}=$1);
105    }
106    return ($Cache{"getDirname"}{$_[0]}="");
107}
108
109sub sepPath($) {
110    return (getDirname($_[0]), getFilename($_[0]));
111}
112
113sub escapeArg($)
114{
115    my $Str = $_[0];
116    $Str=~s/([()\[\]{}$ &'"`;,<>\+])/\\$1/g;
117    return $Str;
118}
119
120sub readLineNum($$)
121{
122    my ($Path, $Num) = @_;
123
124    open(FILE, $Path);
125    foreach (1 ... $Num) {
126        <FILE>;
127    }
128    my $Line = <FILE>;
129    close(FILE);
130    return $Line;
131}
132
133sub readAttributes($$)
134{
135    my ($Path, $Num) = @_;
136
137    my %Attributes = ();
138    if(readLineNum($Path, $Num)=~/<!--\s+(.+)\s+-->/)
139    {
140        foreach my $AttrVal (split(/;/, $1))
141        {
142            if($AttrVal=~/(.+):(.+)/)
143            {
144                my ($Name, $Value) = ($1, $2);
145                $Attributes{$Name} = $Value;
146            }
147        }
148    }
149    return \%Attributes;
150}
151
152sub isAbsPath($) {
153    return ($_[0]=~/\A(\/|\w+:[\/\\])/);
154}
155
156sub specChars($)
157{
158    my $Str = $_[0];
159    if(not $Str) {
160        return $Str;
161    }
162    $Str=~s/\&([^#]|\Z)/&amp;$1/g;
163    $Str=~s/</&lt;/g;
164    $Str=~s/\-\>/&#45;&gt;/g; # &minus;
165    $Str=~s/>/&gt;/g;
166    $Str=~s/([^ ]) ([^ ])/$1\@SP\@$2/g;
167    $Str=~s/([^ ]) ([^ ])/$1\@SP\@$2/g;
168    $Str=~s/ /&#160;/g; # &nbsp;
169    $Str=~s/\@SP\@/ /g;
170    $Str=~s/\"/&quot;/g;
171    $Str=~s/\'/&#39;/g;
172    return $Str;
173}
174
175sub parseTag(@)
176{
177    my $CodeRef = shift(@_);
178    my $Tag = shift(@_);
179    if(not $Tag or not $CodeRef) {
180        return undef;
181    }
182    my $Sp = 0;
183    if(@_) {
184        $Sp = shift(@_);
185    }
186    my $Start = index(${$CodeRef}, "<$Tag>");
187    if($Start!=-1)
188    {
189        my $End = index(${$CodeRef}, "</$Tag>");
190        if($End!=-1)
191        {
192            my $TS = length($Tag)+3;
193            my $Content = substr(${$CodeRef}, $Start, $End-$Start+$TS, "");
194            substr($Content, 0, $TS-1, ""); # cut start tag
195            substr($Content, -$TS, $TS, ""); # cut end tag
196            if(not $Sp)
197            {
198                $Content=~s/\A\s+//g;
199                $Content=~s/\s+\Z//g;
200            }
201            if(substr($Content, 0, 1) ne "<") {
202                $Content = xmlSpecChars_R($Content);
203            }
204            return $Content;
205        }
206    }
207    return undef;
208}
209
210sub xmlSpecChars($)
211{
212    my $Str = $_[0];
213    if(not $Str) {
214        return $Str;
215    }
216
217    $Str=~s/\&([^#]|\Z)/&amp;$1/g;
218    $Str=~s/</&lt;/g;
219    $Str=~s/>/&gt;/g;
220
221    $Str=~s/\"/&quot;/g;
222    $Str=~s/\'/&#39;/g;
223
224    return $Str;
225}
226
227sub xmlSpecChars_R($)
228{
229    my $Str = $_[0];
230    if(not $Str) {
231        return $Str;
232    }
233
234    $Str=~s/&amp;/&/g;
235    $Str=~s/&lt;/</g;
236    $Str=~s/&gt;/>/g;
237
238    $Str=~s/&quot;/"/g;
239    $Str=~s/&#39;/'/g;
240
241    return $Str;
242}
243
244sub push_U($@)
245{ # push unique
246    if(my $Array = shift @_)
247    {
248        if(@_)
249        {
250            my %Exist = map {$_=>1} @{$Array};
251            foreach my $Elem (@_)
252            {
253                if(not defined $Exist{$Elem})
254                {
255                    push(@{$Array}, $Elem);
256                    $Exist{$Elem} = 1;
257                }
258            }
259        }
260    }
261}
262
263sub getDepth($)
264{
265    if(defined $Cache{"getDepth"}{$_[0]}) {
266        return $Cache{"getDepth"}{$_[0]};
267    }
268    return ($Cache{"getDepth"}{$_[0]} = ($_[0]=~tr![\/\\]|\:\:!!));
269}
270
271sub cmpVersions($$)
272{ # compare two versions in dotted-numeric format
273    my ($V1, $V2) = @_;
274    return 0 if($V1 eq $V2);
275    my @V1Parts = split(/\./, $V1);
276    my @V2Parts = split(/\./, $V2);
277    for (my $i = 0; $i <= $#V1Parts && $i <= $#V2Parts; $i++)
278    {
279        return -1 if(int($V1Parts[$i]) < int($V2Parts[$i]));
280        return 1 if(int($V1Parts[$i]) > int($V2Parts[$i]));
281    }
282    return -1 if($#V1Parts < $#V2Parts);
283    return 1 if($#V1Parts > $#V2Parts);
284    return 0;
285}
286
287sub isDump($)
288{
289    if(getFilename($_[0])=~/\A(.+)\.(abi|abidump|dump)((\.tar\.gz|\.tgz)(\.\w+|)|\.zip|\.xml|)\Z/)
290    { # NOTE: name.abi.tar.gz.amd64 (dh & cdbs)
291        return $1;
292    }
293    return 0;
294}
295
296sub isDump_U($)
297{
298    if(getFilename($_[0])=~/\A(.+)\.(abi|abidump|dump)(\.xml|)\Z/) {
299        return $1;
300    }
301    return 0;
302}
303
304sub cutPrefix($$)
305{
306    my ($Path, $Prefix) = @_;
307    if(not $Prefix) {
308        return $Path;
309    }
310    $Prefix=~s/[\/\\]+\Z//;
311    $Path=~s/\A\Q$Prefix\E([\/\\]+|\Z)//;
312    return $Path;
313}
314
315sub sortByWord($$)
316{
317    my ($ArrRef, $W) = @_;
318    if(length($W)<2) {
319        return;
320    }
321    @{$ArrRef} = sort {getFilename($b)=~/\Q$W\E/i<=>getFilename($a)=~/\Q$W\E/i} @{$ArrRef};
322}
323
324sub showPos($)
325{
326    my $N = $_[0];
327    if(not $N) {
328        $N = 1;
329    }
330    else {
331        $N = int($N)+1;
332    }
333    if($N>3) {
334        return $N."th";
335    }
336    elsif($N==1) {
337        return "1st";
338    }
339    elsif($N==2) {
340        return "2nd";
341    }
342    elsif($N==3) {
343        return "3rd";
344    }
345
346    return $N;
347}
348
349sub isCyclical($$)
350{
351    my ($Stack, $Value) = @_;
352    return (grep {$_ eq $Value} @{$Stack});
353}
354
355sub formatName($$)
356{ # type name correction
357    if(defined $Cache{"formatName"}{$_[1]}{$_[0]}) {
358        return $Cache{"formatName"}{$_[1]}{$_[0]};
359    }
360
361    my $N = $_[0];
362
363    if($_[1] ne "S")
364    {
365        $N=~s/\A[ ]+//g;
366        $N=~s/[ ]+\Z//g;
367        $N=~s/[ ]{2,}/ /g;
368    }
369
370    $N=~s/[ ]*(\W)[ ]*/$1/g; # std::basic_string<char> const
371
372    $N=~s/\b(const|volatile) ([\w\:]+)([\*&,>]|\Z)/$2 $1$3/g; # "const void" to "void const"
373
374    $N=~s/\bvolatile const\b/const volatile/g;
375
376    $N=~s/\b(long long|short|long) unsigned\b/unsigned $1/g;
377    $N=~s/\b(short|long) int\b/$1/g;
378
379    $N=~s/([\)\]])(const|volatile)\b/$1 $2/g;
380
381    while($N=~s/>>/> >/g) {};
382
383    if($_[1] eq "S")
384    {
385        if(index($N, "operator")!=-1) {
386            $N=~s/\b(operator[ ]*)> >/$1>>/;
387        }
388    }
389
390    $N=~s/,([^ ])/, $1/g;
391
392    return ($Cache{"formatName"}{$_[1]}{$_[0]} = $N);
393}
394
395sub isRecurType($$$)
396{
397    foreach (@{$_[2]})
398    {
399        if( $_->{"T1"} eq $_[0]
400        and $_->{"T2"} eq $_[1] )
401        {
402            return 1;
403        }
404    }
405    return 0;
406}
407
408sub pushType($$$)
409{
410    my %IDs = (
411        "T1" => $_[0],
412        "T2" => $_[1]
413    );
414    push(@{$_[2]}, \%IDs);
415}
416
417sub formatVersion($$)
418{ # cut off version digits
419    my ($V, $Digits) = @_;
420    my @Elems = split(/\./, $V);
421    return join(".", splice(@Elems, 0, $Digits));
422}
423
424sub showNum($)
425{
426    if($_[0])
427    {
428        my $Num = cutNum($_[0], 2, 0);
429        if($Num eq "0")
430        {
431            foreach my $P (3 .. 7)
432            {
433                $Num = cutNum($_[0], $P, 1);
434                if($Num ne "0") {
435                    last;
436                }
437            }
438        }
439        if($Num eq "0") {
440            $Num = $_[0];
441        }
442        return $Num;
443    }
444    return $_[0];
445}
446
447sub cutNum($$$)
448{
449    my ($num, $digs_to_cut, $z) = @_;
450    if($num!~/\./)
451    {
452        $num .= ".";
453        foreach (1 .. $digs_to_cut-1) {
454            $num .= "0";
455        }
456    }
457    elsif($num=~/\.(.+)\Z/ and length($1)<$digs_to_cut-1)
458    {
459        foreach (1 .. $digs_to_cut - 1 - length($1)) {
460            $num .= "0";
461        }
462    }
463    elsif($num=~/\d+\.(\d){$digs_to_cut,}/) {
464      $num=sprintf("%.".($digs_to_cut-1)."f", $num);
465    }
466    $num=~s/\.[0]+\Z//g;
467    if($z) {
468        $num=~s/(\.[1-9]+)[0]+\Z/$1/g;
469    }
470    return $num;
471}
472
473sub getPrefix($)
474{
475    my $Str = $_[0];
476    if($Str=~/\A([_]*[A-Z][a-z]{1,5})[A-Z]/)
477    { # XmuValidArea: Xmu
478        return $1;
479    }
480    elsif($Str=~/\A([_]*[a-z]+)[A-Z]/)
481    { # snfReadFont: snf
482        return $1;
483    }
484    elsif($Str=~/\A([_]*[A-Z]{2,})[A-Z][a-z]+([A-Z][a-z]+|\Z)/)
485    { # XRRTimes: XRR
486        return $1;
487    }
488    elsif($Str=~/\A([_]*[a-z]{1,2}\d+)[a-z\d]*_[a-z]+/i)
489    { # H5HF_delete: H5
490        return $1;
491    }
492    elsif($Str=~/\A([_]*[a-z0-9]{2,}_)[a-z]+/i)
493    { # alarm_event_add: alarm_
494        return $1;
495    }
496    elsif($Str=~/\A(([a-z])\2{1,})/i)
497    { # ffopen
498        return $1;
499    }
500    return "";
501}
502
503sub isBuiltIn($) {
504    return ($_[0] and $_[0]=~/\<built\-in\>|\<internal\>|\A\./);
505}
506
507sub checkWin32Env()
508{
509    if(not $ENV{"VCINSTALLDIR"}
510    or not $ENV{"INCLUDE"}) {
511        exitStatus("Error", "can't start without VC environment (vcvars64.bat)");
512    }
513}
514
515sub symbolParts($)
516{
517    my $S = $_[0];
518
519    if(index($S, '@')==-1
520    and index($S, '$')==-1) {
521        return ($S, "", "");
522    }
523
524    if($S=~/\A([^\@\$\?]+)([\@\$]+)([^\@\$]+)\Z/) {
525        return ($1, $2, $3);
526    }
527
528    return ($S, "", "");
529}
530
531sub getOSgroup()
532{
533    my $N = $Config{"osname"};
534    my $G = undef;
535
536    if($N=~/macos|darwin|rhapsody/i) {
537        $G = "macos";
538    }
539    elsif($N=~/freebsd|openbsd|netbsd/i) {
540        $G = "bsd";
541    }
542    elsif($N=~/haiku|beos/i) {
543        $G = "beos";
544    }
545    elsif($N=~/symbian|epoc/i) {
546        $G = "symbian";
547    }
548    elsif($N=~/win/i) {
549        $G = "windows";
550    }
551    elsif($N=~/solaris/i) {
552        $G = "solaris";
553    }
554    else
555    { # linux, unix-like
556        $G = "linux";
557    }
558
559    return $G;
560}
561
562sub getLibExt($$)
563{
564    my ($Target, $Static) = @_;
565
566    my $LType = "dynamic";
567
568    if($Static) {
569        $LType = "static";
570    }
571
572    if(my $Ex = $OS_LibExt{$LType}{$Target}) {
573        return $Ex;
574    }
575    return $OS_LibExt{$LType}{"default"};
576}
577
578sub isAnon($)
579{ # "._N" or "$_N" in older GCC versions
580    return ($_[0] and $_[0]=~/(\.|\$)\_\d+|anon\-/);
581}
582
583sub checkCmd($)
584{
585    my $Cmd = $_[0];
586
587    foreach my $Path (sort {length($a)<=>length($b)} split(/:/, $ENV{"PATH"}))
588    {
589        if(-x $Path."/".$Cmd) {
590            return 1;
591        }
592    }
593
594    return 0;
595}
596
597sub checkList($$)
598{
599    my ($Item, $Skip) = @_;
600    if(not $Skip) {
601        return 0;
602    }
603    foreach my $P (@{$Skip})
604    {
605        my $Pattern = $P;
606        if(index($Pattern, "*")!=-1)
607        { # wildcards
608            $Pattern=~s/\*/.*/g; # to perl format
609            if($Item=~/$Pattern/) {
610                return 1;
611            }
612        }
613        elsif(index($Pattern, "/")!=-1
614        or index($Pattern, "\\")!=-1)
615        { # directory
616            if(index($Item, $Pattern)!=-1) {
617                return 1;
618            }
619        }
620        elsif($Item eq $Pattern
621        or getFilename($Item) eq $Pattern)
622        { # by name
623            return 1;
624        }
625    }
626    return 0;
627}
628
629sub getArExt($)
630{
631    my $Target = $_[0];
632    if($Target eq "windows") {
633        return "zip";
634    }
635    return "tar.gz";
636}
637
638sub cutAttrs($)
639{
640    if($_[0]=~s/(\))((| (const volatile|const|volatile))(| \[static\]))\Z/$1/) {
641        return $2;
642    }
643    return "";
644}
645
646sub splitSignature($)
647{
648    my $Signature = $_[0];
649    if(my $ShortName = substr($Signature, 0, findCenter($Signature, "(")))
650    {
651        $Signature=~s/\A\Q$ShortName\E\(//g;
652        cutAttrs($Signature);
653        $Signature=~s/\)\Z//;
654        return ($ShortName, $Signature);
655    }
656
657    # error
658    return ($Signature, "");
659}
660
661sub sepParams($$$)
662{
663    my ($Params, $Comma, $Sp) = @_;
664    my @Parts = ();
665    my %B = ( "("=>0, "<"=>0, ")"=>0, ">"=>0 );
666    my $Part = 0;
667    foreach my $Pos (0 .. length($Params) - 1)
668    {
669        my $S = substr($Params, $Pos, 1);
670        if(defined $B{$S}) {
671            $B{$S} += 1;
672        }
673        if($S eq "," and
674        $B{"("}==$B{")"} and $B{"<"}==$B{">"})
675        {
676            if($Comma)
677            { # include comma
678                $Parts[$Part] .= $S;
679            }
680            $Part += 1;
681        }
682        else {
683            $Parts[$Part] .= $S;
684        }
685    }
686    if(not $Sp)
687    { # remove spaces
688        foreach (@Parts)
689        {
690            s/\A //g;
691            s/ \Z//g;
692        }
693    }
694    return @Parts;
695}
696
697sub findCenter($$)
698{
699    my ($Sign, $Target) = @_;
700    my %B = ( "("=>0, "<"=>0, ")"=>0, ">"=>0 );
701    my $Center = 0;
702    if($Sign=~s/(operator([^\w\s\(\)]+|\(\)))//g)
703    { # operators
704        $Center+=length($1);
705    }
706    foreach my $Pos (0 .. length($Sign)-1)
707    {
708        my $S = substr($Sign, $Pos, 1);
709        if($S eq $Target)
710        {
711            if($B{"("}==$B{")"}
712            and $B{"<"}==$B{">"}) {
713                return $Center;
714            }
715        }
716        if(defined $B{$S}) {
717            $B{$S}+=1;
718        }
719        $Center+=1;
720    }
721    return 0;
722}
723
724sub deleteKeywords($)
725{
726    my $TypeName = $_[0];
727    $TypeName=~s/\b(enum|struct|union|class) //g;
728    return $TypeName;
729}
730
731sub readBytes($)
732{
733    sysopen(FILE, $_[0], O_RDONLY);
734    sysread(FILE, my $Header, 4);
735    close(FILE);
736    my @Bytes = map { sprintf('%02x', ord($_)) } split (//, $Header);
737    return join("", @Bytes);
738}
739
740sub isElf($)
741{
742    my $Path = $_[0];
743    return (readBytes($Path) eq "7f454c46");
744}
745
746return 1;
747