mirror of
https://github.com/kennethreitz/context.git
synced 2026-06-05 14:50:19 +00:00
127 lines
3.3 KiB
LLVM
127 lines
3.3 KiB
LLVM
/*
|
|
* @progname pointers
|
|
* @version 1.0
|
|
* @author Chandler
|
|
* @category
|
|
* @output Text
|
|
* @description
|
|
|
|
Test a database for reciprocity of pointers between persons and families.
|
|
|
|
Report any failures, primarily the following:
|
|
|
|
Person Inn is a spouse/child in Fnn, but Fnn has no corresponding pointer.
|
|
Family Fnn has HUSB/WIFE/CHIL Inn, but Inn has no corresponding pointer.
|
|
|
|
Some failures are supposed to be impossible, but are covered here
|
|
nonetheless:
|
|
|
|
Family Fnn has HUSB/WIFE/CHIL Inn, but Inn does not exist.
|
|
Family Fnn has a null HUSB/WIFE/CHIL line.
|
|
Person Inn is a spouse/child in Fnn, but Fnn does not exist.
|
|
Person Inn has a null FAMS/FAMC line.
|
|
|
|
Version 1.0 - 2003 Jul 2 - John F. Chandler
|
|
|
|
This program works only with LifeLines.
|
|
|
|
*/
|
|
|
|
global(pointers)
|
|
|
|
proc main() {
|
|
table(spou) /* each entry is the list of spouses in the keyed family */
|
|
table(chil) /* each entry is the list of children in the keyed family */
|
|
|
|
"Testing database " qt() database() qt() " for pointer reciprocity\n"
|
|
|
|
set(pointers,0)
|
|
|
|
/* loop through persons and note all the families they belong to */
|
|
forindi(i,n) {
|
|
set(k,save(key(i)))
|
|
fornodes(root(i),node) {
|
|
set(type,tag(node))
|
|
if(eqstr(type,"FAMC")) {
|
|
call tally(type,"child",chil,node,k)
|
|
} elsif(eqstr(type,"FAMS")) {
|
|
call tally(type,"spouse",spou,node,k)
|
|
}
|
|
}
|
|
}
|
|
/* loop through families and compare the members against the list
|
|
compiled by scanning persons -- flag any mismatches */
|
|
forfam(f,n) {
|
|
set(id,save(key(f)))
|
|
set(cl,lookup(chil,id))
|
|
set(sl,lookup(spou,id))
|
|
fornodes(root(f),node) {
|
|
set(type,tag(node))
|
|
if(eqstr(type,"CHIL")) { call checkoff(type,cl,id,node) }
|
|
elsif(or(eqstr(type,"HUSB"),eqstr(type,"WIFE"))) {
|
|
call checkoff(type,sl,id,node)
|
|
}
|
|
}
|
|
/* any remaining list elements are errors */
|
|
if(sl) {
|
|
while(k,dequeue(sl)) {
|
|
"\nPerson " k " is a spouse in " id
|
|
", but " id " has no corresponding pointer."
|
|
}
|
|
}
|
|
if(cl) {
|
|
while(k,dequeue(cl)) {
|
|
"\nPerson " k " is a child in " id
|
|
", but " id " has no corresponding pointer."
|
|
}
|
|
}
|
|
}
|
|
"\n\nFinished after checking " d(pointers) " pointers.\n"
|
|
|
|
}
|
|
|
|
/* check a family member against the expected list.
|
|
anyone not on the list is an error.
|
|
remove each person from the list when found here. */
|
|
proc checkoff(type,list,id,node) {
|
|
incr(pointers)
|
|
if(eq(mod(pointers,500),0)) { print(".") }
|
|
if(k,value(node)) {
|
|
set(key,substring(k,2,sub(strlen(k),1)))
|
|
if(list) {
|
|
set(count,length(list))
|
|
while(gt(count,0)) {
|
|
decr(count)
|
|
set(c,dequeue(list))
|
|
if(eqstr(c,key)) { set(count,-1) }
|
|
else { enqueue(list,c) }
|
|
}
|
|
}
|
|
if(eq(count,0)) {
|
|
"\nFamily " id " has " type " " key ", but " key
|
|
if(reference(k)) { " has no corresponding pointer." }
|
|
else { " does not exist." }
|
|
}
|
|
} else { "\nFamily " id " has a null " type " line." }
|
|
}
|
|
|
|
/* build a list of persons who belong to families */
|
|
proc tally(type,member,table,node,k) {
|
|
incr(pointers)
|
|
if(eq(mod(pointers,500),0)) { print(".") }
|
|
set(id,value(node))
|
|
if(reference(id)) {
|
|
set(id,save(substring(id,2,sub(strlen(id),1))))
|
|
if(l,lookup(table,id)) { enqueue(l,k) }
|
|
else {
|
|
list(l)
|
|
enqueue(l,k)
|
|
insert(table,id,l)
|
|
}
|
|
} elsif(id) {
|
|
"\nPerson " k " is a " member " in " id
|
|
", but " id " does not exist."
|
|
} else { "\nPerson " k " has a null " type " line." }
|
|
}
|
|
|