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

Wire up ability to print RTL program arities

Browse source 
* libguile/procprop.c (scm_i_procedure_arity): Allow RTL programs to
  dispatch to scm_i_program_arity.

* libguile/programs.c (scm_i_program_print): Refactor reference to
  write-program.
  (scm_i_rtl_program_minimum_arity): New procedure, dispatches to
  Scheme.
  (scm_i_program_arity): Dispatch to scm_i_rtl_program_minimum_arity if
  appropriate.

* module/system/vm/debug.scm (program-minimum-arity): New export.

* module/system/vm/program.scm (rtl-program-minimum-arity): New internal
  function.
  (program-arguments-alists): New helper, implemented also for RTL
  procedures.
  (write-program): Refactor a bit, and call program-arguments-alists.

* test-suite/tests/rtl.test ("simply procedure arity"): Add tests that
  arities make it all the way to cold ELF and back to warm Guile.
This commit is contained in:
Andy Wingo 2013-05-16 20:58:54 +02:00
parent f88e574d58
commit eb2bc00fb3
5 changed files with 100 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

30
test-suite/tests/rtl.test
View file

@ -316,3 +316,33 @@
(return 0)
(end-arity)
(end-program))))))
(with-test-prefix "simply procedure arity"
(pass-if-equal "#<procedure foo ()>"
(object->string
(assemble-program
'((begin-program foo ((name . foo)))
(begin-standard-arity () 1 #f)
(load-constant 0 42)
(return 0)
(end-arity)
(end-program)))))
(pass-if-equal "#<procedure foo (x y)>"
(object->string
(assemble-program
'((begin-program foo ((name . foo)))
(begin-standard-arity (x y) 2 #f)
(load-constant 0 42)
(return 0)
(end-arity)
(end-program)))))
(pass-if-equal "#<procedure foo (x #:optional y . z)>"
(object->string
(assemble-program
'((begin-program foo ((name . foo)))
(begin-opt-arity (x) (y) z 3 #f)
(load-constant 0 42)
(return 0)
(end-arity)
(end-program))))))