Author: lgiessmann Date: Mon Jun 29 05:11:38 2009 New Revision: 77 Log: json-server: fixed a bug with tmcl-type-validation when there is no topictype or no topictype-constraint or if they isn't either a topictype nor a topictype-constraint Modified: trunk/src/json/json_tmcl.lisp trunk/src/json/json_tmcl_validation.lisp trunk/src/rest_interface/set-up-json-interface.lisp Modified: trunk/src/json/json_tmcl.lisp ============================================================================== --- trunk/src/json/json_tmcl.lisp (original) +++ trunk/src/json/json_tmcl.lisp Mon Jun 29 05:11:38 2009 @@ -35,7 +35,7 @@ (let ((value (get-constraints-of-topic topics :treat-as treat-as))) (concatenate 'string "\"topicConstraints\":" value)))) - (let ((available-associations ;what's with association which have only a associationrole-constraints? + (let ((available-associations (remove-duplicates (loop for topic in topics append (get-available-associations-of-topic topic :treat-as treat-as))))) Modified: trunk/src/json/json_tmcl_validation.lisp ============================================================================== --- trunk/src/json/json_tmcl_validation.lisp (original) +++ trunk/src/json/json_tmcl_validation.lisp Mon Jun 29 05:11:38 2009 @@ -287,7 +287,7 @@ (local-akos-checked)) (when (not topictype-constraint) - (return-from valid-instance-p topic-instance)) + (return-from valid-instance-p (list topic-instance))) (when (and topictype-constraint (not topictype)) Modified: trunk/src/rest_interface/set-up-json-interface.lisp ============================================================================== --- trunk/src/rest_interface/set-up-json-interface.lisp (original) +++ trunk/src/rest_interface/set-up-json-interface.lisp Mon Jun 29 05:11:38 2009 @@ -169,8 +169,8 @@ (let ((external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) (let ((json-data (hunchentoot:raw-post-data :external-format external-format :force-text t))) (handler-case (let ((psis - (json:decode-json-from-string json-data))) - (let ((tmcl + (json:decode-json-from-string json-data))) + (let ((tmcl (json-tmcl:get-constraints-of-fragment psis :treat-as treat-as))) (if tmcl (progn