;; -*-theme-d-*-

;; Copyright (C) 2016 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.

;; Expected results: error
;;   invalid attributes in generic procedure dispatch

(define-proper-program (tests test401)

  (import (standard-library core)
	  (standard-library list-utilities)
	  (standard-library object-string-conversion)
	  (standard-library console-io)
	  (standard-library text-file-io))

  (define-param-logical-type :hash-proc (%key)
    (:procedure (%key <integer>) <integer> pure))

  (define-param-logical-type :assoc-proc (%key %value)
    (:procedure (%key (:alist %key %value)) (:maybe (:pair %key %value))
		pure))

  (define-param-class :hash-table (%key %value) <object> #t #f #f public ()
    ((v (:maybe (:mutable-vector (:alist %key %value))) public module null)
     (proc-hash (:maybe (:hash-proc %key)) public module null)
     (proc-assoc (:maybe (:assoc-proc %key %value)) public module null)))

  (define-param-method initialize (%key %value)
		       (((ht (:hash-table %key %value))
			 (i-size <integer>)
			 (proc-hash (:hash-proc %key))
			 (proc-assoc (:assoc-proc %key %value)))
			<none>
			nonpure)
    (console-display-string "initialize (:hash-table ...)\n")
    (field-set! ht 'v (make-mutable-vector (:alist %key %value) i-size null))
    (field-set! ht 'proc-hash proc-hash)
    (field-set! ht 'proc-assoc proc-assoc))

  (define-param-class :logged-hash-table (%key %value)
    (:hash-table %key %value) #t #f #f public ()
    ((op-log (:maybe <output-port>) public module null)))

  (define my-hash
    (:hash-proc <symbol>)
    (unchecked-prim-proc hashv (<symbol> <integer>) <integer> pure))

  (define-simple-proc my-assoc (((s-key <symbol>)
				 (al (:alist <symbol> <string>)))
				(:maybe (:pair <symbol> <string>))
				pure)
    (assoc-objects s-key al null))

  (define-param-method initialize (%key %value)
		       (((ht (:logged-hash-table %key %value))
			 (i-size <integer>)
			 (proc-hash (:hash-proc %key))
			 (proc-assoc (:assoc-proc %key %value))
			 (op-log <output-port>))
			<none>
			nonpure)
    (console-display-string "initialize (:logged-hash-table ...)\n")
    ((generic-proc-dispatch-without-result
      initialize
      ((:hash-table %key %value)
       <integer>
       (:hash-proc %key)
       (:assoc-proc %key %value))
      (pure))
     ht i-size proc-hash proc-assoc)
    (field-set! ht 'op-log op-log))

  (define-simple-proc main (() <none> nonpure)
    (let ((ht
	   (let ((ht1 (make (:logged-hash-table <symbol> <string>))))
	     (initialize ht1 100 my-hash my-assoc
			 (current-output-port))
	     ht1)))
      (display-line (cast <output-port> (field-ref ht 'op-log))
		    (mutable-vector-ref
		     (cast (:mutable-vector (:alist <symbol> <string>))
			   (field-ref ht 'v))
		     1)))))
