OverviewFilesCommitsIssuesDocsReleasesPeers

opencog-atomspace / tests / atoms / flow / filter-glob-test.scm

108 lines · scm ref:
#! /usr/bin/env guile
-s
!#
;
; filter-glob-test.scm -- Simple tests of top-level globs.
;
(use-modules (opencog))
(use-modules (opencog test-runner))

(opencog-test-runner)
(define tname "filter-glob-test")
(test-begin tname)

; -----------
(define glob-all (Filter (Glob "$x") (Concept "va")))
(define e-glob-all (cog-execute! glob-all))

(test-assert "glob of everything"
	(equal? e-glob-all (List (Concept "va"))))

; -----------
(define glob-rule
	(Filter
		(Rule (Glob "$x")(Glob "$x")(Glob "$x"))
		(Concept "vb")))
(define e-glob-rule (cog-execute! glob-rule))

(test-assert "glob of everything"
	(equal? e-glob-rule (List (Concept "vb"))))

; -----------
(define glob-of
	(Filter
		(Rule (Glob "$x")(Glob "$x")(Glob "$x"))
		(ValueOf (Concept "a") (Predicate "b"))))

(cog-set-value! (Concept "a") (Predicate "b") (Concept "vc"))

(define e-glob-of (cog-execute! glob-of))
(test-assert "glob of value of"
	(equal? e-glob-of (List (Concept "vc"))))

(cog-set-value! (Concept "a") (Predicate "b")
	(StringValue "a" "b" "c"))

(define e-glob-svof (cog-execute! glob-of))
(test-assert "glob of string"
	(equal? e-glob-svof (LinkValue (StringValue "a" "b" "c"))))

(cog-set-value! (Concept "a") (Predicate "b")
	(LinkValue (StringValue "d" "e" "f")))

(define e-glob-lsvof (cog-execute! glob-of))
(test-assert "glob of linkstring"
	(equal? e-glob-lsvof (LinkValue (LinkValue (StringValue "d" "e" "f")))))

; -----------

(cog-set-value! (Concept "a") (Predicate "b")
	(LinkValue (LinkValue (StringValue "d" "e" "f"))))

; Earlier versions of the code core dumped when executing the below,
; with a null-pointer deref, because `(Glob "$uh-ohhhh")` was never
; grounded. This test passes if there is no crash.
(define glob-match
	(Filter
		(Rule
			(LinkSignature (Type 'LinkValue) (Glob "$x"))
			(Glob "$uh-ohhhh"))
		(ValueOf (Concept "a") (Predicate "b"))))

(cog-execute! glob-match)
(define uhohh (cog-execute! glob-match))
(test-assert "bad grounding glob"
	(equal? uhohh (LinkValue (Glob "$uh-ohhhh"))))

; -----------

; Same as before, but set it again, just in case.
(cog-set-value! (Concept "a") (Predicate "b")
	(LinkValue (LinkValue (StringValue "d" "e" "f"))))

(define (print-atom x) (format #t "Printer function got ~A" x) #f)
(define (debug-prt x)
	(ExecutionOutput (GroundedSchema "scm: print-atom") x))

; Earlier versions of the code puked because GroundedSchema got
; a Value instead of an Atom. This is now fixed.
(define glob-print
	(Filter
		(Rule
			(LinkSignature (Type 'LinkValue) (Glob "$x"))
			(debug-prt (Glob "$x")))
		(ValueOf (Concept "a") (Predicate "b"))))

(define prt-result (cog-execute! glob-print))

; The "scm: print-atom" returns #f which the guile code converts
; into BoolValue.
(test-assert "bad printing glob"
	(equal? prt-result (LinkValue (BoolValue #f))))

; -----------

(test-end tname)

(opencog-test-end)