--- unif.c.~1.137.~ 2003-09-13 09:34:18.000000000 +1000 +++ unif.c 2003-12-19 15:22:10.000000000 +1000 @@ -1,4 +1,5 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003 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 @@ -72,6 +73,7 @@ */ scm_t_bits scm_tc16_array; +static SCM exactly_one_third; /* return the size of an element in a uniform array or 0 if type not found. */ @@ -175,6 +177,15 @@ else type = scm_tc7_ivect; } + else if (SCM_FRACTIONP (prot)) + { + /* The manual says "1/3" is the prototype for a "double". This was + fine before fractions existed, 1/3 gave a flonum which didn't fit a + "float" (not without rounding). But now we need to check for this + value explicitly (to maintain upward compatibility). */ + if (scm_num_eq_p (exactly_one_third, prot)) + goto dvect; + } else if (SCM_SYMBOLP (prot) && (1 == SCM_SYMBOL_LENGTH (prot))) { char s; @@ -213,6 +224,7 @@ } else { + dvect: i = sizeof (double) * k; type = scm_tc7_dvect; } @@ -574,7 +586,11 @@ else if (SCM_SYMBOLP (prot)) scm_array_fill_x (answer, SCM_MAKINUM (0)); else - scm_array_fill_x (answer, prot); + { + if (SCM_FRACTIONP (prot) && scm_num_eq_p (exactly_one_third, prot)) + prot = scm_exact_to_inexact (prot); + scm_array_fill_x (answer, prot); + } return answer; } @@ -599,7 +615,11 @@ else if (SCM_SYMBOLP (prot)) scm_array_fill_x (ra, SCM_MAKINUM (0)); else - scm_array_fill_x (ra, prot); + { + if (SCM_FRACTIONP (prot) && scm_num_eq_p (exactly_one_third, prot)) + prot = scm_exact_to_inexact (prot); + scm_array_fill_x (ra, prot); + } if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)) @@ -2585,6 +2605,8 @@ scm_set_smob_free (scm_tc16_array, array_free); scm_set_smob_print (scm_tc16_array, scm_raprin1); scm_set_smob_equalp (scm_tc16_array, scm_array_equal_p); + exactly_one_third = scm_permanent_object (scm_make_ratio (SCM_MAKINUM (1), + SCM_MAKINUM (3))); scm_add_feature ("array"); #include "libguile/unif.x" }