# Qore

To use this language, use the class "language-qore".

## Full example

    #!/usr/bin/env qore

    # database test script
    # databases users must be able to create and destroy tables and procedures, etc
    # in order to execute all tests

    %require-our
    %enable-all-warnings

    our ($o, $errors, $test_count);

    const opts =
    	( "help"    : "h,help",
    	  "host"    : "H,host=s",
    	  "pass"    : "p,pass=s",
    	  "db"      : "d,db=s",
    	  "user"    : "u,user=s",
    	  "type"    : "t,type=s",
    	  "enc"     : "e,encoding=s",
    	  "verbose" : "v,verbose:i+",
    	  "leave"   : "l,leave"
     );

    sub usage()
    {
    	printf("usage: %s [options]
     -h,--help          this help text
     -u,--user=ARG      set username
     -p,--pass=ARG      set password
     -d,--db=ARG        set database name
     -e,--encoding=ARG  set database character set encoding (i.e. \"utf8\")
     -H,--host=ARG      set hostname (for MySQL and PostgreSQL connections)
     -t,--type          set database driver (default mysql)
     -v,--verbose       more v's = more information
     -l,--leave         leave test tables in schema at end\n",
    	   basename($ENV."_"));
    	exit();
    }

    const object_map =
     ( "oracle" :
       ( "tables" : ora_tables ),
       "mysql"  :
       ( "tables" : mysql_tables ),
       "pgsql"  :
       ( "tables" : pgsql_tables ),
       "sybase" :
       ( "tables" : syb_tables,
    	 "procs"  : sybase_procs ),
       "freetds"  :
       ( "tables" : freetds_sybase_tables,
    	 "procs"  : sybase_procs ) );

    const ora_tables = (
    	"family" : "create table family (
       family_id int not null,
       name varchar2(80) not null
    )",
    	"people" : "create table people (
       person_id int not null,
       family_id int not null,
       name varchar2(250) not null,
       dob date not null
    )",
    	"attributes" : "create table attributes (
       person_id int not null,
       attribute varchar2(80) not null,
       value varchar2(160) not null
    )" );

    const mysql_tables = (
    	"family" : "create table family (
       family_id int not null,
       name varchar(80) not null
    ) type = innodb",
    	"people" : "create table people (
       person_id int not null,
       family_id int not null,
       name varchar(250) not null,
       dob date not null
    ) type = innodb",
    	"attributes" : "create table attributes (
       person_id int not null,
       attribute varchar(80) not null,
       value varchar(160) not null
    ) type = innodb" );

    const pgsql_tables = (
    	"family" : "create table family (
       family_id int not null,
       name varchar(80) not null )",
    	"people" : "create table people (
       person_id int not null,
       family_id int not null,
       name varchar(250) not null,
       dob date not null )",
    	"attributes" : "create table attributes (
       person_id int not null,
       attribute varchar(80) not null,
       value varchar(160) not null)",
    	"data_test" : "create table data_test (
    		int2_f smallint not null,
    		int4_f integer not null,
    		int8_f int8 not null,
    		bool_f boolean not null,

    		float4_f real not null,
    		float8_f double precision not null,

    		number_f numeric(16,3) not null,
    		money_f money not null,

    		text_f text not null,
    		varchar_f varchar(40) not null,
    		char_f char(40) not null,
    		name_f name not null,

    		date_f date not null,
    		abstime_f abstime not null,
    		reltime_f reltime not null,
    		interval_f interval not null,
    		time_f time not null,
    		timetz_f time with time zone not null,
    		timestamp_f timestamp not null,
    		timestamptz_f timestamp with time zone not null,
    		tinterval_f tinterval not null,

    		bytea_f bytea not null
    		--bit_f bit(11) not null,
    		--varbit_f bit varying(11) not null
    )" );

    const syb_tables = (
    	"family" : "create table family (
       family_id int not null,
       name varchar(80) not null
    )",
    	"people" : "create table people (
       person_id int not null,
       family_id int not null,
       name varchar(250) not null,
       dob date not null
    )",
    	"attributes" : "create table attributes (
       person_id int not null,
       attribute varchar(80) not null,
       value varchar(160) not null
    )",
    	"data_test" : "create table data_test (
    	null_f char(1) null,

    	varchar_f varchar(40) not null,
    	char_f char(40) not null,
    	unichar_f unichar(40) not null,
    	univarchar_f univarchar(40) not null,
    	text_f text not null,
    	unitext_f unitext not null, -- note that unitext is stored as 'image'

    		bit_f bit not null,
    	tinyint_f tinyint not null,
    	smallint_f smallint not null,
    	int_f int not null,
    		int_f2 int not null,

    	decimal_f decimal(10,4) not null,

    	float_f float not null,     -- 8-bytes
    	real_f real not null,       -- 4-bytes
    	money_f money not null,
    	smallmoney_f smallmoney not null,

    	date_f date not null,
    	time_f time not null,
    	datetime_f datetime not null,
    	smalldatetime_f smalldatetime not null,

    	binary_f binary(4) not null,
    	varbinary_f varbinary(4) not null,
    	image_f image not null
    )" );

    const sybase_procs = (
    	"find_family" :
    "create procedure find_family @name varchar(80)
    as
    select * from family where name = @name
    commit -- to maintain transaction count
    ",
    	"get_values" :
    "create procedure get_values @string varchar(80) output, @int int output
    as
    select @string = 'hello there'
    select @int = 150
    commit -- to maintain transaction count
    ",
    	"get_values_and_select" :
    "create procedure get_values_and_select @string varchar(80) output, @int int output
    as
    select @string = 'hello there'
    select @int = 150
    select * from family where family_id = 1
    commit -- to maintain transaction count
    ",
    	"get_values_and_multiple_select" :
    "create procedure get_values_and_multiple_select @string varchar(80) output, @int int output
    as
    select @string = 'hello there'
    select @int = 150
    select * from family where family_id = 1
    select * from people where person_id = 1
    commit -- to maintain transaction count
    ",
    	"just_select" :
    "create procedure just_select
    as
    select * from family where family_id = 1
    commit -- to maintain transaction count
    ",
    	"multiple_select" :
    "create procedure multiple_select
    as
    select * from family where family_id = 1
    select * from people where person_id = 1
    commit -- to maintain transaction count
    "
     );

    const freetds_sybase_tables = (
    	"family" : "create table family (
       family_id int not null,
       name varchar(80) not null
    )",
    	"people" : "create table people (
       person_id int not null,
       family_id int not null,
       name varchar(250) not null,
       dob date not null
    )",
    	"attributes" : "create table attributes (
       person_id int not null,
       attribute varchar(80) not null,
       value varchar(160) not null
    )",
    	"data_test" : "create table data_test (
    	null_f char(1) null,

    	varchar_f varchar(40) not null,
    	char_f char(40) not null,
    	text_f text not null,
    	unitext_f unitext not null, -- note that unitext is stored as 'image'

    		bit_f bit not null,
    	tinyint_f tinyint not null,
    	smallint_f smallint not null,
    	int_f int not null,
    		int_f2 int not null,

    	decimal_f decimal(10,4) not null,

    	float_f float not null,     -- 8-bytes
    	real_f real not null,       -- 4-bytes
    	money_f money not null,
    	smallmoney_f smallmoney not null,

    	date_f date not null,
    	time_f time not null,
    	datetime_f datetime not null,
    	smalldatetime_f smalldatetime not null,

    	binary_f binary(4) not null,
    	varbinary_f varbinary(4) not null,
    	image_f image not null
    )" );

    const freetds_mssql_tables = (
    	"family" : "create table family (
       family_id int not null,
       name varchar(80) not null
    )",
    	"people" : "create table people (
       person_id int not null,
       family_id int not null,
       name varchar(250) not null,
       dob datetime not null
    )",
    	"attributes" : "create table attributes (
       person_id int not null,
       attribute varchar(80) not null,
       value varchar(160) not null
    )",
    	"data_test" : "create table data_test (
    	null_f char(1) null,

    	varchar_f varchar(40) not null,
    	char_f char(40) not null,
    	text_f text not null,

    		bit_f bit not null,
    	tinyint_f tinyint not null,
    	smallint_f smallint not null,
    	int_f int not null,
    		int_f2 int not null,

    	decimal_f decimal(10,4) not null,

    	float_f float not null,     -- 8-bytes
    	real_f real not null,       -- 4-bytes
    	money_f money not null,
    	smallmoney_f smallmoney not null,

    	datetime_f datetime not null,
    	smalldatetime_f smalldatetime not null,

    	binary_f binary(4) not null,
    	varbinary_f varbinary(4) not null,
    	image_f image not null
    )" );

    sub parse_command_line()
    {
    	my $g = new GetOpt(opts);
    	$o = $g.parse(\$ARGV);
    	if ($o.help)
    	usage();

    	if (!strlen($o.db))
    	{
    	stderr.printf("set the login parameters with -u,-p,-d, etc (-h for help)\n");
    	exit(1);
    	}
    	if (elements $ARGV)
    	{
    	stderr.printf("excess arguments on command-line (%n): -h for help\n", $ARGV);
    	exit(1);
    	}
    	if (!strlen($o.type))
    	$o.type = "mysql";
    }

    sub create_datamodel($db)
    {
    	drop_test_datamodel($db);

    	my $driver = $db.getDriverName();
    	# create tables
    	my $tables = object_map.$driver.tables;
    	if ($driver == "freetds")
    	if ($db.is_sybase)
    		$tables = freetds_sybase_tables;
    		else
    		$tables = freetds_mssql_tables;

    	foreach my $table in (keys $tables)
    	{
    	tprintf(2, "creating table %n\n", $table);
    	$db.exec($tables.$table);
    	}

    	# create procedures if any
    	foreach my $proc in (keys object_map.$driver.procs)
    	{
    	tprintf(2, "creating procedure %n\n", $proc);
    	$db.exec(object_map.$driver.procs.$proc);
    	}

    	# create functions if any
    	foreach my $func in (keys object_map.$driver.funcs)
    	{
    	tprintf(2, "creating function %n\n", $func);
    	$db.exec(object_map.$driver.funcs.$func);
    	}

    	$db.exec("insert into family values ( 1, 'Smith' )");
    	$db.exec("insert into family values ( 2, 'Jones' )");

    	# we insert the dates here using binding by value so we don't have
    	# to worry about each database's specific date format
    	$db.exec("insert into people values ( 1, 1, 'Arnie', %v)", 1983-05-13);
    	$db.exec("insert into people values ( 2, 1, 'Sylvia', %v)", 1994-11-10);
    	$db.exec("insert into people values ( 3, 1, 'Carol', %v)", 2003-07-23);
    	$db.exec("insert into people values ( 4, 1, 'Bernard', %v)", 1979-02-27);
    	$db.exec("insert into people values ( 5, 1, 'Isaac', %v)", 2000-04-04);
    	$db.exec("insert into people values ( 6, 2, 'Alan', %v)", 1992-06-04);
    	$db.exec("insert into people values ( 7, 2, 'John', %v)", 1995-03-23);

    	$db.exec("insert into attributes values ( 1, 'hair', 'blond' )");
    	$db.exec("insert into attributes values ( 1, 'eyes', 'hazel' )");
    	$db.exec("insert into attributes values ( 2, 'hair', 'blond' )");
    	$db.exec("insert into attributes values ( 2, 'eyes', 'blue' )");
    	$db.exec("insert into attributes values ( 3, 'hair', 'brown' )");
    	$db.exec("insert into attributes values ( 3, 'eyes', 'grey')");
    	$db.exec("insert into attributes values ( 4, 'hair', 'brown' )");
    	$db.exec("insert into attributes values ( 4, 'eyes', 'brown' )");
    	$db.exec("insert into attributes values ( 5, 'hair', 'red' )");
    	$db.exec("insert into attributes values ( 5, 'eyes', 'green' )");
    	$db.exec("insert into attributes values ( 6, 'hair', 'black' )");
    	$db.exec("insert into attributes values ( 6, 'eyes', 'blue' )");
    	$db.exec("insert into attributes values ( 7, 'hair', 'brown' )");
    	$db.exec("insert into attributes values ( 7, 'eyes', 'brown' )");
    	$db.commit();
    }

    sub drop_test_datamodel($db)
    {
    	my $driver = $db.getDriverName();
    	# drop the tables and ignore exceptions
    	# the commits are needed for databases like postgresql, where errors will prohibit and further
    	# actions from being taken on the Datasource
    	foreach my $table in (keys object_map.$driver.tables)
    	try {
    		$db.exec("drop table " + $table);
    		$db.commit();
    		tprintf(2, "dropped table %n\n", $table);
    	}
    		catch ()
    	{
    		$db.commit();
    	}

    	# drop procedures and ignore exceptions
    	foreach my $proc in (keys object_map.$driver.procs)
    	{
    	my $cmd = object_map.$driver.drop_proc_cmd;
    	if (!exists $cmd)
    		$cmd = "drop procedure";
    	try {
    		$db.exec($cmd + " " + $proc);
    		$db.commit();
    		tprintf(2, "dropped procedure %n\n", $proc);
    	}
    	catch ()
    	{
    		$db.commit();
    	}
    	}

    	# drop functions and ignore exceptions
    	foreach my $func in (keys object_map.$driver.funcs)
    	{
    	my $cmd = object_map.$driver.drop_func_cmd;
    	if (!exists $cmd)
    		$cmd = "drop function";
    	try {
    		$db.exec($cmd + " " + $func);
    		$db.commit();
    		tprintf(2, "dropped function %n\n", $func);
    	}
    	catch ()
    	{
    		$db.commit();
    	}
    	}
    }

    sub getDS()
    {
    	my $ds = new Datasource($o.type, $o.user, $o.pass, $o.db, $o.enc);
    	if (strlen($o.host))
    	$ds.setHostName($o.host);
    	return $ds;
    }

    sub tprintf($v, $msg)
    {
    	if ($v <= $o.verbose)
    	vprintf($msg, $argv);
    }

    sub test_value($v1, $v2, $msg)
    {
    	++$test_count;
    	if ($v1 == $v2)
    	tprintf(1, "OK: %s test\n", $msg);
    	else
    	{
    		tprintf(0, "ERROR: %s test failed! (%n != %n)\n", $msg, $v1, $v2);
    		$errors++;
    	}
    }

    const family_hash = (
      "Jones" : (
    	  "people" : (
    	  "John" : (
    		  "dob" : 1995-03-23,
    		  "eyes" : "brown",
    		  "hair" : "brown" ),
    	  "Alan" : (
    		  "dob" : 1992-06-04,
    		  "eyes" : "blue",
    		  "hair" : "black" ) ) ),
    	"Smith" : (
    	"people" : (
    		"Arnie" : (
    		"dob" : 1983-05-13,
    		"eyes" : "hazel",
    		"hair" : "blond" ),
    		"Carol" : (
    		"dob" : 2003-07-23,
    		"eyes" : "grey",
    		"hair" : "brown" ),
    		"Isaac" : (
    		"dob" : 2000-04-04,
    		"eyes" : "green",
    		"hair" : "red" ),
    		"Bernard" : (
    		"dob" : 1979-02-27,
    		"eyes" : "brown",
    		"hair" : "brown" ),
    		"Sylvia" : (
    		"dob" : 1994-11-10,
    		"eyes" : "blue",
    		"hair" : "blond" ) ) ) );

    sub context_test($db)
    {
    	# first we select all the data from the tables and then use
    	# context statements to order the output hierarchically

    	# context statements are most useful when a set of queries can be executed once
    	# and the results processed many times by creating "views" with context statements

    	my $people = $db.select("select * from people");
    	my $attributes = $db.select("select * from attributes");

    	my $today = format_date("YYYYMMDD", now());

    	# in this test, we create a big hash structure out of the queries executed above
    	# and compare it at the end to the expected result

    	# display each family sorted by family name
    	my $fl;
    	context family ($db.select("select * from family")) sortBy (%name)
    	{
    	my $pl;
    	tprintf(2, "Family %d: %s\n", %family_id, %name);

    	# display people, sorted by eye color, descending
    	context people ($people)
    		sortDescendingBy (find %value in $attributes
    				  where (%attribute == "eyes"
    					 && %person_id == %people:person_id))
    		where (%family_id == %family:family_id)
    	{
    		my $al;
    		tprintf(2, "  %s, born %s\n", %name, format_date("Month DD, YYYY", %dob));
    		context ($attributes) sortBy (%attribute) where (%person_id == %people:person_id)
    		{
    		$al.%attribute = %value;
    		tprintf(2, "    has %s %s\n", %value, %attribute);
    		}
    		# leave out the ID fields and name from hash under name; subtracting a
    		# string from a hash removes that key from the result
    		# this is "doing it the hard way", there is only one key left,
    		# "dob", then attributes are added directly into the person hash
    		$pl.%name = %% - "family_id" - "person_id" - "name" + $al;
    	}
    	# leave out family_id and name fields (leaving an empty hash)
    	$fl.%name = %% - "family_id" - "name" + ( "people" : $pl );
    	}

    	# test context ordering
    	test_value(keys $fl, ("Jones", "Smith"), "first context");
    	test_value(keys $fl.Smith.people, ("Arnie", "Carol", "Isaac", "Bernard", "Sylvia"), "second context");
    	# test entire context value
    	test_value($fl, family_hash, "third context");
    }

    sub test_timeout($db, $c)
    {
    	$db.setTransactionLockTimeout(1ms);
    	try {
    	# this should cause a TRANSACTION-LOCK-TIMEOUT exception to be thrown
    	$db.exec("insert into family values (3, 'Test')\n");
    	test_value(True, False, "transaction timeout");
    	$db.exec("delete from family where name = 'Test'");
    	}
    	catch ($ex)
    	{
    	test_value(True, True, "transaction timeout");
    	}
    	# signal parent thread to continue
    	$c.dec();
    }

    sub transaction_test($db)
    {
    	my $ndb = getDS();
    	my $r;
    	tprintf(2, "db.autocommit=%N, ndb.autocommit=%N\n", $db.getAutoCommit(), $ndb.getAutoCommit());

    	# first, we insert a new row into "family" but do not commit it
    	my $rows = $db.exec("insert into family values (3, 'Test')\n");
    	if ($rows !== 1)
    	printf("FAILED INSERT, rows=%N\n", $rows);

    	# now we verify that the new row is not visible to the other datasource
    	# unless it's a sybase/ms sql server datasource, in which case this would deadlock :-(
    	if ($o.type != "sybase" && $o.type != "freetds")
    	{
    	$r = $ndb.selectRow("select name from family where family_id = 3").name;
    	test_value($r, NOTHING, "first transaction");
    	}

    	# now we verify that the new row is visible to the inserting datasource
    	$r = $db.selectRow("select name from family where family_id = 3").name;
    	test_value($r, "Test", "second transaction");

    	# test datasource timeout
    	# this Counter variable will allow the parent thread to sleep
    	# until the child thread times out
    	my $c = new Counter(1);
    	background test_timeout($db, $c);

    	# wait for child thread to time out
    	$c.waitForZero();

    	# now, we commit the transaction
    	$db.commit();

    	# now we verify that the new row is visible in the other datasource
    	$r = $ndb.selectRow("select name from family where family_id = 3").name;
    	test_value($r, "Test", "third transaction");

    	# now we delete the row we inserted (so we can repeat the test)
    	$r = $ndb.exec("delete from family where family_id = 3");
    	test_value($r, 1, "delete row count");
    	$ndb.commit();
    }

    sub oracle_test()
    {
    }

    # here we use a little workaround for modules that provide functions,
    # namespace additions (constants, classes, etc) needed by test functions
    # at parse time.  To avoid parse errors (as database modules are loaded
    # in this script at run-time when the Datasource class is instantiated)
    # we use a Program object that we parse and run on demand to return the
    # value required
    sub get_val($code)
    {
    	my $p = new Program();

    	my $str = sprintf("return %s;", $code);
    	$p.parse($str, "code");
    	return $p.run();
    }

    sub pgsql_test($db)
    {
    	my $args = ( "int2_f"          : 258,
    		 "int4_f"          : 233932,
    		 "int8_f"          : 239392939458,
    		 "bool_f"          : True,
    		 "float4_f"        : 21.3444,
    		 "float8_f"        : 49394.23423491,
    		 "number_f"        : get_val("pgsql_bind(PG_TYPE_NUMERIC, '7235634215.3250')"),
    		 "money_f"         : get_val("pgsql_bind(PG_TYPE_CASH, \"400.56\")"),
    		 "text_f"          : 'some text  ',
    		 "varchar_f"       : 'varchar ',
    		 "char_f"          : 'char text',
    		 "name_f"          : 'name',
    		 "date_f"          : 2004-01-05,
    		 "abstime_f"       : 2005-12-03T10:00:01,
    		 "reltime_f"       : 5M + 71D + 19h + 245m + 51s,
    		 "interval_f"      : 6M + 3D + 2h + 45m + 15s,
    		 "time_f"          : 11:35:00,
    		 "timetz_f"        : get_val("pgsql_bind(PG_TYPE_TIMETZ, \"11:38:21 CST\")"),
    		 "timestamp_f"     : 2005-04-01T11:35:26,
    		 "timestamptz_f"   : 2005-04-01T11:35:26.259,
    		 "tinterval_f"     : get_val("pgsql_bind(PG_TYPE_TINTERVAL, '[\"May 10, 1947 23:59:12\" \"Jan 14, 1973 03:14:21\"]')"),
    		 "bytea_f"         : <bead>
    		 #bit_f             :
    		 #varbit_f          :
    	);

    	$db.vexec("insert into data_test values (%v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v)", hash_values($args));

    	my $q = $db.selectRow("select * from data_test");
    	if ($o.verbose > 1)
    	foreach my $k in (keys $q)
    		tprintf(2, " %-16s= %-10s %N\n", $k, type($q.$k), $q.$k);

    	# fix values where we know the return type is different
    	$args.money_f = 400.56;
    	$args.timetz_f = 11:38:21;
    	$args.tinterval_f = '["1947-05-10 21:59:12" "1973-01-14 02:14:21"]';
    	$args.number_f = "7235634215.3250";
    	$args.reltime_f = 19177551s;
    	$args.interval_f = 6M + 3D + 9915s;

    	# rounding errors can happen in float4
    	$q.float4_f = round($q.float4_f);
    	$args.float4_f = round($args.float4_f);

    	# remove values where we know they won't match
    	# abstime and timestamptz are converted to GMT by the server
    	delete $q.abstime_f;
    	delete $q.timestamptz_f;

    	# compare each value
    	foreach my $k in (keys $q)
    	test_value($q.$k, $args.$k, sprintf("%s bind and retrieve", $k));

    	$db.commit();
    }

    sub mysql_test()
    {
    }

    const family_q = ( "family_id" : 1,
    		   "name" : "Smith" );
    const person_q = ( "person_id" : 1,
    		   "family_id" : 1,
    		   "name" : "Arnie",
    		   "dob" : 1983-05-13 );
    const params = ( "string" : "hello there",
    		 "int" : 150 );

    sub sybase_test($db)
    {
    	# simple stored proc test, bind by name
    	my $x = $db.exec("exec find_family %v", "Smith");
    	test_value($x, ("name": list("Smith"), "family_id" : list(1)), "simple stored proc");

    	# stored proc execute with output params
    	$x = $db.exec("declare @string varchar(40), @int int
    exec get_values :string output, :int output");
    	test_value($x, params + ("rowcount":1), "get_values");

    	# we use Datasource::selectRows() in the following queries because we
    	# get hash results instead of a hash of lists as with exec in the queries
    	# normally we should not use selectRows to execute a stored procedure,
    	# as the Datasource::selectRows() method will not grab the transaction lock,
    	# but we already called Datasource::exec() above, so we have it already.
    	# the other alternative would be to call Datasource::beginTransaction() before
    	# Datasource::selectRows()

    	# simple stored proc test, bind by name, returns hash
    	$x = $db.selectRows("exec find_family %v", "Smith");
    	test_value($x, family_q, "simple stored proc");

    	# stored proc execute with output params and select results
    	$x = $db.selectRows("declare @string varchar(40), @int int
    exec get_values_and_select :string output, :int output");
    	test_value($x, ("query":family_q,"params":params), "get_values_and_select");

    	# stored proc execute with output params and multiple select results
    	$x = $db.selectRows("declare @string varchar(40), @int int
    exec get_values_and_multiple_select :string output, :int output");
    	test_value($x, ("query":("query0":family_q,"query1":person_q),"params":params), "get_values_and_multiple_select");

    	# stored proc execute with just select results
    	$x = $db.selectRows("exec just_select");
    	test_value($x, family_q, "just_select");

    	# stored proc execute with multiple select results
    	$x = $db.selectRows("exec multiple_select");
    	test_value($x, ("query0":family_q,"query1":person_q), "multiple_select");

    	my $args = ( "null_f"          : NULL,
    		 "varchar_f"       : "varchar",
    		 "char_f"          : "char",
    		 "unichar_f"       : "unichar",
    		 "univarchar_f"    : "univarchar",
    		 "text_f"          : "test",
    		 "unitext_f"       : "test",
    		 "bit_f"           : True,
    		 "tinyint_f"       : 55,
    		 "smallint_f"      : 4285,
    		 "int_f"           : 405402,
    		 "int_f2"          : 214123498,
    		 "decimal_f"       : 500.1231,
    		 "float_f"         : 23443.234324234,
    		 "real_f"          : 213.123,
    		 "money_f"         : 3434234250.2034,
    		 "smallmoney_f"    : 211100.1012,
    		 "date_f"          : 2007-05-01,
    			 "time_f"          : 10:30:01,
    		 "datetime_f"      : 3459-01-01T11:15:02.250,
    		 "smalldatetime_f" : 2007-12-01T12:01:00,
    		 "binary_f"        : <0badbeef>,
    		 "varbinary_f"     : <feedface>,
    		 "image_f"         : <cafebead> );

    	# insert data
    	my $rows = $db.vexec("insert into data_test values (%v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %d, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v, %v)", hash_values($args));

    	my $q = $db.selectRow("select * from data_test");
    	if ($o.verbose > 1)
    	foreach my $k in (keys $q)
    		tprintf(2, " %-16s= %-10s %N\n", $k, type($q.$k), $q.$k);

    	# remove values where we know they won't match
    	# unitext_f is returned as IMAGE by the server
    	delete $q.unitext_f;
    	delete $args.unitext_f;
    	# rounding errors can happen in real
    	$q.real_f = round($q.real_f);
    	$args.real_f = round($args.real_f);

    	# compare each value
    	foreach my $k in (keys $q)
    	test_value($q.$k, $args.$k, sprintf("%s bind and retrieve", $k));

    	$db.commit();
    }

    sub freetds_test($db)
    {
    	# simple stored proc test, bind by name
    	my $x = $db.exec("exec find_family %v", "Smith");
    	test_value($x, ("name": list("Smith"), "family_id" : list(1)), "simple stored proc");

    	# we cannot retrieve parameters from newer SQL Servers with the approach we use;
    	# Microsoft changed the handling of the protocol and require us to use RPC calls,
    	# this will be implemented in the next version of qore where the "freetds" driver will
    	# be able to add custom methods to the Datasource class.  For now, we skip these tests

    	if ($db.is_sybase)
    	{
    	$x = $db.exec("declare @string varchar(40), @int int
    exec get_values :string output, :int output");
    	test_value($x, params, "get_values");
    	}

    	# we use Datasource::selectRows() in the following queries because we
    	# get hash results instead of a hash of lists as with exec in the queries
    	# normally we should not use selectRows to execute a stored procedure,
    	# as the Datasource::selectRows() method will not grab the transaction lock,
    	# but we already called Datasource::exec() above, so we have it already.
    	# the other alternative would be to call Datasource::beginTransaction() before
    	# Datasource::selectRows()

    	# simple stored proc test, bind by name, returns hash
    	$x = $db.selectRows("exec find_family %v", "Smith");
    	test_value($x, family_q, "simple stored proc");

    	# stored proc execute with output params and select results
    	if ($db.is_sybase)
    	{
    	$x = $db.selectRows("declare @string varchar(40), @int int
    exec get_values_and_select :string output, :int output");
    	test_value($x, ("query":family_q,"params":params), "get_values_and_select");

    	# stored proc execute with output params and multiple select results
    	$x = $db.selectRows("declare @string varchar(40), @int int
    exec get_values_and_multiple_select :string output, :int output");
    	test_value($x, ("query":("query0":family_q,"query1":person_q),"params":params), "get_values_and_multiple_select");
    	}

    	# stored proc execute with just select results
    	$x = $db.selectRows("exec just_select");
    	test_value($x, family_q, "just_select");

    	# stored proc execute with multiple select results
    	$x = $db.selectRows("exec multiple_select");
    	test_value($x, ("query0":family_q,"query1":person_q), "multiple_select");

    	# the freetds driver does not work with the following sybase column types:
    	# unichar, univarchar

    	my $args = ( "null_f"          : NULL,
    		 "varchar_f"       : "test",
    		 "char_f"          : "test",
    		 "text_f"          : "test",
    		 "unitext_f"       : "test",
    		 "bit_f"           : True,
    		 "tinyint_f"       : 55,
    		 "smallint_f"      : 4285,
    		 "int_f"           : 405402,
    		 "int_f2"          : 214123498,
    		 "decimal_f"       : 500.1231,
    		 "float_f"         : 23443.234324234,
    		 "real_f"          : 213.123,
    		 "money_f"         : 3434234250.2034,
    		 "smallmoney_f"    : 211100.1012,
    		 "date_f"          : 2007-05-01,
    			 "time_f"          : 10:30:01,
    		 "datetime_f"      : 3459-01-01T11:15:02.250,
    		 "smalldatetime_f" : 2007-12-01T12:01:00,
    		 "binary_f"        : <0badbeef>,
    		 "varbinary_f"     : <feedface>,
    		 "image_f"         : <cafebead> );

    	# remove fields not supported by sql server
    	if (!$db.is_sybase)
    	{
    	delete $args.unitext_f;
    	delete $args.date_f;
    	delete $args.time_f;
    	}

    	my $sql = "insert into data_test values (";
    	for (my $i; $i < elements $args; ++$i)
    	$sql += "%v, ";
    	$sql = substr($sql, 0, -2) + ")";

    	# insert data, using the values from the hash above
    	my $rows = $db.vexec($sql, hash_values($args));

    	my $q = $db.selectRow("select * from data_test");
    	if ($o.verbose > 1)
    	foreach my $k in (keys $q)
    		tprintf(2, " %-16s= %-10s %N\n", $k, type($q.$k), $q.$k);

    	# remove values where we know they won't match
    	# unitext_f is returned as IMAGE by the server
    	delete $q.unitext_f;
    	delete $args.unitext_f;
    	# rounding errors can happen in real
    	$q.real_f = round($q.real_f);
    	$args.real_f = round($args.real_f);

    	# compare each value
    	foreach my $k in (keys $q)
    	test_value($q.$k, $args.$k, sprintf("%s bind and retrieve", $k));

    	$db.commit();
    }

    sub main()
    {
    	my $test_map =
    	( "sybase" : \sybase_test(),
    	  "freetds"  : \freetds_test(),
    	  "mysql"  : \mysql_test(),
    	  "pgsql"  : \pgsql_test(),
    	  "oracle" : \oracle_test());

    	parse_command_line();
    	my $db = getDS();

    	my $driver = $db.getDriverName();
    	printf("testing %s driver\n", $driver);
    	my $sv = $db.getServerVersion();
    	if ($o.verbose > 1)
    	tprintf(2, "client version=%n\nserver version=%n\n", $db.getClientVersion(), $sv);

    	# determine if the server is a sybase or sql server dataserver
    	if ($driver == "freetds")
    	if ($sv !~ /microsoft/i)
    		$db.is_sybase = True;

    	create_datamodel($db);

    	context_test($db);
    	transaction_test($db);
    	my $test = $test_map.($db.getDriverName());
    	if (exists $test)
    	$test($db);

    	if (!$o.leave)
    	drop_test_datamodel($db);
    	printf("%d/%d tests OK\n", $test_count - $errors, $test_count);
    }

    main();