From 6bee48909148f9c4675de0adc63640eaf6076a31 Mon Sep 17 00:00:00 2001
From: Mike Sperber <sperber@deinprogramm.de>
Date: Tue, 14 Dec 2010 17:29:30 +0100
Subject: [PATCH] Add menu item to disable signature checking.

---
 collects/deinprogramm/deinprogramm-langs.rkt         |  1 +
 collects/deinprogramm/signature/info.rkt             | 12 ++++++++++++
 collects/deinprogramm/signature/signature.rkt        |  9 +++++++--
 collects/lang/htdp-langs.rkt                         |  1 +
 .../string-constants/english-string-constants.rkt    |  3 +++
 .../string-constants/german-string-constants.rkt     |  3 +++
 6 files changed, 27 insertions(+), 2 deletions(-)
 create mode 100644 collects/deinprogramm/signature/info.rkt

diff --git a/collects/deinprogramm/deinprogramm-langs.rkt b/collects/deinprogramm/deinprogramm-langs.rkt
index b764bbe436..a8f6de65ea 100644
--- a/collects/deinprogramm/deinprogramm-langs.rkt
+++ b/collects/deinprogramm/deinprogramm-langs.rkt
@@ -202,6 +202,7 @@
 				 obj signature message blame))))))
                  (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%))
                  (test-execute (get-preference 'tests:enable? (lambda () #t)))
+		 (signature-checking-enabled? (get-preference 'signatures:enable-checking? (lambda () #t)))
                  (test-format (make-formatter (lambda (v o)
 						(render-value/format (if (procedure? v)
 									 generic-proc
diff --git a/collects/deinprogramm/signature/info.rkt b/collects/deinprogramm/signature/info.rkt
new file mode 100644
index 0000000000..45d132ec17
--- /dev/null
+++ b/collects/deinprogramm/signature/info.rkt
@@ -0,0 +1,12 @@
+#lang setup/infotab
+
+(define name "DeinProgramm - Signatures")
+
+(define drracket-tools '("tool.rkt"))
+(define drracket-tool-names '("Signatures"))
+#lang setup/infotab
+
+(define name "DeinProgramm - Signatures")
+
+(define drracket-tools '("tool.rkt"))
+(define drracket-tool-names '("Signatures"))
diff --git a/collects/deinprogramm/signature/signature.rkt b/collects/deinprogramm/signature/signature.rkt
index 6d26eba234..0f37ad17f3 100644
--- a/collects/deinprogramm/signature/signature.rkt
+++ b/collects/deinprogramm/signature/signature.rkt
@@ -14,7 +14,8 @@
 	 make-procedure-to-blame
 	 procedure-to-blame?
 	 procedure-to-blame-proc procedure-to-blame-syntax
-	 make-type-variable-info type-variable-info?)
+	 make-type-variable-info type-variable-info?
+	 signature-checking-enabled?)
 
 (require scheme/promise
 	 mzlib/struct
@@ -143,8 +144,12 @@
 	   'stepper-skipto/discard
 	   '(syntax-e cdr syntax-e cdr cdr car))))))))
 
+(define signature-checking-enabled? (make-parameter #t))
+
 (define (apply-signature signature val)
-  ((signature-enforcer signature) signature val))
+  (if (signature-checking-enabled?)
+      ((signature-enforcer signature) signature val)
+      val))
 
 (define-struct type-variable-info ())
 
diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt
index ad9a47317e..0ac6818765 100644
--- a/collects/lang/htdp-langs.rkt
+++ b/collects/lang/htdp-langs.rkt
@@ -168,6 +168,7 @@
 				 obj signature message blame))))))
                  (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%))
                  (test-execute (get-preference 'tests:enable? (lambda () #t)))
+		 (signature-checking-enabled? (get-preference 'signatures:enable-checking? (lambda () #t)))
                  (test-format (make-formatter (lambda (v o) (render-value/format v settings o 40)))))))
             (super on-execute settings run-in-user-thread))
           
diff --git a/collects/string-constants/english-string-constants.rkt b/collects/string-constants/english-string-constants.rkt
index 3e6303858f..ed11703cff 100644
--- a/collects/string-constants/english-string-constants.rkt
+++ b/collects/string-constants/english-string-constants.rkt
@@ -1455,6 +1455,9 @@ please adhere to these guidelines:
   (test-engine-property-fail-error "Property falsifiable with")
   (test-engine-property-error-error "check-property encountered the following error~n:: ~a")
 
+  (signature-enable-checks "Enable Signature Checks")
+  (signature-disable-checks "Disable Signature Checks")
+
   ; section header
   (test-engine-check-failures "Check failures:")
   ; section header
diff --git a/collects/string-constants/german-string-constants.rkt b/collects/string-constants/german-string-constants.rkt
index abc08cd66d..dab3600c79 100644
--- a/collects/string-constants/german-string-constants.rkt
+++ b/collects/string-constants/german-string-constants.rkt
@@ -1353,6 +1353,9 @@
   (test-engine-property-fail-error "Eigenschaft falsifizierbar mit")
   (test-engine-property-error-error "`check-property' bekam den folgenden Fehler~n:: ~a")
 
+  (signature-enable-checks "Signaturüberprüfung aktivieren")
+  (signature-disable-checks "Signaturüberprüfung deaktivieren")
+
   ; section header
   (test-engine-check-failures "Check-Fehler:")
   ; section header