Test suite improvements & other code cleanup

src/metabase/db/connection_pool.clj

@@ -5,7 +5,9 @@
   The aim here is to completely encapsulate the connection pool library we use -- that way we can swap it out if we
   want to at some point without having to touch any other files. (TODO - this is currently true of everything except
   for the options, which are c3p0-specific -- consider abstracting those as well?)"
-  (:require [metabase.util :as u])
+  (:require [metabase.util :as u]
+            [metabase.util.schema :as su]
+            [schema.core :as s])
   (:import com.mchange.v2.c3p0.DataSources
            [java.sql Driver DriverManager]
            [java.util Map Properties]
@@ -46,13 +48,19 @@
 (defn- spec->properties ^Properties [spec]
   (map->properties (dissoc spec :classname :subprotocol :subname)))
 
-(defn- unpooled-data-source ^DataSource [{:keys [subname subprotocol], :as spec}]
-  {:pre [(string? subname) (string? subprotocol)]}
+(def ^:private JDBCSpec
+  {:subname     su/NonBlankString
+   :subprotocol su/NonBlankString
+   s/Any        s/Any})
+
+(s/defn ^:private unpooled-data-source :- DataSource
+  [{:keys [subname subprotocol], :as spec} :- JDBCSpec]
   (proxy-data-source (format "jdbc:%s:%s" subprotocol subname) (spec->properties spec)))
 
 (defn- pooled-data-source ^DataSource
   ([spec]
    (DataSources/pooledDataSource (unpooled-data-source spec)))
+
   ([spec, ^Map pool-properties]
    (DataSources/pooledDataSource (unpooled-data-source spec), pool-properties)))
 

src/metabase/driver/sql_jdbc/connection.clj

@@ -79,7 +79,7 @@
   [_ database]
   (set-pool! (u/get-id database) nil))
 
-(def ^:private db->pooled-spec-lock (Object.))
+(def ^:private create-pool-lock (Object.))
 
 (defn db->pooled-connection-spec
   "Return a JDBC connection spec that includes a cp30 `ComboPooledDataSource`.
@@ -92,7 +92,7 @@
    ;; don't want to end up with a bunch of simultaneous threads creating pools only to have them destroyed the very
    ;; next instant. This will cause their queries to fail. Thus we should do the usual locking here and make sure only
    ;; one thread will be creating a pool at a given instant.
-   (locking db->pooled-spec-lock
+   (locking create-pool-lock
      (or
       ;; check if another thread created the pool while we were waiting to acquire the lock
       (get @database-id->connection-pool (u/get-id database-or-id))

src/metabase/email/messages.clj

@@ -23,9 +23,8 @@
             [toucan.db :as db])
   (:import [java.io File IOException]))
 
-(when-not *compile-files*
-  (when config/is-dev?
-    (alter-meta! #'stencil.core/render-file assoc :style/indent 1)))
+(when config/is-dev?
+  (alter-meta! #'stencil.core/render-file assoc :style/indent 1))
 
 ;; Dev only -- disable template caching
 (when config/is-dev?

src/metabase/metabot/command.clj

@@ -99,11 +99,11 @@
 
 ;;; ------------------------------------------------------ list ------------------------------------------------------
 
-(defn- formar-cards-list
+(defn- format-cards-list
   "Format a sequence of Cards as a nice multiline list for use in responses."
   [cards]
-  (apply str (interpose "\n" (for [{id :id, card-name :name} cards]
-                               (format "%d.  <%s|\"%s\">" id (urls/card-url id) card-name)))))
+  (str/join "\n" (for [{id :id, card-name :name} cards]
+                   (format "%d.  <%s|\"%s\">" id (urls/card-url id) card-name))))
 
 (defn- list-cards []
   (filter-metabot-readable
@@ -127,7 +127,7 @@
   (let [cards (list-cards)]
     (str (tru "Here''s your {0} most recent cards:" (count cards))
          "\n"
-          (formar-cards-list cards))))
+          (format-cards-list cards))))
 
 
 ;;; ------------------------------------------------------ show ------------------------------------------------------
@@ -135,7 +135,9 @@
 (defn- cards-with-name [card-name]
   (db/select [Card :id :name]
     :%lower.name [:like (str \% (str/lower-case card-name) \%)]
-    :archived false))
+    :archived false
+    {:order-by [[:%lower.name :asc]]
+     :limit    10}))
 
 (defn- card-with-name [card-name]
   (let [[first-card & more, :as cards] (cards-with-name card-name)]
@@ -145,7 +147,7 @@
         (str
          (tru "Could you be a little more specific, or use the ID? I found these cards with names that matched:")
          "\n"
-         (formar-cards-list cards)))))
+         (format-cards-list cards)))))
     first-card))
 
 (defn- id-or-name->card [card-id-or-name]

src/metabase/query_processor/middleware/check_features.clj

@@ -21,7 +21,9 @@
     :stddev
     :standard-deviation-aggregations
 
-    :joined-field
+    ;; `:fk->` is normally replaced by `:joined-field` already but the middleware that does the replacement won't run
+    ;; if the driver doesn't support foreign keys, meaning the clauses can leak thru
+    #{:joined-field :fk->}
     :foreign-keys))
 
 (defn- check-features* [{query-type :type, :as query}]

src/metabase/query_processor/middleware/resolve_joined_tables.clj

@@ -182,15 +182,18 @@
       resolved-source-query (assoc-in [:query :source-query] resolved-source-query))))
 
 (defn- resolve-joined-tables* [{query-type :type, :as query}]
+  ;; if this is a native query, or if `driver/*driver*` is bound *and* it DOES NOT support `:foreign-keys`, return
+  ;; query as is. Otherwise add implicit joins for `fk->` clauses
   (if (or (= query-type :native)
-          (and driver/*driver*
-               (not (driver/supports? driver/*driver* :foreign-keys))))
+          (some-> driver/*driver* ((complement driver/supports?) :foreign-keys)))
     query
     (resolve-joined-tables-in-query-all-levels query)))
 
 (defn resolve-joined-tables
   "Fetch and store any Tables other than the source Table referred to by `fk->` clauses in an MBQL query, and add a
-  `:join-tables` key inside the MBQL inner query dictionary containing information about the `JOIN`s (or equivalent)
-  that need to be performed for these tables."
+  `:join-tables` key inside the MBQL inner query containing information about the `JOIN`s (or equivalent) that need to
+  be performed for these tables.
+
+  This middleware also replaces all `fk->` clauses with `joined-field` clauses, which are easier to work with."
   [qp]
   (comp qp resolve-joined-tables*))

src/metabase/util.clj

@@ -280,46 +280,36 @@
     "Get the stack trace associated with E and return it as a vector with non-metabase frames after the last Metabase
     frame filtered out."))
 
-;; These next two functions are a workaround for this bug https://dev.clojure.org/jira/browse/CLJ-1790
-;; When Throwable/Thread are type-hinted, they return an array of type StackTraceElement, this causes
-;; a VerifyError. Adding a layer of indirection here avoids the problem. Once we upgrade to Clojure 1.9
-;; we should be able to remove this code.
-(defn- throwable-get-stack-trace [^Throwable t]
-  (.getStackTrace t))
+(extend-protocol IFilteredStacktrace
+  nil
+  (filtered-stacktrace [_] nil)
 
-(defn- thread-get-stack-trace [^Thread t]
-  (.getStackTrace t))
+  Throwable
+  (filtered-stacktrace [^Throwable this]
+    (filtered-stacktrace (.getStackTrace this)))
 
-(extend nil
-  IFilteredStacktrace {:filtered-stacktrace (constantly nil)})
+  Thread
+  (filtered-stacktrace [^Thread this]
+    (filtered-stacktrace (.getStackTrace this))))
 
-(extend Throwable
-  IFilteredStacktrace {:filtered-stacktrace (fn [this]
-                                             (filtered-stacktrace (throwable-get-stack-trace this)))})
-
-(extend Thread
-  IFilteredStacktrace {:filtered-stacktrace (fn [this]
-                                              (filtered-stacktrace (thread-get-stack-trace this)))})
-
-(defn- metabase-frame? [frame]
-  (re-find #"metabase" (str frame)))
-
-;; StackTraceElement[] is what the `.getStackTrace` method for Thread and Throwable returns
 (extend (Class/forName "[Ljava.lang.StackTraceElement;")
   IFilteredStacktrace
   {:filtered-stacktrace
    (fn [this]
      ;; keep all the frames before the last Metabase frame, but then filter out any other non-Metabase frames after
      ;; that
-     (let [[frames-after-last-mb other-frames]     (split-with (complement metabase-frame?)
-                                                               (map str (seq this)))
-           [last-mb-frame & frames-before-last-mb] (map #(str/replace % #"^metabase\." "")
-                                                        (filter metabase-frame? other-frames))]
+     (let [[frames-after-last-mb other-frames]     (split-with #(not (str/includes? % "metabase"))
+                                                               (seq this))
+           [last-mb-frame & frames-before-last-mb] (for [frame other-frames
+                                                         :when (str/includes? frame "metabase")]
+                                                     (str/replace frame #"^metabase\." ""))]
        (concat
-        frames-after-last-mb
+        (map str frames-after-last-mb)
         ;; add a little arrow to the frame so it stands out more
-        (cons (some->> last-mb-frame (str "--> "))
-              frames-before-last-mb))))})
+        (cons
+         (some->> last-mb-frame (str "--> "))
+         frames-before-last-mb))))})
+
 
 (defn deref-with-timeout
   "Call `deref` on a something derefable (e.g. a future or promise), and throw an exception if it takes more than

src/metabase/util/honeysql_extensions.clj

@@ -11,10 +11,9 @@
   (:import honeysql.format.ToSql
            java.util.Locale))
 
-(when-not *compile-files*
-  (when config/is-dev?
-    (alter-meta! #'honeysql.core/format assoc :style/indent 1)
-    (alter-meta! #'honeysql.core/call   assoc :style/indent 1)))
+(when config/is-dev?
+  (alter-meta! #'honeysql.core/format assoc :style/indent 1)
+  (alter-meta! #'honeysql.core/call   assoc :style/indent 1))
 
 (defn- english-upper-case
   "Use this function when you need to upper-case an identifier or table name. Similar to `clojure.string/upper-case`
@@ -78,6 +77,11 @@
                                  (:components component)
                                  [component])]
                  component)))
+;; don't use `->Identifier` or `map->Identifier`. Use the `identifier` function instead, which cleans up its input
+(when-not config/is-prod?
+  (alter-meta! #'->Identifier    assoc :private true)
+  (alter-meta! #'map->Identifier assoc :private true))
+
 
 ;; Single-quoted string literal
 (defrecord Literal [literal]
@@ -91,6 +95,11 @@
   (pretty [_]
     (list 'literal literal)))
 
+;; as with `Identifier` you should use the the `literal` function below instead of the auto-generated factory functions.
+(when-not config/is-prod?
+  (alter-meta! #'->Literal    assoc :private true)
+  (alter-meta! #'map->Literal assoc :private true))
+
 (defn literal
   "Wrap keyword or string `s` in single quotes and a HoneySQL `raw` form.
 
@@ -107,8 +116,8 @@
 (def ^{:arglists '([& exprs])}  *  "Math operator. Interpose `*` between `exprs` and wrap in parentheses." (partial hsql/call :*))
 (def ^{:arglists '([& exprs])} mod "Math operator. Interpose `%` between `exprs` and wrap in parentheses." (partial hsql/call :%))
 
-(defn inc "Add 1 to X."        [x] (+ x 1))
-(defn dec "Subtract 1 from X." [x] (- x 1))
+(defn inc "Add 1 to `x`."        [x] (+ x 1))
+(defn dec "Subtract 1 from `x`." [x] (- x 1))
 
 
 (defn cast
@@ -134,13 +143,13 @@
   [x decimal-places]
   (hsql/call :round x decimal-places))
 
-(defn ->date                     "CAST X to a `date`."                     [x] (cast :date x))
-(defn ->datetime                 "CAST X to a `datetime`."                 [x] (cast :datetime x))
-(defn ->timestamp                "CAST X to a `timestamp`."                [x] (cast :timestamp x))
-(defn ->timestamp-with-time-zone "CAST X to a `timestamp with time zone`." [x] (cast "timestamp with time zone" x))
-(defn ->integer                  "CAST X to a `integer`."                  [x] (cast :integer x))
-(defn ->time                     "CAST X to a `time` datatype"             [x] (cast :time x))
-(defn ->boolean                  "CAST X to a `boolean` datatype"          [x] (cast :boolean x))
+(defn ->date                     "CAST `x` to a `date`."                     [x] (cast :date x))
+(defn ->datetime                 "CAST `x` to a `datetime`."                 [x] (cast :datetime x))
+(defn ->timestamp                "CAST `x` to a `timestamp`."                [x] (cast :timestamp x))
+(defn ->timestamp-with-time-zone "CAST `x` to a `timestamp with time zone`." [x] (cast "timestamp with time zone" x))
+(defn ->integer                  "CAST `x` to a `integer`."                  [x] (cast :integer x))
+(defn ->time                     "CAST `x` to a `time` datatype"             [x] (cast :time x))
+(defn ->boolean                  "CAST `x` to a `boolean` datatype"          [x] (cast :boolean x))
 
 ;;; Random SQL fns. Not all DBs support all these!
 (def ^{:arglists '([& exprs])} floor   "SQL `floor` function."  (partial hsql/call :floor))

src/metabase/util/pretty.clj

@@ -5,7 +5,9 @@
            java.util.Map))
 
 (defprotocol PrettyPrintable
-  "Implmement this protocol to return custom representations of objects when printing them."
+  "Implmement this protocol to return custom representations of objects when printing them. This only seems to work if
+  it's done as part of the type declaration (`defrecord`); it doesn't seem to be respected if you use
+  `extend-protocol` for an existing type. Not sure why this is :("
   (pretty [_]
     "Return an appropriate representation of this object to be used when printing it, such as in the REPL or in log
     messages."))

test/expectation_options.clj

@@ -5,8 +5,7 @@
              [set :as set]]
             [expectations :as expectations]
             [metabase.util :as u]
-            [metabase.util.date :as du])
-  (:import java.util.concurrent.TimeoutException))
+            [metabase.util.date :as du]))
 
 ;;; ---------------------------------------- Expectations Framework Settings -----------------------------------------
 
@@ -62,12 +61,14 @@
   [run]
   (fn [test-fn]
     (let [start-time-ms (System/currentTimeMillis)]
-      (u/prog1 (run test-fn)
-        (let [duration-ms (- (System/currentTimeMillis) start-time-ms)]
-          (when (> duration-ms slow-test-threshold-ms)
-            (let [{:keys [file line]} (-> test-fn meta :the-var meta)]
-              (println (u/format-color 'red "%s %s is a slow test! It took %s to finish."
-                         file line (du/format-milliseconds duration-ms))))))))))
+      (run test-fn)
+      (let [duration-ms (- (System/currentTimeMillis) start-time-ms)]
+        (when (> duration-ms slow-test-threshold-ms)
+          (println
+           (let [{:keys [file line]} (-> test-fn meta :the-var meta)]
+             (u/format-color 'red "%s %s is a slow test! It took %s to finish."
+               file line (du/format-milliseconds duration-ms)))
+           "(This may have been because it was loading test data.)"))))))
 
 
 ;;; ------------------------------------------------ enforce-timeout -------------------------------------------------
@@ -75,18 +76,22 @@
 (def ^:private test-timeout-ms (* 60 1000))
 
 (defn- enforce-timeout
-  "If any test takes longer that 60 seconds to run return a TimeoutException, effectively failing the test."
+  "If any test takes longer that 60 seconds to run print a message and stop running tests. (This usually happens when
+  something is fundamentally broken, and we don't want to continue running thousands of tests that can hang for a
+  minute each.)"
   [run]
   (fn [test-fn]
-    (deref
-     (future
-       (try
-         (run test-fn)
-         (catch Throwable e
-           e)))
-     test-timeout-ms
-     ;; return Exception than throwing, otherwise it will mess up our test running
-     (TimeoutException. (format "Test timed out after %s" (du/format-milliseconds test-timeout-ms))))))
+    (when (= (deref (future (run test-fn)) test-timeout-ms ::timed-out)
+             ::timed-out)
+      (let [{:keys [file line]} (-> test-fn meta :the-var meta)]
+        (println
+         (u/format-color 'red "%s %s timed out after %s" file line (du/format-milliseconds test-timeout-ms)))
+        (println "Stacktraces:")
+        (doseq [[thread stacktrace] (Thread/getAllStackTraces)]
+          (println "\n" (u/pprint-to-str 'red thread))
+          (doseq [frame stacktrace]
+            (println frame))))
+      (System/exit 1))))
 
 
 ;;; ---------------------------------------------- check-table-cleanup -----------------------------------------------
@@ -101,12 +106,9 @@
   message"
   [models-to-check]
   (for [model models-to-check
-        :let  [instances-found (count (model))
-               more-than-one? (> 1 instances-found)]
-        :when (< 0 instances-found)]
-    (str "Found '" instances-found "' instance" (when more-than-one? "s")
-         " of '" (:name model) "' that " (if more-than-one? "were" "was")
-         " not cleaned up.")))
+        :let  [instances-found (count (model))]
+        :when (pos? instances-found)]
+    (format "Found %d instances of %s that were not cleaned up." instances-found (:name model))))
 
 (def ^{:arglists '([run])} check-table-cleanup
   "Function that will run around each test. This function is usually a noop, but it useful for helping to debug stale
@@ -117,34 +119,37 @@
     identity
     (fn [run]
       (fn [test-fn]
-        (let [result              (run test-fn)
-              {:keys [file line]} (-> test-fn meta :the-var meta)
-              error-msgs          (tables-with-data->error-msg models-to-check)]
+        (run test-fn)
+        (let [error-msgs (tables-with-data->error-msg models-to-check)]
           (when (seq error-msgs)
             (println "\n-----------------------------------------------------")
             (doseq [error-msg error-msgs]
               (println error-msg))
             (println "-----------------------------------------------------")
-            (printf "\nStale test rows found in tables, check '%s' at line '%s'\n\n" file line)
+            (let [{:keys [file line]} (-> test-fn meta :the-var meta)]
+              (printf "\nStale test rows found in tables, check '%s' at line '%s'\n\n" file line))
             (flush)
             ;; I found this necessary as throwing an exception would show the exception, but the test run would hang and
             ;; you'd have to Ctrl-C anyway
-            (System/exit 1))
-          result)))))
+            (System/exit 1)))))))
 
 
 ;;; -------------------------------------------- Putting it all together ---------------------------------------------
 
 (defn- log-tests [run]
-  (fn [test-fn]
-    (let [{:keys [file line]} (-> test-fn meta :the-var meta)]
-      (println (format "Run %s %s" file line)))
-    (run test-fn)))
-
+  (comp
+   run
+   (fn [test-fn]
+     (let [{:keys [file line]} (-> test-fn meta :the-var meta)]
+       (println (format "Run %s %s" file line)))
+     test-fn)))
+
+;; This middleware does not need to worry about passing results to the next function in the chain; `test-fn` always
+;; returns `nil`
 (def ^:private ^{:expectations-options :in-context} test-middleware
   (-> (fn [test-fn]
         (test-fn))
-      ;; uncomment `log-tests` if you need to debug tests or see which ones are being noisy
+      ;; uncomment `log-tests` if you need to debug tests or see which ones are being noisy or hanging forever
       #_log-tests
       log-slow-tests
       enforce-timeout

test/metabase/query_processor_test.clj

@@ -294,27 +294,36 @@
   this behavior."
   {:style/indent 1}
   ([format-fns rows]
-   (format-rows-by format-fns (not :format-nil-values?) rows))
-  ([format-fns format-nil-values? rows]
-   (cond
-     (= (:status rows) :failed)
-     (do (println "Error running query:" (u/pprint-to-str 'red rows))
-         (throw (ex-info (:error rows) rows)))
-
-     (:data rows)
-     (update-in rows [:data :rows] (partial format-rows-by format-fns))
-
-     (:rows rows)
-     (update rows :rows (partial format-rows-by format-fns))
-
-     :else
-     (vec (for [row rows]
-            (vec (for [[f v] (partition 2 (interleave format-fns row))]
-                   (when (or v format-nil-values?)
-                     (try (f v)
-                          (catch Throwable e
-                            (printf "(%s %s) failed: %s" f v (.getMessage e))
-                            (throw e)))))))))))
+   (format-rows-by format-fns false rows))
+
+  ([format-fns format-nil-values? response]
+   (when (= (:status response) :failed)
+     (println "Error running query:" (u/pprint-to-str 'red response))
+     (throw (ex-info (:error response) response)))
+
+   (-> response
+       ((fn format-rows [rows]
+          (cond
+            (:data rows)
+            (update rows :data format-rows)
+
+            (:rows rows)
+            (update rows :rows format-rows)
+
+            (sequential? rows)
+            (vec
+             (for [row rows]
+               (vec
+                (for [[f v] (partition 2 (interleave format-fns row))]
+                  (when (or v format-nil-values?)
+                    (try
+                      (f v)
+                      (catch Throwable e
+                        (printf "(%s %s) failed: %s" f v (.getMessage e))
+                        (throw e))))))))
+
+            :else
+            (throw (ex-info "Unexpected response: rows are not sequential!" {:response response}))))))))
 
 (def ^{:arglists '([results])} formatted-venues-rows
   "Helper function to format the rows in `results` when running a 'raw data' query against the Venues test table."