Add error checking to ensure blame-source produces a srcloc? as documented.

collects/racket/contract/private/base.rkt

@@ -49,7 +49,7 @@
     (check-source-location! 'contract loc)
     (let ([new-val
            (((contract-projection c)
-             (make-blame loc name (λ () (contract-name c)) pos neg #t))
+             (make-blame (build-source-location loc) name (λ () (contract-name c)) pos neg #t))
             v)])
       (if (and (not (parameter? new-val))  ;; when PR 11221 is fixed, remove this line
                (procedure? new-val)

collects/racket/contract/private/blame.rkt

@@ -45,17 +45,26 @@
 
 (define -make-blame
   (let ([make-blame
-         (λ (source value build-name positive negative original?)
+         (lambda (source value build-name positive negative original?)
+           (unless (srcloc? source)
+             (raise-type-error 'make-blame "source location (srcloc?)" 0
+               source value build-name positive negative original?))
+           (unless (procedure? build-name)
+             (raise-type-error 'make-blame "procedure" 2
+               source value build-name positive negative original?))
+           (unless (procedure-arity-includes? build-name 0)
+             (raise-type-error 'make-blame "procedure of 0 arguments" 2
+               source value build-name positive negative original?))
            (make-blame 
-            source
+             source
-            value
+             value
-            build-name
+             build-name
-            (list positive)
+             (list positive)
-            (list negative)
+             (list negative)
-            original?
+             original?
-            '()
+             '()
-            #t 
+             #t 
-            #f))])
+             #f))])
     make-blame))
 
 ;; s : (or/c string? #f)