Corrected bugs:

abstract class implementing interface does not have to fully implement it
  super.METHOD(...) now fails when super method is abstract

svn: r2291

collects/profj/build-info.ss

@@ -569,6 +569,15 @@
                                           level
                                           type-recs)
                    
+                   (when (and (memq 'abstract test-mods)
+                              (or (not (null? iface-records))
+                                  (not (null? (header-implements info)))))
+                     (let ((unimp-stubs (make-unimplmented-stubs iface-records (header-implements info)
+                                                                 m type-recs)))
+                       (set-def-members! class
+                                         (append unimp-stubs (def-members class)))
+                       (set! m (append m (map method-rec unimp-stubs)))))
+                   
                    (let ((record
                           (make-class-record 
                            cname
@@ -1035,7 +1044,7 @@
                                  #f))))
         (check-for-conflicts (cdr methods) record members level type-recs)))
   
-  ;class-fully-implemented? class-record id (list class-record) (list id) (list method) symbol -> bool
+  ;class-fully-implemented? class-record id (list class-record) (list id) (list method) type-records symbol -> bool
   (define (class-fully-implemented? super super-name ifaces ifaces-name methods type-recs level)
     (when (memq 'abstract (class-record-modifiers super))
       (let ((unimplemented-iface-methods (get-unimplemented-methods (class-record-methods super)
@@ -1052,6 +1061,59 @@
             ifaces
             ifaces-name))
   
+  ;make-unimplmented-stubs: (list class-record) (list name) (list method-record) type-records -> (list method)
+  (define (make-unimplmented-stubs ifaces ifaces-name methods type-recs)
+    (letrec ((type->type-spec
+              (lambda (t)
+                (cond
+                  ((symbol? t) (make-type-spec t 0 #f))
+                  ((ref-type? t) (make-type-spec (make-name (make-id (ref-type-class/iface t) #f)
+                                                            (map (lambda (t) (make-id t #f))
+                                                                 (ref-type-path t)) #f)
+                                                 0 #f))
+                  ((array-type? t) (make-type-spec (type-spec-name (type->type-spec (array-type-type t)))
+                                                   (array-type-dim t))))))
+             (copy-method-record
+              (lambda (m)
+                (make-method-record (method-record-name m)
+                                    (cons 'abstract (method-record-modifiers m))
+                                    (method-record-rtype m)
+                                    (method-record-atypes m)
+                                    (method-record-throws m)
+                                    #f
+                                    (method-record-class m))))
+             (remove-dups
+              (lambda (l)
+                (cond
+                  ((null? l) l)
+                  ((member (car l) (cdr l)) (remove-dups (cdr l)))
+                  (else (cons (car l) (remove-dups (cdr l)))))))
+             (unimplemented-iface-methods 
+              (car (get-unimplemented-methods methods 
+                                              (remove-dups (append (map (lambda (iface)
+                                                                          (cond 
+                                                                            ((id? iface) (list (id-string iface)))
+                                                                            ((name? iface) (cons (id-string (name-id iface))
+                                                                                                 (map id-string (name-path iface))))))
+                                                                        ifaces-name)
+                                                                   (map class-record-name ifaces))) type-recs))))
+      (apply append
+             (map (lambda (m-lists)
+                    (map (lambda (m)
+                           (make-method (cons (make-modifier 'abstract #f) 
+                                              (map (lambda (a) (make-modifier a #f)) (method-record-modifiers m)))
+                                        (type->type-spec (method-record-rtype m))
+                                        null
+                                        (make-id (method-record-name m) #f)
+                                        (map (lambda (a)
+                                               (make-var-decl (make-id (gensym) #f) null
+                                                              (type->type-spec a) #f))
+                                             (method-record-atypes m))
+                                        null #f #f 
+                                        (copy-method-record m) #f))
+                         m-lists))
+                  unimplemented-iface-methods))))
+  
   ;get-unimplemented-methods: (list method-record) (list (list string)) type-recs -> (list (list (list method-record)) (list string(
   (define (get-unimplemented-methods methods ifaces type-recs)
     (letrec ((method-req-equal 

collects/profj/check.ss

@@ -2152,6 +2152,11 @@
            (when (and static? (not (memq 'static mods)) (not expr))
              (non-static-called-error name c-class src level))
            
+           (when (and (memq 'abstract mods)
+                      (special-name? expr)
+                      (equal? "super" (special-name-name expr)))
+             (call-abstract-error level name exp-type src))
+           
            (when (and (memq 'protected mods) (reference-type? exp-type) 
                       (or (not (is-eq-subclass? this exp-type type-recs))
                           (not (package-members? c-class (cons (ref-type-class/iface exp-type) (ref-type-path exp-type))
@@ -3038,6 +3043,16 @@
                                types)))))
       (substring out 0 (- (string-length out) 5))))                                                         
   
+  ;call-abstract-error: symbol id type src -> void
+  (define (call-abstract-error level name exp src)
+    (let ((n (id->ext-name name))
+          (t (get-call-type exp)))
+      (raise-error n
+                   (if (memq level '(beginner))
+                       (format "You maynot call method ~a from ~a" n t)
+                       (format "super.~a(...) may not be called as ~a is abstract in ~a." n n t))
+                   n src)))
+  
   ;call-access-error: symbol symbol id type src -> void
   (define (call-access-error kind level name exp src)
     (let ((n (id->ext-name name))

collects/tests/profj/intermediate-tests.ss

@@ -5,6 +5,22 @@
   
   ;;Execute tests without errors
   
+  (execute-test
+   "interface A { int a(); }
+    abstract class B implements A { }
+   "
+   'intermediate
+   #f "abstract class not fully implementing an interface")
+  
+  (execute-test
+   "interface A { int a(); }
+    abstract class B implements A { }
+    class C extends B {
+     int a() { return 3; }
+    }"
+   'intermediate
+   #f "class implementing abstract class's unimplmenented interface")
+
   (execute-test
    "abstract class Foo {
       abstract int f();
@@ -302,6 +318,22 @@
   
   ;;Execute tests with errors
   
+  (execute-test
+   "interface A { int a(); }
+    abstract class B implements A { }
+    class C extends B { int a() { return super.a() + 3; } }"
+   'intermediate
+   #t "Extending class calls super.a() of an abstract method")
+
+
+  (execute-test
+   "interface A { int a(); }
+    abstract class B implements A { }
+    class C extends B { }"
+   'intermediate
+   #t
+   "Extending class fails to implement abstract parent's unimplemented interfaces")
+  
   (execute-test
    "class Foo {
   Foo() {}