From 5dcad70d993e68b0b175efff8c9b3b7477a74891 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 14 Oct 2018 02:22:22 -0400 Subject: [PATCH] Fix list validation of *list->bytevector procedures. Fixes . Reported by Josh Datko . * libguile/validate.h (SCM_VALIDATE_LIST_COPYLEN) (SCM_VALIDATE_NONEMPTYLIST_COPYLEN): Use '!=' instead of '>=' to validate the result of 'scm_ilength' after it has been stored in the user variable 'cvar'. * test-suite/tests/bytevectors.test: Add tests. Use '#:use-module' instead of ':use-module' in 'define-module' form. --- libguile/list.h | 10 ++++++--- test-suite/tests/bytevectors.test | 37 ++++++++++++++++++++++++++----- 2 files changed, 39 insertions(+), 8 deletions(-) diff --git a/libguile/list.h b/libguile/list.h index a494a480c..5ebcc8a82 100644 --- a/libguile/list.h +++ b/libguile/list.h @@ -1,7 +1,7 @@ #ifndef SCM_LIST_H #define SCM_LIST_H -/* Copyright 1995-1997,2000-2001,2003-2006,2008-2009,2018 +/* Copyright 1995-1997,2000-2001,2003-2006,2008-2009,2018-2019 Free Software Foundation, Inc. This file is part of Guile. @@ -88,16 +88,20 @@ SCM_API SCM scm_copy_tree (SCM obj); SCM_ASSERT (scm_ilength (lst) > 0, lst, pos, FUNC_NAME); \ } while (0) +/* Note: we use (cvar != -1) instead of (cvar >= 0) below + in case 'cvar' is of unsigned type. */ #define SCM_VALIDATE_LIST_COPYLEN(pos, lst, cvar) \ do { \ cvar = scm_ilength (lst); \ - SCM_ASSERT (cvar >= 0, lst, pos, FUNC_NAME); \ + SCM_ASSERT (cvar != -1, lst, pos, FUNC_NAME); \ } while (0) +/* Note: we use (cvar != -1) instead of (cvar >= 0) below + in case 'cvar' is of unsigned type. */ #define SCM_VALIDATE_NONEMPTYLIST_COPYLEN(pos, lst, cvar) \ do { \ cvar = scm_ilength (lst); \ - SCM_ASSERT (cvar >= 1, lst, pos, FUNC_NAME); \ + SCM_ASSERT (cvar != -1, lst, pos, FUNC_NAME); \ } while (0) diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test index f0d9f1983..5d4568d82 100644 --- a/test-suite/tests/bytevectors.test +++ b/test-suite/tests/bytevectors.test @@ -1,6 +1,6 @@ ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2009-2015 Free Software Foundation, Inc. +;;;; Copyright (C) 2009-2015, 2018 Free Software Foundation, Inc. ;;;; ;;;; Ludovic Courtès ;;;; @@ -19,10 +19,11 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-bytevector) - :use-module (test-suite lib) - :use-module (system base compile) - :use-module (rnrs bytevectors) - :use-module (srfi srfi-4)) + #:use-module (test-suite lib) + #:use-module (system base compile) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-4)) (define exception:decoding-error (cons 'decoding-error "input (locale conversion|decoding) error")) @@ -111,6 +112,14 @@ (equal? lst (bytevector->u8-list (u8-list->bytevector lst))))) + (pass-if-exception "u8-list->bytevector [invalid argument type]" + exception:wrong-type-arg + (u8-list->bytevector 'not-a-list)) + + (pass-if-exception "u8-list->bytevector [circular list]" + exception:wrong-type-arg + (u8-list->bytevector (circular-list 1 2 3))) + (pass-if "bytevector-uint-{ref,set!} [small]" (let ((b (make-bytevector 15))) (bytevector-uint-set! b 0 #x1234 @@ -206,6 +215,24 @@ (bytevector-u8-set! bv 3 #xff) bv))) + (pass-if-exception "sint-list->bytevector [invalid argument type]" + exception:wrong-type-arg + (sint-list->bytevector 'not-a-list (endianness big) 2)) + + (pass-if-exception "uint-list->bytevector [invalid argument type]" + exception:wrong-type-arg + (uint-list->bytevector 'not-a-list (endianness big) 2)) + + (pass-if-exception "sint-list->bytevector [circular list]" + exception:wrong-type-arg + (sint-list->bytevector (circular-list 1 2 3) (endianness big) + 2)) + + (pass-if-exception "uint-list->bytevector [circular list]" + exception:wrong-type-arg + (uint-list->bytevector (circular-list 1 2 3) (endianness big) + 2)) + (pass-if-exception "sint-list->bytevector [out-of-range]" exception:out-of-range (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)