Changeset 455 for trunk/src/json/JTM


Ignore:
Timestamp:
05/06/11 23:02:35 (14 years ago)
Author:
lgiessmann
Message:

JTM: added unit-tests for functions that are responsible for importing jtm-variants, jtm-names, and jtm-occurrences => fixed some bugs

File:
1 edited

Legend:

Unmodified
Added
Removed

  • TabularUnified trunk/src/json/JTM/jtm_importer.lisp

    r454 r455  
    3333               :prefixes prefixes))
    3434         (scope (get-item :SCOPE jtm-list))
    35          (type (get-item :SCOPE jtm-list))
     35         (type (get-item :TYPE jtm-list))
    3636         (value (get-item :VALUE jtm-list))
    3737         (name-variants (get-item :VARIANTS jtm-list))
    … …  
    4444                (get-items-from-jtm-references
    4545                 parent-references :revision revision :prefixes prefixes)))))
    46     (unless local-parent
    47       (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-string(): the JTM occurrence ~a must have a parent set in its members." jtm-list))))
    48     (unless type
    49       (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-string(): the JTM occurrence ~a must have a type set in its members." jtm-list))))
     46    (when (/= (length local-parent) 1)
     47      (error (make-condition 'JTM-error :message (format nil "From import-name-from-jtm-string(): the JTM name ~a must have exactly one parent set in its members." jtm-list))))
    5048    (let ((name
    5149           (make-construct
    5250            'NameC :start-revision revision
    5351            :item-identifiers iis
    54             :value (if value value "")
     52            :charvalue value
    5553            :themes (get-items-from-jtm-references
    5654                     scope :revision revision :prefixes prefixes)
    57             :instance-of (get-item-from-jtm-reference
    58                           type :revision revision :prefixes prefixes)
    59             :parent local-parent
     55            :instance-of (when type
     56                           (get-item-from-jtm-reference
     57                            type :revision revision :prefixes prefixes))
     58            :parent (first local-parent)
    6059            :reifier (when reifier
    6160                       (get-item-from-jtm-reference
    … …  
    7372  (declare (List jtm-list prefixes)
    7473           (Integer revision)
    75            (type (or Null OccurrenceC) parent))
     74           (type (or Null TopicC) parent))
    7675  (let* ((iis (import-identifiers-from-jtm-strings
    7776               (get-item :ITEM--IDENTIFIERS jtm-list)
    … …  
    7978         (datatype (get-item :DATATYPE jtm-list))
    8079         (scope (get-item :SCOPE jtm-list))
    81          (type (get-item :SCOPE jtm-list))
     80         (type (get-item :TYPE jtm-list))
    8281         (value (get-item :VALUE jtm-list))
    8382         (reifier (get-item :REIFIER jtm-list))
    … …  
    8988                (get-items-from-jtm-references
    9089                 parent-references :revision revision :prefixes prefixes)))))
    91     (unless local-parent
     90    (when (/= (length local-parent) 1)
    9291      (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-string(): the JTM occurrence ~a must have a parent set in its members." jtm-list))))
    9392    (unless type
    … …  
    9695                    :item-identifiers iis
    9796                    :datatype (if datatype datatype *xml-string*)
    98                     :value (if value value "")
     97                    :charvalue value
    9998                    :themes (get-items-from-jtm-references
    10099                             scope :revision revision :prefixes prefixes)
    101100                    :instance-of (get-item-from-jtm-reference
    102101                                  type :revision revision :prefixes prefixes)
    103                     :parent local-parent
     102                    :parent (first local-parent)
    104103                    :reifier (when reifier
    105104                               (get-item-from-jtm-reference
    … …  
    112111  (declare (List jtm-lists prefixes)
    113112           (Integer revision)
    114            (type (or Null NameC) parent)
     113           (type (or Null ReifiableConstructC) parent)
    115114           (Function next-fun))
    116115  (map 'list #'(lambda(jtm-list)
    … …  
    141140                (get-items-from-jtm-references
    142141                 parent-references :revision revision :prefixes prefixes)))))
    143     (unless local-parent
    144       (error (make-condition 'JTM-error :message (format nil "From import-variant-from-jtm-string(): the JTM variant ~a must have a parent set in its members." jtm-list))))
     142    (when (/= (length local-parent) 1)
     143      (error (make-condition 'JTM-error :message (format nil "From import-variant-from-jtm-string(): the JTM variant ~a must have exactly one parent set in its members." jtm-list))))
    145144    (make-construct 'VariantC :start-revision revision
    146145                    :item-identifiers iis
    147146                    :datatype (if datatype datatype *xml-string*)
    148                     :value (if value value "")
     147                    :charvalue value
    149148                    :themes (get-items-from-jtm-references
    150149                             scope :revision revision :prefixes prefixes)
    151                     :parent local-parent
     150                    :parent (first local-parent)
    152151                    :reifier (when reifier
    153152                               (get-item-from-jtm-reference
    … …  
    156155
    157156(defun import-identifiers-from-jtm-strings
    158     (jtm-strings  &key (identifier-type-symbol 'ItemIdentifeirC) prefixes)
     157    (jtm-strings  &key (identifier-type-symbol 'ItemIdentifierC) prefixes)
    159158  "Creates and returns a list of identifiers specified by jtm-strings and
    160159   identifier-type-symbol."
    … …  
    164163  (map 'list #'(lambda(jtm-string)
    165164                 (import-identifier-from-jtm-string
    166                   jtm-string identifier-type-symbol :prefixes prefixes))
     165                  jtm-string :prefixes prefixes
     166                  :identifier-type-symbol identifier-type-symbol))
    167167       jtm-strings))
    168168
    169 (defun import-identifier-from-jtm-string(jtm-string identifier-type-symbol
    170                                          &key prefixes)
     169
     170(defun import-identifier-from-jtm-string
     171    (jtm-string &key (identifier-type-symbol 'ItemIdentifierC) prefixes)
    171172  "Creates and returns an identifier of the type specified by
    172173   identifier-type-symbol."
Note: See TracChangeset for help on using the changeset viewer.