Re: Introduction of fractions exposes uniform vector prototype bug

[Kevin Ryde <user42@zip.com.au>]

[-- Attachment #1: Type: text/plain, Size: 1190 bytes --]

Mikael Djurfeldt <mdj@mit.edu> writes:
>
> I have no good suggestion for what to do about this, but one thing is
> certain: We can't suggest people to use 1/3 as prototype for double
> arrays (at least now without modifying scm_make_uve).

I'd be pretty inclined to make it a special case, for compatibility.

Asking people to change their code after they've followed something
the manual explicitly said is never nice.

Fractions apart from 1/3 could be left to indicate an array of
fractions, if such a thing is added in the future.

Perhaps (below),

        * unif.c (scm_make_uve): Recognise 1/3 for a dvect array of doubles,
        as specified in the manual.
        (scm_dimensions_to_uniform_array): Convert prototype 1/3 to an
        inexact, as required by scm_array_fill_x.
        (exactly_one_third): New variable.
        (scm_init_unif): Initialize it.

        * tests/unif.test: New file.

Maybe array-fill! should use scm_num2dbl the same way array-set! does,
instead of converting in scm_dimensions_to_uniform_array.

I think it'd make a lot of sense for array-fill! and array-set! to
accept the same operands.  (Irrespective of what's done or not done to
make_uve.)


[-- Attachment #2: unif.c.dvect.diff --]
[-- Type: text/plain, Size: 2499 bytes --]

--- 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"
 }

[-- Attachment #3: unif.test --]
[-- Type: text/plain, Size: 3297 bytes --]

;;;; unif.test --- tests guile's uniform arrays     -*- scheme -*-
;;;;
;;;; Copyright 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
;;;; License as published by the Free Software Foundation; either
;;;; version 2.1 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

(define-module (test-suite test-unif)
  #:use-module (test-suite lib)
  #:use-module (ice-9 documentation))

;;;
;;; prototypes
;;;

(with-test-prefix "prototypes"

  (with-test-prefix "make-uniform-vector"
    (pass-if "bool"
      (eq? #t (array-prototype (make-uniform-vector 1 #t))))

    (pass-if "char"
      (char=? #\a (array-prototype (make-uniform-vector 1 #\a))))

    (pass-if "byte"
      (char=? #\nul (array-prototype (make-uniform-vector 1 #\nul))))

    (pass-if "short"
      (eq? 's (array-prototype (make-uniform-vector 1 's))))

    (pass-if "ulong"
      (= 1 (array-prototype (make-uniform-vector 1 1))))

    (pass-if "long"
      (= -1 (array-prototype (make-uniform-vector 1 -1))))

    ;; FIXME: What's a good way to tell if long long is available?
    ;; (pass-if "long long"
    ;;   (eq? 'l (array-prototype (make-uniform-vector 1 'l))))

    (pass-if "float"
      (= 1.0 (array-prototype (make-uniform-vector 1 1.0))))

    (with-test-prefix "double"
      (pass-if "no fill"
	(= 1/3 (array-prototype (make-uniform-vector 1 1/3))))
      (pass-if "fill 1.0"
	(= 1/3 (array-prototype (make-uniform-vector 1 1/3 1.0)))))

    (pass-if "complex"
      (= 0+i (array-prototype (make-uniform-vector 1 0+i))))

    (pass-if "scm"
      (eq? '() (array-prototype (make-uniform-vector 1 '())))))

  (with-test-prefix "make-uniform-vector"

    (pass-if "bool"
      (eq? #t (array-prototype (make-uniform-array #t '(5 6)))))

    (pass-if "char"
      (char=? #\a (array-prototype (make-uniform-array #\a '(5 6)))))

    (pass-if "byte"
      (char=? #\nul (array-prototype (make-uniform-array #\nul '(5 6)))))

    (pass-if "short"
      (eq? 's (array-prototype (make-uniform-array 's '(5 6)))))

    (pass-if "ulong"
      (= 1 (array-prototype (make-uniform-array 1 '(5 6)))))

    (pass-if "long"
      (= -1 (array-prototype (make-uniform-array -1 '(5 6)))))

    ;; FIXME: What's a good way to tell if long long is available?
    ;; (pass-if "long long"
    ;;   (eq? 'l (array-prototype (make-uniform-array 'l '(5 6)))))

    (pass-if "float"
      (= 1.0 (array-prototype (make-uniform-array 1.0 '(5 6)))))

    (pass-if "double"
      (= 1/3 (array-prototype (make-uniform-array 1/3 '(5 6)))))

    (pass-if "complex"
      (= 0+i (array-prototype (make-uniform-array 0+i '(5 6)))))

    (pass-if "scm"
      (eq? '() (array-prototype (make-uniform-array '( '(5 6))))))))

[-- Attachment #4: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel