Typo: was only servicing abusive IPs.

Typo: was only servicing abusive IPs.

; HTTP Server.

; To improve performance with static files, set static-max-age*.

(= arcdir* "arc/" logdir* "arc/logs/" staticdir* "static/")

(= quitsrv* nil breaksrv* nil)

(def serve ((o port 8080))
  (wipe quitsrv*)
  (ensure-srvdirs)
  (map [apply new-bgthread _] pending-bgthreads*)
  (w/socket s port
    (setuid 2) ; XXX switch from root to pg
    (prn "ready to serve port " port)
    (flushout)
    (= currsock* s)
    (until quitsrv*
      (handle-request s breaksrv*)))
  (prn "quit server"))

(def serve1 ((o port 8080))
  (w/socket s port (handle-request s t)))

(def ensure-srvdirs ()
  (map ensure-dir (list arcdir* logdir* staticdir*)))

(= srv-noisy* nil)

; http requests currently capped at 2 meg by socket-accept

; should threads process requests one at a time? no, then
; a browser that's slow consuming the data could hang the
; whole server.

; wait for a connection from a browser and start a thread
; to handle it. also arrange to kill that thread if it
; has not completed in threadlife* seconds.

(= threadlife* 30  requests* 0  requests/ip* (table)
   throttle-ips* (table)  ignore-ips* (table)  spurned* (table))

(def handle-request (s breaksrv)
  (if breaksrv
      (handle-request-1 s)
      (errsafe (handle-request-1 s))))

(def handle-request-1 (s)
  (with ((i o ip) (socket-accept s)
         th1 nil th2 nil)
    (++ requests*)
    (let ip-wrapper (fn args
                      (if args
                        (= ip car.args)
                        ip))
      (= th1 (thread
               (after (handle-request-thread i o ip-wrapper)
                      (close i o)
                      (kill-thread th2))))
      (= th2 (thread
               (sleep threadlife*)
               (unless (dead th1)
                 (prn "srv thread took too long for " ip))
               (kill-thread th1)
               (force-close i o))))))

; Returns true if ip has made req-limit* requests in less than
; req-window* seconds.  If an ip is throttled, only 1 request is
; allowed per req-window* seconds.  If an ip makes req-limit*
; requests in less than dos-window* seconds, it is a treated as a DoS
; attack and put in ignore-ips* (for this server invocation).

; To adjust this while running, adjust the req-window* time, not
; req-limit*, because algorithm doesn't enforce decreases in the latter.

(= req-times* (table) req-limit* 30 req-window* 10 dos-window* 2)

(wipe show-abuse*)
(def abusive-ip (ip)
  (++ (requests/ip* ip 0))
  (if show-abuse*
    (if (ignore-ips* ip)
      (prn ip " ignored")
      (prn ip " " (if (abusive-ip-core ip) "" "not ") "abusive (" requests/ip*.ip ")")))
  (and (or (ignore-ips* ip) (abusive-ip-core ip))
       (++ (spurned* ip 0))))

(def abusive-ip-core (ip)
  (and (only.> (requests/ip* ip) 250)
       (let now (seconds)
         (do1 (if (req-times* ip)
                  (and (>= (qlen (req-times* ip))
                           (if (throttle-ips* ip) 1 req-limit*))
                       (let dt (- now (deq (req-times* ip)))
                         (if (< dt dos-window*) (set (ignore-ips* ip)))
                         (< dt req-window*)))
                  (do (= (req-times* ip) (queue))
                      nil))
              (enq now (req-times* ip))))))

(let proxy-header "X-Forwarded-For: "
  (def strip-header(s)
    (subst "" proxy-header s))
  (def proxy-ip(ip-wrapper lines)
    (aif (only.strip-header (car:keep [headmatch proxy-header _] lines))
        (ip-wrapper it)
        (ip-wrapper))))

(wipe show-requests*)
(def handle-request-thread (i o ip-wrapper)
  (with (nls 0 lines nil line nil responded nil t0 (msec))
    (after
      (whilet c (unless responded (readc i))
        (if srv-noisy* (pr c))
        (if (is c #\newline)
            (if (is (++ nls) 2)
                (let (type op args n cooks) (parseheader (rev lines))
                  (if show-requests* (prn lines))
                  (unless (abusive-ip (proxy-ip ip-wrapper lines))
                    (let t1 (msec)
                      (case type
                        get  (respond o op args cooks (ip-wrapper))
                        post (handle-post i o op args n cooks (ip-wrapper))
                             (respond-err o "Unknown request: " (car lines)))
                      (log-request type op args cooks (ip-wrapper) t0 t1)))
                  (set responded))
                (do (push (string (rev line)) lines)
                    (wipe line)))
            (unless (is c #\return)
              (push c line)
              (= nls 0))))
      (close i o)))
  (harvest-fnids))

(def log-request (type op args cooks ip t0 t1)
  (with (parsetime (- t1 t0) respondtime (- (msec) t1))
    (srvlog 'srv ip
                 parsetime
                 respondtime
                 (if (> (+ parsetime respondtime) 1000) "***" "")
                 type
                 op
                 (let arg1 (car args)
                   (if (caris arg1 "fnid") "" arg1))
                 cooks)))

; Could ignore return chars (which come from textarea fields) here by
; (unless (is c #\return) (push c line))

(def handle-post (i o op args n cooks ip)
  (if srv-noisy* (pr "Post Contents: "))
  (if (no n)
      (respond-err o "Post request without Content-Length.")
      (let line nil
        (whilet c (and (> n 0) (readc i))
          (if srv-noisy* (pr c))
          (-- n)
          (push c line))
        (if srv-noisy* (pr "\n\n"))
        (respond o op (+ (parseargs (string (rev line))) args) cooks ip))))

(= header* "HTTP/1.1 200 OK
Content-Type: text/html; charset=utf-8
Connection: close")

(= type-header* (table))

(def gen-type-header (ctype)
  (+ "HTTP/1.0 200 OK
Content-Type: "
     ctype
     "
Connection: close"))

(map (fn ((k v)) (= (type-header* k) (gen-type-header v)))
     '((gif       "image/gif")
       (jpg       "image/jpeg")
       (png       "image/png")
       (text/html "text/html; charset=utf-8")))

(= rdheader* "HTTP/1.0 302 Moved")

(= srvops* (table) redirector* (table) optimes* (table) opcounts* (table))

(def save-optime (name elapsed)
  ; this is the place to put a/b testing
  ; toggle a flag and push elapsed into one of two lists
  (++ (opcounts* name 0))
  (unless (optimes* name) (= (optimes* name) (queue)))
  (enq-limit elapsed (optimes* name) 1000))

; For ops that want to add their own headers.  They must thus remember
; to prn a blank line before anything meant to be part of the page.

(mac defop-raw (name parms . body)
  (w/uniq t1
    `(= (srvops* ',name)
        (fn ,parms
          (let ,t1 (msec)
            (do1 (do ,@body)
                 (save-optime ',name (- (msec) ,t1))))))))

(mac defopr-raw (name parms . body)
  `(= (redirector* ',name) t
      (srvops* ',name)     (fn ,parms ,@body)))

(mac defop (name parm . body)
  (w/uniq gs
    `(do (wipe (redirector* ',name))
         (defop-raw ,name (,gs ,parm)
           (w/stdout ,gs (prn) ,@body)))))

; Defines op as a redirector.  Its retval is new location.

(mac defopr (name parm . body)
  (w/uniq gs
    `(do (set (redirector* ',name))
         (defop-raw ,name (,gs ,parm)
           ,@body))))

;(mac testop (name . args) `((srvops* ',name) ,@args))

(deftem request
  args  nil
  cooks nil
  ip    nil)

(= unknown-msg* "Unknown." max-age* (table) static-max-age* nil)

(def respond (str op args cooks ip)
  (w/stdout str
    (iflet f (srvops* op)
           (let req (inst 'request 'args args 'cooks cooks 'ip ip)
             (if (redirector* op)
                 (do (prn rdheader*)
                     (prn "Location: " (f str req))
                     (prn))
                 (do (prn header*)
                     (awhen (max-age* op)
                       (prn "Cache-Control: max-age=" it))
                     (f str req))))
           (let filetype (static-filetype op)
             (aif (and filetype (file-exists (string staticdir* op)))
                  (do (prn (type-header* filetype))
                      (awhen static-max-age*
                        (prn "Cache-Control: max-age=" it))
                      (prn)
                      (w/infile i it
                        (whilet b (readb i)
                          (writeb b str))))
                  (respond-err str unknown-msg*))))))

(def static-filetype (sym)
  (let fname (coerce sym 'string)
    (and (~find #\/ fname)
         (case (downcase (last (check (tokens fname #\.) ~single)))
           "gif"  'gif
           "jpg"  'jpg
           "jpeg" 'jpg
           "png"  'png
           "css"  'text/html
           "txt"  'text/html
           "htm"  'text/html
           "html" 'text/html
           "arc"  'text/html
           ))))

(def respond-err (str msg . args)
  (w/stdout str
    (prn header*)
    (prn)
    (apply pr msg args)))

(def parseheader (lines)
  (let (type op args) (parseurl (car lines))
    (list type
          op
          args
          (and (is type 'post)
               (some (fn (s)
                       (and (begins s "Content-Length:")
                            (errsafe:coerce (cadr (tokens s)) 'int)))
                     (cdr lines)))
          (some (fn (s)
                  (and (begins s "Cookie:")
                       (parsecookies s)))
                (cdr lines)))))

; (parseurl "GET /p1?foo=bar&ug etc") -> (get p1 (("foo" "bar") ("ug")))

(def parseurl (s)
  (let (type url) (tokens s)
    (let (base args) (tokens url #\?)
      (list (sym (downcase type))
            (sym (cut base 1))
            (if args
                (parseargs args)
                nil)))))

; I don't urldecode field names or anything in cookies; correct?

(def parseargs (s)
  (map (fn ((k v)) (list k (urldecode v)))
       (map [tokens _ #\=] (tokens s #\&))))

(def parsecookies (s)
  (map [tokens _ #\=]
       (cdr (tokens s [or (whitec _) (is _ #\;)]))))

(def arg (req key) (alref req!args key))

; *** Warning: does not currently urlencode args, so if need to do
; that replace v with (urlencode v).

(def reassemble-args (req)
  (aif req!args
       (apply string "?" (intersperse '&
                                      (map (fn ((k v))
                                             (string k '= v))
                                           it)))
       ""))

(= fns* (table) fnids* nil timed-fnids* nil)

; count on huge (expt 64 10) size of fnid space to avoid clashes

(def new-fnid ()
  (check (sym (rand-string 10)) ~fns* (new-fnid)))

(def fnid (f)
  (atlet key (new-fnid)
    (= (fns* key) f)
    (push key fnids*)
    key))

(def timed-fnid (lasts f)
  (atlet key (new-fnid)
    (= (fns* key) f)
    (push (list key (seconds) lasts) timed-fnids*)
    key))

; Within f, it will be bound to the fn's own fnid.  Remember that this is
; so low-level that need to generate the newline to separate from the headers
; within the body of f.

(mac afnid (f)
  `(atlet it (new-fnid)
     (= (fns* it) ,f)
     (push it fnids*)
     it))

;(defop test-afnid req
;  (tag (a href (url-for (afnid (fn (req) (prn) (pr "my fnid is " it)))))
;    (pr "click here")))

; To be more sophisticated, instead of killing fnids, could first
; replace them with fns that tell the server it's harvesting too
; aggressively if they start to get called.  But the right thing to
; do is estimate what the max no of fnids can be and set the harvest
; limit there-- beyond that the only solution is to buy more memory.

(def harvest-fnids ((o n 50000))  ; was 20000
  (when (len> fns* n)
    (pull (fn ((id created lasts))
            (when (> (since created) lasts)
              (wipe (fns* id))
              t))
          timed-fnids*)
    (atlet nharvest (trunc (/ n 10))
      (let (kill keep) (split (rev fnids*) nharvest)
        (= fnids* (rev keep))
        (each id kill
          (wipe (fns* id)))))))

(= fnurl* "/x" rfnurl* "/r" rfnurl2* "/y" jfnurl* "/a")

(= dead-msg* "\nUnknown or expired link.")

(defop-raw x (str req)
  (w/stdout str
    (aif (fns* (sym (arg req "fnid")))
         (it req)
         (pr dead-msg*))))

(defopr-raw y (str req)
  (aif (fns* (sym (arg req "fnid")))
       (w/stdout str (it req))
       "deadlink"))

; For asynchronous calls; discards the page.  Would be better to tell
; the fn not to generate it.

(defop-raw a (str req)
  (aif (fns* (sym (arg req "fnid")))
       (tostring (it req))))

(defopr r req
  (aif (fns* (sym (arg req "fnid")))
       (it req)
       "deadlink"))

(defop deadlink req
  (pr dead-msg*))

(def url-for (fnid)
  (string fnurl* "?fnid=" fnid))

(def flink (f)
  (string fnurl* "?fnid=" (fnid (fn (req) (prn) (f req)))))

(def rflink (f)
  (string rfnurl* "?fnid=" (fnid f)))

; Since it's just an expr, gensym a parm for (ignored) args.

(mac w/link (expr . body)
  `(tag (a href (flink (fn (,(uniq)) ,expr)))
     ,@body))

(mac w/rlink (expr . body)
  `(tag (a href (rflink (fn (,(uniq)) ,expr)))
     ,@body))

(mac onlink (text . body)
  `(w/link (do ,@body) (pr ,text)))

(mac onrlink (text . body)
  `(w/rlink (do ,@body) (pr ,text)))

; bad to have both flink and linkf; rename flink something like fnid-link

(mac linkf (text parms . body)
  `(tag (a href (flink (fn ,parms ,@body))) (pr ,text)))

(mac rlinkf (text parms . body)
  `(tag (a href (rflink (fn ,parms ,@body))) (pr ,text)))

;(defop top req (linkf 'whoami? (req) (pr "I am " (get-user req))))

;(defop testf req (w/link (pr "ha ha ha") (pr "laugh")))

(mac w/link-if (test expr . body)
  `(tag-if ,test (a href (flink (fn (,(uniq)) ,expr)))
     ,@body))

(def fnid-field (id)
  (gentag input type 'hidden name 'fnid value id))

; f should be a fn of one arg, which will be http request args.

(def fnform (f bodyfn (o redir))
  (tag (form method 'post action (if redir rfnurl2* fnurl*))
    (fnid-field (fnid f))
    (bodyfn)))

; Could also make a version that uses just an expr, and var capture.
; Is there a way to ensure user doesn't use "fnid" as a key?

(mac aform (f . body)
  (w/uniq ga
    `(tag (form method 'post action fnurl*)
       (fnid-field (fnid (fn (,ga)
                           (prn)
                           (,f ,ga))))
       ,@body)))

;(defop test1 req
;  (fnform (fn (req) (prn) (pr req))
;          (fn () (single-input "" 'foo 20 "submit"))))

;(defop test2 req
;  (aform (fn (req) (pr req))
;    (single-input "" 'foo 20 "submit")))

; Like aform except creates a fnid that will last for lasts seconds
; (unless the server is restarted).

(mac taform (lasts f . body)
  (w/uniq (gl gf gi ga)
    `(withs (,gl ,lasts
             ,gf (fn (,ga) (prn) (,f ,ga)))
       (tag (form method 'post action fnurl*)
         (fnid-field (if ,gl (timed-fnid ,gl ,gf) (fnid ,gf)))
         ,@body))))

(mac arform (f . body)
  `(tag (form method 'post action rfnurl*)
     (fnid-field (fnid ,f))
     ,@body))

; overlong

(mac tarform (lasts f . body)
  (w/uniq (gl gf)
    `(withs (,gl ,lasts ,gf ,f)
       (tag (form method 'post action rfnurl*)
         (fnid-field (if ,gl (timed-fnid ,gl ,gf) (fnid ,gf)))
         ,@body))))

(mac aformh (f . body)
  `(tag (form method 'post action fnurl*)
     (fnid-field (fnid ,f))
     ,@body))

(mac arformh (f . body)
  `(tag (form method 'post action rfnurl2*)
     (fnid-field (fnid ,f))
     ,@body))

; only unique per server invocation

(= unique-ids* (table))

(def unique-id ((o len 8))
  (let id (sym (rand-string (max 5 len)))
    (if (unique-ids* id)
        (unique-id)
        (= (unique-ids* id) id))))

(def srvlog (type . args)
  (w/appendfile o (logfile-name type)
    (w/stdout o (atomic (apply prs (seconds) args) (prn)))))

(def logfile-name (type)
  (string logdir* type "-" (memodate)))

(with (lastasked nil lastval nil)

(def memodate ()
  (let now (seconds)
    (if (or (no lastasked) (> (- now lastasked) 60))
        (= lastasked now lastval (datestring))
        lastval)))

)

(defop || req (pr "It's alive."))

(defop topips req
  (when (admin (get-user req))
    (whitepage
      (sptab
        (each ip (let leaders nil
                   (maptable (fn (ip n)
                               (when (> n 100)
                                 (insort (compare > requests/ip*)
                                         ip
                                         leaders)))
                             requests/ip*)
                   leaders)
          (let n (requests/ip* ip)
            (row ip n (pr (num (* 100 (/ n requests*)) 1)))))))))

(defop spurned req
  (when (admin (get-user req))
    (whitepage
      (sptab
        (map (fn ((ip n)) (row ip n))
             (sortable spurned*))))))

; eventually promote to general util

(def sortable (ht (o f >))
  (let res nil
    (maptable (fn kv
                (insort (compare f cadr) kv res))
              ht)
    res))

; Background Threads

(= bgthreads* (table) pending-bgthreads* nil)

(def new-bgthread (id f sec)
  (aif (bgthreads* id) (break-thread it))
  (= (bgthreads* id) (new-thread (fn ()
                                   (while t
                                     (sleep sec)
                                     (f))))))

; should be a macro for this?

(mac defbg (id sec . body)
  `(do (pull [caris _ ',id] pending-bgthreads*)
       (push (list ',id (fn () ,@body) ,sec)
             pending-bgthreads*)))

; Idea: make form fields that know their value type because of
; gensymed names, and so the receiving fn gets args that are not
; strings but parsed values.

; HTTP Server.

; To improve performance with static files, set static-max-age*.

(= arcdir* "arc/" logdir* "arc/logs/" staticdir* "static/")

(= quitsrv* nil breaksrv* nil)

(def serve ((o port 8080))
  (wipe quitsrv*)
  (ensure-srvdirs)
  (map [apply new-bgthread _] pending-bgthreads*)
  (w/socket s port
    (setuid 2) ; XXX switch from root to pg
    (prn "ready to serve port " port)
    (flushout)
    (= currsock* s)
    (until quitsrv*
      (handle-request s breaksrv*)))
  (prn "quit server"))

(def serve1 ((o port 8080))
  (w/socket s port (handle-request s t)))

(def ensure-srvdirs ()
  (map ensure-dir (list arcdir* logdir* staticdir*)))

(= srv-noisy* nil)

; http requests currently capped at 2 meg by socket-accept

; should threads process requests one at a time? no, then
; a browser that's slow consuming the data could hang the
; whole server.

; wait for a connection from a browser and start a thread
; to handle it. also arrange to kill that thread if it
; has not completed in threadlife* seconds.

(= threadlife* 30  requests* 0  requests/ip* (table)
   throttle-ips* (table)  ignore-ips* (table)  spurned* (table))

(def handle-request (s breaksrv)
  (if breaksrv
      (handle-request-1 s)
      (errsafe (handle-request-1 s))))

(def handle-request-1 (s)
  (with ((i o ip) (socket-accept s)
         th1 nil th2 nil)
    (++ requests*)
    (let ip-wrapper (fn args
                      (if args
                        (= ip car.args)
                        ip))
      (= th1 (thread
               (after (handle-request-thread i o ip-wrapper)
                      (close i o)
                      (kill-thread th2))))
      (= th2 (thread
               (sleep threadlife*)
               (unless (dead th1)
                 (prn "srv thread took too long for " ip))
               (kill-thread th1)
               (force-close i o))))))

; Returns true if ip has made req-limit* requests in less than
; req-window* seconds.  If an ip is throttled, only 1 request is
; allowed per req-window* seconds.  If an ip makes req-limit*
; requests in less than dos-window* seconds, it is a treated as a DoS
; attack and put in ignore-ips* (for this server invocation).

; To adjust this while running, adjust the req-window* time, not
; req-limit*, because algorithm doesn't enforce decreases in the latter.

(= req-times* (table) req-limit* 30 req-window* 10 dos-window* 2)

(wipe show-abuse*)
(def abusive-ip (ip)
  (++ (requests/ip* ip 0))
  (if show-abuse*
    (if (ignore-ips* ip)
      (prn ip " ignored")
      (prn ip " " (if (abusive-ip-core ip) "" "not ") "abusive (" requests/ip*.ip ")")))
  (and (or (ignore-ips* ip) (abusive-ip-core ip))
       (++ (spurned* ip 0))))

(def abusive-ip-core (ip)
  (and (only.> (requests/ip* ip) 250)
       (let now (seconds)
         (do1 (if (req-times* ip)
                  (and (>= (qlen (req-times* ip))
                           (if (throttle-ips* ip) 1 req-limit*))
                       (let dt (- now (deq (req-times* ip)))
                         (if (< dt dos-window*) (set (ignore-ips* ip)))
                         (< dt req-window*)))
                  (do (= (req-times* ip) (queue))
                      nil))
              (enq now (req-times* ip))))))

(let proxy-header "X-Forwarded-For: "
  (def strip-header(s)
    (subst "" proxy-header s))
  (def proxy-ip(ip-wrapper lines)
    (aif (only.strip-header (car:keep [headmatch proxy-header _] lines))
        (ip-wrapper it)
        (ip-wrapper))))

(wipe show-requests*)
(def handle-request-thread (i o ip-wrapper)
  (with (nls 0 lines nil line nil responded nil t0 (msec))
    (after
      (whilet c (unless responded (readc i))
        (if srv-noisy* (pr c))
        (if (is c #\newline)
            (if (is (++ nls) 2)
                (let (type op args n cooks) (parseheader (rev lines))
                  (if show-requests* (prn lines))
                  (unless (~abusive-ip (proxy-ip ip-wrapper lines))
                    (let t1 (msec)
                      (case type
                        get  (respond o op args cooks (ip-wrapper))
                        post (handle-post i o op args n cooks (ip-wrapper))
                             (respond-err o "Unknown request: " (car lines)))
                      (log-request type op args cooks (ip-wrapper) t0 t1)))
                  (set responded))
                (do (push (string (rev line)) lines)
                    (wipe line)))
            (unless (is c #\return)
              (push c line)
              (= nls 0))))
      (close i o)))
  (harvest-fnids))

(def log-request (type op args cooks ip t0 t1)
  (with (parsetime (- t1 t0) respondtime (- (msec) t1))
    (srvlog 'srv ip
                 parsetime
                 respondtime
                 (if (> (+ parsetime respondtime) 1000) "***" "")
                 type
                 op
                 (let arg1 (car args)
                   (if (caris arg1 "fnid") "" arg1))
                 cooks)))

; Could ignore return chars (which come from textarea fields) here by
; (unless (is c #\return) (push c line))

(def handle-post (i o op args n cooks ip)
  (if srv-noisy* (pr "Post Contents: "))
  (if (no n)
      (respond-err o "Post request without Content-Length.")
      (let line nil
        (whilet c (and (> n 0) (readc i))
          (if srv-noisy* (pr c))
          (-- n)
          (push c line))
        (if srv-noisy* (pr "\n\n"))
        (respond o op (+ (parseargs (string (rev line))) args) cooks ip))))

(= header* "HTTP/1.1 200 OK
Content-Type: text/html; charset=utf-8
Connection: close")

(= type-header* (table))

(def gen-type-header (ctype)
  (+ "HTTP/1.0 200 OK
Content-Type: "
     ctype
     "
Connection: close"))

(map (fn ((k v)) (= (type-header* k) (gen-type-header v)))
     '((gif       "image/gif")
       (jpg       "image/jpeg")
       (png       "image/png")
       (text/html "text/html; charset=utf-8")))

(= rdheader* "HTTP/1.0 302 Moved")

(= srvops* (table) redirector* (table) optimes* (table) opcounts* (table))

(def save-optime (name elapsed)
  ; this is the place to put a/b testing
  ; toggle a flag and push elapsed into one of two lists
  (++ (opcounts* name 0))
  (unless (optimes* name) (= (optimes* name) (queue)))
  (enq-limit elapsed (optimes* name) 1000))

; For ops that want to add their own headers.  They must thus remember
; to prn a blank line before anything meant to be part of the page.

(mac defop-raw (name parms . body)
  (w/uniq t1
    `(= (srvops* ',name)
        (fn ,parms
          (let ,t1 (msec)
            (do1 (do ,@body)
                 (save-optime ',name (- (msec) ,t1))))))))

(mac defopr-raw (name parms . body)
  `(= (redirector* ',name) t
      (srvops* ',name)     (fn ,parms ,@body)))

(mac defop (name parm . body)
  (w/uniq gs
    `(do (wipe (redirector* ',name))
         (defop-raw ,name (,gs ,parm)
           (w/stdout ,gs (prn) ,@body)))))

; Defines op as a redirector.  Its retval is new location.

(mac defopr (name parm . body)
  (w/uniq gs
    `(do (set (redirector* ',name))
         (defop-raw ,name (,gs ,parm)
           ,@body))))

;(mac testop (name . args) `((srvops* ',name) ,@args))

(deftem request
  args  nil
  cooks nil
  ip    nil)

(= unknown-msg* "Unknown." max-age* (table) static-max-age* nil)

(def respond (str op args cooks ip)
  (w/stdout str
    (iflet f (srvops* op)
           (let req (inst 'request 'args args 'cooks cooks 'ip ip)
             (if (redirector* op)
                 (do (prn rdheader*)
                     (prn "Location: " (f str req))
                     (prn))
                 (do (prn header*)
                     (awhen (max-age* op)
                       (prn "Cache-Control: max-age=" it))
                     (f str req))))
           (let filetype (static-filetype op)
             (aif (and filetype (file-exists (string staticdir* op)))
                  (do (prn (type-header* filetype))
                      (awhen static-max-age*
                        (prn "Cache-Control: max-age=" it))
                      (prn)
                      (w/infile i it
                        (whilet b (readb i)
                          (writeb b str))))
                  (respond-err str unknown-msg*))))))

(def static-filetype (sym)
  (let fname (coerce sym 'string)
    (and (~find #\/ fname)
         (case (downcase (last (check (tokens fname #\.) ~single)))
           "gif"  'gif
           "jpg"  'jpg
           "jpeg" 'jpg
           "png"  'png
           "css"  'text/html
           "txt"  'text/html
           "htm"  'text/html
           "html" 'text/html
           "arc"  'text/html
           ))))

(def respond-err (str msg . args)
  (w/stdout str
    (prn header*)
    (prn)
    (apply pr msg args)))

(def parseheader (lines)
  (let (type op args) (parseurl (car lines))
    (list type
          op
          args
          (and (is type 'post)
               (some (fn (s)
                       (and (begins s "Content-Length:")
                            (errsafe:coerce (cadr (tokens s)) 'int)))
                     (cdr lines)))
          (some (fn (s)
                  (and (begins s "Cookie:")
                       (parsecookies s)))
                (cdr lines)))))

; (parseurl "GET /p1?foo=bar&ug etc") -> (get p1 (("foo" "bar") ("ug")))

(def parseurl (s)
  (let (type url) (tokens s)
    (let (base args) (tokens url #\?)
      (list (sym (downcase type))
            (sym (cut base 1))
            (if args
                (parseargs args)
                nil)))))

; I don't urldecode field names or anything in cookies; correct?

(def parseargs (s)
  (map (fn ((k v)) (list k (urldecode v)))
       (map [tokens _ #\=] (tokens s #\&))))

(def parsecookies (s)
  (map [tokens _ #\=]
       (cdr (tokens s [or (whitec _) (is _ #\;)]))))

(def arg (req key) (alref req!args key))

; *** Warning: does not currently urlencode args, so if need to do
; that replace v with (urlencode v).

(def reassemble-args (req)
  (aif req!args
       (apply string "?" (intersperse '&
                                      (map (fn ((k v))
                                             (string k '= v))
                                           it)))
       ""))

(= fns* (table) fnids* nil timed-fnids* nil)

; count on huge (expt 64 10) size of fnid space to avoid clashes

(def new-fnid ()
  (check (sym (rand-string 10)) ~fns* (new-fnid)))

(def fnid (f)
  (atlet key (new-fnid)
    (= (fns* key) f)
    (push key fnids*)
    key))

(def timed-fnid (lasts f)
  (atlet key (new-fnid)
    (= (fns* key) f)
    (push (list key (seconds) lasts) timed-fnids*)
    key))

; Within f, it will be bound to the fn's own fnid.  Remember that this is
; so low-level that need to generate the newline to separate from the headers
; within the body of f.

(mac afnid (f)
  `(atlet it (new-fnid)
     (= (fns* it) ,f)
     (push it fnids*)
     it))

;(defop test-afnid req
;  (tag (a href (url-for (afnid (fn (req) (prn) (pr "my fnid is " it)))))
;    (pr "click here")))

; To be more sophisticated, instead of killing fnids, could first
; replace them with fns that tell the server it's harvesting too
; aggressively if they start to get called.  But the right thing to
; do is estimate what the max no of fnids can be and set the harvest
; limit there-- beyond that the only solution is to buy more memory.

(def harvest-fnids ((o n 50000))  ; was 20000
  (when (len> fns* n)
    (pull (fn ((id created lasts))
            (when (> (since created) lasts)
              (wipe (fns* id))
              t))
          timed-fnids*)
    (atlet nharvest (trunc (/ n 10))
      (let (kill keep) (split (rev fnids*) nharvest)
        (= fnids* (rev keep))
        (each id kill
          (wipe (fns* id)))))))

(= fnurl* "/x" rfnurl* "/r" rfnurl2* "/y" jfnurl* "/a")

(= dead-msg* "\nUnknown or expired link.")

(defop-raw x (str req)
  (w/stdout str
    (aif (fns* (sym (arg req "fnid")))
         (it req)
         (pr dead-msg*))))

(defopr-raw y (str req)
  (aif (fns* (sym (arg req "fnid")))
       (w/stdout str (it req))
       "deadlink"))

; For asynchronous calls; discards the page.  Would be better to tell
; the fn not to generate it.

(defop-raw a (str req)
  (aif (fns* (sym (arg req "fnid")))
       (tostring (it req))))

(defopr r req
  (aif (fns* (sym (arg req "fnid")))
       (it req)
       "deadlink"))

(defop deadlink req
  (pr dead-msg*))

(def url-for (fnid)
  (string fnurl* "?fnid=" fnid))

(def flink (f)
  (string fnurl* "?fnid=" (fnid (fn (req) (prn) (f req)))))

(def rflink (f)
  (string rfnurl* "?fnid=" (fnid f)))

; Since it's just an expr, gensym a parm for (ignored) args.

(mac w/link (expr . body)
  `(tag (a href (flink (fn (,(uniq)) ,expr)))
     ,@body))

(mac w/rlink (expr . body)
  `(tag (a href (rflink (fn (,(uniq)) ,expr)))
     ,@body))

(mac onlink (text . body)
  `(w/link (do ,@body) (pr ,text)))

(mac onrlink (text . body)
  `(w/rlink (do ,@body) (pr ,text)))

; bad to have both flink and linkf; rename flink something like fnid-link

(mac linkf (text parms . body)
  `(tag (a href (flink (fn ,parms ,@body))) (pr ,text)))

(mac rlinkf (text parms . body)
  `(tag (a href (rflink (fn ,parms ,@body))) (pr ,text)))

;(defop top req (linkf 'whoami? (req) (pr "I am " (get-user req))))

;(defop testf req (w/link (pr "ha ha ha") (pr "laugh")))

(mac w/link-if (test expr . body)
  `(tag-if ,test (a href (flink (fn (,(uniq)) ,expr)))
     ,@body))

(def fnid-field (id)
  (gentag input type 'hidden name 'fnid value id))

; f should be a fn of one arg, which will be http request args.

(def fnform (f bodyfn (o redir))
  (tag (form method 'post action (if redir rfnurl2* fnurl*))
    (fnid-field (fnid f))
    (bodyfn)))

; Could also make a version that uses just an expr, and var capture.
; Is there a way to ensure user doesn't use "fnid" as a key?

(mac aform (f . body)
  (w/uniq ga
    `(tag (form method 'post action fnurl*)
       (fnid-field (fnid (fn (,ga)
                           (prn)
                           (,f ,ga))))
       ,@body)))

;(defop test1 req
;  (fnform (fn (req) (prn) (pr req))
;          (fn () (single-input "" 'foo 20 "submit"))))

;(defop test2 req
;  (aform (fn (req) (pr req))
;    (single-input "" 'foo 20 "submit")))

; Like aform except creates a fnid that will last for lasts seconds
; (unless the server is restarted).

(mac taform (lasts f . body)
  (w/uniq (gl gf gi ga)
    `(withs (,gl ,lasts
             ,gf (fn (,ga) (prn) (,f ,ga)))
       (tag (form method 'post action fnurl*)
         (fnid-field (if ,gl (timed-fnid ,gl ,gf) (fnid ,gf)))
         ,@body))))

(mac arform (f . body)
  `(tag (form method 'post action rfnurl*)
     (fnid-field (fnid ,f))
     ,@body))

; overlong

(mac tarform (lasts f . body)
  (w/uniq (gl gf)
    `(withs (,gl ,lasts ,gf ,f)
       (tag (form method 'post action rfnurl*)
         (fnid-field (if ,gl (timed-fnid ,gl ,gf) (fnid ,gf)))
         ,@body))))

(mac aformh (f . body)
  `(tag (form method 'post action fnurl*)
     (fnid-field (fnid ,f))
     ,@body))

(mac arformh (f . body)
  `(tag (form method 'post action rfnurl2*)
     (fnid-field (fnid ,f))
     ,@body))

; only unique per server invocation

(= unique-ids* (table))

(def unique-id ((o len 8))
  (let id (sym (rand-string (max 5 len)))
    (if (unique-ids* id)
        (unique-id)
        (= (unique-ids* id) id))))

(def srvlog (type . args)
  (w/appendfile o (logfile-name type)
    (w/stdout o (atomic (apply prs (seconds) args) (prn)))))

(def logfile-name (type)
  (string logdir* type "-" (memodate)))

(with (lastasked nil lastval nil)

(def memodate ()
  (let now (seconds)
    (if (or (no lastasked) (> (- now lastasked) 60))
        (= lastasked now lastval (datestring))
        lastval)))

)

(defop || req (pr "It's alive."))

(defop topips req
  (when (admin (get-user req))
    (whitepage
      (sptab
        (each ip (let leaders nil
                   (maptable (fn (ip n)
                               (when (> n 100)
                                 (insort (compare > requests/ip*)
                                         ip
                                         leaders)))
                             requests/ip*)
                   leaders)
          (let n (requests/ip* ip)
            (row ip n (pr (num (* 100 (/ n requests*)) 1)))))))))

(defop spurned req
  (when (admin (get-user req))
    (whitepage
      (sptab
        (map (fn ((ip n)) (row ip n))
             (sortable spurned*))))))

; eventually promote to general util

(def sortable (ht (o f >))
  (let res nil
    (maptable (fn kv
                (insort (compare f cadr) kv res))
              ht)
    res))

; Background Threads

(= bgthreads* (table) pending-bgthreads* nil)

(def new-bgthread (id f sec)
  (aif (bgthreads* id) (break-thread it))
  (= (bgthreads* id) (new-thread (fn ()
                                   (while t
                                     (sleep sec)
                                     (f))))))

; should be a macro for this?

(mac defbg (id sec . body)
  `(do (pull [caris _ ',id] pending-bgthreads*)
       (push (list ',id (fn () ,@body) ,sec)
             pending-bgthreads*)))

; Idea: make form fields that know their value type because of
; gensymed names, and so the receiving fn gets args that are not
; strings but parsed values.


Job: #9088 Add support for new property descriptor in test data (TypeDefinition)

.//========================================================================
.//
.//File:      $RCSfile: create_view_test.arc,v $
.//Version:   $Revision: 1.47 $
.//Modified:  $Date: 2013/05/12 22:30:18 $
.//
.//(c) Copyright 2006-2014 by Mentor Graphics Corp. All rights reserved.
.//
.//========================================================================
.// Licensed under the Apache License, Version 2.0 (the "License"); you may not
.// use this file except in compliance with the License.  You may obtain a copy
.// of the License at
.//
.//       http://www.apache.org/licenses/LICENSE-2.0
.//
.// Unless required by applicable law or agreed to in writing, software
.// distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
.// WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.   See the
.// License for the specific language governing permissions and limitations under
.// the License.
.//========================================================================
.//
.invoke arc_env = GET_ENV_VAR( "PTC_MC_ARC_DIR" )
.assign mc_archetypes = arc_env.result
.if ( mc_archetypes == "" )
  .print "\nERROR: Environment variable PTC_MC_ARC_DIR not set."
  .exit 100
.end if
.//
.include "${mc_archetypes}/arch_utils.inc"
.function get_ref_value
  .param inst_ref child_node   .// T_TNS
  .param string child_var_name
  .//
  .if ( child_node.Key_Lett == "R_REL" )
            "R$${${child_var_name}.Numb}" },
  .elif ( child_node.Key_Lett == "O_IOBJ" )
    ..select one obj related by O_IOBJclass->O_OBJ[R101]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "SM_ASM" )
            "$${O_OBJclass.Name}" },
  .elif ( child_node.Key_Lett == "SM_ISM" )
            "$${O_OBJclass.Name}" },
  .elif ( child_node.Key_Lett == "SM_PEVT" )
     ..assign result = SM_PEVTclass.localEventMning;
     ..if(result == "")
       ..assign result = "test_poly"
     ..end if
            "$${result}" },
  .elif(child_node.Key_Lett == "SM_NLEVT")
            "test_sm::B Class" },
  .elif(child_node.Key_Lett == "SM_TXN")
            "test_sm::B Class" },
  .elif ( child_node.Key_Lett == "O_RTIDA" )
     ..select one cia related by O_RTIDAclass->O_OIDA[R110]
     ..select one assoc related by O_RTIDAclass->R_RTO[R110]->R_OIR[R203]->R_REL[R201]
     ..assign attrName = cia.localAttributeName;
     ..if(attrName == "")
       ..assign attrName = "id"
     ..end if
     ..assign result = attrName + " {R"
     ..assign result = result + "$${assoc.Numb}"
     ..assign result = result + "}"
            "$${result}" },
  .elif ( child_node.Key_Lett == "SM_SM" )
    ..select one obj related by SM_SMclass->SM_ISM[R517]->O_OBJ[R518]
    ..if ( not_empty obj )
            "$${obj.Name}" },
    ..else
      ..select one obj related by SM_SMclass->SM_ASM[R517]->O_OBJ[R519]
            "$${obj.Name}" },
    ..end if
  .elif ( child_node.Key_Lett == "SM_SUPDT")
    ..select many edi_set related by ${child_var_name}->SM_SDI[R522]->SM_EVTDI[R522];
    ..assign result = "("
    ..assign first = true
    ..for each edi in edi_set
      ..if ( not first )
        ..assign result = result + ","
      ..end if
      ..assign result = result + edi.Name
      ..assign first = false
    ..end for
            "$${result}" + ")" },
  .elif ( child_node.Key_Lett == "SM_EVT" )
    ..select any smsevt from instances of SM_SEVT where ((selected.SMevt_ID == SM_EVTclass.SMevt_ID) and (selected.SM_ID == SM_EVTclass.SM_ID) and (selected.SMspd_ID == SM_EVTclass.SMspd_ID))
    ..select one nlevt related by smsevt->SM_NLEVT[R526]
    ..if(not_empty nlevt)
      ..select one smpevt related by nlevt->SM_PEVT[R527]
      ..select any smevt from instances of SM_EVT where ((selected.SMevt_ID == smpevt.SMevt_ID) and (selected.SM_ID == smpevt.SM_ID) and (selected.SMspd_ID == smpevt.SMspd_ID))
      ..select one obj related by smevt->SM_SM[R502]->SM_ISM[R517]->O_OBJ[R518]
            "$${SM_EVTclass.Mning}::$${obj.Name}" },
    ..else
      ..select one obj related by SM_EVTclass->SM_SM[R502]->SM_ISM[R517]->O_OBJ[R518]
      ..if ( not_empty obj )
            "$${SM_EVTclass.Drv_Lbl}: $${SM_EVTclass.Mning}" },
      ..else
        ..select one obj related by SM_EVTclass->SM_SM[R502]->SM_ASM[R517]->O_OBJ[R519]
            "$${SM_EVTclass.Drv_Lbl}: $${SM_EVTclass.Mning}" },
      ..end if
    ..end if
  .elif ( child_node.Key_Lett == "SM_SEME" )
            "State Event Matrix Entry (test_poly::B Class)" },
  .elif ( child_node.Key_Lett == "SM_ACT" )
      ..select one state related by SM_ACTclass->SM_AH[R514]->SM_MOAH[R513]->SM_STATE[R511]
      ..if(empty state)
            "Transition Action" },
      ..else
            "State Action" },
      ..end if
  .elif ( child_node.Key_Lett == "O_ID" )
      ..assign id_val = O_IDclass.Oid_ID + 1
              "*$${id_val}" },
  .elif ( child_node.Key_Lett == "S_CDT" )
      ..select one dt related by S_CDTclass->S_DT[R17]
            "$${dt.Name}" },
  .elif ( child_node.Key_Lett == "S_EEEVT" )
      ..select one ee related by S_EEEVTclass->S_EE[R10]
            "$${ee.Name}.$${S_EEEVTclass.Drv_Lbl}" },
  .elif ( child_node.Key_Lett == "R_PART" )
      ..select one obj related by R_PARTclass->R_RTO[R204]->R_OIR[R203]->O_OBJ[R201]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "R_FORM" )
      ..select one obj related by R_FORMclass->R_RGO[R205]->R_OIR[R203]->O_OBJ[R201]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "SM_CH" )
      ..select one smsevt related by SM_CHclass->SM_SEME[R504]->SM_SEVT[R503]
      ..select any evt from instances of SM_EVT where ((selected.SMevt_ID == smsevt.SMevt_ID) and (selected.SM_ID == smsevt.SM_ID) and (selected.SMspd_ID == smsevt.SMspd_ID))
      ..select one state related by SM_CHclass->SM_SEME[R504]->SM_STATE[R503]
            "$${evt.Drv_Lbl}/$${state.Name}" },
  .elif ( child_node.Key_Lett == "R_CONE" )
      ..select one obj related by R_CONEclass->R_OIR[R203]->O_OBJ[R201]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "R_COTH" )
      ..select one obj related by R_COTHclass->R_OIR[R203]->O_OBJ[R201]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "SM_SDI" )
      ..select one edi related by SM_SDIclass->SM_EVTDI[R522]
            "$${edi.Name}" },
  .elif ( child_node.Key_Lett == "S_UDT" )
  	..select any dt related by S_UDTclass->S_DT[R17]
  			"$${dt.Name}" },
  .elif ( child_node.Key_Lett == "S_SDT" )
  	..select any dt related by S_SDTclass->S_DT[R17]
  			"$${dt.Name}" },
  .elif ( child_node.Key_Lett == "S_EDT" )
  	..select any dt related by S_EDTclass->S_DT[R17]
  			"$${dt.Name}" },
  .elif(((child_node.Key_Lett == "SQ_CP") or (child_node.Key_Lett == "MSG_A")) or (child_node.Key_Lett == "SQ_AV"))
    				"$${${child_var_name}.InformalName}" },
  .elif((child_node.Key_Lett == "MSG_SM") or (child_node.Key_Lett == "MSG_AM"))
        "$${${child_var_name}.InformalName}" },
  .elif(child_node.Key_Lett == "MSG_ISM")
    ..select one sm related by ${child_var_name}->MSG_SM[R1020]
        "$${sm.InformalName}" },
  .elif(child_node.Key_Lett == "MSG_IAM")
    ..select one am related by ${child_var_name}->MSG_AM[R1019]
        "$${am.InformalName}" },
  .elif ( child_node.Key_Lett == "A_FJ" )
  			"$${${child_var_name}.GuardCondition}" },
  .elif ( child_node.Key_Lett == "A_DM" )
  			"$${${child_var_name}.DecisionInput}" },
  .elif ( child_node.Key_Lett == "A_E" )
  			"$${${child_var_name}.Guard}" },
  .else
            "$${${child_var_name}.Name}" },
  .end if
.end function
.function generateTestCase
  .param String kl
  .assign attr_result = true
  .if(kl == "S_EEDI")
    .assign attr_result = false
  .elif(kl == "CP_CP")
    .assign attr_result = false
  .elif(kl == "C_SF")
    .assign attr_result = false
  .elif(kl == "O_OIDA")
    .assign attr_result = false
  .elif(kl == "EP_PKG")
    .assign attr_result = false
  .elif(kl == "IP_IP")
    .assign attr_result = false
  .elif(kl == "C_C")
    .assign attr_result = false
  .elif(kl == "CL_IP")
    .assign attr_result = false
  .elif(kl == "CL_IR")
    .assign attr_result = false
  .elif(kl == "C_I")
    .assign attr_result = false
  .elif(kl == "C_P")
    .assign attr_result = false
  .elif(kl == "C_R")
    .assign attr_result = false
  .elif(kl == "C_AS")
    .assign attr_result = false
  .elif(kl == "C_IO")
    .assign attr_result = false
  .elif(kl == "C_DG")
    .assign attr_result = false
  .elif(kl == "C_PO")
    .assign attr_result = false
  .elif(kl == "C_PP")
    .assign attr_result = false
  .elif(kl == "CL_IC")
    .assign attr_result = false
  .elif(kl == "SPR_RO")
    .assign attr_result = false
  .elif(kl == "SPR_PO")
    .assign attr_result = false
  .elif(kl == "SPR_RS")
    .assign attr_result = false
  .elif(kl == "SPR_PS")
    .assign attr_result = false
  .elif(kl == "I_INS")
    .assign attr_result = false
  .elif(kl == "I_AVL")
    .assign attr_result = false
  .elif(kl == "I_EVI")
    .assign attr_result = false
  .elif(kl == "RV_RVL")
    .assign attr_result = false
  .elif(kl == "I_EXE")
    .assign attr_result = false
  .elif(kl == "I_LIP")
    .assign attr_result = false
  .elif(kl == "CSME_CIE")
    .assign attr_result = false
  .elif(kl == "SM_CRTXN")
    .assign attr_result = false
   .elif(kl == "CL_POR")
    .assign attr_result = false
  .elif(kl == "SM_STATE")
    .// Test case commented out, see DEI 8588
    .assign attr_result = false
  .elif(kl == "SM_TXN")
    .// Test case commented out, see DEI 8588
    .assign attr_result = false
.// START: dts0100656086
  .elif(kl == "S_DOM")
    .assign attr_result = false
  .elif(kl == "S_SS")
    .assign attr_result = false
  .elif(kl == "O_OBJ")
    .assign attr_result = false
  .elif(kl == "O_TFR")
    .assign attr_result = false
  .elif(kl == "O_TPARM")
    .assign attr_result = false
  .elif(kl == "SM_ISM")
    .assign attr_result = false
  .elif(kl == "SM_EVT")
    .assign attr_result = false
  .elif(kl == "SM_EVTDI")
    .assign attr_result = false
  .elif(kl == "O_ATTR")
    .assign attr_result = false
  .elif(kl == "O_REF")
    .assign attr_result = false
  .elif(kl == "SM_SEME")
    .assign attr_result = false
  .elif(kl == "S_DPK")
    .assign attr_result = false
  .elif(kl == "SQ_CIP")
    .assign attr_result = false
  .elif(kl == "SQ_CP")
    .assign attr_result = false
  .elif(kl == "SQ_PP")
    .assign attr_result = false
  .elif(kl == "S_FPK")
    .assign attr_result = false
  .elif(kl == "S_EEPK")
    .assign attr_result = false
  .elif(kl == "SQ_S")
    .assign attr_result = false
  .elif(kl == "SQ_FPP")
    .assign attr_result = false
  .elif(kl == "COMM_COMM")
    .assign attr_result = false
  .elif(kl == "UC_UCC")
    .assign attr_result = false
  .elif(kl == "A_A")
    .assign attr_result = false
.// END: dts0100656086
  .end if
.end function
.//
.assign path = "org/xtuml/bp/ui/properties/test"
.assign class_name = "PropertiesViewTest"
//======================================================================
//
// File: ${path}/${class_name}.java
//
// WARNING:      Do not edit this generated file
// Generated by: ${info.arch_file_name}
// Version:      $$Revision: 1.47 $$
//
// (c) Copyright 2004-2014 by Mentor Graphics Corp.  All rights reserved.
//
//======================================================================
//
// This class is responsible for determing the dependency between
// classes for displaying property changes.
//
package org.xtuml.bp.ui.properties.test;

import org.eclipse.ui.views.properties.IPropertyDescriptor;
import org.junit.Test;
import org.xtuml.bp.core.*;
import org.xtuml.bp.core.common.ClassQueryInterface_c;
import org.xtuml.bp.test.common.BaseTest;
import org.xtuml.bp.ui.properties.*;

public class ${class_name} extends BaseTest
{
    public ${class_name}() {
        super(null, null);
    }
.select many node_set from instances of T_TNS
.for each node in node_set
  .invoke generateTestCase = generateTestCase(node.Key_Lett);
  .if(generateTestCase.result)
    .select any meta_model_obj from instances of O_OBJ where (selected.Key_Lett == node.Key_Lett)
    .invoke formatted_name = get_class_name(meta_model_obj)
    .invoke gia = get_instance_accessor(meta_model_obj)
    @Test
	public void test$r{meta_model_obj.Name}_$r{node.CategoryName}Properties() throws Exception
    {
    .if ( node.Key_Lett == "S_SYS" )
       .// the SystemModel instances are in the default model root
        ${formatted_name.body} inst = ${formatted_name.body}.${gia.body}(Ooaofooa.getDefaultInstance());
    .elif ( node.Key_Lett == "S_DT" )
       .// the instances are loaded in a different order, so search for specific data type
        ${formatted_name.body} inst = ${formatted_name.body}.${gia.body}(Ooaofooa.getDefaultInstance(), new ClassQueryInterface_c() {
            public boolean evaluate(Object candidate) {
                ${formatted_name.body} selected = (${formatted_name.body}) candidate;
                return selected.getName().equals("void");
            }
        });
	.elif(node.Key_Lett == "O_OBJ")
	ModelClass_c inst = ModelClass_c.ModelClassInstance(modelRoot);
	.elif(node.Key_Lett == "SM_STATE")
		StateMachineState_c inst = StateMachineState_c
				..StateMachineStateInstance(modelRoot, new ClassQueryInterface_c() {

					@Override
					public boolean evaluate(Object candidate) {
								ModelClass_c clazz = ModelClass_c
										..getOneO_OBJOnR518(InstanceStateMachine_c
												..getOneSM_ISMOnR517(StateMachine_c
														..getOneSM_SMOnR501((StateMachineState_c) candidate)));
								if(clazz != null && clazz.getName().equals("C class"))
									return true;
								return false;
					}
				});
    .elif((node.Key_Lett == "S_UDT") or (node.Key_Lett == "S_CDT"))
        ${formatted_name.body} inst = ${formatted_name.body}.${gia.body}(Ooaofooa.getDefaultInstance());
    .else
        ${formatted_name.body} inst = ${formatted_name.body}.${gia.body}(modelRoot);
    .end if
        $r{node.CategoryName}${meta_model_obj.Key_Lett}PropertySource ps = new $r{node.categoryName}${meta_model_obj.Key_Lett}PropertySource(inst);
        IPropertyDescriptor [] pd_set = ps.getPropertyDescriptors();
        for ( int i = 0; i < ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}.length; ++i )
        {
            assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][0], pd_set[i].getClass().getName() );
            assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1], pd_set[i].getId() );
            assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][2], pd_set[i].getDisplayName() );
    .select any descrip_attr related by meta_model_obj->O_ATTR[R102] where (selected.name == "Descrip")
    .select any act_attr related by meta_model_obj->O_ATTR[R102] where (selected.name == "Action_Semantics")
    .if ( (not_empty descrip_attr) and (not_empty act_attr) )
            if ( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1].equals("Descrip"))
            {
                assertEquals( inst.getDescrip().replace('\n','/'), ps.getPropertyValue(pd_set[i].getId()));
            }
            else if ( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1].equals("Action_Semantics"))
            {
                assertEquals( inst.getAction_semantics().replace('\n','/'), ps.getPropertyValue(pd_set[i].getId()));
            }
            else
            {
                assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][3], ps.getPropertyValue(pd_set[i].getId()).toString());
            }
    .elif ( not_empty descrip_attr )
            if ( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1].equals("Descrip"))
            {
                assertEquals( inst.getDescrip().replace('\n','/'), ps.getPropertyValue(pd_set[i].getId()));
            }
            else
            {
                assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][3], ps.getPropertyValue(pd_set[i].getId()).toString());
            }
    .elif ( not_empty act_attr )
            if ( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1].equals("Action_Semantics"))
            {
                assertEquals( inst.getAction_semantics().replace('\n','/'), ps.getPropertyValue(pd_set[i].getId()));
            }
            else
            {
                assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][3], ps.getPropertyValue(pd_set[i].getId()).toString());
            }
     .else
            assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][3], ps.getPropertyValue(pd_set[i].getId()).toString());
     .end if
        }
    }
  .end if .// ( node.Key_Lett != "S_EEDI" )
.end for
}
.emit to file "src/${path}/${class_name}.java"
.//
.// Now generate the archetype that will generate the test data!
.//
//======================================================================
//
// File: ${path}/${class_name}Data.java
//
// WARNING:      Do not edit this generated file
// Generated by: $${info.arch_file_name}
// Version:      $$$$Revision: 1.47 $$$$
//
// (c) Copyright 2004-2014 by Mentor Graphics Corp.  All rights reserved.
//
//======================================================================
///
// This class is responsible for determing the dependency between
// classes for displaying property changes.
//
package org.xtuml.bp.ui.properties.test;

import org.eclipse.ui.views.properties.PropertyDescriptor;
import org.eclipse.ui.views.properties.TextPropertyDescriptor;

import org.xtuml.bp.ui.properties.ActivityPropertyDescriptor;
import org.xtuml.bp.ui.properties.BooleanPropertyDescriptor;
import org.xtuml.bp.ui.properties.DescriptionPropertyDescriptor;
import org.xtuml.bp.ui.properties.DimensionsPropertyDescriptor;
import org.xtuml.bp.ui.properties.ChooserPropertyDescriptor;
import org.xtuml.bp.ui.properties.EnumPropertyDescriptor;
import org.xtuml.bp.ui.properties.IntegerPropertyDescriptor;
import org.xtuml.bp.ui.properties.ConstantValuePropertyDescriptor;
import org.xtuml.bp.ui.properties.TypeDefinitionPropertyDescriptor;

public class ${class_name}Data
{
.for each node in node_set
  .select any meta_model_obj from instances of O_OBJ where (selected.Key_Lett == node.Key_Lett)
  .assign mm_obj_var = "${meta_model_obj.Key_Lett}class"
  .invoke generateTestCase = generateTestCase(node.Key_Lett);
  .if(generateTestCase.result)
	public static final String[][] $r{meta_model_obj.Name}_$r{node.CategoryName} =
      {
    .select many attr_set related by meta_model_obj->O_ATTR[R102]
  .if(node.Key_Lett == "S_DT")
  ..select any ${mm_obj_var} from instances of ${meta_model_obj.Key_Lett} where (selected.Name == "void")
  .elif(node.Key_Lett == "S_UDT")
  ..select any dt from instances of S_DT where (selected.Name == "date")
  ..select one ${mm_obj_var} related by dt->S_UDT[R17];
  .elif(node.Key_Lett == "SM_STATE")
  ..select any cclass from instances of O_OBJ where (selected.Name == "C class")
  ..select any ${mm_obj_var} related by cclass->SM_ISM[R518]->SM_SM[R517]->SM_STATE[R501]
  .else
  ..select any ${mm_obj_var} from instances of ${meta_model_obj.Key_Lett}
  .end if
  .// if the test being generated is for datatype packages
  .// there will be two instances, one for the system level dts and one
  .// for the domain level dts
  .// here we need to use the second as it is the instance that the
  .// test is expecting
  .if(node.Key_Lett == "S_DPK")
  ..select many ${mm_obj_var}s from instances of ${meta_model_obj.Key_Lett}
  ..for each mobj in ${mm_obj_var}s
    ..if(last ${mm_obj_var}s)
      ..assign ${mm_obj_var} = mobj
    ..end if
  ..end for
  .end if
  ..print "Generating class ${meta_model_obj.Name} for $r{node.CategoryName}"
    .for each attr in attr_set
      .if(("$l{attr.Descrip:In Properties}" == "true") or ("$l{attr.Descrip:In Properties}" == ""))
        .select one dt related by attr->S_DT[R114]
        .select one edt related by dt->S_EDT[R17]
        .select one rattr related by attr->O_RATTR[R106]
        .if (((dt.Name != "unique_id") and (empty rattr)) and ("$l{attr.Descrip:User_Visible}" != "false"))
			{
          .assign readonly = "$l{attr.Descrip:readonly}"
          .select one dbattr related by attr->O_BATTR[R106]->O_DBATTR[R107]
          .if ( ((not_empty dbattr) or (readonly == "true")) and (attr.Name != "Action_Semantics") )
            .if ( ("${attr.Descrip:enum0}" == "") and (empty edt) )
                PropertyDescriptor.class.getName(),
            .else
                EnumPropertyDescriptor.class.getName(),
            .end if
          .else
            .if (dt.Name == "boolean" )
               BooleanPropertyDescriptor.class.getName(),
            .elif ((dt.Name == "integer") or (not_empty edt))
              .if ( ("${attr.Descrip:enum0}" == "") and (empty edt) )
               IntegerPropertyDescriptor.class.getName(),
              .else
                EnumPropertyDescriptor.class.getName(),
              .end if
            .elif (dt.Name == "string" )
              .if (attr.Name == "Descrip" )
               DescriptionPropertyDescriptor.class.getName(),
              .elif ( attr.Name == "Action_Semantics" )
               ActivityPropertyDescriptor.class.getName(),
              .elif (( attr.Name == "Dimensions" ) or ( attr.Name == "Return_Dimensions"))
               DimensionsPropertyDescriptor.class.getName(),
              .elif (( attr.Name == "Value" ) and ( node.Key_Lett == "CNST_LSC"))
               ConstantValuePropertyDescriptor.class.getName(),
              .else
               .//
               .// The default datatype package "Datatypes" has a read-only
               .// name attribute.
               .// This corresponds to the 'canRename' special case in
               .// BuildPropertySource.arc
                 .if ( (meta_model_obj.Key_Lett == "S_DPK") and (attr.Name == "Name") )
               PropertyDescriptor.class.getName(),
                 .else
                   .if(attr.Name == "Definition")
               TypeDefinitionPropertyDescriptor.class.getName(),
                   .else
               TextPropertyDescriptor.class.getName(),
                   .end if
              .end if
            .end if
          .end if
        .end if
				"${attr.Name}",
				"${attr.Descrip:Full Name}",
        .if (attr.Name == "Descrip" )
				"" },
        .elif ( attr.Name == "Action_Semantics" )
				"" },
        .else
          .if ( dt.Name == "boolean" )
            .if((meta_model_obj.Key_Lett == "S_EE") and (attr.Name == "isRealized"))
				"true" },
            .else
				"$$l{${mm_obj_var}.${attr.Name}}" },
		    .end if
		  .elif ( ("${attr.Descrip:enum0}" != "") or (not_empty edt) )
            .if ( attr.Name == "Is_Lbl_U" )
				EnumRangeTest.${meta_model_obj.Key_Lett}_${attr.name}_vals[$${${mm_obj_var}.${attr.Name}}] },
		    .else
				EnumRangeTest.${attr.name}_vals[$${${mm_obj_var}.${attr.Name}}] },
            .end if
          .else
              .if(node.Key_Lett == "SM_NLEVT")
                .if(attr.Name == "Name")
        ..select one smpevt related by ${mm_obj_var}->SM_PEVT[R527]
        ..select any smevt from instances of SM_EVT where ((selected.SMevt_ID == smpevt.SMevt_ID) and (selected.SM_ID == smpevt.SM_ID) and (selected.SMspd_ID == smpevt.SMspd_ID))
        ..select one polyClass related by smevt->SM_SM[R502]->SM_ISM[R517]->O_OBJ[R518]
        ..select any smsevt from instances of SM_SEVT where ((selected.SMevt_ID == ${mm_obj_var}.SMevt_ID) and (selected.SM_ID == ${mm_obj_var}.SM_ID) and (selected.SMspd_ID == ${mm_obj_var}.SMspd_ID))
        ..select any evt from instances of SM_EVT where ((selected.SMevt_ID == smsevt.SMevt_ID) and (selected.SM_ID == smsevt.SM_ID) and (selected.SMspd_ID == smsevt.SMspd_ID))
				"$${evt.Mning}::$${polyClass.Name}" },
                .end if
              .else
				"$${${mm_obj_var}.${attr.Name}}" },
				      .end if
            .end if
          .end if
        .end if
      .end if
    .end for
    .//
    .//  Now do the referential attributes
    .//
    .select many child_specs related by node->T_TPS[R1000] where (selected.ExcludedFromProperties == false)
    .for each child in child_specs
      .select one child_node related by child->T_TNS[R1001]
      .select any child_class from instances of O_OBJ where (selected.Key_Lett == child_node.Key_Lett)
      .assign child_var_name = "${child_class.Key_Lett}class"
  ..select many ${child_var_name}_set related by ${mm_obj_var}${child.ParentChildRelChain}
  ..assign count = 0
.//
  	  .if ((((node.Key_Lett == "S_CDT") or ( node.Key_Lett == "S_UDT")) or (node.Key_Lett == "S_SDT")) and ((child_node.Key_Lett == "S_DT") and (child.NameOnly == "")) )
    //Skipping special case for core data types and user data types.
      .elif ( (node.Key_Lett == "CNST_CSP") and (child_node.Key_Lett == "CNST_LSC") )
    //Skipping special case for constants
  	  .elif (node.Key_Lett == "S_SYS")
    //Skipping special case for System Model
  	 .else
.//
  ..for each ${child_var_name} in ${child_var_name}_set
     	.if ( (child_node.Key_Lett == "S_DT") and (node.Key_Lett != "S_EDT"))
            { ChooserPropertyDescriptor.class.getName(),
            "$r{child_node.CategoryName}",
      .else
            { PropertyDescriptor.class.getName(),
            "$r{child_node.CategoryName}$r{child.NameOnly}.$${count}",
      .end if
      .if ( child.NameOnly != "" )
            "${child.NameOnly}",
      .else
            "${child_class.name}",
      .end if
      .invoke grv = get_ref_value( child_node, child_var_name )
${grv.body}\
    ..assign count = count + 1
  ..end for
  	  .end if
    .end for
      };
  .end if   .// not S_EEDI
.end for
}
..emit to file "src/${path}/${class_name}Data.java"
.emit to file "arc/create_view_test_data.arc"

.//========================================================================
.//
.//File:      $RCSfile: create_view_test.arc,v $
.//Version:   $Revision: 1.47 $
.//Modified:  $Date: 2013/05/12 22:30:18 $
.//
.//(c) Copyright 2006-2014 by Mentor Graphics Corp. All rights reserved.
.//
.//========================================================================
.// Licensed under the Apache License, Version 2.0 (the "License"); you may not
.// use this file except in compliance with the License.  You may obtain a copy
.// of the License at
.//
.//       http://www.apache.org/licenses/LICENSE-2.0
.//
.// Unless required by applicable law or agreed to in writing, software
.// distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
.// WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.   See the
.// License for the specific language governing permissions and limitations under
.// the License.
.//========================================================================
.//
.invoke arc_env = GET_ENV_VAR( "PTC_MC_ARC_DIR" )
.assign mc_archetypes = arc_env.result
.if ( mc_archetypes == "" )
  .print "\nERROR: Environment variable PTC_MC_ARC_DIR not set."
  .exit 100
.end if
.//
.include "${mc_archetypes}/arch_utils.inc"
.function get_ref_value
  .param inst_ref child_node   .// T_TNS
  .param string child_var_name
  .//
  .if ( child_node.Key_Lett == "R_REL" )
            "R$${${child_var_name}.Numb}" },
  .elif ( child_node.Key_Lett == "O_IOBJ" )
    ..select one obj related by O_IOBJclass->O_OBJ[R101]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "SM_ASM" )
            "$${O_OBJclass.Name}" },
  .elif ( child_node.Key_Lett == "SM_ISM" )
            "$${O_OBJclass.Name}" },
  .elif ( child_node.Key_Lett == "SM_PEVT" )
     ..assign result = SM_PEVTclass.localEventMning;
     ..if(result == "")
       ..assign result = "test_poly"
     ..end if
            "$${result}" },
  .elif(child_node.Key_Lett == "SM_NLEVT")
            "test_sm::B Class" },
  .elif(child_node.Key_Lett == "SM_TXN")
            "test_sm::B Class" },
  .elif ( child_node.Key_Lett == "O_RTIDA" )
     ..select one cia related by O_RTIDAclass->O_OIDA[R110]
     ..select one assoc related by O_RTIDAclass->R_RTO[R110]->R_OIR[R203]->R_REL[R201]
     ..assign attrName = cia.localAttributeName;
     ..if(attrName == "")
       ..assign attrName = "id"
     ..end if
     ..assign result = attrName + " {R"
     ..assign result = result + "$${assoc.Numb}"
     ..assign result = result + "}"
            "$${result}" },
  .elif ( child_node.Key_Lett == "SM_SM" )
    ..select one obj related by SM_SMclass->SM_ISM[R517]->O_OBJ[R518]
    ..if ( not_empty obj )
            "$${obj.Name}" },
    ..else
      ..select one obj related by SM_SMclass->SM_ASM[R517]->O_OBJ[R519]
            "$${obj.Name}" },
    ..end if
  .elif ( child_node.Key_Lett == "SM_SUPDT")
    ..select many edi_set related by ${child_var_name}->SM_SDI[R522]->SM_EVTDI[R522];
    ..assign result = "("
    ..assign first = true
    ..for each edi in edi_set
      ..if ( not first )
        ..assign result = result + ","
      ..end if
      ..assign result = result + edi.Name
      ..assign first = false
    ..end for
            "$${result}" + ")" },
  .elif ( child_node.Key_Lett == "SM_EVT" )
    ..select any smsevt from instances of SM_SEVT where ((selected.SMevt_ID == SM_EVTclass.SMevt_ID) and (selected.SM_ID == SM_EVTclass.SM_ID) and (selected.SMspd_ID == SM_EVTclass.SMspd_ID))
    ..select one nlevt related by smsevt->SM_NLEVT[R526]
    ..if(not_empty nlevt)
      ..select one smpevt related by nlevt->SM_PEVT[R527]
      ..select any smevt from instances of SM_EVT where ((selected.SMevt_ID == smpevt.SMevt_ID) and (selected.SM_ID == smpevt.SM_ID) and (selected.SMspd_ID == smpevt.SMspd_ID))
      ..select one obj related by smevt->SM_SM[R502]->SM_ISM[R517]->O_OBJ[R518]
            "$${SM_EVTclass.Mning}::$${obj.Name}" },
    ..else
      ..select one obj related by SM_EVTclass->SM_SM[R502]->SM_ISM[R517]->O_OBJ[R518]
      ..if ( not_empty obj )
            "$${SM_EVTclass.Drv_Lbl}: $${SM_EVTclass.Mning}" },
      ..else
        ..select one obj related by SM_EVTclass->SM_SM[R502]->SM_ASM[R517]->O_OBJ[R519]
            "$${SM_EVTclass.Drv_Lbl}: $${SM_EVTclass.Mning}" },
      ..end if
    ..end if
  .elif ( child_node.Key_Lett == "SM_SEME" )
            "State Event Matrix Entry (test_poly::B Class)" },
  .elif ( child_node.Key_Lett == "SM_ACT" )
      ..select one state related by SM_ACTclass->SM_AH[R514]->SM_MOAH[R513]->SM_STATE[R511]
      ..if(empty state)
            "Transition Action" },
      ..else
            "State Action" },
      ..end if
  .elif ( child_node.Key_Lett == "O_ID" )
      ..assign id_val = O_IDclass.Oid_ID + 1
              "*$${id_val}" },
  .elif ( child_node.Key_Lett == "S_CDT" )
      ..select one dt related by S_CDTclass->S_DT[R17]
            "$${dt.Name}" },
  .elif ( child_node.Key_Lett == "S_EEEVT" )
      ..select one ee related by S_EEEVTclass->S_EE[R10]
            "$${ee.Name}.$${S_EEEVTclass.Drv_Lbl}" },
  .elif ( child_node.Key_Lett == "R_PART" )
      ..select one obj related by R_PARTclass->R_RTO[R204]->R_OIR[R203]->O_OBJ[R201]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "R_FORM" )
      ..select one obj related by R_FORMclass->R_RGO[R205]->R_OIR[R203]->O_OBJ[R201]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "SM_CH" )
      ..select one smsevt related by SM_CHclass->SM_SEME[R504]->SM_SEVT[R503]
      ..select any evt from instances of SM_EVT where ((selected.SMevt_ID == smsevt.SMevt_ID) and (selected.SM_ID == smsevt.SM_ID) and (selected.SMspd_ID == smsevt.SMspd_ID))
      ..select one state related by SM_CHclass->SM_SEME[R504]->SM_STATE[R503]
            "$${evt.Drv_Lbl}/$${state.Name}" },
  .elif ( child_node.Key_Lett == "R_CONE" )
      ..select one obj related by R_CONEclass->R_OIR[R203]->O_OBJ[R201]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "R_COTH" )
      ..select one obj related by R_COTHclass->R_OIR[R203]->O_OBJ[R201]
            "$${obj.Name}" },
  .elif ( child_node.Key_Lett == "SM_SDI" )
      ..select one edi related by SM_SDIclass->SM_EVTDI[R522]
            "$${edi.Name}" },
  .elif ( child_node.Key_Lett == "S_UDT" )
  	..select any dt related by S_UDTclass->S_DT[R17]
  			"$${dt.Name}" },
  .elif ( child_node.Key_Lett == "S_SDT" )
  	..select any dt related by S_SDTclass->S_DT[R17]
  			"$${dt.Name}" },
  .elif ( child_node.Key_Lett == "S_EDT" )
  	..select any dt related by S_EDTclass->S_DT[R17]
  			"$${dt.Name}" },
  .elif(((child_node.Key_Lett == "SQ_CP") or (child_node.Key_Lett == "MSG_A")) or (child_node.Key_Lett == "SQ_AV"))
    				"$${${child_var_name}.InformalName}" },
  .elif((child_node.Key_Lett == "MSG_SM") or (child_node.Key_Lett == "MSG_AM"))
        "$${${child_var_name}.InformalName}" },
  .elif(child_node.Key_Lett == "MSG_ISM")
    ..select one sm related by ${child_var_name}->MSG_SM[R1020]
        "$${sm.InformalName}" },
  .elif(child_node.Key_Lett == "MSG_IAM")
    ..select one am related by ${child_var_name}->MSG_AM[R1019]
        "$${am.InformalName}" },
  .elif ( child_node.Key_Lett == "A_FJ" )
  			"$${${child_var_name}.GuardCondition}" },
  .elif ( child_node.Key_Lett == "A_DM" )
  			"$${${child_var_name}.DecisionInput}" },
  .elif ( child_node.Key_Lett == "A_E" )
  			"$${${child_var_name}.Guard}" },
  .else
            "$${${child_var_name}.Name}" },
  .end if
.end function
.function generateTestCase
  .param String kl
  .assign attr_result = true
  .if(kl == "S_EEDI")
    .assign attr_result = false
  .elif(kl == "CP_CP")
    .assign attr_result = false
  .elif(kl == "C_SF")
    .assign attr_result = false
  .elif(kl == "O_OIDA")
    .assign attr_result = false
  .elif(kl == "EP_PKG")
    .assign attr_result = false
  .elif(kl == "IP_IP")
    .assign attr_result = false
  .elif(kl == "C_C")
    .assign attr_result = false
  .elif(kl == "CL_IP")
    .assign attr_result = false
  .elif(kl == "CL_IR")
    .assign attr_result = false
  .elif(kl == "C_I")
    .assign attr_result = false
  .elif(kl == "C_P")
    .assign attr_result = false
  .elif(kl == "C_R")
    .assign attr_result = false
  .elif(kl == "C_AS")
    .assign attr_result = false
  .elif(kl == "C_IO")
    .assign attr_result = false
  .elif(kl == "C_DG")
    .assign attr_result = false
  .elif(kl == "C_PO")
    .assign attr_result = false
  .elif(kl == "C_PP")
    .assign attr_result = false
  .elif(kl == "CL_IC")
    .assign attr_result = false
  .elif(kl == "SPR_RO")
    .assign attr_result = false
  .elif(kl == "SPR_PO")
    .assign attr_result = false
  .elif(kl == "SPR_RS")
    .assign attr_result = false
  .elif(kl == "SPR_PS")
    .assign attr_result = false
  .elif(kl == "I_INS")
    .assign attr_result = false
  .elif(kl == "I_AVL")
    .assign attr_result = false
  .elif(kl == "I_EVI")
    .assign attr_result = false
  .elif(kl == "RV_RVL")
    .assign attr_result = false
  .elif(kl == "I_EXE")
    .assign attr_result = false
  .elif(kl == "I_LIP")
    .assign attr_result = false
  .elif(kl == "CSME_CIE")
    .assign attr_result = false
  .elif(kl == "SM_CRTXN")
    .assign attr_result = false
   .elif(kl == "CL_POR")
    .assign attr_result = false
  .elif(kl == "SM_STATE")
    .// Test case commented out, see DEI 8588
    .assign attr_result = false
  .elif(kl == "SM_TXN")
    .// Test case commented out, see DEI 8588
    .assign attr_result = false
.// START: dts0100656086
  .elif(kl == "S_DOM")
    .assign attr_result = false
  .elif(kl == "S_SS")
    .assign attr_result = false
  .elif(kl == "O_OBJ")
    .assign attr_result = false
  .elif(kl == "O_TFR")
    .assign attr_result = false
  .elif(kl == "O_TPARM")
    .assign attr_result = false
  .elif(kl == "SM_ISM")
    .assign attr_result = false
  .elif(kl == "SM_EVT")
    .assign attr_result = false
  .elif(kl == "SM_EVTDI")
    .assign attr_result = false
  .elif(kl == "O_ATTR")
    .assign attr_result = false
  .elif(kl == "O_REF")
    .assign attr_result = false
  .elif(kl == "SM_SEME")
    .assign attr_result = false
  .elif(kl == "S_DPK")
    .assign attr_result = false
  .elif(kl == "SQ_CIP")
    .assign attr_result = false
  .elif(kl == "SQ_CP")
    .assign attr_result = false
  .elif(kl == "SQ_PP")
    .assign attr_result = false
  .elif(kl == "S_FPK")
    .assign attr_result = false
  .elif(kl == "S_EEPK")
    .assign attr_result = false
  .elif(kl == "SQ_S")
    .assign attr_result = false
  .elif(kl == "SQ_FPP")
    .assign attr_result = false
  .elif(kl == "COMM_COMM")
    .assign attr_result = false
  .elif(kl == "UC_UCC")
    .assign attr_result = false
  .elif(kl == "A_A")
    .assign attr_result = false
.// END: dts0100656086
  .end if
.end function
.//
.assign path = "org/xtuml/bp/ui/properties/test"
.assign class_name = "PropertiesViewTest"
//======================================================================
//
// File: ${path}/${class_name}.java
//
// WARNING:      Do not edit this generated file
// Generated by: ${info.arch_file_name}
// Version:      $$Revision: 1.47 $$
//
// (c) Copyright 2004-2014 by Mentor Graphics Corp.  All rights reserved.
//
//======================================================================
//
// This class is responsible for determing the dependency between
// classes for displaying property changes.
//
package org.xtuml.bp.ui.properties.test;

import org.eclipse.ui.views.properties.IPropertyDescriptor;
import org.junit.Test;
import org.xtuml.bp.core.*;
import org.xtuml.bp.core.common.ClassQueryInterface_c;
import org.xtuml.bp.test.common.BaseTest;
import org.xtuml.bp.ui.properties.*;

public class ${class_name} extends BaseTest
{
    public ${class_name}() {
        super(null, null);
    }
.select many node_set from instances of T_TNS
.for each node in node_set
  .invoke generateTestCase = generateTestCase(node.Key_Lett);
  .if(generateTestCase.result)
    .select any meta_model_obj from instances of O_OBJ where (selected.Key_Lett == node.Key_Lett)
    .invoke formatted_name = get_class_name(meta_model_obj)
    .invoke gia = get_instance_accessor(meta_model_obj)
    @Test
	public void test$r{meta_model_obj.Name}_$r{node.CategoryName}Properties() throws Exception
    {
    .if ( node.Key_Lett == "S_SYS" )
       .// the SystemModel instances are in the default model root
        ${formatted_name.body} inst = ${formatted_name.body}.${gia.body}(Ooaofooa.getDefaultInstance());
    .elif ( node.Key_Lett == "S_DT" )
       .// the instances are loaded in a different order, so search for specific data type
        ${formatted_name.body} inst = ${formatted_name.body}.${gia.body}(Ooaofooa.getDefaultInstance(), new ClassQueryInterface_c() {
            public boolean evaluate(Object candidate) {
                ${formatted_name.body} selected = (${formatted_name.body}) candidate;
                return selected.getName().equals("void");
            }
        });
	.elif(node.Key_Lett == "O_OBJ")
	ModelClass_c inst = ModelClass_c.ModelClassInstance(modelRoot);
	.elif(node.Key_Lett == "SM_STATE")
		StateMachineState_c inst = StateMachineState_c
				..StateMachineStateInstance(modelRoot, new ClassQueryInterface_c() {

					@Override
					public boolean evaluate(Object candidate) {
								ModelClass_c clazz = ModelClass_c
										..getOneO_OBJOnR518(InstanceStateMachine_c
												..getOneSM_ISMOnR517(StateMachine_c
														..getOneSM_SMOnR501((StateMachineState_c) candidate)));
								if(clazz != null && clazz.getName().equals("C class"))
									return true;
								return false;
					}
				});
    .elif((node.Key_Lett == "S_UDT") or (node.Key_Lett == "S_CDT"))
        ${formatted_name.body} inst = ${formatted_name.body}.${gia.body}(Ooaofooa.getDefaultInstance());
    .else
        ${formatted_name.body} inst = ${formatted_name.body}.${gia.body}(modelRoot);
    .end if
        $r{node.CategoryName}${meta_model_obj.Key_Lett}PropertySource ps = new $r{node.categoryName}${meta_model_obj.Key_Lett}PropertySource(inst);
        IPropertyDescriptor [] pd_set = ps.getPropertyDescriptors();
        for ( int i = 0; i < ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}.length; ++i )
        {
            assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][0], pd_set[i].getClass().getName() );
            assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1], pd_set[i].getId() );
            assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][2], pd_set[i].getDisplayName() );
    .select any descrip_attr related by meta_model_obj->O_ATTR[R102] where (selected.name == "Descrip")
    .select any act_attr related by meta_model_obj->O_ATTR[R102] where (selected.name == "Action_Semantics")
    .if ( (not_empty descrip_attr) and (not_empty act_attr) )
            if ( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1].equals("Descrip"))
            {
                assertEquals( inst.getDescrip().replace('\n','/'), ps.getPropertyValue(pd_set[i].getId()));
            }
            else if ( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1].equals("Action_Semantics"))
            {
                assertEquals( inst.getAction_semantics().replace('\n','/'), ps.getPropertyValue(pd_set[i].getId()));
            }
            else
            {
                assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][3], ps.getPropertyValue(pd_set[i].getId()).toString());
            }
    .elif ( not_empty descrip_attr )
            if ( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1].equals("Descrip"))
            {
                assertEquals( inst.getDescrip().replace('\n','/'), ps.getPropertyValue(pd_set[i].getId()));
            }
            else
            {
                assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][3], ps.getPropertyValue(pd_set[i].getId()).toString());
            }
    .elif ( not_empty act_attr )
            if ( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][1].equals("Action_Semantics"))
            {
                assertEquals( inst.getAction_semantics().replace('\n','/'), ps.getPropertyValue(pd_set[i].getId()));
            }
            else
            {
                assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][3], ps.getPropertyValue(pd_set[i].getId()).toString());
            }
     .else
            assertEquals( ${class_name}Data.$r{meta_model_obj.Name}_$r{node.CategoryName}[i][3], ps.getPropertyValue(pd_set[i].getId()).toString());
     .end if
        }
    }
  .end if .// ( node.Key_Lett != "S_EEDI" )
.end for
}
.emit to file "src/${path}/${class_name}.java"
.//
.// Now generate the archetype that will generate the test data!
.//
//======================================================================
//
// File: ${path}/${class_name}Data.java
//
// WARNING:      Do not edit this generated file
// Generated by: $${info.arch_file_name}
// Version:      $$$$Revision: 1.47 $$$$
//
// (c) Copyright 2004-2014 by Mentor Graphics Corp.  All rights reserved.
//
//======================================================================
///
// This class is responsible for determing the dependency between
// classes for displaying property changes.
//
package org.xtuml.bp.ui.properties.test;

import org.eclipse.ui.views.properties.PropertyDescriptor;
import org.eclipse.ui.views.properties.TextPropertyDescriptor;

import org.xtuml.bp.ui.properties.ActivityPropertyDescriptor;
import org.xtuml.bp.ui.properties.BooleanPropertyDescriptor;
import org.xtuml.bp.ui.properties.DescriptionPropertyDescriptor;
import org.xtuml.bp.ui.properties.DimensionsPropertyDescriptor;
import org.xtuml.bp.ui.properties.ChooserPropertyDescriptor;
import org.xtuml.bp.ui.properties.EnumPropertyDescriptor;
import org.xtuml.bp.ui.properties.IntegerPropertyDescriptor;
import org.xtuml.bp.ui.properties.ConstantValuePropertyDescriptor;

public class ${class_name}Data
{
.for each node in node_set
  .select any meta_model_obj from instances of O_OBJ where (selected.Key_Lett == node.Key_Lett)
  .assign mm_obj_var = "${meta_model_obj.Key_Lett}class"
  .invoke generateTestCase = generateTestCase(node.Key_Lett);
  .if(generateTestCase.result)
	public static final String[][] $r{meta_model_obj.Name}_$r{node.CategoryName} =
      {
    .select many attr_set related by meta_model_obj->O_ATTR[R102]
  .if(node.Key_Lett == "S_DT")
  ..select any ${mm_obj_var} from instances of ${meta_model_obj.Key_Lett} where (selected.Name == "void")
  .elif(node.Key_Lett == "S_UDT")
  ..select any dt from instances of S_DT where (selected.Name == "date")
  ..select one ${mm_obj_var} related by dt->S_UDT[R17];
  .elif(node.Key_Lett == "SM_STATE")
  ..select any cclass from instances of O_OBJ where (selected.Name == "C class")
  ..select any ${mm_obj_var} related by cclass->SM_ISM[R518]->SM_SM[R517]->SM_STATE[R501]
  .else
  ..select any ${mm_obj_var} from instances of ${meta_model_obj.Key_Lett}
  .end if
  .// if the test being generated is for datatype packages
  .// there will be two instances, one for the system level dts and one
  .// for the domain level dts
  .// here we need to use the second as it is the instance that the
  .// test is expecting
  .if(node.Key_Lett == "S_DPK")
  ..select many ${mm_obj_var}s from instances of ${meta_model_obj.Key_Lett}
  ..for each mobj in ${mm_obj_var}s
    ..if(last ${mm_obj_var}s)
      ..assign ${mm_obj_var} = mobj
    ..end if
  ..end for
  .end if
  ..print "Generating class ${meta_model_obj.Name} for $r{node.CategoryName}"
    .for each attr in attr_set
      .if(("$l{attr.Descrip:In Properties}" == "true") or ("$l{attr.Descrip:In Properties}" == ""))
        .select one dt related by attr->S_DT[R114]
        .select one edt related by dt->S_EDT[R17]
        .select one rattr related by attr->O_RATTR[R106]
        .if (((dt.Name != "unique_id") and (empty rattr)) and ("$l{attr.Descrip:User_Visible}" != "false"))
			{
          .assign readonly = "$l{attr.Descrip:readonly}"
          .select one dbattr related by attr->O_BATTR[R106]->O_DBATTR[R107]
          .if ( ((not_empty dbattr) or (readonly == "true")) and (attr.Name != "Action_Semantics") )
            .if ( ("${attr.Descrip:enum0}" == "") and (empty edt) )
                PropertyDescriptor.class.getName(),
            .else
                EnumPropertyDescriptor.class.getName(),
            .end if
          .else
            .if (dt.Name == "boolean" )
               BooleanPropertyDescriptor.class.getName(),
            .elif ((dt.Name == "integer") or (not_empty edt))
              .if ( ("${attr.Descrip:enum0}" == "") and (empty edt) )
               IntegerPropertyDescriptor.class.getName(),
              .else
                EnumPropertyDescriptor.class.getName(),
              .end if
            .elif (dt.Name == "string" )
              .if (attr.Name == "Descrip" )
               DescriptionPropertyDescriptor.class.getName(),
              .elif ( attr.Name == "Action_Semantics" )
               ActivityPropertyDescriptor.class.getName(),
              .elif (( attr.Name == "Dimensions" ) or ( attr.Name == "Return_Dimensions"))
               DimensionsPropertyDescriptor.class.getName(),
              .elif (( attr.Name == "Value" ) and ( node.Key_Lett == "CNST_LSC"))
               ConstantValuePropertyDescriptor.class.getName(),
              .else
               .//
               .// The default datatype package "Datatypes" has a read-only
               .// name attribute.
               .// This corresponds to the 'canRename' special case in
               .// BuildPropertySource.arc
                 .if ( (meta_model_obj.Key_Lett == "S_DPK") and (attr.Name == "Name") )
               PropertyDescriptor.class.getName(),
                 .else
               TextPropertyDescriptor.class.getName(),
              .end if
            .end if
          .end if
        .end if
				"${attr.Name}",
				"${attr.Descrip:Full Name}",
        .if (attr.Name == "Descrip" )
				"" },
        .elif ( attr.Name == "Action_Semantics" )
				"" },
        .else
          .if ( dt.Name == "boolean" )
            .if((meta_model_obj.Key_Lett == "S_EE") and (attr.Name == "isRealized"))
				"true" },
            .else
				"$$l{${mm_obj_var}.${attr.Name}}" },
		    .end if
		  .elif ( ("${attr.Descrip:enum0}" != "") or (not_empty edt) )
            .if ( attr.Name == "Is_Lbl_U" )
				EnumRangeTest.${meta_model_obj.Key_Lett}_${attr.name}_vals[$${${mm_obj_var}.${attr.Name}}] },
		    .else
				EnumRangeTest.${attr.name}_vals[$${${mm_obj_var}.${attr.Name}}] },
            .end if
          .else
              .if(node.Key_Lett == "SM_NLEVT")
                .if(attr.Name == "Name")
        ..select one smpevt related by ${mm_obj_var}->SM_PEVT[R527]
        ..select any smevt from instances of SM_EVT where ((selected.SMevt_ID == smpevt.SMevt_ID) and (selected.SM_ID == smpevt.SM_ID) and (selected.SMspd_ID == smpevt.SMspd_ID))
        ..select one polyClass related by smevt->SM_SM[R502]->SM_ISM[R517]->O_OBJ[R518]
        ..select any smsevt from instances of SM_SEVT where ((selected.SMevt_ID == ${mm_obj_var}.SMevt_ID) and (selected.SM_ID == ${mm_obj_var}.SM_ID) and (selected.SMspd_ID == ${mm_obj_var}.SMspd_ID))
        ..select any evt from instances of SM_EVT where ((selected.SMevt_ID == smsevt.SMevt_ID) and (selected.SM_ID == smsevt.SM_ID) and (selected.SMspd_ID == smsevt.SMspd_ID))
				"$${evt.Mning}::$${polyClass.Name}" },
                .end if
              .else
				"$${${mm_obj_var}.${attr.Name}}" },
				      .end if
            .end if
          .end if
        .end if
      .end if
    .end for
    .//
    .//  Now do the referential attributes
    .//
    .select many child_specs related by node->T_TPS[R1000] where (selected.ExcludedFromProperties == false)
    .for each child in child_specs
      .select one child_node related by child->T_TNS[R1001]
      .select any child_class from instances of O_OBJ where (selected.Key_Lett == child_node.Key_Lett)
      .assign child_var_name = "${child_class.Key_Lett}class"
  ..select many ${child_var_name}_set related by ${mm_obj_var}${child.ParentChildRelChain}
  ..assign count = 0
.//
  	  .if ((((node.Key_Lett == "S_CDT") or ( node.Key_Lett == "S_UDT")) or (node.Key_Lett == "S_SDT")) and ((child_node.Key_Lett == "S_DT") and (child.NameOnly == "")) )
    //Skipping special case for core data types and user data types.
      .elif ( (node.Key_Lett == "CNST_CSP") and (child_node.Key_Lett == "CNST_LSC") )
    //Skipping special case for constants
  	  .elif (node.Key_Lett == "S_SYS")
    //Skipping special case for System Model
  	 .else
.//
  ..for each ${child_var_name} in ${child_var_name}_set
     	.if ( (child_node.Key_Lett == "S_DT") and (node.Key_Lett != "S_EDT"))
            { ChooserPropertyDescriptor.class.getName(),
            "$r{child_node.CategoryName}",
      .else
            { PropertyDescriptor.class.getName(),
            "$r{child_node.CategoryName}$r{child.NameOnly}.$${count}",
      .end if
      .if ( child.NameOnly != "" )
            "${child.NameOnly}",
      .else
            "${child_class.name}",
      .end if
      .invoke grv = get_ref_value( child_node, child_var_name )
${grv.body}\
    ..assign count = count + 1
  ..end for
  	  .end if
    .end for
      };
  .end if   .// not S_EEDI
.end for
}
..emit to file "src/${path}/${class_name}Data.java"
.emit to file "arc/create_view_test_data.arc"