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 17package Configure; 18 19use strict; 20 21use vars qw(@EXPORT @ISA); 22 23use Carp; 24require Exporter; 25@ISA = qw(Exporter); 26 27@EXPORT = qw( CPP 28 Compile 29 Link 30 Execute 31 FindHeader 32 FindLib 33 Apply 34 ApplyHeaders 35 ApplyLibs 36 ApplyHeadersAndLibs 37 ApplyHeadersAndLibsAndExecute 38 CheckHeader 39 CheckStructure 40 CheckField 41 CheckHSymbol 42 CheckSymbol 43 CheckLSymbol 44 GetSymbol 45 GetTextSymbol 46 GetNumericSymbol 47 GetConstants); 48 49use Cwd; 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}(join("",map($_?"#include <$_>\n":"",grep(!/^-I/,@h))). 430 $code,grep(/^-I/,@h),@l)) { 431 print "Ret=|$ret|\n" if $Verbose; 432 return $ret unless wantarray; 433 return (join(" ",@h),join(" ",@l)); 434 } 435 } 436 return 0 unless wantarray; 437 (); 438} 439 440=head2 ApplyHeadersAndLibs 441 442This function takes the same sort of arguments as Apply, it just sends them 443directly to Link. 444 445=cut 446 447sub ApplyHeadersAndLibs { # 448 my($code,@lookup) = @_; 449 Apply \&Link,$code,@lookup; 450} 451 452=head2 ApplyHeadersAndLibsAndExecute 453 454This function is similar to Apply and ApplyHeadersAndLibs, but it always 455uses Execute. 456 457=cut 458 459sub ApplyHeadersAndLibsAndExecute { # 460 my($code,@lookup) = @_; 461 Apply \&Execute,$code,@lookup; 462} 463 464=head2 ApplyHeaders 465 466If you are only checking headers, and don't need to look at libs, then 467you will probably want to use ApplyHeaders. The return value is the same 468in a scalar context, but in an array context the returned array will only 469consists of the headers, spread out. 470 471=cut 472 473sub ApplyHeaders { 474 my($code,@headers) = @_; 475 return scalar(ApplyHeadersAndLibs $code, map(($_,""),@headers)) 476 unless wantarray; 477 split(/\s+/,(ApplyHeadersAndLibs $code, map(($_,""),@headers))[0]); 478} 479 480=head2 ApplyLibs 481 482If you are only checking libraries, and don't need to look at headers, then 483you will probably want to use ApplyLibs. The return value is the same 484in a scalar context, but in an array context the returned array will only 485consists of the libraries, spread out. 486 487=cut 488 489sub ApplyLibs { 490 my($code,@libs) = @_; 491 return scalar(ApplyHeadersAndLibs $code, map(("",$_),@libs)) 492 unless wantarray; 493 split(/\s+/,(ApplyHeadersAndLibs $code, map(("",$_),@libs))[0]); 494} 495 496=head2 CheckHeader 497 498Takes an unlimited number of arguments, consiting of headers in the 499Apply style. The first set that is fully accepted 500by the compiler is returned. 501 502=cut 503 504sub CheckHeader { #Find a header (or set of headers) that exists 505 ApplyHeaders("main(){}",@_); 506} 507 508=head2 CheckStructure 509 510Takes the name of a structure, and an unlimited number of further arguments 511consisting of header groups. The first group that defines that structure 512properly will be returned. B<undef> will be returned if nothing succeeds. 513 514=cut 515 516sub CheckStructure { # Check existance of a structure. 517 my($structname,@headers) = @_; 518 ApplyHeaders("main(){ struct $structname s;}",@headers); 519} 520 521=head2 CheckField 522 523Takes the name of a structure, the name of a field, and an unlimited number 524of further arguments consisting of header groups. The first group that 525defines a structure that contains the field will be returned. B<undef> will 526be returned if nothing succeeds. 527 528=cut 529 530sub CheckField { # Check for the existance of specified field in structure 531 my($structname,$fieldname,@headers) = @_; 532 ApplyHeaders("main(){ struct $structname s1; struct $structname s2; 533 s1.$fieldname = s2.$fieldname; }",@headers); 534} 535 536=head2 CheckLSymbol 537 538Takes the name of a symbol, and an unlimited number of further arguments 539consisting of library groups. The first group of libraries that defines 540that symbol will be returned. B<undef> will be returned if nothing succeeds. 541 542=cut 543 544sub CheckLSymbol { # Check for linkable symbol 545 my($symbol,@libs) = @_; 546 ApplyLibs("main() { void * f = (void *)($symbol); }",@libs); 547} 548 549=head2 CheckSymbol 550 551Takes the name of a symbol, and an unlimited number of further arguments 552consisting of header and library groups, in the Apply format. The first 553group of headers and libraries that defines that symbol will be returned. 554B<undef> will be returned if nothing succeeds. 555 556=cut 557 558sub CheckSymbol { # Check for linkable/header symbol 559 my($symbol,@lookup) = @_; 560 ApplyHeadersAndLibs("main() { void * f = (void *)($symbol); }",@lookup); 561} 562 563=head2 CheckHSymbol 564 565Takes the name of a symbol, and an unlimited number of further arguments 566consisting of header groups. The first group of headers that defines 567that symbol will be returned. B<undef> will be returned if nothing succeeds. 568 569=cut 570 571sub CheckHSymbol { # Check for header symbol 572 my($symbol,@headers) = @_; 573 ApplyHeaders("main() { void * f = (void *)($symbol); }",@headers); 574} 575 576=head2 CheckHPrototype (unexported) 577 578An experimental routine that takes a name of a function, a nested array 579consisting of the prototype, and then the normal header groups. It attempts 580to deduce whether the given prototype matches what the header supplies. 581Basically, it doesn't work. Or maybe it does. I wouldn't reccomend it, 582though. 583 584=cut 585 586sub CheckHPrototype { # Check for header prototype. 587 # Note: This function is extremely picky about "const int" versus "int", 588 # and depends on having an extremely snotty compiler. Anything but GCC 589 # may fail, and even GCC may not work properly. In any case, if the 590 # names function doesn't exist, this call will _succeed_. Caveat Utilitor. 591 my($function,$proto,@headers) = @_; 592 my(@proto) = @{$proto}; 593 ApplyHeaders("main() { extern ".$proto[0]." $function(". 594 join(",",@proto[1..$#proto])."); }",@headers); 595} 596 597=head2 GetSymbol 598 599Takes the name of a symbol, a printf command, a cast, and an unlimited 600number of further arguments consisting of header and library groups, in the 601Apply. The first group of headers and libraries that defines that symbol 602will be used to get the contents of the symbol in the format, and return it. 603B<undef> will be returned if nothing defines that symbol. 604 605Example: 606 607 GetSymbol("__LINE__","ld","long","",""); 608 609=cut 610 611sub GetSymbol { # Check for linkable/header symbol 612 my($symbol,$printf,$cast,@lookup) = @_,"",""; 613 scalar(ApplyHeadersAndLibsAndExecute( 614 "main(){ printf(\"\%$printf\",($cast)($symbol));exit(0);}",@lookup)); 615} 616 617=head2 GetTextSymbol 618 619Takes the name of a symbol, and an unlimited number of further arguments 620consisting of header and library groups, in the ApplyHeadersAndLibs format. 621The first group of headers and libraries that defines that symbol will be 622used to get the contents of the symbol in text format, and return it. 623B<undef> will be returned if nothing defines that symbol. 624 625Note that the symbol I<must> actually be text, either a char* or a constant 626string. Otherwise, the results are undefined. 627 628=cut 629 630sub GetTextSymbol { # Check for linkable/header symbol 631 my($symbol,@lookup) = @_,"",""; 632 my($result) = GetSymbol($symbol,"s","char*",@lookup); 633 $result .= "" if defined($result); 634 $result; 635} 636 637=head2 GetNumericSymbol 638 639Takes the name of a symbol, and an unlimited number of further arguments 640consisting of header and library groups, in the ApplyHeadersAndLibs format. 641The first group of headers and libraries that defines that symbol will be 642used to get the contents of the symbol in numeric format, and return it. 643B<undef> will be returned if nothing defines that symbol. 644 645Note that the symbol I<must> actually be numeric, in a format compatible 646with a float. Otherwise, the results are undefined. 647 648=cut 649 650sub GetNumericSymbol { # Check for linkable/header symbol 651 my($symbol,@lookup) = @_,"",""; 652 my($result) = GetSymbol($symbol,"f","float",@lookup); 653 $result += 0 if defined($result); 654 $result; 655} 656 657=head2 GetConstants 658 659Takes a list of header names (possibly including -I directives) and attempts 660to grep the specified files for constants, a constant being something #defined 661with a name that matches /[A-Z0-9_]+/. Returns the list of names. 662 663=cut 664 665sub GetConstants { # Try to grep constants out of a header 666 my(@headers) = @_; 667 @headers = FindHeader(@headers); 668 my %seen; 669 my(%results); 670 map($seen{$_}=1,@headers); 671 while(@headers) { 672 $_=shift(@headers); 673 next if !defined($_); 674 open(SEARCHHEADER,"<$_"); 675 while(<SEARCHHEADER>) { 676 if(/^\s*#\s*define\s+([A-Z_][A-Za-z0-9_]+)\s+/) { 677 $results{$1} = 1; 678 } elsif(/^\s*#\s*include\s+[<"]?([^">]+)[>"]?/) { 679 my(@include) = FindHeader($1); 680 @include = grep(!$seen{$_},map(defined($_)?$_:(),@include)); 681 push(@headers,@include); 682 map($seen{$_}=1,@include); 683 } 684 } 685 close(SEARCHHEADER); 686 } 687 keys %results; 688} 689 690 691=head2 DeducePrototype (unexported) 692 693This one is B<really> experimental. The idea is to figure out some basic 694characteristics of the compiler, and then attempt to "feel out" the prototype 695of a function. Eventually, it may work. It is guaranteed to be very slow, 696and it may simply not be capable of working on some systems. 697 698=cut 699 700my $firstdeduce = 1; 701sub DeducePrototype { 702 703 my (@types, $checkreturn, $checknilargs, $checkniletcargs, $checkreturnnil); 704 705 if($firstdeduce) { 706 $firstdeduce=0; 707 my $checknumber=!Compile("extern int func(int a,int b); 708 extern int func(int a,int b,int c); 709 main(){}"); 710 $checkreturn=!Compile("extern int func(int a,int b); 711 extern long func(int a,int b); 712 main(){}"); 713 my $checketc= !Compile("extern int func(int a,int b); 714 extern long func(int a,...); 715 main(){}"); 716 my $checknumberetc=!Compile("extern int func(int a,int b); 717 extern int func(int a,int b,...); 718 main(){}"); 719 my $checketcnumber=!Compile("extern int func(int a,int b,int c,...); 720 extern int func(int a,int b,...); 721 main(){}"); 722 my $checkargtypes=!Compile("extern int func(int a); 723 extern int func(long a); 724 main(){}"); 725 my $checkargsnil=!Compile("extern int func(); 726 extern int func(int a,int b,int c); 727 main(){}"); 728 $checknilargs=!Compile("extern int func(int a,int b,int c); 729 extern int func(); 730 main(){}"); 731 my $checkargsniletc=!Compile("extern int func(...); 732 extern int func(int a,int b,int c); 733 main(){}"); 734 $checkniletcargs=!Compile("extern int func(int a,int b,int c); 735 extern int func(...); 736 main(){}"); 737 738 my $checkconst=!Compile("extern int func(const int * a); 739 extern int func(int * a); 740 main(){ }"); 741 742 my $checksign=!Compile("extern int func(int a); 743 extern int func(unsigned int a); 744 main(){ }"); 745 746 $checkreturnnil=!Compile("extern func(int a); 747 extern void func(int a); 748 main(){ }"); 749 750 @types = sort grep(Compile("main(){$_ a;}"), 751 "void","int","long int","unsigned int","unsigned long int","long long int", 752 "long long","unsigned long long", 753 "unsigned long long int","float","long float", 754 "double","long double", 755 "char","unsigned char","short int","unsigned short int"); 756 757 if(Compile("main(){flurfie a;}")) { @types = (); } 758 759 $Verbose=0; 760 761 # Attempt to remove duplicate types (if any) from type list 762 my ( $i, $j ); 763 if($checkargtypes) { 764 for ($i=0;$i<=$#types;$i++) { 765 for ($j=$i+1;$j<=$#types;$j++) { 766 next if $j==$i; 767 if(Compile("extern void func($types[$i]); 768 extern void func($types[$j]); main(){}")) { 769 print "Removing type $types[$j] because it equals $types[$i]\n"; 770 splice(@types,$j,1); 771 $j--; 772 } 773 } 774 } 775 } elsif($checkreturn) { 776 for ($i=0;$i<=$#types;$i++) { 777 for ($j=$i+1;$j<=$#types;$j++) { 778 next if $j==$i; 779 if(Compile("$types[$i] func(void); 780 extern $types[$j] func(void); main(){}")) { 781 print "Removing type $types[$j] because it equals $types[$i]\n"; 782 splice(@types,$j,1); 783 $j--; 784 } 785 } 786 } 787 } 788 $Verbose=1; 789 790 print "Detect differing numbers of arguments: $checknumber\n"; 791 print "Detect differing return types: $checkreturn\n"; 792 print "Detect differing argument types if one is ...: $checketc\n"; 793 print "Detect differing numbers of arguments if ... is involved: $checknumberetc\n"; 794 print "Detect differing numbers of arguments if ... is involved #2: $checketcnumber\n"; 795 print "Detect differing argument types: $checkargtypes\n"; 796 print "Detect differing argument types if first has no defined args: $checkargsnil\n"; 797 print "Detect differing argument types if second has no defined args: $checknilargs\n"; 798 print "Detect differing argument types if first has only ...: $checkargsniletc\n"; 799 print "Detect differing argument types if second has only ...: $checkniletcargs\n"; 800 print "Detect differing argument types by constness: $checkconst\n"; 801 print "Detect differing argument types by signedness: $checksign\n"; 802 print "Detect differing return types if one is not defined: $checkreturnnil\n"; 803 print "Types known: ",join(",",@types),"\n"; 804 805 } 806 807 my($function,@headers) = @_; 808 @headers = CheckHSymbol($function,@headers); 809 return undef if !@headers; 810 811 my $rettype = undef; 812 my @args = (); 813 my @validcount = (); 814 815 # Can we check the return type without worry about arguements? 816 if($checkreturn and (!$checknilargs or !$checkniletcargs)) { 817 for (@types) { 818 if(ApplyHeaders("extern $_ $function(". ($checknilargs?"...":"").");main(){}",[@headers])) { 819 $rettype = $_; # Great, we found the return type. 820 last; 821 } 822 } 823 } 824 825 if(!defined($rettype) and $checkreturnnil) { 826 die "No way to deduce function prototype in a rational amount of time"; 827 } 828 829 my $numargs=-1; 830 my $varargs=0; 831 for (0..32) { 832 if(ApplyHeaders("main(){ $function(".join(",",("0") x $_).");}",@headers)) { 833 $numargs=$_; 834 if(ApplyHeaders("main(){ $function(".join(",",("0") x ($_+1)).");}",@headers)) { 835 $varargs=1; 836 } 837 last 838 } 839 } 840 841 die "Unable to deduce number of arguments" if $numargs==-1; 842 843 if($varargs) { $args[$numargs]="..."; } 844 845 # OK, now we know how many arguments the thing takes. 846 847 848 if(@args>0 and !defined($rettype)) { 849 for (@types) { 850 if(defined(ApplyHeaders("extern $_ $function(".join(",",@args).");main(){}",[@headers]))) { 851 $rettype = $_; # Great, we found the return type. 852 last; 853 } 854 } 855 } 856 857 print "Return type: $rettype\nArguments: ",join(",",@args),"\n"; 858 print "Valid number of arguments: $numargs\n"; 859 print "Accepts variable number of args: $varargs\n"; 860} 861 862 863#$Verbose=1; 864 865#print scalar(join("|",CheckHeader("sgtty.h"))),"\n"; 866#print scalar(join("|",FindHeader(CheckHeader("sgtty.h")))),"\n"; 867#print scalar(join("|",CheckSymbol("COLOR_PAIRS","curses.h","-lcurses","ncurses.h","-lncurses","ncurses/ncurses.h","ncurses/libncurses.a"))),"\n"; 868#print scalar(join("|",GetNumericSymbol("PRIO_USER","sys/resource.h",""))),"\n"; 869 870