<commit_before>;; Copyright (c) 2008-2013 <NAME>
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

;; File    : ms_transform_SUITE.lfe
;; Author  : <NAME>
;; Purpose : Match specification test suite.

;; This is a direct translation of ms_transfom_SUITE.erl from R14B02 except
;; for tests with guards containing ';'. We have usually removed these
;; or been careful with these as they don't handle errors the same way
;; as 'or' (which is all we have).
;;
;; Note that some of these tests are not LFE specific but more general
;; guard tests but we include them anyway for completeness.
;;
;; As match-spec is a macro we can expand it directly inline which
;; means that many errors/inconsistencies will be detected at compile
;; time. Should we write it to a file or in memory and compile at
;; run-time?

(include-file "test_server.lfe")

(defmodule ms_transform_SUITE
  (export (all 0) (suite 0) (groups 0) (init_per_suite 1) (end_per_suite 1)
      (init_per_group 2) (end_per_group 2)
      (init_per_testcase 2) (end_per_testcase 2)
      (basic_ets 1) (basic_dbg 1) (from_shell 1) (records 1)
      (record_index 1) (multipass 1) (top_match 1) (old_guards 1)
      (autoimported 1) (semicolon 1) (bitsyntax 1)
      (record_defaults 1) (andalso_orelse 1)
      (float_1_function 1) (action_function 1) (warnings 1)
      ))

(defmacro MODULE () `'ms_transform_SUITE)

(defun all ()
  ;; (: test_lib recompile (MODULE))
  (list 'basic_ets 'basic_dbg 'from_shell 'records
    'record_index 'multipass 'top_match 'old_guards
    'autoimported 'semicolon 'bitsyntax 'record_defaults
    'andalso_orelse 'float_1_function 'action_function 'warnings))

;;(defun suite () (list (tuple 'ct_hooks (list 'ts_install_cth))))
(defun suite () ())

(defun groups () ())

(defun init_per_suite (config) config)

(defun end_per_suite (config) 'ok)

(defun init_per_group (name config) config)

(defun end_per_group (name config) config)

(defun init_per_testcase (func config)
  (let ((dog (: test_server timetrap (: test_server seconds 360))))
    (cons (tuple 'watchdog dog) config)))

(defun end_per_testcase (func config)
  (let ((dog (config 'watchdog config)))
    (: test_server timetrap_cancel dog)))

(defun basic_ets
  (['suite] ())
  (['doc] '"Tests basic ets:fun2ms")
  ([config] (when (is_list config))
   (line (setup config))
   (line (test-pat '(#(#(a b) () (true))) (match-spec ([(tuple 'a 'b)] 'true))))
   (line (test-pat '(#(#($1 foo) (#(is_list $1)) (#(#(#(hd $1) $_))))
             #(#($1 $1) (#(is_tuple $1)) (#(#(#(element 1 $1) $*)))))
           (match-spec ([(tuple x 'foo)] (when (is_list x))
                (tuple (hd x) (object)))
                   ([(tuple x x)] (when (is_tuple x))
                (tuple (element 1 x) (bindings))))
           ))
   (line (test-pat '(#(#($1 $2) () (#(#($2 $1)))))
           (match-spec ([(tuple a b)] (tuple b a)))))
   (line (test-pat '(#(#($1 $2) () (($2 $1))))
           (match-spec ([(tuple a b)] (list b a)))))

   'ok))

(defun basic_dbg
  (['suite] ())
  (['doc] '"Tests basic ets:fun2ms")
  ([config] (when (is_list config))
   (line (setup config))
   (line (test-pat '(#((a b) () (#(message banan) #(return_trace))))
           (match-spec ([(list 'a 'b)]
                (message 'banan) (return_trace)))))
   (line (test-pat '(#(($1 $2) () (#(#($2 $1)))))
           (match-spec ([(list a b)] (tuple b a)))))
   (line (test-pat '(#(($1 $2) () (($2 $1))))
           (match-spec ([(list a b)] (list b a)))))
   (line (test-pat '(#(($1 $2) () ($*)))
           (match-spec ([(list a b)] (bindings)))))
   (line (test-pat '(#(($1 $2) () ($_)))
           (match-spec ([(list a b)] (object)))))

   'ok))

(defun from_shell
  (['suite] ())
  (['doc] '"Test calling of ets/dbg:fun2ms from the shell")
  ([config] (when (is_list config))
   ;; Not relevant to LFE.
   'ok))

(defrecord t (t1 ()) (t2 'foo) t3 t4)

(defun records
  (['suite] ())
  (['doc] '"Tests expansion of records in fun2ms")
  ([config] (when (is_list config))
   (line (setup config))
   (line
    (test-pat
     '(#(#(t $1 $2 foo _) (#(is_list $1)) (#(#(#(hd $1) $_))))
       #(#(t _ _ _ _) (#(== #(element 2 $_) nisse)) (#(#($*)))))
     (match-spec ([(match-t t1 x t2 y t3 'foo)] (when (is_list x))
          (tuple (hd x) (object)))
         ([(match-t)] (when (== (t-t1 (object)) 'nisse))
          (tuple (bindings))))
     ))
   ;; [{{t,'$1','$2','_',foo},[{'==',{element,4,'$_'},7},{is_list,'$1'}],
   ;;   [{{{hd,'$1'},'$_'}}]},
   ;;  {'$1',[{is_record,'$1',t,5}],
   ;;   [{{{element,2,'$1'},
   ;;      {{t,'$1',foo,undefined,undefined}},
   ;;      {{t,{element,2,'$1'},{element,3,'$1'},{element,4,'$1'},boooo}}}}]}]
   (line
    (test-pat
     '(#(#(t $1 $2 _ foo) (#(== #(element 4 $_) 7) #(is_list $1))
     (#(#(#(hd $1) $_))))
       #($1 (#(is_record $1 t 5))
        (#(#(#(element 2 $1)
         #(#(t $1 foo undefined undefined))
         #(setelement 5 $1 boooo))))))
     (match-spec ([(match-t t1 x t2 y t4 'foo)]
          (when (== (t-t3 (object)) 7) (is_list x))
          (tuple (hd x) (object)))
         ([a] (when (is-t a))
          (tuple (t-t1 a) (make-t t1 a) (set-t-t4 a 'boooo))))
     ))
   ;; [{[{t,'$1','$2',foo,'_'}],[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]},
   ;;  {[{t,'_','_','_','_'}],[{'==',{element,2,{hd,'$_'}},nisse}],[{{'$*'}}]}]
   (line
    (test-pat
     '(#((#(t $1 $2 foo _)) (#(is_list $1)) (#(#(#(hd $1) $_))))
       #((#(t _ _ _ _)) (#(== #(element 2 #(hd $_)) nisse)) (#(#($*)))))
     (match-spec ([(list (match-t t1 x t2 y t3 'foo))] (when (is_list x))
          (tuple (hd x) (object)))
         ([(list (match-t))] (when (== (t-t1 (hd (object))) 'nisse))
          (tuple (bindings))))
     ))

   'ok))

(defrecord a a b)

(defun record_index
  (['suite] ())
  (['doc] '"Tests expansion of records in fun2ms, part 2")
  ([config] (when (is_list config))
   (line (setup config))


   'ok))

(defun multipass
  (['suite] ())
  (['doc] '"Tests that multi-defined fields in records give errors.")
  ([config] (when (is_list config))

   'ok))

(defrecord a a b)

(defun top_match<commit_msg>Remove record field access from match spec guard and body.<commit_after>;; Copyright (c) 2008-2013 <NAME>
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

;; File    : ms_transform_SUITE.lfe
;; Author  : <NAME>
;; Purpose : Match specification test suite.

;; This is a direct translation of ms_transfom_SUITE.erl from R14B02 except
;; for tests with guards containing ';'. We have usually removed these
;; or been careful with these as they don't handle errors the same way
;; as 'or' (which is all we have).
;;
;; Note that some of these tests are not LFE specific but more general
;; guard tests but we include them anyway for completeness.
;;
;; As match-spec is a macro we can expand it directly inline which
;; means that many errors/inconsistencies will be detected at compile
;; time. Should we write it to a file or in memory and compile at
;; run-time?

(include-file "test_server.lfe")

(defmodule ms_transform_SUITE
  (export (all 0) (suite 0) (groups 0) (init_per_suite 1) (end_per_suite 1)
      (init_per_group 2) (end_per_group 2)
      (init_per_testcase 2) (end_per_testcase 2)
      (basic_ets 1) (basic_dbg 1) (from_shell 1) (records 1)
      (record_index 1) (multipass 1) (top_match 1) (old_guards 1)
      (autoimported 1) (semicolon 1) (bitsyntax 1)
      (record_defaults 1) (andalso_orelse 1)
      (float_1_function 1) (action_function 1) (warnings 1)
      ))

(defmacro MODULE () `'ms_transform_SUITE)

(defun all ()
  ;; (: test_lib recompile (MODULE))
  (list 'basic_ets 'basic_dbg 'from_shell 'records
    'record_index 'multipass 'top_match 'old_guards
    'autoimported 'semicolon 'bitsyntax 'record_defaults
    'andalso_orelse 'float_1_function 'action_function 'warnings))

;;(defun suite () (list (tuple 'ct_hooks (list 'ts_install_cth))))
(defun suite () ())

(defun groups () ())

(defun init_per_suite (config) config)

(defun end_per_suite (config) 'ok)

(defun init_per_group (name config) config)

(defun end_per_group (name config) config)

(defun init_per_testcase (func config)
  (let ((dog (: test_server timetrap (: test_server seconds 360))))
    (cons (tuple 'watchdog dog) config)))

(defun end_per_testcase (func config)
  (let ((dog (config 'watchdog config)))
    (: test_server timetrap_cancel dog)))

(defun basic_ets
  (['suite] ())
  (['doc] '"Tests basic ets:fun2ms")
  ([config] (when (is_list config))
   (line (setup config))
   (line (test-pat '(#(#(a b) () (true))) (match-spec ([(tuple 'a 'b)] 'true))))
   (line (test-pat '(#(#($1 foo) (#(is_list $1)) (#(#(#(hd $1) $_))))
             #(#($1 $1) (#(is_tuple $1)) (#(#(#(element 1 $1) $*)))))
           (match-spec ([(tuple x 'foo)] (when (is_list x))
                (tuple (hd x) (object)))
                   ([(tuple x x)] (when (is_tuple x))
                (tuple (element 1 x) (bindings))))
           ))
   (line (test-pat '(#(#($1 $2) () (#(#($2 $1)))))
           (match-spec ([(tuple a b)] (tuple b a)))))
   (line (test-pat '(#(#($1 $2) () (($2 $1))))
           (match-spec ([(tuple a b)] (list b a)))))

   'ok))

(defun basic_dbg
  (['suite] ())
  (['doc] '"Tests basic ets:fun2ms")
  ([config] (when (is_list config))
   (line (setup config))
   (line (test-pat '(#((a b) () (#(message banan) #(return_trace))))
           (match-spec ([(list 'a 'b)]
                (message 'banan) (return_trace)))))
   (line (test-pat '(#(($1 $2) () (#(#($2 $1)))))
           (match-spec ([(list a b)] (tuple b a)))))
   (line (test-pat '(#(($1 $2) () (($2 $1))))
           (match-spec ([(list a b)] (list b a)))))
   (line (test-pat '(#(($1 $2) () ($*)))
           (match-spec ([(list a b)] (bindings)))))
   (line (test-pat '(#(($1 $2) () ($_)))
           (match-spec ([(list a b)] (object)))))

   'ok))

(defun from_shell
  (['suite] ())
  (['doc] '"Test calling of ets/dbg:fun2ms from the shell")
  ([config] (when (is_list config))
   ;; Not relevant to LFE.
   'ok))

(defrecord t (t1 ()) (t2 'foo) t3 t4)

(defun records
  (['suite] ())
  (['doc] '"Tests expansion of records in fun2ms")
  ([config] (when (is_list config))
   (line (setup config))
   (line
    (test-pat
     ;; '(#(#(t $1 $2 foo _) (#(is_list $1)) (#(#(#(hd $1) $_))))
     ;;   #(#(t _ _ _ _) (#(== #(element 2 $_) nisse)) (#(#($*)))))
     ;; (match-spec ([(match-t t1 x t2 y t3 'foo)] (when (is_list x))
     ;;              (tuple (hd x) (object)))
     ;;             ([(match-t)] (when (== (t-t1 (object)) 'nisse))
     ;;              (tuple (bindings))))
     '(#(#(t $1 $2 foo _) (#(is_list $1)) (#(#(#(hd $1) $_)))))
     (match-spec ([(match-t t1 x t2 y t3 'foo)] (when (is_list x))
                  (tuple (hd x) (object))))
     ))
   ;; [{{t,'$1','$2','_',foo},[{'==',{element,4,'$_'},7},{is_list,'$1'}],
   ;;   [{{{hd,'$1'},'$_'}}]},
   ;;  {'$1',[{is_record,'$1',t,5}],
   ;;   [{{{element,2,'$1'},
   ;;      {{t,'$1',foo,undefined,undefined}},
   ;;      {{t,{element,2,'$1'},{element,3,'$1'},{element,4,'$1'},boooo}}}}]}]
   ;; (line
   ;;  (test-pat
   ;;   '(#(#(t $1 $2 _ foo) (#(== #(element 4 $_) 7) #(is_list $1))
   ;;       (#(#(#(hd $1) $_))))
   ;;     #($1 (#(is_record $1 t 5))
   ;;          (#(#(#(element 2 $1)
   ;;               #(#(t $1 foo undefined undefined))
   ;;               #(setelement 5 $1 boooo))))))
   ;;   (match-spec ([(match-t t1 x t2 y t4 'foo)]
   ;;                (when (== (t-t3 (object)) 7) (is_list x))
   ;;                (tuple (hd x) (object)))
   ;;               ([a] (when (is-t a))
   ;;                (tuple (t-t1 a) (make-t t1 a) (set-t-t4 a 'boooo))))
   ;;   ))
   ;; [{[{t,'$1','$2',foo,'_'}],[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]},
   ;;  {[{t,'_','_','_','_'}],[{'==',{element,2,{hd,'$_'}},nisse}],[{{'$*'}}]}]
   (line
    (test-pat
     ;; '(#((#(t $1 $2 foo _)) (#(is_list $1)) (#(#(#(hd $1) $_))))
     ;;   #((#(t _ _ _ _)) (#(== #(element 2 #(hd $_)) nisse)) (#(#($*)))))
     ;; (match-spec ([(list (match-t t1 x t2 y t3 'foo))] (when (is_list x))
     ;;              (tuple (hd x) (object)))
     ;;             ([(list (match-t))] (when (== (t-t1 (hd (object))) 'nisse))
     ;;              (tuple (bindings))))
     '(#((#(t $1 $2 foo _)) (#(is_list $1)) (#(#(#(hd $1) $_)))))
     (match-spec ([(list (match-t t1 x t2 y t3 'foo))] (when (is_list x))
                  (tuple (hd x) (object))))
     ))

   'ok))

(defrecord a a b)

(defun record_index
  (['suite] ())
  (['doc] '"Tests expansion of records in fun2ms, part 2")
  ([config] (when (is_list config))
   (line (setup config))


   'ok))

(defun multipass
  (['suite] ())
  (['doc] '"Tests that multi-defined fields in records give errors.")
  ([config] (when (is_list config))

   'ok))

(defrecord a a b)

(defun top_match
{'fraction_non_alphanumeric': 0.22310034802784223, 'fraction_numerical': 0.02247679814385151, 'mean_word_length': 3.1470234515935056, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 7, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5258095', 'n_tokens_mistral': 5447, 'n_tokens_neox': 5068, 'n_words': 1505}