mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Fix likely crash in `stable-sort!'

Browse source 
* libguile/sort.c (scm_stable_sort_x): Properly handle zero-length
  vectors.
* test-suite/tests/sort.test ("stable-sort"): Add test for this case.
This commit is contained in:
Andreas Rottmann 2011-06-09 22:11:02 +02:00
parent e108c961fe
commit 589bc528bd
2 changed files with 13 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/sort.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1999,2000,2001,2002, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. /* Copyright (C) 1999,2000,2001,2002, 2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of * as published by the Free Software Foundation; either version 3 of
@ -495,6 +495,11 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
vec_elts = scm_vector_writable_elements (items, &vec_handle, vec_elts = scm_vector_writable_elements (items, &vec_handle,
&len, &inc); &len, &inc);
if (len == 0) {
scm_array_handle_release (&vec_handle);
return items;
}
temp = scm_c_make_vector (len, SCM_UNDEFINED); temp = scm_c_make_vector (len, SCM_UNDEFINED);
temp_elts = scm_vector_writable_elements (temp, &temp_handle, temp_elts = scm_vector_writable_elements (temp, &temp_handle,
NULL, NULL); NULL, NULL);

9
test-suite/tests/sort.test
View file

@ -1,5 +1,5 @@
;;;; sort.test --- tests Guile's sort functions -*- scheme -*- ;;;; sort.test --- tests Guile's sort functions -*- scheme -*-
;;;; Copyright (C) 2003, 2006, 2007, 2009 Free Software Foundation, Inc. ;;;; Copyright (C) 2003, 2006, 2007, 2009, 2011 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -73,5 +73,10 @@
;; in guile 1.8.0 and 1.8.1 this test failed, an empty list provoked a ;; in guile 1.8.0 and 1.8.1 this test failed, an empty list provoked a
;; wrong-type-arg exception (where it shouldn't) ;; wrong-type-arg exception (where it shouldn't)
(pass-if "empty list" (pass-if "empty list"
(eq? '() (stable-sort '() <)))) (eq? '() (stable-sort '() <)))
;; Ditto here, but up to 2.0.1 and 2.1.0 and invoking undefined
;; behavior (integer underflow) leading to crashes.
(pass-if "empty vector"
(equal? '#() (stable-sort '#() <))))