Changeset 39777 in project


Ignore:
Timestamp:
04/02/21 15:25:48 (3 weeks ago)
Author:
juergen
Message:

simple-contracts 1.0.2 with bugfix in tests

Location:
release/5/simple-contracts
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/simple-contracts/tags/1.0.2/simple-contracts.egg

    r38305 r39777  
    55 (test-dependencies checks simple-tests)
    66 (author "Juergen Lorenz")
    7  (version "1.0.1")
     7 (version "1.0.2")
    88 (components (extension simple-contracts (csc-options "-d0" "-O3"))))
  • release/5/simple-contracts/tags/1.0.2/tests/run.scm

    r37484 r39777  
    44        simple-tests
    55        simple-contracts)
    6 
    76(contract-check-level 1)
    8 
    9 (define-values (counter! counter)
    10   (let ((state 0))
    11     (values
    12       (xlambda ((new (cut = <> (add1 old)))
    13                 ;integer? (lambda (x) (= x (add1 old))))
    14                 (old integer?)
    15                 <-)
    16         (let ((old state))
    17           (set! state (add1 state))
    18           (values state old)))
    19       (xlambda ((result (cut = <> state))
    20                 <-)
    21         state))))
    22 
    23 (define-values (push pop top)
    24   (let ((stk '()))
    25     (let (
    26           (push
    27             (xlambda ((new list? (cut equal? <> (cons arg old)))
    28                       (old list?)
    29                       <-
    30                       (arg))
    31               (let ((old stk))
    32                 (set! stk (cons arg stk))
    33                 (values stk old))))
    34           (pop
    35             (xlambda ((new list? (cut equal? <> (cdr old)))
    36                       (old list?)
    37                       <-)
    38               (let ((old (<<< 'pop stk (o not null?))))
    39                 (set! stk (cdr stk))
    40                 (values stk old))))
    41           (top
    42             (xlambda ((result) <-)
    43               (car (<<< 'top stk (o not null?)))))
    44           )
    45       (values push pop top)
    46       )))
    47 
    48 (define-values (add add-pre add-post)
    49   (xlambda ((result integer? odd? (cut = <> (apply + x y ys)))
    50             <-
    51             (x integer? odd?) (y integer? even?) ys integer? even?)
    52     (apply + x y ys)))
    53 
    54 (define wrong-add
    55   (xlambda ((result integer? even?)
    56             <-
    57             (x integer? odd?) xs integer?  even?)
    58     (apply + x xs)))
    59 
    60 (define-values (divide divide-pre divide-post)
    61   (xlambda ((q integer?)
    62             (r (lambda (x) (= (+ x (* n q)) m)))
    63             <-
    64             (m integer? (cut >= <> 0))
    65             (n integer? positive?))
    66     (let loop ((q 0) (r m))
    67       (if (< r n)
    68         (values q r)
    69         (loop (+ q 1) (- r n))))))
    707
    718(xdefine ((result integer?)
     
    8017
    8118(define-test (contracts?)
     19  "SOME DEFINITIONS"
     20  (set!-values (counter! counter)
     21    (let ((state 0))
     22      (values
     23        (xlambda ((new (cut = <> (add1 old)))
     24                  ;integer? (lambda (x) (= x (add1 old))))
     25                  (old integer?)
     26                  <-)
     27          (let ((old state))
     28            (set! state (add1 state))
     29            (values state old)))
     30        (xlambda ((result (cut = <> state))
     31                  <-)
     32          state))))
     33
     34  (set!-values (push pop top)
     35    (let ((stk '()))
     36      (let (
     37            (push
     38              (xlambda ((new list? (cut equal? <> (cons arg old)))
     39                        (old list?)
     40                        <-
     41                        (arg))
     42                (let ((old stk))
     43                  (set! stk (cons arg stk))
     44                  (values stk old))))
     45            (pop
     46              (xlambda ((new list? (cut equal? <> (cdr old)))
     47                        (old list?)
     48                        <-)
     49                (let ((old (<<< 'pop stk (o not null?))))
     50                  (set! stk (cdr stk))
     51                  (values stk old))))
     52            (top
     53              (xlambda ((result) <-)
     54                (car (<<< 'top stk (o not null?)))))
     55            )
     56        (values push pop top)
     57        )))
     58
     59  (set!-values (add add-pre add-post)
     60    (xlambda ((result integer? odd? (cut = <> (apply + x y ys)))
     61              <-
     62              (x integer? odd?) (y integer? even?) ys integer? even?)
     63      (apply + x y ys)))
     64
     65  (set! wrong-add
     66    (xlambda ((result integer? even?)
     67              <-
     68              (x integer? odd?) xs integer?  even?)
     69      (apply + x xs)))
     70
     71  (set!-values (divide divide-pre divide-post)
     72    (xlambda ((q integer?)
     73              (r (lambda (x) (= (+ x (* n q)) m)))
     74              <-
     75              (m integer? (cut >= <> 0))
     76              (n integer? positive?))
     77      (let loop ((q 0) (r m))
     78        (if (< r n)
     79          (values q r)
     80          (loop (+ q 1) (- r n))))))
    8281
    8382  "QUERIES"
     
    9493  (equal? add-post
    9594          '(result integer? odd? (cut = <> (apply + x y ys))))
    96   (not (condition-case (add 1 2 3) ((exn) #f)))
    97   ;(not (condition-case (add 1 2 3) ((exn argument) #f)))
     95  (not (condition-case (add 1 2 3) ((exn argument) #f)))
    9896
    9997  '(define wrong-add
     
    102100               (x integer? odd?) xs integer?  even?)
    103101       (apply + x xs)))
    104   (not (condition-case (wrong-add 1 2 4) ((exn) #f)))
    105   ;(not (condition-case (wrong-add 1 2 4) ((exn result) #f)))
     102  (not (condition-case (wrong-add 1 2 4) ((exn result) #f)))
    106103
    107104  '(define-values (divide divide-pre divide-post)
     
    188185  ;(print sum-pre)
    189186  (= (sum 1 2 3) 6)
    190   (not (condition-case (sum 1 2 #f) ((exn) #f)))
    191   ;(not (condition-case (sum 1 2 #f) ((exn argument) #f)))
     187  (not (condition-case (sum 1 2 #f) ((exn argument) #f)))
    192188  '(xdefine ((result list?)
    193189             wrong-sum
    194190             (a integer?) as integer?)
    195191    (apply + a as))
    196   (not (condition-case (wrong-sum 1 2 3) ((exn) #f)))
    197   ;(not (condition-case (wrong-sum 1 2 3) ((exn result) #f)))
     192  (not (condition-case (wrong-sum 1 2 3) ((exn result) #f)))
    198193  )
    199194 
  • release/5/simple-contracts/trunk/simple-contracts.egg

    r38305 r39777  
    55 (test-dependencies checks simple-tests)
    66 (author "Juergen Lorenz")
    7  (version "1.0.1")
     7 (version "1.0.2")
    88 (components (extension simple-contracts (csc-options "-d0" "-O3"))))
  • release/5/simple-contracts/trunk/tests/run.scm

    r37484 r39777  
    44        simple-tests
    55        simple-contracts)
    6 
    76(contract-check-level 1)
    8 
    9 (define-values (counter! counter)
    10   (let ((state 0))
    11     (values
    12       (xlambda ((new (cut = <> (add1 old)))
    13                 ;integer? (lambda (x) (= x (add1 old))))
    14                 (old integer?)
    15                 <-)
    16         (let ((old state))
    17           (set! state (add1 state))
    18           (values state old)))
    19       (xlambda ((result (cut = <> state))
    20                 <-)
    21         state))))
    22 
    23 (define-values (push pop top)
    24   (let ((stk '()))
    25     (let (
    26           (push
    27             (xlambda ((new list? (cut equal? <> (cons arg old)))
    28                       (old list?)
    29                       <-
    30                       (arg))
    31               (let ((old stk))
    32                 (set! stk (cons arg stk))
    33                 (values stk old))))
    34           (pop
    35             (xlambda ((new list? (cut equal? <> (cdr old)))
    36                       (old list?)
    37                       <-)
    38               (let ((old (<<< 'pop stk (o not null?))))
    39                 (set! stk (cdr stk))
    40                 (values stk old))))
    41           (top
    42             (xlambda ((result) <-)
    43               (car (<<< 'top stk (o not null?)))))
    44           )
    45       (values push pop top)
    46       )))
    47 
    48 (define-values (add add-pre add-post)
    49   (xlambda ((result integer? odd? (cut = <> (apply + x y ys)))
    50             <-
    51             (x integer? odd?) (y integer? even?) ys integer? even?)
    52     (apply + x y ys)))
    53 
    54 (define wrong-add
    55   (xlambda ((result integer? even?)
    56             <-
    57             (x integer? odd?) xs integer?  even?)
    58     (apply + x xs)))
    59 
    60 (define-values (divide divide-pre divide-post)
    61   (xlambda ((q integer?)
    62             (r (lambda (x) (= (+ x (* n q)) m)))
    63             <-
    64             (m integer? (cut >= <> 0))
    65             (n integer? positive?))
    66     (let loop ((q 0) (r m))
    67       (if (< r n)
    68         (values q r)
    69         (loop (+ q 1) (- r n))))))
    707
    718(xdefine ((result integer?)
     
    8017
    8118(define-test (contracts?)
     19  "SOME DEFINITIONS"
     20  (set!-values (counter! counter)
     21    (let ((state 0))
     22      (values
     23        (xlambda ((new (cut = <> (add1 old)))
     24                  ;integer? (lambda (x) (= x (add1 old))))
     25                  (old integer?)
     26                  <-)
     27          (let ((old state))
     28            (set! state (add1 state))
     29            (values state old)))
     30        (xlambda ((result (cut = <> state))
     31                  <-)
     32          state))))
     33
     34  (set!-values (push pop top)
     35    (let ((stk '()))
     36      (let (
     37            (push
     38              (xlambda ((new list? (cut equal? <> (cons arg old)))
     39                        (old list?)
     40                        <-
     41                        (arg))
     42                (let ((old stk))
     43                  (set! stk (cons arg stk))
     44                  (values stk old))))
     45            (pop
     46              (xlambda ((new list? (cut equal? <> (cdr old)))
     47                        (old list?)
     48                        <-)
     49                (let ((old (<<< 'pop stk (o not null?))))
     50                  (set! stk (cdr stk))
     51                  (values stk old))))
     52            (top
     53              (xlambda ((result) <-)
     54                (car (<<< 'top stk (o not null?)))))
     55            )
     56        (values push pop top)
     57        )))
     58
     59  (set!-values (add add-pre add-post)
     60    (xlambda ((result integer? odd? (cut = <> (apply + x y ys)))
     61              <-
     62              (x integer? odd?) (y integer? even?) ys integer? even?)
     63      (apply + x y ys)))
     64
     65  (set! wrong-add
     66    (xlambda ((result integer? even?)
     67              <-
     68              (x integer? odd?) xs integer?  even?)
     69      (apply + x xs)))
     70
     71  (set!-values (divide divide-pre divide-post)
     72    (xlambda ((q integer?)
     73              (r (lambda (x) (= (+ x (* n q)) m)))
     74              <-
     75              (m integer? (cut >= <> 0))
     76              (n integer? positive?))
     77      (let loop ((q 0) (r m))
     78        (if (< r n)
     79          (values q r)
     80          (loop (+ q 1) (- r n))))))
    8281
    8382  "QUERIES"
     
    9493  (equal? add-post
    9594          '(result integer? odd? (cut = <> (apply + x y ys))))
    96   (not (condition-case (add 1 2 3) ((exn) #f)))
    97   ;(not (condition-case (add 1 2 3) ((exn argument) #f)))
     95  (not (condition-case (add 1 2 3) ((exn argument) #f)))
    9896
    9997  '(define wrong-add
     
    102100               (x integer? odd?) xs integer?  even?)
    103101       (apply + x xs)))
    104   (not (condition-case (wrong-add 1 2 4) ((exn) #f)))
    105   ;(not (condition-case (wrong-add 1 2 4) ((exn result) #f)))
     102  (not (condition-case (wrong-add 1 2 4) ((exn result) #f)))
    106103
    107104  '(define-values (divide divide-pre divide-post)
     
    188185  ;(print sum-pre)
    189186  (= (sum 1 2 3) 6)
    190   (not (condition-case (sum 1 2 #f) ((exn) #f)))
    191   ;(not (condition-case (sum 1 2 #f) ((exn argument) #f)))
     187  (not (condition-case (sum 1 2 #f) ((exn argument) #f)))
    192188  '(xdefine ((result list?)
    193189             wrong-sum
    194190             (a integer?) as integer?)
    195191    (apply + a as))
    196   (not (condition-case (wrong-sum 1 2 3) ((exn) #f)))
    197   ;(not (condition-case (wrong-sum 1 2 3) ((exn result) #f)))
     192  (not (condition-case (wrong-sum 1 2 3) ((exn result) #f)))
    198193  )
    199194 
Note: See TracChangeset for help on using the changeset viewer.