mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-27 21:40:34 +02:00
Code Activity

Merge remote-tracking branch 'local-2.0/stable-2.0'

Browse source 
Conflicts:
	module/language/tree-il/analyze.scm
This commit is contained in:
Andy Wingo 2012-02-23 14:10:22 +01:00
commit 9d15db65ff
10 changed files with 381 additions and 172 deletions
Download patch file Download diff file Expand all files Collapse all files

5
test-suite/standalone/Makefile.am
View file

@ -1,7 +1,7 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
## 2011 Free Software Foundation, Inc.
## 2011, 2012 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@ -85,6 +85,9 @@ EXTRA_DIST += test-import-order-a.scm test-import-order-b.scm \
check_SCRIPTS += test-command-line-encoding
TESTS += test-command-line-encoding
check_SCRIPTS += test-command-line-encoding2
TESTS += test-command-line-encoding2
# test-num2integral
test_num2integral_SOURCES = test-num2integral.c
test_num2integral_CFLAGS = ${test_cflags}

20
test-suite/standalone/test-command-line-encoding2 Executable file
View file

@ -0,0 +1,20 @@
#!/bin/sh
# Choose a locale name that lacks a dot followed by the encoding name.
# This should not confuse `environ_locale_charset'.
# See <http://bugs.gnu.org/10742> for the original bug report.
LC_ALL="en_US"
export LC_ALL
unset LANG
unset LC_CTYPE
exec guile -q -s "$0" "hello"
!#
;; Make sure our argument was suitable decoded.
(exit (string=? (cadr (program-arguments)) "hello"))
;; Local Variables:
;; mode: scheme
;; coding: iso-8859-1
;; End:

42
test-suite/tests/tree-il.test
View file

@ -2172,12 +2172,34 @@
"non-literal format string")))))
(pass-if "non-literal format string using gettext"
(null? (call-with-warnings
(lambda ()
(compile '(format #t (gettext "~A ~A!") "hello" "world")
#:opts %opts-w-format
#:to 'assembly)))))
(pass-if "non-literal format string using gettext as _"
(null? (call-with-warnings
(lambda ()
(compile '(format #t (_ "~A ~A!") "hello" "world")
#:opts %opts-w-format
#:to 'assembly)))))
(pass-if "non-literal format string using ngettext"
(null? (call-with-warnings
(lambda ()
(compile '(format #t
(ngettext "~a thing" "~a things" n "dom") n)
#:opts %opts-w-format
#:to 'assembly)))))
(pass-if "non-literal format string using ngettext as N_"
(null? (call-with-warnings
(lambda ()
(compile '(format #t (N_ "~a thing" "~a things" n) n)
#:opts %opts-w-format
#:to 'assembly)))))
(pass-if "wrong format string"
(let ((w (call-with-warnings
(lambda ()
@ -2219,7 +2241,7 @@
(pass-if "one missing argument, gettext"
(let ((w (call-with-warnings
(lambda ()
(compile '(format some-port (_ "foo ~A~%"))
(compile '(format some-port (gettext "foo ~A~%"))
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@ -2550,5 +2572,23 @@
(compile '(simple-format #t "foo ~x~%" 16)
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w) "unsupported format option")))))
(pass-if "unsupported, gettext"
(let ((w (call-with-warnings
(lambda ()
(compile '(simple-format #t (gettext "foo ~2f~%") 3.14)
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w) "unsupported format option")))))
(pass-if "unsupported, ngettext"
(let ((w (call-with-warnings
(lambda ()
(compile '(simple-format #t (ngettext "s ~x" "p ~x" x) x)
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w) "unsupported format option"))))))))

6
test-suite/tests/web-uri.test
View file

@ -1,6 +1,6 @@
;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;;;; Copyright (C) 2010, 2011, 2012 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
@ -143,6 +143,10 @@
(uri=? (string->uri "http://foo:/")
#:scheme 'http #:host "foo" #:path "/"))
(pass-if "http://2012.jsconf.us/"
(uri=? (string->uri "http://2012.jsconf.us/")
#:scheme 'http #:host "2012.jsconf.us" #:path "/"))
(pass-if "http://foo:not-a-port"
(not (string->uri "http://foo:not-a-port")))