Merge pull request #1456 from stan-dev/test-coverage

Add a bunch of edge-case tests

src/frontend/Deprecation_analysis.ml

@@ -11,6 +11,7 @@ let expired (major, minor) =
 let deprecated_functions = String.Map.of_alist_exn []
 let stan_lib_deprecations = deprecated_functions
 
+(* TODO deprecate other pre-variadics like algebra_solver? *)
 let deprecated_odes =
   String.Map.of_alist_exn
     [ ("integrate_ode", ("ode_rk45", (3, 0)))

src/frontend/Preprocessor.ml

@@ -83,12 +83,6 @@ let restore_prior_lexbuf () =
   lexbuf.lex_start_p <- old_pos;
   old_lexbuf
 
-let maybe_remove_quotes str =
-  let open String in
-  if is_prefix str ~prefix:"\"" && is_suffix str ~suffix:"\"" then
-    drop_suffix (drop_prefix str 1) 1
-  else str
-
 let find_include_fs lookup_paths fname =
   let rec loop paths =
     match paths with
@@ -131,7 +125,7 @@ let find_include fname =
 
 let try_get_new_lexbuf fname =
   let lexbuf = Stack.top_exn include_stack in
-  let new_lexbuf, file = find_include (maybe_remove_quotes fname) in
+  let new_lexbuf, file = find_include fname in
   lexer_logger ("opened " ^ file);
   new_lexbuf.lex_start_p <-
     new_file_start_position file

src/frontend/Typechecker.ml

@@ -113,18 +113,12 @@ let verify_identifier id : unit =
       "Variable name 'jacobian' will be a reserved word starting in Stan 2.38. \
        Please rename it!";
   if id.name = !model_name then
-    Semantic_error.ident_is_model_name id.id_loc id.name |> error
-  else if
+    Semantic_error.ident_is_model_name id.id_loc id.name |> error;
+  if
     String.is_suffix id.name ~suffix:"__"
     || List.mem reserved_keywords id.name ~equal:String.equal
   then Semantic_error.ident_is_keyword id.id_loc id.name |> error
 
-let distribution_name_variants name =
-  match Utils.split_distribution_suffix name with
-  | Some (stem, "lpmf") -> [name; stem ^ "_lpdf"]
-  | Some (stem, "lpdf") -> [name; stem ^ "_lpmf"]
-  | _ -> [name]
-
 (** verify that the variable being declared is previous unused.
    allowed to shadow StanLib *)
 let verify_name_fresh_var loc tenv name =
@@ -160,10 +154,8 @@ let verify_name_fresh_udf loc tenv name =
   - is not already in use (for now)
 *)
 let verify_name_fresh tenv id ~is_udf =
-  let f =
-    if is_udf then verify_name_fresh_udf id.id_loc tenv
-    else verify_name_fresh_var id.id_loc tenv in
-  List.iter ~f (distribution_name_variants id.name)
+  if is_udf then verify_name_fresh_udf id.id_loc tenv id.name
+  else verify_name_fresh_var id.id_loc tenv id.name
 
 let is_of_compatible_return_type rt1 srt2 =
   UnsizedType.(
@@ -513,10 +505,10 @@ let check_normal_fn ~is_cond_dist loc tenv id es =
           let is_known_family s =
             List.mem known_families s ~equal:String.equal in
           match suffix with
-          | ("lpmf" | "lumpf") when Env.mem tenv (prefix ^ "_lpdf") ->
+          | ("lpmf" | "lupmf") when Env.mem tenv (prefix ^ "_lpdf") ->
               Semantic_error.returning_fn_expected_wrong_dist_suffix_found loc
                 (prefix, suffix)
-          | ("lpdf" | "lumdf") when Env.mem tenv (prefix ^ "_lpmf") ->
+          | ("lpdf" | "lupdf") when Env.mem tenv (prefix ^ "_lpmf") ->
               Semantic_error.returning_fn_expected_wrong_dist_suffix_found loc
                 (prefix, suffix)
           | _ ->
@@ -1692,9 +1684,7 @@ and check_var_decl loc cf tenv sized_ty trans
 
 (* function definitions *)
 and exists_matching_fn_declared tenv id arg_tys rt =
-  let options =
-    List.concat_map ~f:(Env.find tenv) (distribution_name_variants id.name)
-  in
+  let options = Env.find tenv id.name in
   let f = function
     | Env.{kind= `UserDeclared _; type_= UFun (listedtypes, rt', _, _)}
       when arg_tys = listedtypes && rt = rt' ->
@@ -1703,9 +1693,7 @@ and exists_matching_fn_declared tenv id arg_tys rt =
   List.exists ~f options
 
 and verify_unique_signature tenv loc id arg_tys rt =
-  let existing =
-    List.concat_map ~f:(Env.find tenv) (distribution_name_variants id.name)
-  in
+  let existing = Env.find tenv id.name in
   let same_args = function
     | Env.{type_= UFun (listedtypes, _, _, _); _}
       when List.map ~f:snd arg_tys = List.map ~f:snd listedtypes ->

src/middle/UnsizedType.ml

@@ -42,12 +42,6 @@ let pp_autodifftype ppf = function
   | AutoDiffable -> ()
   | tup -> pp_tuple_autodifftype ppf tup
 
-let unsized_array_depth unsized_ty =
-  let rec aux depth = function
-    | UArray ut -> aux (depth + 1) ut
-    | ut -> (ut, depth) in
-  aux 0 unsized_ty
-
 let count_dims unsized_ty =
   let rec aux dims = function
     | UArray t -> aux (dims + 1) t
@@ -176,7 +170,7 @@ let rec common_type = function
 let rec is_autodiffable = function
   | UReal | UVector | URowVector | UMatrix -> true
   | UArray t -> is_autodiffable t
-  | _ -> false
+  | _ (* wrong? *) -> false
 
 let rec is_autodifftype possibly_adtype =
   match possibly_adtype with

src/middle/Utils.ml

@@ -58,16 +58,6 @@ let%expect_test "unnormalized name mangling" =
   stdlib_distribution_name "normal" |> ( ^ ) "; " |> print_string;
   [%expect {| bernoulli_logit_lpmf; normal_lpdf; normal_lpdf; normal |}]
 
-let all_but_last_n l n =
-  List.fold_right l ~init:([], n) ~f:(fun ele (accum, n) ->
-      if n = 0 then (ele :: accum, n) else (accum, n - 1))
-  |> fst
-
-let%expect_test "all but last n" =
-  let l = all_but_last_n [1; 2; 3; 4] 2 in
-  print_s [%sexp (l : int list)];
-  [%expect {| (1 2) |}]
-
 (* Utilities for using Tuples and Transformations together *)
 let tuple_trans_exn = function
   | Transformation.TupleTransformation transforms -> transforms

src/stan_math_backend/Lower_stmt.ml

@@ -16,7 +16,9 @@ let check_to_string = function
   | LowerUpper _ ->
       Common.ICE.internal_compiler_error
         [%message "LowerUpper is really two other checks tied together"]
-  | Offset _ | Multiplier _ | OffsetMultiplier _ -> None
+  | Offset _ | Multiplier _ | OffsetMultiplier _ ->
+      Common.ICE.internal_compiler_error
+        [%message "Offset and multiplier don't have a check"]
   | t -> constraint_to_string t
 
 let math_fn_translations = function

test/integration/bad/algebra_solver/bad_solve_newton_lpdf.stan

@@ -0,0 +1,30 @@
+functions {
+
+  real algebra_system_lpdf(vector x, vector y, array[] real dat,
+                        array[] int dat_int) {
+    vector[2] f_x;
+    f_x[1] = x[1] - y[1];
+    f_x[2] = x[2] - y[2];
+    return f_x[1];
+  }
+}
+data {
+
+}
+transformed data {
+  vector[2] x;
+  vector[2] y;
+  array[0] real dat;
+  array[0] int dat_int;
+
+}
+parameters {
+  vector[2] x_p;
+  vector[2] y_p;
+}
+transformed parameters {
+  vector[2] theta_p;
+
+  theta_p = solve_newton(algebra_system_lpdf, x, y, dat, dat_int);
+
+}