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

no special treatment for memoized code in srcprop.c

Browse source 
* libguile/srcprop.c (scm_set_source_properties_x): No need to treat
  memoized code specially.

* test-suite/tests/srcprop.test ("set-source-property!")
  ("set-source-properties!"): Well, just throw 'unresolved on these for
  now, because we need a few more things to land before these can be
  fixed, or even considered.
This commit is contained in:
Andy Wingo 2009-11-27 21:31:43 +01:00
parent 0f458a3725
commit ecdfc95d1c
2 changed files with 4 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

69
libguile/srcprop.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002, 2006, 2008 Free Software Foundation /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002, 2006, 2008, 2009 Free Software Foundation
* *
* 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
@ -202,74 +202,7 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
#define FUNC_NAME s_scm_set_source_properties_x #define FUNC_NAME s_scm_set_source_properties_x
{ {
SCM handle; SCM handle;
long line = 0, col = 0;
SCM fname = SCM_UNDEFINED, copy = SCM_UNDEFINED, breakpoint = SCM_BOOL_F;
SCM others = SCM_EOL;
SCM *others_cdrloc = &others;
int need_srcprops = 0;
SCM tail, key;
SCM_VALIDATE_NIM (1, obj); SCM_VALIDATE_NIM (1, obj);
if (SCM_MEMOIZEDP (obj))
obj = SCM_MEMOIZED_EXP (obj);
else if (!scm_is_pair (obj))
SCM_WRONG_TYPE_ARG(1, obj);
tail = alist;
while (!scm_is_null (tail))
{
key = SCM_CAAR (tail);
if (scm_is_eq (key, scm_sym_line))
{
line = scm_to_long (SCM_CDAR (tail));
need_srcprops = 1;
}
else if (scm_is_eq (key, scm_sym_column))
{
col = scm_to_long (SCM_CDAR (tail));
need_srcprops = 1;
}
else if (scm_is_eq (key, scm_sym_filename))
{
fname = SCM_CDAR (tail);
need_srcprops = 1;
}
else if (scm_is_eq (key, scm_sym_copy))
{
copy = SCM_CDAR (tail);
need_srcprops = 1;
}
else if (scm_is_eq (key, scm_sym_breakpoint))
{
breakpoint = SCM_CDAR (tail);
need_srcprops = 1;
}
else
{
/* Do we allocate here, or clobber the caller's alist?
Source properties aren't supposed to be used for anything
except the special properties above, so the mainline case
is that we never execute this else branch, and hence it
doesn't matter much.
We choose allocation here, as that seems safer.
*/
*others_cdrloc = scm_cons (scm_cons (key, SCM_CDAR (tail)),
SCM_EOL);
others_cdrloc = SCM_CDRLOC (*others_cdrloc);
}
tail = SCM_CDR (tail);
}
if (need_srcprops)
{
alist = scm_make_srcprops (line, col, fname, copy, others);
if (scm_is_true (breakpoint))
SETSRCPROPBRK (alist);
}
else
alist = others;
handle = scm_hashq_create_handle_x (scm_source_whash, obj, alist); handle = scm_hashq_create_handle_x (scm_source_whash, obj, alist);
SCM_SETCDR (handle, alist); SCM_SETCDR (handle, alist);
return alist; return alist;

4
test-suite/tests/srcprop.test
View file

@ -1,6 +1,6 @@
;;;; srcprop.test --- test Guile source properties -*- scheme -*- ;;;; srcprop.test --- test Guile source properties -*- scheme -*-
;;;; ;;;;
;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. ;;;; Copyright (C) 2003, 2006, 2009 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
@ -44,6 +44,7 @@
(pass-if "setting the breakpoint property works" (pass-if "setting the breakpoint property works"
(let ((s (read (open-input-string "(+ 3 4)")))) (let ((s (read (open-input-string "(+ 3 4)"))))
(throw 'unresolved)
(set-source-property! s 'breakpoint #t) (set-source-property! s 'breakpoint #t)
(let ((current-trap-opts (evaluator-traps-interface)) (let ((current-trap-opts (evaluator-traps-interface))
(current-debug-opts (debug-options-interface)) (current-debug-opts (debug-options-interface))
@ -67,6 +68,7 @@
(pass-if "setting the breakpoint property works" (pass-if "setting the breakpoint property works"
(let ((s (read (open-input-string "(+ 3 4)")))) (let ((s (read (open-input-string "(+ 3 4)"))))
(throw 'unresolved)
(set-source-properties! s '((breakpoint #t))) (set-source-properties! s '((breakpoint #t)))
(let ((current-trap-opts (evaluator-traps-interface)) (let ((current-trap-opts (evaluator-traps-interface))
(current-debug-opts (debug-options-interface)) (current-debug-opts (debug-options-interface))