gen-libm-test.pl 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737
  1. #!/usr/bin/perl -w
  2. # Copyright (C) 1999 Free Software Foundation, Inc.
  3. # This file is part of the GNU C Library.
  4. # Contributed by Andreas Jaeger <aj@suse.de>, 1999.
  5. # The GNU C Library is free software; you can redistribute it and/or
  6. # modify it under the terms of the GNU Lesser General Public
  7. # License as published by the Free Software Foundation; either
  8. # version 2.1 of the License, or (at your option) any later version.
  9. # The GNU C Library is distributed in the hope that it will be useful,
  10. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  12. # Lesser General Public License for more details.
  13. # You should have received a copy of the GNU Lesser General Public
  14. # License along with the GNU C Library; see the file COPYING.LIB. If
  15. # not, see <http://www.gnu.org/licenses/>.
  16. # This file needs to be tidied up
  17. # Note that functions and tests share the same namespace.
  18. # Information about tests are stored in: %results
  19. # $results{$test}{"kind"} is either "fct" or "test" and flags whether this
  20. # is a maximal error of a function or a single test.
  21. # $results{$test}{"type"} is the result type, e.g. normal or complex.
  22. # $results{$test}{"has_ulps"} is set if deltas exist.
  23. # $results{$test}{"has_fails"} is set if exptected failures exist.
  24. # In the following description $type and $float are:
  25. # - $type is either "normal", "real" (for the real part of a complex number)
  26. # or "imag" (for the imaginary part # of a complex number).
  27. # - $float is either of float, ifloat, double, idouble, ldouble, ildouble;
  28. # It represents the underlying floating point type (float, double or long
  29. # double) and if inline functions (the leading i stands for inline)
  30. # are used.
  31. # $results{$test}{$type}{"fail"}{$float} is defined and has a 1 if
  32. # the test is expected to fail
  33. # $results{$test}{$type}{"ulp"}{$float} is defined and has a delta as value
  34. use Getopt::Std;
  35. use strict;
  36. use vars qw ($input $output);
  37. use vars qw (%results);
  38. use vars qw (@tests @functions);
  39. use vars qw ($count);
  40. use vars qw (%beautify @all_floats);
  41. use vars qw ($output_dir $ulps_file);
  42. # all_floats is sorted and contains all recognised float types
  43. @all_floats = ('double', 'float', 'idouble',
  44. 'ifloat', 'ildouble', 'ldouble');
  45. %beautify =
  46. ( "minus_zero" => "-0",
  47. "plus_zero" => "+0",
  48. "minus_infty" => "-inf",
  49. "plus_infty" => "inf",
  50. "nan_value" => "NaN",
  51. "M_El" => "e",
  52. "M_E2l" => "e^2",
  53. "M_E3l" => "e^3",
  54. "M_LOG10El", "log10(e)",
  55. "M_PIl" => "pi",
  56. "M_PI_34l" => "3/4 pi",
  57. "M_PI_2l" => "pi/2",
  58. "M_PI_4l" => "pi/4",
  59. "M_PI_6l" => "pi/6",
  60. "M_PI_34_LOG10El" => "3/4 pi*log10(e)",
  61. "M_PI_LOG10El" => "pi*log10(e)",
  62. "M_PI2_LOG10El" => "pi/2*log10(e)",
  63. "M_PI4_LOG10El" => "pi/4*log10(e)",
  64. "M_LOG_SQRT_PIl" => "log(sqrt(pi))",
  65. "M_LOG_2_SQRT_PIl" => "log(2*sqrt(pi))",
  66. "M_2_SQRT_PIl" => "2 sqrt (pi)",
  67. "M_SQRT_PIl" => "sqrt (pi)",
  68. "INVALID_EXCEPTION" => "invalid exception",
  69. "DIVIDE_BY_ZERO_EXCEPTION" => "division by zero exception",
  70. "INVALID_EXCEPTION_OK" => "invalid exception allowed",
  71. "DIVIDE_BY_ZERO_EXCEPTION_OK" => "division by zero exception allowed",
  72. "EXCEPTIONS_OK" => "exceptions allowed",
  73. "IGNORE_ZERO_INF_SIGN" => "sign of zero/inf not specified",
  74. "INVALID_EXCEPTION|IGNORE_ZERO_INF_SIGN" => "invalid exception and sign of zero/inf not specified"
  75. );
  76. # get Options
  77. # Options:
  78. # u: ulps-file
  79. # h: help
  80. # o: output-directory
  81. # n: generate new ulps file
  82. use vars qw($opt_u $opt_h $opt_o $opt_n);
  83. getopts('u:o:nh');
  84. $ulps_file = 'libm-test-ulps';
  85. $output_dir = '';
  86. if ($opt_h) {
  87. print "Usage: gen-libm-test.pl [OPTIONS]\n";
  88. print " -h print this help, then exit\n";
  89. print " -o DIR directory where generated files will be placed\n";
  90. print " -n only generate sorted file NewUlps from libm-test-ulps\n";
  91. print " -u FILE input file with ulps\n";
  92. exit 0;
  93. }
  94. $ulps_file = $opt_u if ($opt_u);
  95. $output_dir = $opt_o if ($opt_o);
  96. $input = "libm-test.inc";
  97. $output = "${output_dir}libm-test.c";
  98. $count = 0;
  99. &parse_ulps ($ulps_file);
  100. &generate_testfile ($input, $output) unless ($opt_n);
  101. &output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file) unless ($opt_n);
  102. &print_ulps_file ("${output_dir}NewUlps") if ($opt_n);
  103. # Return a nicer representation
  104. sub beautify {
  105. my ($arg) = @_;
  106. my ($tmp);
  107. if (exists $beautify{$arg}) {
  108. return $beautify{$arg};
  109. }
  110. if ($arg =~ /^-/) {
  111. $tmp = $arg;
  112. $tmp =~ s/^-//;
  113. if (exists $beautify{$tmp}) {
  114. return '-' . $beautify{$tmp};
  115. }
  116. }
  117. if ($arg =~ /[0-9]L$/) {
  118. $arg =~ s/L$//;
  119. }
  120. return $arg;
  121. }
  122. # Return a nicer representation of a complex number
  123. sub build_complex_beautify {
  124. my ($r, $i) = @_;
  125. my ($str1, $str2);
  126. $str1 = &beautify ($r);
  127. $str2 = &beautify ($i);
  128. if ($str2 =~ /^-/) {
  129. $str2 =~ s/^-//;
  130. $str1 .= ' - ' . $str2;
  131. } else {
  132. $str1 .= ' + ' . $str2;
  133. }
  134. $str1 .= ' i';
  135. return $str1;
  136. }
  137. # Return name of a variable
  138. sub get_variable {
  139. my ($number) = @_;
  140. return "x" if ($number == 1);
  141. return "y" if ($number == 2);
  142. return "z" if ($number == 3);
  143. # return x1,x2,...
  144. $number =-3;
  145. return "x$number";
  146. }
  147. # Add a new test to internal data structures and fill in the
  148. # ulps, failures and exception information for the C line.
  149. sub new_test {
  150. my ($test, $exception) = @_;
  151. my $rest;
  152. # Add ulp, xfail
  153. if (exists $results{$test}{'has_ulps'}) {
  154. $rest = ", DELTA$count";
  155. } else {
  156. $rest = ', 0';
  157. }
  158. if (exists $results{$test}{'has_fails'}) {
  159. $rest .= ", FAIL$count";
  160. } else {
  161. $rest .= ', 0';
  162. }
  163. if (defined $exception) {
  164. $rest .= ", $exception";
  165. } else {
  166. $rest .= ', 0';
  167. }
  168. $rest .= ");\n";
  169. # We must increment here to keep @tests and count in sync
  170. push @tests, $test;
  171. ++$count;
  172. return $rest;
  173. }
  174. # Treat some functions especially.
  175. # Currently only sincos needs extra treatment.
  176. sub special_functions {
  177. my ($file, $args) = @_;
  178. my (@args, $str, $test, $cline);
  179. @args = split /,\s*/, $args;
  180. unless ($args[0] =~ /sincos/) {
  181. die ("Don't know how to handle $args[0] extra.");
  182. }
  183. print $file " FUNC (sincos) ($args[1], &sin_res, &cos_res);\n";
  184. $str = 'sincos (' . &beautify ($args[1]) . ', &sin_res, &cos_res)';
  185. # handle sin
  186. $test = $str . ' puts ' . &beautify ($args[2]) . ' in sin_res';
  187. if ($#args == 4) {
  188. $test .= " plus " . &beautify ($args[4]);
  189. }
  190. $cline = " check_float (\"$test\", sin_res, $args[2]";
  191. $cline .= &new_test ($test, $args[4]);
  192. print $file $cline;
  193. # handle cos
  194. $test = $str . ' puts ' . &beautify ($args[3]) . ' in cos_res';
  195. $cline = " check_float (\"$test\", cos_res, $args[3]";
  196. # only tests once for exception
  197. $cline .= &new_test ($test, undef);
  198. print $file $cline;
  199. }
  200. # Parse the arguments to TEST_x_y
  201. sub parse_args {
  202. my ($file, $descr, $args) = @_;
  203. my (@args, $str, $descr_args, $descr_res, @descr);
  204. my ($current_arg, $cline, $i);
  205. my ($pre, $post, @special);
  206. my ($extra_var, $call, $c_call);
  207. if ($descr eq 'extra') {
  208. &special_functions ($file, $args);
  209. return;
  210. }
  211. ($descr_args, $descr_res) = split /_/,$descr, 2;
  212. @args = split /,\s*/, $args;
  213. $call = "$args[0] (";
  214. # Generate first the string that's shown to the user
  215. $current_arg = 1;
  216. $extra_var = 0;
  217. @descr = split //,$descr_args;
  218. for ($i = 0; $i <= $#descr; $i++) {
  219. if ($i >= 1) {
  220. $call .= ', ';
  221. }
  222. # FLOAT, int, long int, long long int
  223. if ($descr[$i] =~ /f|i|l|L/) {
  224. $call .= &beautify ($args[$current_arg]);
  225. ++$current_arg;
  226. next;
  227. }
  228. # &FLOAT, &int - argument is added here
  229. if ($descr[$i] =~ /F|I/) {
  230. ++$extra_var;
  231. $call .= '&' . &get_variable ($extra_var);
  232. next;
  233. }
  234. # complex
  235. if ($descr[$i] eq 'c') {
  236. $call .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]);
  237. $current_arg += 2;
  238. next;
  239. }
  240. die ("$descr[$i] is unknown");
  241. }
  242. $call .= ')';
  243. $str = "$call == ";
  244. # Result
  245. @descr = split //,$descr_res;
  246. foreach (@descr) {
  247. if ($_ =~ /f|i|l|L/) {
  248. $str .= &beautify ($args[$current_arg]);
  249. ++$current_arg;
  250. } elsif ($_ eq 'c') {
  251. $str .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]);
  252. $current_arg += 2;
  253. } elsif ($_ eq 'b') {
  254. # boolean
  255. $str .= ($args[$current_arg] == 0) ? "false" : "true";
  256. ++$current_arg;
  257. } elsif ($_ eq '1') {
  258. ++$current_arg;
  259. } else {
  260. die ("$_ is unknown");
  261. }
  262. }
  263. # consistency check
  264. if ($current_arg == $#args) {
  265. die ("wrong number of arguments")
  266. unless ($args[$current_arg] =~ /EXCEPTION|IGNORE_ZERO_INF_SIGN/);
  267. } elsif ($current_arg < $#args) {
  268. die ("wrong number of arguments");
  269. } elsif ($current_arg > ($#args+1)) {
  270. die ("wrong number of arguments");
  271. }
  272. # check for exceptions
  273. if ($current_arg <= $#args) {
  274. $str .= " plus " . &beautify ($args[$current_arg]);
  275. }
  276. # Put the C program line together
  277. # Reset some variables to start again
  278. $current_arg = 1;
  279. $extra_var = 0;
  280. if (substr($descr_res,0,1) eq 'f') {
  281. $cline = 'check_float'
  282. } elsif (substr($descr_res,0,1) eq 'b') {
  283. $cline = 'check_bool';
  284. } elsif (substr($descr_res,0,1) eq 'c') {
  285. $cline = 'check_complex';
  286. } elsif (substr($descr_res,0,1) eq 'i') {
  287. $cline = 'check_int';
  288. } elsif (substr($descr_res,0,1) eq 'l') {
  289. $cline = 'check_long';
  290. } elsif (substr($descr_res,0,1) eq 'L') {
  291. $cline = 'check_longlong';
  292. }
  293. # Special handling for some macros:
  294. $cline .= " (\"$str\", ";
  295. if ($args[0] =~ /fpclassify|isnormal|isfinite|signbit/) {
  296. $c_call = "$args[0] (";
  297. } else {
  298. $c_call = " FUNC($args[0]) (";
  299. }
  300. @descr = split //,$descr_args;
  301. for ($i=0; $i <= $#descr; $i++) {
  302. if ($i >= 1) {
  303. $c_call .= ', ';
  304. }
  305. # FLOAT, int, long int, long long int
  306. if ($descr[$i] =~ /f|i|l|L/) {
  307. $c_call .= $args[$current_arg];
  308. $current_arg++;
  309. next;
  310. }
  311. # &FLOAT, &int
  312. if ($descr[$i] =~ /F|I/) {
  313. ++$extra_var;
  314. $c_call .= '&' . &get_variable ($extra_var);
  315. next;
  316. }
  317. # complex
  318. if ($descr[$i] eq 'c') {
  319. $c_call .= "BUILD_COMPLEX ($args[$current_arg], $args[$current_arg+1])";
  320. $current_arg += 2;
  321. next;
  322. }
  323. }
  324. $c_call .= ')';
  325. $cline .= "$c_call, ";
  326. @descr = split //,$descr_res;
  327. foreach (@descr) {
  328. if ($_ =~ /b|f|i|l|L/ ) {
  329. $cline .= $args[$current_arg];
  330. $current_arg++;
  331. } elsif ($_ eq 'c') {
  332. $cline .= "BUILD_COMPLEX ($args[$current_arg], $args[$current_arg+1])";
  333. $current_arg += 2;
  334. } elsif ($_ eq '1') {
  335. push @special, $args[$current_arg];
  336. ++$current_arg;
  337. }
  338. }
  339. # Add ulp, xfail
  340. $cline .= &new_test ($str, ($current_arg <= $#args) ? $args[$current_arg] : undef);
  341. # special treatment for some functions
  342. if ($args[0] eq 'frexp') {
  343. if (defined $special[0] && $special[0] ne "IGNORE") {
  344. my ($str) = "$call sets x to $special[0]";
  345. $post = " check_int (\"$str\", x, $special[0]";
  346. $post .= &new_test ($str, undef);
  347. }
  348. } elsif ($args[0] eq 'gamma' || $args[0] eq 'lgamma') {
  349. $pre = " signgam = 0;\n";
  350. if (defined $special[0] && $special[0] ne "IGNORE") {
  351. my ($str) = "$call sets signgam to $special[0]";
  352. $post = " check_int (\"$str\", signgam, $special[0]";
  353. $post .= &new_test ($str, undef);
  354. }
  355. } elsif ($args[0] eq 'modf') {
  356. if (defined $special[0] && $special[0] ne "IGNORE") {
  357. my ($str) = "$call sets x to $special[0]";
  358. $post = " check_float (\"$str\", x, $special[0]";
  359. $post .= &new_test ($str, undef);
  360. }
  361. } elsif ($args[0] eq 'remquo') {
  362. if (defined $special[0] && $special[0] ne "IGNORE") {
  363. my ($str) = "$call sets x to $special[0]";
  364. $post = " check_int (\"$str\", x, $special[0]";
  365. $post .= &new_test ($str, undef);
  366. }
  367. }
  368. print $file $pre if (defined $pre);
  369. print $file " $cline";
  370. print $file $post if (defined $post);
  371. }
  372. # Generate libm-test.c
  373. sub generate_testfile {
  374. my ($input, $output) = @_;
  375. my ($lasttext);
  376. my (@args, $i, $str);
  377. open INPUT, $input or die ("Can't open $input: $!");
  378. open OUTPUT, ">$output" or die ("Can't open $output: $!");
  379. # Replace the special macros
  380. while (<INPUT>) {
  381. # TEST_...
  382. if (/^\s*TEST_/) {
  383. my ($descr, $args);
  384. chop;
  385. ($descr, $args) = ($_ =~ /TEST_(\w+)\s*\((.*)\)/);
  386. &parse_args (\*OUTPUT, $descr, $args);
  387. next;
  388. }
  389. # START (function)
  390. if (/START/) {
  391. print OUTPUT " init_max_error ();\n";
  392. next;
  393. }
  394. # END (function)
  395. if (/END/) {
  396. my ($fct, $line, $type);
  397. if (/complex/) {
  398. s/,\s*complex\s*//;
  399. $type = 'complex';
  400. } else {
  401. $type = 'normal';
  402. }
  403. ($fct) = ($_ =~ /END\s*\((.*)\)/);
  404. if ($type eq 'complex') {
  405. $line = " print_complex_max_error (\"$fct\", ";
  406. } else {
  407. $line = " print_max_error (\"$fct\", ";
  408. }
  409. if (exists $results{$fct}{'has_ulps'}) {
  410. $line .= "DELTA$fct";
  411. } else {
  412. $line .= '0';
  413. }
  414. if (exists $results{$fct}{'has_fails'}) {
  415. $line .= ", FAIL$fct";
  416. } else {
  417. $line .= ', 0';
  418. }
  419. $line .= ");\n";
  420. print OUTPUT $line;
  421. push @functions, $fct;
  422. next;
  423. }
  424. print OUTPUT;
  425. }
  426. close INPUT;
  427. close OUTPUT;
  428. }
  429. # Parse ulps file
  430. sub parse_ulps {
  431. my ($file) = @_;
  432. my ($test, $type, $float, $eps, $kind);
  433. # $type has the following values:
  434. # "normal": No complex variable
  435. # "real": Real part of complex result
  436. # "imag": Imaginary part of complex result
  437. open ULP, $file or die ("Can't open $file: $!");
  438. while (<ULP>) {
  439. chop;
  440. # ignore comments and empty lines
  441. next if /^#/;
  442. next if /^\s*$/;
  443. if (/^Test/) {
  444. if (/Real part of:/) {
  445. s/Real part of: //;
  446. $type = 'real';
  447. } elsif (/Imaginary part of:/) {
  448. s/Imaginary part of: //;
  449. $type = 'imag';
  450. } else {
  451. $type = 'normal';
  452. }
  453. s/^.+\"(.*)\".*$/$1/;
  454. $test = $_;
  455. $kind = 'test';
  456. next;
  457. }
  458. if (/^Function: /) {
  459. if (/Real part of/) {
  460. s/Real part of //;
  461. $type = 'real';
  462. } elsif (/Imaginary part of/) {
  463. s/Imaginary part of //;
  464. $type = 'imag';
  465. } else {
  466. $type = 'normal';
  467. }
  468. ($test) = ($_ =~ /^Function:\s*\"([a-zA-Z0-9_]+)\"/);
  469. $kind = 'fct';
  470. next;
  471. }
  472. if (/^i?(float|double|ldouble):/) {
  473. ($float, $eps) = split /\s*:\s*/,$_,2;
  474. if ($eps eq 'fail') {
  475. $results{$test}{$type}{'fail'}{$float} = 1;
  476. $results{$test}{'has_fails'} = 1;
  477. } elsif ($eps eq "0") {
  478. # ignore
  479. next;
  480. } else {
  481. $results{$test}{$type}{'ulp'}{$float} = $eps;
  482. $results{$test}{'has_ulps'} = 1;
  483. }
  484. if ($type =~ /^real|imag$/) {
  485. $results{$test}{'type'} = 'complex';
  486. } elsif ($type eq 'normal') {
  487. $results{$test}{'type'} = 'normal';
  488. }
  489. $results{$test}{'kind'} = $kind;
  490. next;
  491. }
  492. print "Skipping unknown entry: `$_'\n";
  493. }
  494. close ULP;
  495. }
  496. # Clean up a floating point number
  497. sub clean_up_number {
  498. my ($number) = @_;
  499. # Remove trailing zeros
  500. $number =~ s/0+$//;
  501. $number =~ s/\.$//;
  502. return $number;
  503. }
  504. # Output a file which can be read in as ulps file.
  505. sub print_ulps_file {
  506. my ($file) = @_;
  507. my ($test, $type, $float, $eps, $fct, $last_fct);
  508. $last_fct = '';
  509. open NEWULP, ">$file" or die ("Can't open $file: $!");
  510. print NEWULP "# Begin of automatic generation\n";
  511. # first the function calls
  512. foreach $test (sort keys %results) {
  513. next if ($results{$test}{'kind'} ne 'test');
  514. foreach $type ('real', 'imag', 'normal') {
  515. if (exists $results{$test}{$type}) {
  516. if (defined $results{$test}) {
  517. ($fct) = ($test =~ /^(\w+)\s/);
  518. if ($fct ne $last_fct) {
  519. $last_fct = $fct;
  520. print NEWULP "\n# $fct\n";
  521. }
  522. }
  523. if ($type eq 'normal') {
  524. print NEWULP "Test \"$test\":\n";
  525. } elsif ($type eq 'real') {
  526. print NEWULP "Test \"Real part of: $test\":\n";
  527. } elsif ($type eq 'imag') {
  528. print NEWULP "Test \"Imaginary part of: $test\":\n";
  529. }
  530. foreach $float (@all_floats) {
  531. if (exists $results{$test}{$type}{'ulp'}{$float}) {
  532. print NEWULP "$float: ",
  533. &clean_up_number ($results{$test}{$type}{'ulp'}{$float}),
  534. "\n";
  535. }
  536. if (exists $results{$test}{$type}{'fail'}{$float}) {
  537. print NEWULP "$float: fail\n";
  538. }
  539. }
  540. }
  541. }
  542. }
  543. print NEWULP "\n# Maximal error of functions:\n";
  544. foreach $fct (sort keys %results) {
  545. next if ($results{$fct}{'kind'} ne 'fct');
  546. foreach $type ('real', 'imag', 'normal') {
  547. if (exists $results{$fct}{$type}) {
  548. if ($type eq 'normal') {
  549. print NEWULP "Function: \"$fct\":\n";
  550. } elsif ($type eq 'real') {
  551. print NEWULP "Function: Real part of \"$fct\":\n";
  552. } elsif ($type eq 'imag') {
  553. print NEWULP "Function: Imaginary part of \"$fct\":\n";
  554. }
  555. foreach $float (@all_floats) {
  556. if (exists $results{$fct}{$type}{'ulp'}{$float}) {
  557. print NEWULP "$float: ",
  558. &clean_up_number ($results{$fct}{$type}{'ulp'}{$float}),
  559. "\n";
  560. }
  561. if (exists $results{$fct}{$type}{'fail'}{$float}) {
  562. print NEWULP "$float: fail\n";
  563. }
  564. }
  565. print NEWULP "\n";
  566. }
  567. }
  568. }
  569. print NEWULP "# end of automatic generation\n";
  570. close NEWULP;
  571. }
  572. sub get_ulps {
  573. my ($test, $type, $float) = @_;
  574. if ($type eq 'complex') {
  575. my ($res);
  576. # Return 0 instead of BUILD_COMPLEX (0,0)
  577. if (!exists $results{$test}{'real'}{'ulp'}{$float} &&
  578. !exists $results{$test}{'imag'}{'ulp'}{$float}) {
  579. return "0";
  580. }
  581. $res = 'BUILD_COMPLEX (';
  582. $res .= (exists $results{$test}{'real'}{'ulp'}{$float}
  583. ? $results{$test}{'real'}{'ulp'}{$float} : "0");
  584. $res .= ', ';
  585. $res .= (exists $results{$test}{'imag'}{'ulp'}{$float}
  586. ? $results{$test}{'imag'}{'ulp'}{$float} : "0");
  587. $res .= ')';
  588. return $res;
  589. }
  590. return (exists $results{$test}{'normal'}{'ulp'}{$float}
  591. ? $results{$test}{'normal'}{'ulp'}{$float} : "0");
  592. }
  593. sub get_failure {
  594. my ($test, $type, $float) = @_;
  595. if ($type eq 'complex') {
  596. # return x,y
  597. my ($res);
  598. # Return 0 instead of BUILD_COMPLEX_INT (0,0)
  599. if (!exists $results{$test}{'real'}{'ulp'}{$float} &&
  600. !exists $results{$test}{'imag'}{'ulp'}{$float}) {
  601. return "0";
  602. }
  603. $res = 'BUILD_COMPLEX_INT (';
  604. $res .= (exists $results{$test}{'real'}{'fail'}{$float}
  605. ? $results{$test}{'real'}{'fail'}{$float} : "0");
  606. $res .= ', ';
  607. $res .= (exists $results{$test}{'imag'}{'fail'}{$float}
  608. ? $results{$test}{'imag'}{'fail'}{$float} : "0");
  609. $res .= ')';
  610. return $res;
  611. }
  612. return (exists $results{$test}{'normal'}{'fail'}{$float}
  613. ? $results{$test}{'normal'}{'fail'}{$float} : "0");
  614. }
  615. # Output the defines for a single test
  616. sub output_test {
  617. my ($file, $test, $name) = @_;
  618. my ($ldouble, $double, $float, $ildouble, $idouble, $ifloat);
  619. my ($type);
  620. # Do we have ulps/failures?
  621. if (!exists $results{$test}{'type'}) {
  622. return;
  623. }
  624. $type = $results{$test}{'type'};
  625. if (exists $results{$test}{'has_ulps'}) {
  626. # XXX use all_floats (change order!)
  627. $ldouble = &get_ulps ($test, $type, "ldouble");
  628. $double = &get_ulps ($test, $type, "double");
  629. $float = &get_ulps ($test, $type, "float");
  630. $ildouble = &get_ulps ($test, $type, "ildouble");
  631. $idouble = &get_ulps ($test, $type, "idouble");
  632. $ifloat = &get_ulps ($test, $type, "ifloat");
  633. print $file "#define DELTA$name CHOOSE($ldouble, $double, $float, $ildouble, $idouble, $ifloat)\t/* $test */\n";
  634. }
  635. if (exists $results{$test}{'has_fails'}) {
  636. $ldouble = &get_failure ($test, "ldouble");
  637. $double = &get_failure ($test, "double");
  638. $float = &get_failure ($test, "float");
  639. $ildouble = &get_failure ($test, "ildouble");
  640. $idouble = &get_failure ($test, "idouble");
  641. $ifloat = &get_failure ($test, "ifloat");
  642. print $file "#define FAIL$name CHOOSE($ldouble, $double, $float $ildouble, $idouble, $ifloat)\t/* $test */\n";
  643. }
  644. }
  645. # Print include file
  646. sub output_ulps {
  647. my ($file, $ulps_filename) = @_;
  648. my ($i, $fct);
  649. open ULP, ">$file" or die ("Can't open $file: $!");
  650. print ULP "/* This file is automatically generated\n";
  651. print ULP " from $ulps_filename with gen-libm-test.pl.\n";
  652. print ULP " Don't change it - change instead the master files. */\n\n";
  653. print ULP "\n/* Maximal error of functions. */\n";
  654. foreach $fct (@functions) {
  655. output_test (\*ULP, $fct, $fct);
  656. }
  657. print ULP "\n/* Error of single function calls. */\n";
  658. for ($i = 0; $i < $count; $i++) {
  659. output_test (\*ULP, $tests[$i], $i);
  660. }
  661. close ULP;
  662. }