[R] Check warnings explicitly for model compatibility tests (#6114)

* [R] Check warnings explicitly for model compatibility tests

* Address reviewer's feedback

R-package/tests/testthat/test_model_compatibility.R

@@ -61,7 +61,7 @@ test_that("Models from previous versions of XGBoost can be loaded", {
   zipfile <- file.path(getwd(), file_name)
   model_dir <- file.path(getwd(), 'models')
   download.file(paste('https://', bucket, '.s3-', region, '.amazonaws.com/', file_name, sep = ''),
-                destfile = zipfile, mode = 'wb')
+                destfile = zipfile, mode = 'wb', quiet = TRUE)
   unzip(zipfile, overwrite = TRUE)
 
   pred_data <- xgb.DMatrix(matrix(c(0, 0, 0, 0), nrow = 1, ncol = 4))
@@ -72,13 +72,34 @@ test_that("Models from previous versions of XGBoost can be loaded", {
     m <- regmatches(model_file, m)[[1]]
     model_xgb_ver <- m[2]
     name <- m[3]
+    is_rds <- endsWith(model_file, '.rds')
 
-    if (endsWith(model_file, '.rds')) {
-      booster <- readRDS(model_file)
-    } else {
-      booster <- xgb.load(model_file)
+    cpp_warning <- capture.output({
+      # Expect an R warning when a model is loaded from RDS and it was generated by version < 1.1.x
+      if (is_rds && compareVersion(model_xgb_ver, '1.1.1.1') < 0) {
+        booster <- readRDS(model_file)
+        expect_warning(predict(booster, newdata = pred_data))
+        expect_warning(run_booster_check(booster, name))
+      } else {
+        if (is_rds) {
+          booster <- readRDS(model_file)
+        } else {
+          booster <- xgb.load(model_file)
+        }
+        predict(booster, newdata = pred_data)
+        run_booster_check(booster, name)
+      }
+    })
+    if (compareVersion(model_xgb_ver, '1.0.0.0') < 0) {
+      # Expect a C++ warning when a model was generated in version < 1.0.x
+      m <- grepl(paste0('.*Loading model from XGBoost < 1\\.0\\.0, consider saving it again for ',
+                        'improved compatibility.*'), cpp_warning, perl = TRUE)
+      expect_true(length(m) > 0 && all(m))
+    } else if (is_rds && model_xgb_ver == '1.1.1.1') {
+      # Expect a C++ warning when a model is loaded from RDS and it was generated by version 1.1.x
+      m <- grepl(paste0('.*Attempted to load internal configuration for a model file that was ',
+                        'generated by a previous version of XGBoost.*'), cpp_warning, perl = TRUE)
+      expect_true(length(m) > 0 && all(m))
     }
-    predict(booster, newdata = pred_data)
-    run_booster_check(booster, name)
   })
 })

src/tree/updater_quantile_hist.h

@@ -132,7 +132,8 @@ class QuantileHistMaker: public TreeUpdater {
       // We add this compatibility check because it's just recently that we (developers) began
       // persuade R users away from using saveRDS() for model serialization. Hopefully, one day,
       // everyone will be using xgb.save().
-      LOG(WARNING) << "Attempted to load interal configuration for a model file that was generated "
+      LOG(WARNING)
+        << "Attempted to load internal configuration for a model file that was generated "
         << "by a previous version of XGBoost. A likely cause for this warning is that the model "
         << "was saved with saveRDS() in R or pickle.dump() in Python. We strongly ADVISE AGAINST "
         << "using saveRDS() or pickle.dump() so that the model remains accessible in current and "