<commit_before>#!/usr/bin/perl

use strict;
use lib qw(tcl/lib ./lib ../lib ../../lib ../../../lib);
use Parrot::Test tests => 12;
use Test::More;

language_output_is("tcl",<<'TCL',<<OUT,"return value");
 set a [proc me {} {
  puts 2
 }]
 me
 puts $a
TCL
2

OUT

language_output_is("tcl",<<'TCL',<<'OUT',"return value from user-defined command");
 proc foo {} {
   append x {foo bar}
 }
 puts [foo]
TCL
foo bar
OUT

language_output_is("tcl",<<'TCL',<<OUT,"noarg");
 proc me {} {
  puts 2
 }
 me
TCL
2
OUT

language_output_is("tcl",<<'TCL',<<OUT,"onearg");
 proc me {a} {
  puts $a
 }
 me 2
TCL
2
OUT

language_output_is("tcl",<<'TCL',<<OUT,"twoarg");
 proc me {a b} {
  puts $a
  puts $b
 }
 me 2  3
TCL
2
3
OUT

language_output_is("tcl",<<'TCL',<<OUT,"too many args");
 proc me {a b} {
  puts $a
  puts $b
 }
 me 2 3 4
TCL
wrong # args: should be "me a b"
OUT

language_output_is("tcl",<<'TCL',<<OUT,"too few args");
 proc me {a b} {
  puts $a
  puts $b
 }
 me 2
TCL
wrong # args: should be "me a b"
OUT

language_output_is("tcl",<<'TCL',<<OUT,"bad varargs");
 proc me {a b args} {
  puts $a
  puts $b
 }
 me 2
TCL
wrong # args: should be "me a b args"
OUT

language_output_is("tcl",<<'TCL',<<OUT,"vararg");
 proc me {a args} {
  puts $a
  puts $args
 }
 me 2 3 4 5 6
TCL
2
3 4 5 6
OUT

language_output_is("tcl",<<'TCL',<<OUT,"vararg empty");
 proc me {a args} {
  puts $a
  puts $args
 }
 me 2
TCL
2

OUT

TODO: {
  local $TODO = "unimplemented, pending new CC.";

language_output_is("tcl",<<'TCL',<<OUT,"default args");
 proc me {{a 2}} {
  puts $a
 }
 me
 me 7
TCL
2
7
OUT

language_output_is("tcl",<<'TCL',<<OUT,"bad default args");
 proc me {{a 2 3}} {
  puts $a
 }
TCL
too many fields in argument specifier "a 2 3"
OUT
}<commit_msg>[tcl]: add a failing [proc] test<commit_after>#!/usr/bin/perl

use strict;
use lib qw(tcl/lib ./lib ../lib ../../lib ../../../lib);
use Parrot::Test tests => 13;
use Test::More;

language_output_is("tcl",<<'TCL',<<OUT,"return value");
 set a [proc me {} {
  puts 2
 }]
 me
 puts $a
TCL
2

OUT

language_output_is("tcl",<<'TCL',<<'OUT',"return value from user-defined command");
 proc foo {} {
   append x {foo bar}
 }
 puts [foo]
TCL
foo bar
OUT

language_output_is("tcl",<<'TCL',<<OUT,"noarg");
 proc me {} {
  puts 2
 }
 me
TCL
2
OUT

language_output_is("tcl",<<'TCL',<<OUT,"onearg");
 proc me {a} {
  puts $a
 }
 me 2
TCL
2
OUT

language_output_is("tcl",<<'TCL',<<OUT,"twoarg");
 proc me {a b} {
  puts $a
  puts $b
 }
 me 2  3
TCL
2
3
OUT

language_output_is("tcl",<<'TCL',<<OUT,"too many args");
 proc me {a b} {
  puts $a
  puts $b
 }
 me 2 3 4
TCL
wrong # args: should be "me a b"
OUT

language_output_is("tcl",<<'TCL',<<OUT,"too few args");
 proc me {a b} {
  puts $a
  puts $b
 }
 me 2
TCL
wrong # args: should be "me a b"
OUT

language_output_is("tcl",<<'TCL',<<OUT,"bad varargs");
 proc me {a b args} {
  puts $a
  puts $b
 }
 me 2
TCL
wrong # args: should be "me a b args"
OUT

language_output_is("tcl",<<'TCL',<<OUT,"vararg");
 proc me {a args} {
  puts $a
  puts $args
 }
 me 2 3 4 5 6
TCL
2
3 4 5 6
OUT

language_output_is("tcl",<<'TCL',<<OUT,"vararg empty");
 proc me {a args} {
  puts $a
  puts $args
 }
 me 2
TCL
2

OUT

language_output_is("tcl", <<'TCL', <<'OUT', "unknown namespace");
  proc a::b {} {puts a::b}
  a::b
TCL
can't create procedure "a::b": unknown namespace
OUT

TODO: {
  local $TODO = "unimplemented, pending new CC.";

language_output_is("tcl",<<'TCL',<<OUT,"default args");
 proc me {{a 2}} {
  puts $a
 }
 me
 me 7
TCL
2
7
OUT

language_output_is("tcl",<<'TCL',<<OUT,"bad default args");
 proc me {{a 2 3}} {
  puts $a
 }
TCL
too many fields in argument specifier "a 2 3"
OUT
}
{'fraction_non_alphanumeric': 0.19343365253077976, 'fraction_numerical': 0.02024623803009576, 'mean_word_length': 3.581453634085213, 'pattern_counts': {'":': 1, '<': 103, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, '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': '7558072', 'n_tokens_mistral': 1636, 'n_tokens_neox': 1598, 'n_words': 487}