mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 23:00:22 +02:00
Code Activity

(scm_array_p): Add missing "break"s in switch, fix llvect

Browse source 
test look for "l" not "s", fix fvect need NIMP before singp, fix dvect
to be false for singp(prot) since such a value is for fvect.
This commit is contained in:
Kevin Ryde 2004-02-11 22:19:30 +00:00
parent 1d69d405d5
commit cd18429baf
1 changed files with 14 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

18
libguile/unif.c
View file

@ -318,34 +318,44 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
{ {
case scm_tc7_bvect: case scm_tc7_bvect:
protp = (SCM_EQ_P (prot, SCM_BOOL_T)); protp = (SCM_EQ_P (prot, SCM_BOOL_T));
break;
case scm_tc7_string: case scm_tc7_string:
protp = SCM_CHARP(prot) && (SCM_CHAR (prot) != '\0'); protp = SCM_CHARP(prot) && (SCM_CHAR (prot) != '\0');
break;
case scm_tc7_byvect: case scm_tc7_byvect:
protp = SCM_EQ_P (prot, SCM_MAKE_CHAR ('\0')); protp = SCM_EQ_P (prot, SCM_MAKE_CHAR ('\0'));
break;
case scm_tc7_uvect: case scm_tc7_uvect:
protp = SCM_INUMP(prot) && SCM_INUM(prot)>0; protp = SCM_INUMP(prot) && SCM_INUM(prot)>0;
break;
case scm_tc7_ivect: case scm_tc7_ivect:
protp = SCM_INUMP(prot) && SCM_INUM(prot)<=0; protp = SCM_INUMP(prot) && SCM_INUM(prot)<=0;
break;
case scm_tc7_svect: case scm_tc7_svect:
protp = SCM_SYMBOLP (prot) protp = SCM_SYMBOLP (prot)
&& (1 == SCM_SYMBOL_LENGTH (prot)) && (1 == SCM_SYMBOL_LENGTH (prot))
&& ('s' == SCM_SYMBOL_CHARS (prot)[0]); && ('s' == SCM_SYMBOL_CHARS (prot)[0]);
break;
#ifdef HAVE_LONG_LONGS #ifdef HAVE_LONG_LONGS
case scm_tc7_llvect: case scm_tc7_llvect:
protp = SCM_SYMBOLP (prot) protp = SCM_SYMBOLP (prot)
&& (1 == SCM_SYMBOL_LENGTH (prot)) && (1 == SCM_SYMBOL_LENGTH (prot))
&& ('s' == SCM_SYMBOL_CHARS (prot)[0]); && ('l' == SCM_SYMBOL_CHARS (prot)[0]);
break;
#endif #endif
case scm_tc7_fvect: case scm_tc7_fvect:
protp = singp (prot); protp = (SCM_NIMP (prot) && singp (prot));
break;
case scm_tc7_dvect: case scm_tc7_dvect:
protp = SCM_REALP(prot); protp = (SCM_REALP (prot) && ! singp (prot));
break;
case scm_tc7_cvect: case scm_tc7_cvect:
protp = SCM_COMPLEXP(prot); protp = SCM_COMPLEXP(prot);
break;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
protp = SCM_NULLP(prot); protp = SCM_NULLP(prot);
break;
default: default:
/* no default */ /* no default */
; ;