From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Kevin Ryde Newsgroups: gmane.lisp.guile.devel Subject: num2integral long long range check Date: Sun, 25 Apr 2004 07:30:56 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87fzathxm7.fsf@zip.com.au> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1082842398 4502 80.91.224.253 (24 Apr 2004 21:33:18 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sat, 24 Apr 2004 21:33:18 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Apr 24 23:33:10 2004 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1BHUlp-0003Gh-00 for ; Sat, 24 Apr 2004 23:33:09 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1BHUkv-0005fK-L7 for guile-devel@m.gmane.org; Sat, 24 Apr 2004 17:32:13 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1BHUkq-0005eh-Cf for guile-devel@gnu.org; Sat, 24 Apr 2004 17:32:08 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1BHUkK-0005Yz-DB for guile-devel@gnu.org; Sat, 24 Apr 2004 17:32:07 -0400 Original-Received: from [61.8.0.84] (helo=mailout1.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.30) id 1BHUkJ-0005YW-83 for guile-devel@gnu.org; Sat, 24 Apr 2004 17:31:35 -0400 Original-Received: from mailproxy2.pacific.net.au (mailproxy2.pacific.net.au [61.8.0.87]) by mailout1.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id i3OLVV4u012954 for ; Sun, 25 Apr 2004 07:31:31 +1000 Original-Received: from localhost (ppp2822.dyn.pacific.net.au [61.8.40.34]) by mailproxy2.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id i3OLVLHV003540 for ; Sun, 25 Apr 2004 07:31:27 +1000 Original-Received: from gg by localhost with local (Exim 3.36 #1 (Debian)) id 1BHUji-0001W8-00; Sun, 25 Apr 2004 07:30:58 +1000 Original-To: guile-devel@gnu.org Mail-Copies-To: never User-Agent: Gnus/5.110002 (No Gnus v0.2) Emacs/21.3 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:3639 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:3639 --=-=-= Some gremlins in the range checking of scm_num2long_long, * num2integral.i.c (NUM2INTEGRAL): Under non-BIGMPZ_FITSP case, corrections to range check for signed numbers. * standalone/test-num2integral.c (test_long_long): Exercise out-of-range errors on various cases. (test_ulong_long): New function, split from test_long_long and similarly exercising out-of-range. --=-=-= Content-Disposition: attachment; filename=num2integral.i.c.range.diff --- num2integral.i.c.~1.21.~ 2004-02-14 13:23:30.000000000 +1000 +++ num2integral.i.c 2004-04-24 15:54:15.000000000 +1000 @@ -88,19 +88,44 @@ } else { + size_t itype_bits = sizeof (ITYPE) * SCM_CHAR_BIT; + int sgn = mpz_sgn (SCM_I_BIG_MPZ (num)); size_t numbits; + if (UNSIGNED) { - int sgn = mpz_sgn (SCM_I_BIG_MPZ (num)); - scm_remember_upto_here_1 (num); if (sgn < 0) scm_out_of_range (s_caller, num); } - + numbits = mpz_sizeinbase (SCM_I_BIG_MPZ (num), 2); - scm_remember_upto_here_1 (num); - if (numbits > (sizeof (ITYPE) * SCM_CHAR_BIT)) - scm_out_of_range (s_caller, num); + + if (UNSIGNED) + { + if (numbits > itype_bits) + scm_out_of_range (s_caller, num); + } + else + { + if (sgn >= 0) + { + /* positive, require num < 2^(itype_bits-1) */ + if (numbits > itype_bits-1) + scm_out_of_range (s_caller, num); + } + else + { + /* negative, require abs(num) < 2^(itype_bits-1), but + also allow num == -2^(itype_bits-1), the latter + detected by numbits==itype_bits plus the lowest + (and only) 1 bit at position itype_bits-1 */ + if (numbits > itype_bits + || (numbits == itype_bits + && (mpz_scan1 (SCM_I_BIG_MPZ (num), 0) + != itype_bits - 1))) + scm_out_of_range (s_caller, num); + } + } } if (UNSIGNED && (SIZEOF_ITYPE <= SIZEOF_UNSIGNED_LONG)) --=-=-= Content-Disposition: attachment; filename=test-num2integral.c.range.diff --- test-num2integral.c.~1.1.~ 2003-04-08 03:48:31.000000000 +1000 +++ test-num2integral.c 2004-04-24 15:59:13.000000000 +1000 @@ -1,4 +1,4 @@ -/* Copyright (C) 1999,2000,2001,2003 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001,2003,2004 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -29,6 +29,33 @@ # endif #endif + +SCM out_of_range_handler (void *data, SCM key, SCM args); +SCM call_num2long_long_body (void *data); +SCM call_num2ulong_long_body (void *data); + +/* expect to catch an `out-of-range' exception */ +SCM +out_of_range_handler (void *data, SCM key, SCM args) +{ + assert (scm_equal_p (key, scm_str2symbol ("out-of-range"))); + return SCM_BOOL_T; +} + +SCM +call_num2long_long_body (void *data) +{ + scm_num2long_long (* (SCM *) data, SCM_ARG1, "call_num2long_long_body"); + return SCM_BOOL_F; +} + +SCM +call_num2ulong_long_body (void *data) +{ + scm_num2ulong_long (* (SCM *) data, SCM_ARG1, "call_num2ulong_long_body"); + return SCM_BOOL_F; +} + static void test_long_long () { @@ -38,11 +65,87 @@ long long result = scm_num2long_long(n, 0, "main"); assert (result == LLONG_MIN); } + + /* LLONG_MIN - 1 */ + { + SCM n = scm_difference (scm_long_long2num (LLONG_MIN), SCM_MAKINUM(1)); + SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, + out_of_range_handler, NULL); + assert (! SCM_FALSEP (caught)); + } + + /* LLONG_MIN + LLONG_MIN/2 */ + { + SCM n = scm_sum (scm_long_long2num (LLONG_MIN), + scm_long_long2num (LLONG_MIN / 2)); + SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, + out_of_range_handler, NULL); + assert (! SCM_FALSEP (caught)); + } + + /* LLONG_MAX + 1 */ + { + SCM n = scm_sum (scm_long_long2num (LLONG_MAX), SCM_MAKINUM(1)); + SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, + out_of_range_handler, NULL); + assert (! SCM_FALSEP (caught)); + } + + /* 2^1024 */ + { + SCM n = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024)); + SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, + out_of_range_handler, NULL); + assert (! SCM_FALSEP (caught)); + } + + /* -2^1024 */ + { + SCM n = scm_difference (SCM_MAKINUM (0), + scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024))); + SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, + out_of_range_handler, NULL); + assert (! SCM_FALSEP (caught)); + } + +#endif /* SCM_SIZEOF_LONG_LONG != 0 */ +} + +static void +test_ulong_long () +{ +#if SCM_SIZEOF_LONG_LONG != 0 + { SCM n = scm_ulong_long2num (ULLONG_MAX); unsigned long long result = scm_num2ulong_long(n, 0, "main"); assert (result == ULLONG_MAX); } + + /* -1 */ + { + SCM n = SCM_MAKINUM (-1); + SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n, + out_of_range_handler, NULL); + assert (! SCM_FALSEP (caught)); + } + + /* ULLONG_MAX + 1 */ + { + SCM n = scm_sum (scm_ulong_long2num (ULLONG_MAX), SCM_MAKINUM(1)); + SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n, + out_of_range_handler, NULL); + assert (! SCM_FALSEP (caught)); + } + + /* 2^1024 */ + { + SCM n = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (1024)); + SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n, + out_of_range_handler, NULL); + assert (! SCM_FALSEP (caught)); + } + #endif /* SCM_SIZEOF_LONG_LONG != 0 */ } @@ -51,5 +154,6 @@ { scm_init_guile(); test_long_long (); + test_ulong_long (); return 0; } --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel --=-=-=--