1#!/usr/bin/perl 2 3# Configure.pm. Version 1.00 Copyright (C) 1995, Kenneth Albanowski 4# 5# You are welcome to use this code in your own perl modules, I just 6# request that you don't distribute modified copies without making it clear 7# that you have changed something. If you have a change you think is worth 8# merging into the original, please contact me at kjahds@kjahds.com or 9# CIS:70705,126 10# 11# $Id: Configure.pm,v 2.21 2004/03/02 20:28:11 jonathan Exp $ 12# 13 14# Todo: clean up redudant code in CPP, Compile, Link, and Execute 15# 16 17# for when no_index is not enough 18package 19 Configure; 20 21use strict; 22use vars qw(@EXPORT @ISA); 23 24use Carp; 25require Exporter; 26@ISA = qw(Exporter); 27 28@EXPORT = qw( CPP 29 Compile 30 Link 31 Execute 32 FindHeader 33 FindLib 34 Apply 35 ApplyHeaders 36 ApplyLibs 37 ApplyHeadersAndLibs 38 ApplyHeadersAndLibsAndExecute 39 CheckHeader 40 CheckStructure 41 CheckField 42 CheckHSymbol 43 CheckSymbol 44 CheckLSymbol 45 GetSymbol 46 GetTextSymbol 47 GetNumericSymbol 48 GetConstants); 49 50use Config; 51 52my ($C_usrinc, $C_libpth, $C_cppstdin, $C_cppflags, $C_cppminus, 53$C_ccflags,$C_ldflags,$C_cc,$C_libs) = 54 @Config{qw( usrinc libpth cppstdin cppflags cppminus 55 ccflags ldflags cc libs)}; 56 57my $Verbose = 0; 58 59=head1 NAME 60 61Configure.pm - provide auto-configuration utilities 62 63=head1 SUMMARY 64 65This perl module provides tools to figure out what is present in the C 66compilation environment. This is intended mostly for perl extensions to use 67to configure themselves. There are a number of functions, with widely varying 68levels of specificity, so here is a summary of what the functions can do: 69 70 71CheckHeader: Look for headers. 72 73CheckStructure: Look for a structure. 74 75CheckField: Look for a field in a structure. 76 77CheckHSymbol: Look for a symbol in a header. 78 79CheckLSymbol: Look for a symbol in a library. 80 81CheckSymbol: Look for a symbol in a header and library. 82 83GetTextSymbol: Get the contents of a symbol as text. 84 85GetNumericSymbol: Get the contents of a symbol as a number. 86 87Apply: Try compiling code with a set of headers and libs. 88 89ApplyHeaders: Try compiling code with a set of headers. 90 91ApplyLibraries: Try linking code with a set of libraries. 92 93ApplyHeadersAndLibaries: You get the idea. 94 95ApplyHeadersAndLibariesAnExecute: You get the idea. 96 97CPP: Feed some code through the C preproccessor. 98 99Compile: Try to compile some C code. 100 101Link: Try to compile & link some C code. 102 103Execute: Try to compile, link, & execute some C code. 104 105=head1 FUNCTIONS 106 107=cut 108 109# Here we go into the actual functions 110 111=head2 CPP 112 113Takes one or more arguments. The first is a string containing a C program. 114Embedded newlines are legal, the text simply being stuffed into a temporary 115file. The result is then fed to the C preproccessor (that preproccessor being 116previously determined by perl's Configure script.) Any additional arguments 117provided are passed to the preprocessing command. 118 119In a scalar context, the return value is either undef, if something went wrong, 120or the text returned by the preprocessor. In an array context, two values are 121returned: the numeric exit status and the output of the preproccessor. 122 123=cut 124 125sub CPP { # Feed code to preproccessor, returning error value and output 126 127 my($code,@options) = @_; 128 my($options) = join(" ",@options); 129 my($file) = "tmp$$"; 130 my($in,$out) = ($file.".c",$file.".o"); 131 132 open(F,">$in"); 133 print F $code; 134 close(F); 135 136 print "Preprocessing |$code|\n" if $Verbose; 137 my($result) = scalar(`$C_cppstdin $C_cppflags $C_cppminus $options < $in 2>/dev/null`); 138 print "Executing '$C_cppstdin $C_cppflags $C_cppminus $options < $in 2>/dev/null'\n" if $Verbose; 139 140 141 my($error) = $?; 142 print "Returned |$result|\n" if $Verbose; 143 unlink($in,$out); 144 return ($error ? undef : $result) unless wantarray; 145 ($error,$result); 146} 147 148=head2 Compile 149 150Takes one or more arguments. The first is a string containing a C program. 151Embedded newlines are legal, the text simply being stuffed into a temporary 152file. The result is then fed to the C compiler (that compiler being 153previously determined by perl's Configure script.) Any additional arguments 154provided are passed to the compiler command. 155 156In a scalar context, either 0 or 1 will be returned, with 1 indicating a 157successful compilation. In an array context, three values are returned: the 158numeric exit status of the compiler, a string consisting of the output 159generated by the compiler, and a numeric value that is false if a ".o" file 160wasn't produced by the compiler, error status or no. 161 162=cut 163 164sub Compile { # Feed code to compiler. On error, return status and text 165 my($code,@options) = @_; 166 my($options)=join(" ",@options); 167 my($file) = "tmp$$"; 168 my($in,$out) = ($file.".c",$file.".o"); 169 170 open(F,">$in"); 171 print F $code; 172 close(F); 173 print "Compiling |$code|\n" if $Verbose; 174 my($result) = scalar(`$C_cc $C_ccflags -c $in $C_ldflags $C_libs $options 2>&1`); 175 print "Executing '$C_cc $C_ccflags -c $in $C_ldflags $C_libs $options 2>&1'\n" if $Verbose; 176 my($error) = $?; 177 my($error2) = ! -e $out; 178 unlink($in,$out); 179 return (($error || $error2) ? 0 : 1) unless wantarray; 180 ($error,$result,$error2); 181} 182 183=head2 Link 184 185Takes one or more arguments. The first is a string containing a C program. 186Embedded newlines are legal, the text simply being stuffed into a temporary 187file. The result is then fed to the C compiler and linker (that compiler and 188linker being previously determined by perl's Configure script.) Any 189additional arguments provided are passed to the compilation/link command. 190 191In a scalar context, either 0 or 1 is returned, with 1 indicating a 192successful compilation. In an array context, two values are returned: the 193numeric exit status of the compiler/linker, and a string consisting of the 194output generated by the compiler/linker. 195 196Note that this command I<only> compiles and links the C code. It does not 197attempt to execute it. 198 199=cut 200 201sub Link { # Feed code to compiler and linker. On error, return status and text 202 my($code,@options) = @_; 203 my($options) = join(" ",@options); 204 my($file) = "tmp$$"; 205 my($in,$out) = $file.".c",$file.".o"; 206 207 open(F,">$in"); 208 print F $code; 209 close(F); 210 print "Linking |$code|\n" if $Verbose; 211 my($result) = scalar(`$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1`); 212 print "Executing '$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1'\n" if $Verbose; 213 my($error)=$?; 214 print "Error linking: $error, |$result|\n" if $Verbose; 215 unlink($in,$out,$file); 216 return (($error || $result ne "")?0:1) unless wantarray; 217 ($error,$result); 218} 219 220=head2 Execute 221 222Takes one or more arguments. The first is a string containing a C program. 223Embedded newlines are legal, the text simply being stuffed into a temporary 224file. The result is then fed to the C compiler and linker (that compiler and 225linker being previously determined by perl's metaconfig script.) and then 226executed. Any additional arguments provided are passed to the 227compilation/link command. (There is no way to feed arguments to the program 228being executed.) 229 230In a scalar context, the return value is either undef, indicating the 231compilation or link failed, or that the executed program returned a nonzero 232status. Otherwise, the return value is the text output by the program. 233 234In an array context, an array consisting of three values is returned: the 235first value is 0 or 1, 1 if the compile/link succeeded. The second value either 236the exist status of the compiler or program, and the third is the output text. 237 238=cut 239 240sub Execute { #Compile, link, and execute. 241 242 my($code,@options) = @_; 243 my($options)=join(" ",@options); 244 my($file) = "tmp$$"; 245 my($in,$out) = $file.".c",$file.".o"; 246 247 open(F,">$in"); 248 print F $code; 249 close(F); 250 print "Executing |$code|\n" if $Verbose; 251 my($result) = scalar(`$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1`); 252 print "Executing '$C_cc $C_ccflags -o $file $in $C_ldflags $C_libs $options 2>&1'\n" if $Verbose; 253 my($error) = $?; 254 unlink($in,$out); 255 if(!$error) { 256 my($result2) = scalar(`./$file`); 257 $error = $?; 258 unlink($file); 259 return ($error?undef:$result2) unless wantarray; 260 print "Executed successfully, status $error, link $result, exec |$result2|\n" if $Verbose; 261 (1,$error,$result2); 262 } else { 263 print "Link failed, status $error, message |$result|\n" if $Verbose; 264 return undef unless wantarray; 265 (0,$error,$result); 266 } 267} 268 269=head2 FindHeader 270 271Takes an unlimited number of arguments, consisting of both header names in 272the form "header.h", or directory specifications such as "-I/usr/include/bsd". 273For each supplied header, FindHeader will attempt to find the complete path. 274The return value is an array consisting of all the headers that were located. 275 276=cut 277 278sub FindHeader { #For each supplied header name, find full path 279 my(@headers) = grep(!/^-I/,@_); 280 my(@I) = grep(/^-I/,@_); 281 my($h); 282 for $h (@headers) { 283 print "Searching for $h... " if $Verbose; 284 if($h eq "") {$h=undef; next} 285 if( -f $h) {next} 286 if( -f $Config{"usrinc"}."/".$h) { 287 $h = $Config{"usrinc"}."/".$h; 288 print "Found as $h.\n" if $Verbose; 289 } else { 290 my $text; 291 if($text = CPP("#include <$h>",join(" ",@I))) { 292 grepcpp: 293 for (split(/\s+/,(grep(/^\s*#.*$h/,split(/\n/,$text)))[0])) { 294 if(/$h/) { 295 s/^\"(.*)\"$/$1/; 296 s/^\'(.*)\'$/$1/; 297 $h = $_; 298 print "Found as $h.\n" if $Verbose; 299 last grepcpp; 300 } 301 } 302 } else { 303 $h = undef; # remove header from resulting list 304 print "Not found.\n" if $Verbose; 305 } 306 } 307 } 308 grep($_,@headers); 309} 310 311=head2 FindLib 312 313Takes an unlimited number of arguments, consisting of both library names in 314the form "-llibname", "/usr/lib/libxyz.a" or "dld", or directory 315specifications such as "-L/usr/lib/foo". For each supplied library, FindLib 316will attempt to find the complete path. The return value is an array 317consisting of the full paths to all of the libraries that were located. 318 319=cut 320 321sub FindLib { #For each supplied library name, find full path 322 my(@libs) = grep(!/^-L/,@_); 323 my(@L) = (grep(/^-L/,@_),split(" ",$Config{"libpth"})); 324 grep(s/^-L//,@L); 325 my($l); 326 my($so) = $Config{"so"}; 327 my($found); 328 #print "Libaries I am searching for: ",join(",",@libs),"\n"; 329 #print "Directories: ",join(",",@L),"\n"; 330 my $lib; 331 for $lib (@libs) { 332 print "Searching for $lib... " if $Verbose; 333 $found=0; 334 $lib =~ s/^-l//; 335 if($lib eq "") {$lib=undef; next} 336 next if -f $lib; 337 my $path; 338 for $path (@L) { 339 my ( $fullname, @fullname ); 340 print "Searching $path for $lib...\n" if $Verbose; 341 if (@fullname=<${path}/lib${lib}.${so}.[0-9]*>){ 342 $fullname=$fullname[-1]; #ATTN: 10 looses against 9! 343 } elsif (-f ($fullname="$path/lib$lib.$so")){ 344 } elsif (-f ($fullname="$path/lib${lib}_s.a") 345 && ($lib .= "_s") ){ # we must explicitly ask for _s version 346 } elsif (-f ($fullname="$path/lib$lib.a")){ 347 } elsif (-f ($fullname="$path/Slib$lib.a")){ 348 } else { 349 warn "$lib not found in $path\n" if $Verbose; 350 next; 351 } 352 warn "'-l$lib' found at $fullname\n" if $Verbose; 353 $lib = $fullname; 354 $found=1; 355 } 356 if(!$found) { 357 $lib = undef; # Remove lib if not found 358 print "Not found.\n" if $Verbose; 359 } 360 } 361 grep($_,@libs); 362} 363 364 365=head2 366 367Apply takes a chunk of code, a series of libraries and headers, and attempts 368to apply them, in series, to a given perl command. In a scalar context, the 369return value of the first set of headers and libraries that produces a 370non-zero return value from the command is returned. In an array context, the 371header and library set it returned. 372 373This is best explained by some examples: 374 375 Apply(\&Compile,"main(){}","sgtty.h",""); 376 377In a scalar context either C<undef> or C<1>. In an array context, 378this returns C<()> or C<("sgtty.h","")>. 379 380 Apply(\&Link,"main(){int i=COLOR_PAIRS;}","curses.h","-lcurses", 381 "ncurses.h","-lncurses","ncurses/ncurses.h","-lncurses"); 382 383In a scalar context, this returns either C<undef>, C<1>. In an array context, 384this returns C<("curses.h","-lcurses")>, C<("ncurses.h","-lncurses")>, 385C<("ncurses/ncurses.h","-lncurses")>, or C<()>. 386 387If we had instead said 388C<Apply(\&Execute,'main(){printf("%d",(int)COLOR_PAIRS)',...)> then in a scalar 389context either C<undef> or the value of COLOR_PAIRS would be returned. 390 391Note that you can also supply multiple headers and/or libraries at one time, 392like this: 393 394 Apply(\&Compile,"main(){fcntl(0,F_GETFD);}","fcntl.h","", 395 "ioctl.h fcntl.h","","sys/ioctl.h fcntl.h"",""); 396 397So if fcntl needs ioctl or sys/ioctl loaded first, this will catch it. In an 398array context, C<()>, C<("fcntl.h","")>, C<("ioctl.h fcntl.h","")>, or 399C<("sys/ioctl.h fcntl.h","")> could be returned. 400 401You can also use nested arrays to get exactly the same effect. The returned 402array will always consist of a string, though, with elements separated by 403spaces. 404 405 Apply(\&Compile,"main(){fcntl(0,F_GETFD);}",["fcntl.h"],"", 406 ["ioctl.h","fcntl.h"],"",["sys/ioctl.h","fcntl.h"],""); 407 408Note that there are many functions that provide simpler ways of doing these 409things, from GetNumericSymbol to get the value of a symbol, to ApplyHeaders 410which doesn't ask for libraries. 411 412=cut 413 414sub Apply { # 415 my($cmd,$code,@lookup) = @_; 416 my(@l,@h,$i,$ret); 417 for ($i=0;$i<@lookup;$i+=2) { 418 if( ref($lookup[$i]) eq "ARRAY" ) { 419 @h = @{$lookup[$i]}; 420 } else { 421 @h = split(/\s+/,$lookup[$i]); 422 } 423 if( ref($lookup[$i+1]) eq "ARRAY" ) { 424 @l = @{$lookup[$i+1]}; 425 } else { 426 @l = split(/\s+/,$lookup[$i+1]); 427 } 428 429 if ($ret=&{$cmd == \&Link && !@l?\&Compile:$cmd}( 430 join("",map($_?"#include <$_>\n":"",grep(!/^-I/,@h))). 431 $code,grep(/^-I/,@h),@l)) { 432 print "Ret=|$ret|\n" if $Verbose; 433 return $ret unless wantarray; 434 return (join(" ",@h),join(" ",@l)); 435 } 436 } 437 return 0 unless wantarray; 438 (); 439} 440 441=head2 ApplyHeadersAndLibs 442 443This function takes the same sort of arguments as Apply, it just sends them 444directly to Link. 445 446=cut 447 448sub ApplyHeadersAndLibs { # 449 my($code,@lookup) = @_; 450 Apply \&Link,$code,@lookup; 451} 452 453=head2 ApplyHeadersAndLibsAndExecute 454 455This function is similar to Apply and ApplyHeadersAndLibs, but it always 456uses Execute. 457 458=cut 459 460sub ApplyHeadersAndLibsAndExecute { # 461 my($code,@lookup) = @_; 462 Apply \&Execute,$code,@lookup; 463} 464 465=head2 ApplyHeaders 466 467If you are only checking headers, and don't need to look at libs, then 468you will probably want to use ApplyHeaders. The return value is the same 469in a scalar context, but in an array context the returned array will only 470consists of the headers, spread out. 471 472=cut 473 474sub ApplyHeaders { 475 my($code,@headers) = @_; 476 return scalar(ApplyHeadersAndLibs $code, map(($_,""),@headers)) 477 unless wantarray; 478 split(/\s+/,(ApplyHeadersAndLibs $code, map(($_,""),@headers))[0]); 479} 480 481=head2 ApplyLibs 482 483If you are only checking libraries, and don't need to look at headers, then 484you will probably want to use ApplyLibs. The return value is the same 485in a scalar context, but in an array context the returned array will only 486consists of the libraries, spread out. 487 488=cut 489 490sub ApplyLibs { 491 my($code,@libs) = @_; 492 return scalar(ApplyHeadersAndLibs $code, map(("",$_),@libs)) 493 unless wantarray; 494 split(/\s+/,(ApplyHeadersAndLibs $code, map(("",$_),@libs))[0]); 495} 496 497=head2 CheckHeader 498 499Takes an unlimited number of arguments, consiting of headers in the 500Apply style. The first set that is fully accepted 501by the compiler is returned. 502 503=cut 504 505sub CheckHeader { #Find a header (or set of headers) that exists 506 ApplyHeaders("main(){}",@_); 507} 508 509=head2 CheckStructure 510 511Takes the name of a structure, and an unlimited number of further arguments 512consisting of header groups. The first group that defines that structure 513properly will be returned. B<undef> will be returned if nothing succeeds. 514 515=cut 516 517sub CheckStructure { # Check existance of a structure. 518 my($structname,@headers) = @_; 519 ApplyHeaders("main(){ struct $structname s;}",@headers); 520} 521 522=head2 CheckField 523 524Takes the name of a structure, the name of a field, and an unlimited number 525of further arguments consisting of header groups. The first group that 526defines a structure that contains the field will be returned. B<undef> will 527be returned if nothing succeeds. 528 529=cut 530 531sub CheckField { # Check for the existance of specified field in structure 532 my($structname,$fieldname,@headers) = @_; 533 ApplyHeaders("main(){ struct $structname s1; struct $structname s2; 534 s1.$fieldname = s2.$fieldname; }",@headers); 535} 536 537=head2 CheckLSymbol 538 539Takes the name of a symbol, and an unlimited number of further arguments 540consisting of library groups. The first group of libraries that defines 541that symbol will be returned. B<undef> will be returned if nothing succeeds. 542 543=cut 544 545sub CheckLSymbol { # Check for linkable symbol 546 my($symbol,@libs) = @_; 547 ApplyLibs("main() { void * f = (void *)($symbol); }",@libs); 548} 549 550=head2 CheckSymbol 551 552Takes the name of a symbol, and an unlimited number of further arguments 553consisting of header and library groups, in the Apply format. The first 554group of headers and libraries that defines that symbol will be returned. 555B<undef> will be returned if nothing succeeds. 556 557=cut 558 559sub CheckSymbol { # Check for linkable/header symbol 560 my($symbol,@lookup) = @_; 561 ApplyHeadersAndLibs("main() { void * f = (void *)($symbol); }",@lookup); 562} 563 564=head2 CheckHSymbol 565 566Takes the name of a symbol, and an unlimited number of further arguments 567consisting of header groups. The first group of headers that defines 568that symbol will be returned. B<undef> will be returned if nothing succeeds. 569 570=cut 571 572sub CheckHSymbol { # Check for header symbol 573 my($symbol,@headers) = @_; 574 ApplyHeaders("main() { void * f = (void *)($symbol); }",@headers); 575} 576 577=head2 CheckHPrototype (unexported) 578 579An experimental routine that takes a name of a function, a nested array 580consisting of the prototype, and then the normal header groups. It attempts 581to deduce whether the given prototype matches what the header supplies. 582Basically, it doesn't work. Or maybe it does. I wouldn't reccomend it, 583though. 584 585=cut 586 587sub CheckHPrototype { # Check for header prototype. 588 # Note: This function is extremely picky about "const int" versus "int", 589 # and depends on having an extremely snotty compiler. Anything but GCC 590 # may fail, and even GCC may not work properly. In any case, if the 591 # names function doesn't exist, this call will _succeed_. Caveat Utilitor. 592 my($function,$proto,@headers) = @_; 593 my(@proto) = @{$proto}; 594 ApplyHeaders("main() { extern ".$proto[0]." $function(". 595 join(",",@proto[1..$#proto])."); }",@headers); 596} 597 598=head2 GetSymbol 599 600Takes the name of a symbol, a printf command, a cast, and an unlimited 601number of further arguments consisting of header and library groups, in the 602Apply. The first group of headers and libraries that defines that symbol 603will be used to get the contents of the symbol in the format, and return it. 604B<undef> will be returned if nothing defines that symbol. 605 606Example: 607 608 GetSymbol("__LINE__","ld","long","",""); 609 610=cut 611 612sub GetSymbol { # Check for linkable/header symbol 613 my($symbol,$printf,$cast,@lookup) = @_,"",""; 614 scalar(ApplyHeadersAndLibsAndExecute( 615 "main(){ printf(\"\%$printf\",($cast)($symbol));exit(0);}",@lookup)); 616} 617 618=head2 GetTextSymbol 619 620Takes the name of a symbol, and an unlimited number of further arguments 621consisting of header and library groups, in the ApplyHeadersAndLibs format. 622The first group of headers and libraries that defines that symbol will be 623used to get the contents of the symbol in text format, and return it. 624B<undef> will be returned if nothing defines that symbol. 625 626Note that the symbol I<must> actually be text, either a char* or a constant 627string. Otherwise, the results are undefined. 628 629=cut 630 631sub GetTextSymbol { # Check for linkable/header symbol 632 my($symbol,@lookup) = @_,"",""; 633 my($result) = GetSymbol($symbol,"s","char*",@lookup); 634 $result .= "" if defined($result); 635 $result; 636} 637 638=head2 GetNumericSymbol 639 640Takes the name of a symbol, and an unlimited number of further arguments 641consisting of header and library groups, in the ApplyHeadersAndLibs format. 642The first group of headers and libraries that defines that symbol will be 643used to get the contents of the symbol in numeric format, and return it. 644B<undef> will be returned if nothing defines that symbol. 645 646Note that the symbol I<must> actually be numeric, in a format compatible 647with a float. Otherwise, the results are undefined. 648 649=cut 650 651sub GetNumericSymbol { # Check for linkable/header symbol 652 my($symbol,@lookup) = @_,"",""; 653 my($result) = GetSymbol($symbol,"f","float",@lookup); 654 $result += 0 if defined($result); 655 $result; 656} 657 658=head2 GetConstants 659 660Takes a list of header names (possibly including -I directives) and attempts 661to grep the specified files for constants, a constant being something #defined 662with a name that matches /[A-Z0-9_]+/. Returns the list of names. 663 664=cut 665 666sub GetConstants { # Try to grep constants out of a header 667 my(@headers) = @_; 668 @headers = FindHeader(@headers); 669 my %seen; 670 my(%results); 671 map($seen{$_}=1,@headers); 672 while(@headers) { 673 $_=shift(@headers); 674 next if !defined($_); 675 open(SEARCHHEADER,"<$_"); 676 while(<SEARCHHEADER>) { 677 if(/^\s*#\s*define\s+([A-Z_][A-Za-z0-9_]+)\s+/) { 678 $results{$1} = 1; 679 } elsif(/^\s*#\s*include\s+[<"]?([^">]+)[>"]?/) { 680 my(@include) = FindHeader($1); 681 @include = grep(!$seen{$_},map(defined($_)?$_:(),@include)); 682 push(@headers,@include); 683 map($seen{$_}=1,@include); 684 } 685 } 686 close(SEARCHHEADER); 687 } 688 keys %results; 689} 690 691 692=head2 DeducePrototype (unexported) 693 694This one is B<really> experimental. The idea is to figure out some basic 695characteristics of the compiler, and then attempt to "feel out" the prototype 696of a function. Eventually, it may work. It is guaranteed to be very slow, 697and it may simply not be capable of working on some systems. 698 699=cut 700 701my $firstdeduce = 1; 702sub DeducePrototype { 703 704 my (@types, $checkreturn, $checknilargs, $checkniletcargs, $checkreturnnil); 705 706 if($firstdeduce) { 707 $firstdeduce=0; 708 my $checknumber=!Compile(" 709extern int func(int a,int b); 710extern int func(int a,int b,int c); 711main(){}"); 712 $checkreturn=!Compile(" 713extern int func(int a,int b); 714extern long func(int a,int b); 715main(){}"); 716 my $checketc= !Compile(" 717extern int func(int a,int b); 718extern long func(int a,...); 719main(){}"); 720 my $checknumberetc=!Compile(" 721extern int func(int a,int b); 722extern int func(int a,int b,...); 723main(){}"); 724 my $checketcnumber=!Compile(" 725extern int func(int a,int b,int c,...); 726extern int func(int a,int b,...); 727main(){}"); 728 my $checkargtypes=!Compile(" 729extern int func(int a); 730extern int func(long a); 731main(){}"); 732 my $checkargsnil=!Compile(" 733extern int func(); 734extern int func(int a,int b,int c); 735main(){}"); 736 $checknilargs=!Compile(" 737extern int func(int a,int b,int c); 738extern int func(); 739main(){}"); 740 my $checkargsniletc=!Compile(" 741extern int func(...); 742extern int func(int a,int b,int c); 743main(){}"); 744 $checkniletcargs=!Compile(" 745extern int func(int a,int b,int c); 746extern int func(...); 747main(){}"); 748 749 my $checkconst=!Compile(" 750extern int func(const int * a); 751extern int func(int * a); 752main(){ }"); 753 754 my $checksign=!Compile(" 755extern int func(int a); 756extern int func(unsigned int a); 757main(){ }"); 758 759 $checkreturnnil=!Compile(" 760extern func(int a); 761extern void func(int a); 762main(){ }"); 763 764 @types = sort grep(Compile("main(){$_ a;}"), 765 "void","int","long int","unsigned int","unsigned long int","long long int", 766 "long long","unsigned long long", 767 "unsigned long long int","float","long float", 768 "double","long double", 769 "char","unsigned char","short int","unsigned short int"); 770 771 if(Compile("main(){flurfie a;}")) { @types = (); } 772 773 $Verbose=0; 774 775 # Attempt to remove duplicate types (if any) from type list 776 my ( $i, $j ); 777 if($checkargtypes) { 778 for ($i=0;$i<=$#types;$i++) { 779 for ($j=$i+1;$j<=$#types;$j++) { 780 next if $j==$i; 781 if(Compile(" 782extern void func($types[$i]); 783extern void func($types[$j]); 784main(){}")) { 785 print "Removing type $types[$j] because it equals $types[$i]\n"; 786 splice(@types,$j,1); 787 $j--; 788 } 789 } 790 } 791 } elsif($checkreturn) { 792 for ($i=0;$i<=$#types;$i++) { 793 for ($j=$i+1;$j<=$#types;$j++) { 794 next if $j==$i; 795 if(Compile(" 796$types[$i] func(void); 797extern $types[$j] func(void); 798main(){}")) { 799 print "Removing type $types[$j] because it equals $types[$i]\n"; 800 splice(@types,$j,1); 801 $j--; 802 } 803 } 804 } 805 } 806 $Verbose=1; 807 808 print "Detect differing numbers of arguments: $checknumber\n"; 809 print "Detect differing return types: $checkreturn\n"; 810 print "Detect differing argument types if one is ...: $checketc\n"; 811 print "Detect differing numbers of arguments if ... is involved: $checknumberetc\n"; 812 print "Detect differing numbers of arguments if ... is involved #2: $checketcnumber\n"; 813 print "Detect differing argument types: $checkargtypes\n"; 814 print "Detect differing argument types if first has no defined args: $checkargsnil\n"; 815 print "Detect differing argument types if second has no defined args: $checknilargs\n"; 816 print "Detect differing argument types if first has only ...: $checkargsniletc\n"; 817 print "Detect differing argument types if second has only ...: $checkniletcargs\n"; 818 print "Detect differing argument types by constness: $checkconst\n"; 819 print "Detect differing argument types by signedness: $checksign\n"; 820 print "Detect differing return types if one is not defined: $checkreturnnil\n"; 821 print "Types known: ",join(",",@types),"\n"; 822 823 } 824 825 my($function,@headers) = @_; 826 @headers = CheckHSymbol($function,@headers); 827 return undef if !@headers; 828 829 my $rettype = undef; 830 my @args = (); 831 my @validcount = (); 832 833 # Can we check the return type without worry about arguements? 834 if($checkreturn and (!$checknilargs or !$checkniletcargs)) { 835 for (@types) { 836 if(ApplyHeaders("extern $_ $function(". ($checknilargs?"...":"").");main(){}",[@headers])) { 837 $rettype = $_; # Great, we found the return type. 838 last; 839 } 840 } 841 } 842 843 if(!defined($rettype) and $checkreturnnil) { 844 die "No way to deduce function prototype in a rational amount of time"; 845 } 846 847 my $numargs=-1; 848 my $varargs=0; 849 for (0..32) { 850 if(ApplyHeaders("main(){ $function(".join(",",("0") x $_).");}",@headers)) { 851 $numargs=$_; 852 if(ApplyHeaders("main(){ $function(".join(",",("0") x ($_+1)).");}",@headers)) { 853 $varargs=1; 854 } 855 last 856 } 857 } 858 859 die "Unable to deduce number of arguments" if $numargs==-1; 860 861 if($varargs) { $args[$numargs]="..."; } 862 863 # OK, now we know how many arguments the thing takes. 864 865 866 if(@args>0 and !defined($rettype)) { 867 for (@types) { 868 if(defined(ApplyHeaders("extern $_ $function(".join(",",@args).");main(){}",[@headers]))) { 869 $rettype = $_; # Great, we found the return type. 870 last; 871 } 872 } 873 } 874 875 print "Return type: $rettype\nArguments: ",join(",",@args),"\n"; 876 print "Valid number of arguments: $numargs\n"; 877 print "Accepts variable number of args: $varargs\n"; 878} 879 880 881#$Verbose=1; 882 883#print scalar(join("|",CheckHeader("sgtty.h"))),"\n"; 884#print scalar(join("|",FindHeader(CheckHeader("sgtty.h")))),"\n"; 885#print scalar(join("|",CheckSymbol("COLOR_PAIRS","curses.h","-lcurses","ncurses.h","-lncurses","ncurses/ncurses.h","ncurses/libncurses.a"))),"\n"; 886#print scalar(join("|",GetNumericSymbol("PRIO_USER","sys/resource.h",""))),"\n"; 887 888