diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 60a5bcddd..61357f821 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1343,6 +1343,27 @@ accurate information is missing from a given `tree-il' element."
                               min-count max-count))))
           (else (error "computer bought the farm" state))))))
 
+;; Return the literal format pattern for X, or #f.
+(define (const-fmt x)
+  (record-case x
+    ((<const> exp)
+     ;; String literals.
+     (and (string? exp) exp))
+    ((<application> proc args)
+     ;; Gettexted string literals, like `(_ "foo")'.
+     (and (record-case proc
+            ((<toplevel-ref> name) (eq? name '_))
+            ((<module-ref> name) (eq? name '_))
+            (else #f))
+          (pmatch args
+            ((,fmt)
+             (record-case fmt
+               ((<const> exp)
+                (and (string? exp) exp))
+               (else #f)))
+            (else #f))))
+    (else #f)))
+
 (define format-analysis
   ;; Report arity mismatches in the given tree.
   (make-tree-analysis
@@ -1355,11 +1376,11 @@ accurate information is missing from a given `tree-il' element."
      (define (check-format-args args loc)
        (pmatch args
          ((,port ,fmt . ,rest)
-          (guard (const? fmt))
+          (guard (const-fmt fmt))
           (if (and (const? port)
                    (not (boolean? (const-exp port))))
               (warning 'format loc 'wrong-port (const-exp port)))
-          (let ((fmt   (const-exp fmt))
+          (let ((fmt   (const-fmt fmt))
                 (count (length rest)))
             (if (string? fmt)
                 (catch &syntax-error
@@ -1375,6 +1396,9 @@ accurate information is missing from a given `tree-il' element."
                     (warning 'format loc 'syntax-error key fmt)))
                 (warning 'format loc 'wrong-format-string fmt))))
          ((,port ,fmt . ,rest)
+          (if (and (const? port)
+                   (not (boolean? (const-exp port))))
+              (warn 'format loc 'wrong-port (const-exp port)))
           ;; Warn on non-literal format strings, unless they refer to a
           ;; lexical variable named "fmt".
           (if (record-case fmt