mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 20:20:24 +02:00
Code Activity
guile/test-suite/tests/chars.test
Andy Wingo b7742c6b71 new evaluator, y'all 
* libguile/eval.c: So, ladies & gents, a new evaluator. It's similar to
  the old one, in that we memoize and then evaluate, but in this
  incarnation, memoization of an expression happens before evaluation,
  not lazily as the expression is evaluated. This makes the evaluation
  itself much cleaner, in addition to being threadsafe. In addition,
  since this C evaluator will in the future just serve to bootstrap the
  Scheme evaluator, we don't have to pay much concern for debugging
  conveniences. So the environment is just a list of values, and the
  memoizer pre-computes where it's going to find each individual value
  in the environment.

  Interface changes are commented below, with eval.h.

  (scm_evaluator_traps): No need to reset the debug mode after rnning te
  traps thing. But really, the whole traps system needs some love.

* libguile/memoize.h:
* libguile/memoize.c: New memoizer, which runs before evaluation,
  checking all syntax before evaluation begins. Significantly, no
  debugging information is left for lexical variables, which is not so
  great for interactive debugging; perhaps we should change this to have
  a var list in the future as per the classic interpreters. But it's
  quite fast, and the resulting code is quite good. Also note that it
  doesn't produce ilocs, memoized code is a smob whose type is in the
  first word of the smob itself.

* libguile/eval.h (scm_sym_and, scm_sym_begin, scm_sym_case)
  (scm_sym_cond, scm_sym_define, scm_sym_do, scm_sym_if, scm_sym_lambda)
  (scm_sym_let, scm_sym_letstar, scm_sym_letrec, scm_sym_quote)
  (scm_sym_quasiquote, scm_sym_unquote, scm_sym_uq_splicing, scm_sym_at)
  (scm_sym_atat, scm_sym_atapply, scm_sym_atcall_cc)
  (scm_sym_at_call_with_values, scm_sym_delay, scm_sym_eval_when)
  (scm_sym_arrow, scm_sym_else, scm_sym_apply, scm_sym_set_x)
  (scm_sym_args): Remove public declaration of these symbols.
  (scm_ilookup, scm_lookupcar, scm_eval_car, scm_eval_body)
  (scm_eval_args, scm_i_eval_x, scm_i_eval): Remove public declaration
  of these functions.
  (scm_ceval, scm_deval, scm_ceval_ptr): Remove declarations of these
  deprecated functions.
  (scm_i_print_iloc, scm_i_print_isym, scm_i_unmemocopy_expr)
  (scm_i_unmemocopy_body): Remove declarations of these internal
  functions.
  (scm_primitive_eval_x, scm_eval_x): Redefine as macros for their less
  destructive siblings.

* libguile/Makefile.am: Add memoize.[ch] to the build.

* libguile/debug.h (scm_debug_mode_p, scm_check_entry_p)
  (scm_check_apply_p, scm_check_exit_p, scm_check_memoize_p)
  (scm_debug_eframe_size): Remove these vars that were tied to the old
  evaluator's execution model.
  (SCM_RESET_DEBUG_MODE): Remove, no more need for this.
  (SCM_MEMOIZEDP, SCM_MEMOIZED_EXP, SCM_MEMOIZED_ENV): Remove macros
  referring to old memoized code representation.
  (scm_local_eval, scm_procedure_environment, scm_memoized_environment)
  (scm_make_memoized, scm_memoized_p): Remove functions operating on old
  memoized code representation.
  (scm_memcons, scm_mem_to_proc, scm_proc_to_mem): Remove debug-only
  code for old evaluator.

* libguile/debug.c: Remove code to correspond with debug.h removals.
  (scm_debug_options): No need to set the debug mode or frame limit
  here, as we don't have C stack limits any more. Perhaps this is a bug,
  but as long as we can compile eval.scm, we should be fine.

* libguile/init.c (scm_i_init_guile): Init memoize.c.

* libguile/modules.c (scm_top_level_env, scm_env_top_level)
  (scm_env_module, scm_system_module_env_p): Remove these functions.

* libguile/print.c (iprin1): No more need to handle isyms. Adapt to new
  form of interpreted procedures.

* libguile/procprop.c (scm_i_procedure_arity): Adapt to new form of
  interpreted procedures.

* libguile/procs.c (scm_thunk_p): Adapt to new form of interpreted
  procedures.
* libguile/procs.h (SCM_CLOSURE_FORMALS): Removed, this exists no more.
  (SCM_CLOSURE_NUM_REQUIRED_ARGS, SCM_CLOSURE_HAS_REST_ARGS): New
  accessors.

* libguile/srcprop.c (scm_source_properties, scm_source_property)
  (scm_set_source_property_x): Remove special cases for memoized code.

* libguile/stacks.c (read_frame): Remove a source-property case for
  interpreted code.
  (NEXT_FRAME): Remove a case that I don't fully understand, that seems
  to be designed to skip over apply frames. Will be obsolete in the
  futures.
  (read_frames): Default source value for interpreted frames to #f.
  (narrow_stack): Don't pay attention to the system_module thing.

* libguile/tags.h: Remove isyms and ilocs. Whee!

* libguile/validate.h (SCM_VALIDATE_MEMOIZED): Fix to use the new
  MEMOIZED_P formulation.

* module/ice-9/psyntax-pp.scm (do, quasiquote, case): Adapt for these no
  longer being primitive macros.
* module/ice-9/boot-9.scm: Whitespace change, but just a poke to force a
  rebuild due to and/or/cond/... not being primitives any more.

* module/ice-9/deprecated.scm (unmemoize-expr): Deprecate, it's
  unmemoize-expression now.

* test-suite/tests/eval.test ("define set procedure-name"): XFAIL a
  couple of tests here; I don't know what to do about them. I reckon the
  expander should ensure that defined values are named.

* test-suite/tests/chars.test ("basic char handling"): Fix expected
  exception when trying to apply a char.
2009-12-01 21:00:26 +01:00

288 lines
7.6 KiB
Scheme
Raw Blame History

;;;; chars.test --- test suite for Guile's char functions -*- scheme -*-
;;;; Greg J. Badros <gjb@cs.washington.edu>
;;;;
;;;; Copyright (C) 2000, 2006, 2009 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 3 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(use-modules (test-suite lib))
(define exception:wrong-type-to-apply
(cons 'misc-error "^Wrong type to apply:"))
(define exception:unknown-character-name
(cons #t "unknown character"))
(define exception:out-of-range-octal
(cons #t "out-of-range"))
(with-test-prefix "basic char handling"
(with-test-prefix "evaluator"
;; The following test makes sure that the evaluator distinguishes between
;; evaluator-internal instruction codes and characters.
(pass-if-exception "evaluating chars"
exception:wrong-type-arg
(eval '(#\0) (interaction-environment))))
(with-test-prefix "comparisons"
;; char=?
(pass-if "char=? #\\A #\\A"
(char=? #\A #\A))
(expect-fail "char=? #\\A #\\a"
(char=? #\A #\a))
(expect-fail "char=? #\\A #\\B"
(char=? #\A #\B))
(expect-fail "char=? #\\B #\\A"
(char=? #\A #\B))
;; char<?
(expect-fail "char<? #\\A #\\A"
(char<? #\A #\A))
(pass-if "char<? #\\A #\\a"
(char<? #\A #\a))
(pass-if "char<? #\\A #\\B"
(char<? #\A #\B))
(expect-fail "char<? #\\B #\\A"
(char<? #\B #\A))
;; char<=?
(pass-if "char<=? #\\A #\\A"
(char<=? #\A #\A))
(pass-if "char<=? #\\A #\\a"
(char<=? #\A #\a))
(pass-if "char<=? #\\A #\\B"
(char<=? #\A #\B))
(expect-fail "char<=? #\\B #\\A"
(char<=? #\B #\A))
;; char>?
(expect-fail "char>? #\\A #\\A"
(char>? #\A #\A))
(expect-fail "char>? #\\A #\\a"
(char>? #\A #\a))
(expect-fail "char>? #\\A #\\B"
(char>? #\A #\B))
(pass-if "char>? #\\B #\\A"
(char>? #\B #\A))
;; char>=?
(pass-if "char>=? #\\A #\\A"
(char>=? #\A #\A))
(expect-fail "char>=? #\\A #\\a"
(char>=? #\A #\a))
(expect-fail "char>=? #\\A #\\B"
(char>=? #\A #\B))
(pass-if "char>=? #\\B #\\A"
(char>=? #\B #\A))
;; char-ci=?
(pass-if "char-ci=? #\\A #\\A"
(char-ci=? #\A #\A))
(pass-if "char-ci=? #\\A #\\a"
(char-ci=? #\A #\a))
(expect-fail "char-ci=? #\\A #\\B"
(char-ci=? #\A #\B))
(expect-fail "char-ci=? #\\B #\\A"
(char-ci=? #\A #\B))
;; char-ci<?
(expect-fail "char-ci<? #\\A #\\A"
(char-ci<? #\A #\A))
(expect-fail "char-ci<? #\\A #\\a"
(char-ci<? #\A #\a))
(pass-if "char-ci<? #\\A #\\B"
(char-ci<? #\A #\B))
(expect-fail "char-ci<? #\\B #\\A"
(char-ci<? #\B #\A))
;; char-ci<=?
(pass-if "char-ci<=? #\\A #\\A"
(char-ci<=? #\A #\A))
(pass-if "char-ci<=? #\\A #\\a"
(char-ci<=? #\A #\a))
(pass-if "char-ci<=? #\\A #\\B"
(char-ci<=? #\A #\B))
(expect-fail "char-ci<=? #\\B #\\A"
(char-ci<=? #\B #\A))
;; char-ci>?
(expect-fail "char-ci>? #\\A #\\A"
(char-ci>? #\A #\A))
(expect-fail "char-ci>? #\\A #\\a"
(char-ci>? #\A #\a))
(expect-fail "char-ci>? #\\A #\\B"
(char-ci>? #\A #\B))
(pass-if "char-ci>? #\\B #\\A"
(char-ci>? #\B #\A))
;; char-ci>=?
(pass-if "char-ci>=? #\\A #\\A"
(char-ci>=? #\A #\A))
(pass-if "char-ci>=? #\\A #\\a"
(char-ci>=? #\A #\a))
(expect-fail "char-ci>=? #\\A #\\B"
(char-ci>=? #\A #\B))
(pass-if "char-ci>=? #\\B #\\A"
(char-ci>=? #\B #\A)))
(with-test-prefix "categories"
(pass-if "char-alphabetic?"
(and (char-alphabetic? #\a)
(char-alphabetic? #\A)
(not (char-alphabetic? #\1))
(not (char-alphabetic? #\+))))
(pass-if "char-numeric?"
(and (not (char-numeric? #\a))
(not (char-numeric? #\A))
(char-numeric? #\1)
(not (char-numeric? #\+))))
(pass-if "char-whitespace?"
(and (not (char-whitespace? #\a))
(not (char-whitespace? #\A))
(not (char-whitespace? #\1))
(char-whitespace? #\space)
(not (char-whitespace? #\+))))
(pass-if "char-upper-case?"
(and (not (char-upper-case? #\a))
(char-upper-case? #\A)
(not (char-upper-case? #\1))
(not (char-upper-case? #\+))))
(pass-if "char-lower-case?"
(and (char-lower-case? #\a)
(not (char-lower-case? #\A))
(not (char-lower-case? #\1))
(not (char-lower-case? #\+))))
(pass-if "char-is-both? works"
(and
(not (char-is-both? #\?))
(not (char-is-both? #\newline))
(char-is-both? #\a)
(char-is-both? #\Z)
(not (char-is-both? #\1)))))
(with-test-prefix "integer"
(pass-if "char->integer"
(eqv? (char->integer #\A) 65))
(pass-if "integer->char"
(eqv? (integer->char 65) #\A))
(pass-if-exception "integer->char out of range, -1" exception:out-of-range
(integer->char -1))
(pass-if-exception "integer->char out of range, surrrogate"
exception:out-of-range
(integer->char #xd800))
(pass-if-exception "integer->char out of range, too big"
exception:out-of-range
(integer->char #x110000))
(pass-if-exception "octal out of range, surrrogate"
exception:out-of-range-octal
(with-input-from-string "#\\154000" read))
(pass-if-exception "octal out of range, too big"
exception:out-of-range-octal
(with-input-from-string "#\\4200000" read)))
(with-test-prefix "case"
(pass-if "char-upcase"
(eqv? (char-upcase #\a) #\A))
(pass-if "char-downcase"
(eqv? (char-downcase #\A) #\a)))
(with-test-prefix "charnames"
(pass-if "R5RS character names are case insensitive"
(and (eqv? #\space #\ )
(eqv? #\SPACE #\ )
(eqv? #\Space #\ )
(eqv? #\newline (integer->char 10))
(eqv? #\NEWLINE (integer->char 10))
(eqv? #\Newline (integer->char 10))))
(pass-if "C0 control names are case insensitive"
(and (eqv? #\nul #\000)
(eqv? #\soh #\001)
(eqv? #\stx #\002)
(eqv? #\NUL #\000)
(eqv? #\SOH #\001)
(eqv? #\STX #\002)
(eqv? #\Nul #\000)
(eqv? #\Soh #\001)
(eqv? #\Stx #\002)))
(pass-if "alt charnames are case insensitive"
(eqv? #\null #\nul)
(eqv? #\NULL #\nul)
(eqv? #\Null #\nul))
(pass-if-exception "bad charname" exception:unknown-character-name
(with-input-from-string "#\\blammo" read))
(pass-if "R5RS character names are preferred write format"
(string=?
(with-output-to-string (lambda () (write #\space)))
"#\\space"))
(pass-if "C0 control character names are preferred write format"
(string=?
(with-output-to-string (lambda () (write #\soh)))
"#\\soh"))))
View git blame Copy permalink