1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%
22
23-module(odbc_query_SUITE).
24
25%% Note: This directive should only be used in test suites.
26-compile(export_all).
27
28-include_lib("common_test/include/ct.hrl").
29-include("odbc_test.hrl").
30
31%%--------------------------------------------------------------------
32%% all(Arg) -> [Doc] | [Case] | {skip, Comment}
33%% Arg - doc | suite
34%% Doc - string()
35%% Case - atom()
36%%	Name of a test case function.
37%% Comment - string()
38%% Description: Returns documentation/test cases in this test suite
39%%		or a skip tuple if the platform is not supported.
40%%--------------------------------------------------------------------
41suite() -> [{ct_hooks,[ts_install_cth]}].
42
43all() ->
44    case odbc_test_lib:odbc_check() of
45	ok ->
46	    [stored_proc, sql_query, next, {group, scrollable_cursors}, select_count,
47	     select_next, select_relative, select_absolute,
48	     create_table_twice, delete_table_twice, duplicate_key,
49	     not_connection_owner, no_result_set, query_error,
50	     {group, multiple_result_sets},
51	     {group, parameterized_queries}, {group, describe_table},
52	     delete_nonexisting_row];
53	Other -> {skip, Other}
54    end.
55
56groups() ->
57    [{multiple_result_sets, [], [multiple_select_result_sets,
58                                 multiple_mix_result_sets,
59                                 multiple_result_sets_error]},
60     {scrollable_cursors, [],  [first, last, prev]},
61     {parameterized_queries, [],
62      [{group, param_integers}, param_insert_decimal,
63       param_insert_numeric, {group, param_insert_string},
64       param_insert_float, param_insert_real,
65       param_insert_double, param_insert_mix, param_update,
66       param_delete, param_select,
67       param_select_empty_params, param_delete_empty_params]},
68     {param_integers, [],
69      [param_insert_tiny_int, param_insert_small_int,
70       param_insert_int, param_insert_integer]},
71     {param_insert_string, [],
72      [param_insert_char, param_insert_character,
73       param_insert_char_varying,
74       param_insert_character_varying]},
75     {describe_table, [],
76      [describe_integer, describe_string, describe_floating,
77       describe_dec_num, describe_no_such_table]}].
78
79init_per_group(multiple_result_sets, Config) ->
80    case is_supported_multiple_resultsets(?RDBMS) of
81	true ->
82	    Config;
83	false ->
84	    {skip, "Not supported by " ++ atom_to_list(?RDBMS) ++ "driver"}
85    end;
86init_per_group(scrollable_cursors, Config) ->
87    case proplists:get_value(scrollable_cursors, odbc_test_lib:platform_options()) of
88	off ->
89	    {skip, "Not supported by driver"};
90	_ ->
91	    Config
92    end;
93
94init_per_group(_,Config) ->
95    Config.
96
97end_per_group(_GroupName, Config) ->
98    Config.
99
100%%--------------------------------------------------------------------
101%% Function: init_per_suite(Config) -> Config
102%% Config - [tuple()]
103%%   A list of key/value pairs, holding the test case configuration.
104%% Description: Initiation before the whole suite
105%%
106%% Note: This function is free to add any key/value pairs to the Config
107%% variable, but should NOT alter/remove any existing entries.
108%%--------------------------------------------------------------------
109init_per_suite(Config) when is_list(Config) ->
110    case odbc_test_lib:skip() of
111	true ->
112	    {skip, "ODBC not supported"};
113	false ->
114	    case (catch odbc:start()) of
115		ok ->
116		    ct:timetrap(?default_timeout),
117		    [{tableName, odbc_test_lib:unique_table_name()}| Config];
118		_ ->
119		    {skip, "ODBC not startable"}
120	    end
121    end.
122
123%%--------------------------------------------------------------------
124%% Function: end_per_suite(Config) -> _
125%% Config - [tuple()]
126%%   A list of key/value pairs, holding the test case configuration.
127%% Description: Cleanup after the whole suite
128%%--------------------------------------------------------------------
129end_per_suite(_Config) ->
130    application:stop(odbc),
131    ok.
132
133%%--------------------------------------------------------------------
134%% Function: init_per_testcase(Case, Config) -> Config
135%% Case - atom()
136%%   Name of the test case that is about to be run.
137%% Config - [tuple()]
138%%   A list of key/value pairs, holding the test case configuration.
139%%
140%% Description: Initiation before each test case
141%%
142%% Note: This function is free to add any key/value pairs to the Config
143%% variable, but should NOT alter/remove any existing entries.
144%%--------------------------------------------------------------------
145init_per_testcase(_Case, Config) ->
146    {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()),
147    odbc_test_lib:strict(Ref, ?RDBMS),
148
149    NewConfig = lists:keydelete(connection_ref, 1, Config),
150
151    [{connection_ref, Ref} | NewConfig].
152
153%%--------------------------------------------------------------------
154%% Function: end_per_testcase(Case, Config) -> _
155%% Case - atom()
156%%   Name of the test case that is about to be run.
157%% Config - [tuple()]
158%%   A list of key/value pairs, holding the test case configuration.
159%% Description: Cleanup after each test case
160%%--------------------------------------------------------------------
161end_per_testcase(_Case, Config) ->
162    Ref = proplists:get_value(connection_ref, Config),
163    ok = odbc:disconnect(Ref),
164    %% Clean up if needed
165    Table = proplists:get_value(tableName, Config),
166    {ok, NewRef} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()),
167    odbc:sql_query(NewRef, "DROP TABLE " ++ Table),
168    odbc:disconnect(NewRef).
169
170%%-------------------------------------------------------------------------
171%% Test cases starts here.
172%%-------------------------------------------------------------------------
173stored_proc()->
174    [{doc, "Test stored proc with OUT param"}].
175stored_proc(Config) when is_list(Config) ->
176    case ?RDBMS of
177        X when X == oracle; X == postgres->
178            Ref = proplists:get_value(connection_ref, Config),
179            {updated, _} =
180                odbc:sql_query(Ref,
181                               ?RDBMS:stored_proc_integer_out()),
182            Result = ?RDBMS:query_result(),
183            Result =
184                ?RDBMS:param_query(Ref),
185            {updated, _} =
186                odbc:sql_query(Ref, ?RDBMS:drop_proc()),
187            ok;
188        _ ->
189	    {skip, "stored proc not yet supported"}
190    end.
191
192sql_query()->
193    [{doc, "Test the common cases"}].
194sql_query(Config) when is_list(Config) ->
195    Ref = proplists:get_value(connection_ref, Config),
196    Table = proplists:get_value(tableName, Config),
197
198    {updated, _} =
199	odbc:sql_query(Ref,
200		       "CREATE TABLE " ++ Table ++
201		       " (ID integer, DATA varchar(10))"),
202
203    {updated, Count} =
204	odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'bar')"),
205
206    true = odbc_test_lib:check_row_count(1, Count),
207
208    InsertResult = ?RDBMS:insert_result(),
209    InsertResult =
210	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
211
212    {updated, NewCount} =
213	odbc:sql_query(Ref, "UPDATE " ++ Table ++
214		       " SET DATA = 'foo' WHERE ID = 1"),
215
216    true = odbc_test_lib:check_row_count(1, NewCount),
217
218    UpdateResult = ?RDBMS:update_result(),
219    UpdateResult =
220	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
221
222    {updated,  NewCount1} = odbc:sql_query(Ref, "DELETE FROM " ++ Table ++
223				  " WHERE ID = 1"),
224
225    true = odbc_test_lib:check_row_count(1, NewCount1),
226
227    {selected, Fields, []} =
228	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
229
230    ["ID","DATA"] = odbc_test_lib:to_upper(Fields),
231    ok.
232
233%%-------------------------------------------------------------------------
234select_count() ->
235    [{doc, "Tests select_count/[2,3]'s timeout, "
236	   " select_count's functionality will be better tested by other tests "
237      " such as first."}].
238select_count(sute) -> [];
239select_count(Config) when is_list(Config) ->
240    Ref = proplists:get_value(connection_ref, Config),
241    Table = proplists:get_value(tableName, Config),
242
243    {updated, _} = odbc:sql_query(Ref,
244				  "CREATE TABLE " ++ Table ++
245				  " (ID integer)"),
246
247    {updated, Count} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
248				  " VALUES(1)"),
249    true = odbc_test_lib:check_row_count(1, Count),
250    {ok, _} =
251	odbc:select_count(Ref, "SELECT * FROM " ++ Table, ?TIMEOUT),
252    {'EXIT', {function_clause, _}} =
253	(catch odbc:select_count(Ref, "SELECT * FROM ", -1)),
254    ok.
255%%-------------------------------------------------------------------------
256first() ->
257    [doc, {"Tests first/[1,2]"}].
258first(Config) when is_list(Config) ->
259    Ref = proplists:get_value(connection_ref, Config),
260    Table = proplists:get_value(tableName, Config),
261
262    {updated, _} = odbc:sql_query(Ref,
263				  "CREATE TABLE " ++ Table ++
264				  " (ID integer)"),
265
266    {updated, Count} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
267				  " VALUES(1)"),
268    true = odbc_test_lib:check_row_count(1, Count),
269    {updated, NewCount} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
270				  " VALUES(2)"),
271    true = odbc_test_lib:check_row_count(1, NewCount),
272    {ok, _} = odbc:select_count(Ref, "SELECT * FROM " ++ Table),
273
274
275    FirstResult = ?RDBMS:selected_ID(1, first),
276    FirstResult = odbc:first(Ref),
277    FirstResult = odbc:first(Ref, ?TIMEOUT),
278    {'EXIT', {function_clause, _}} = (catch odbc:first(Ref, -1)),
279    ok.
280
281%%-------------------------------------------------------------------------
282last() ->
283    [{doc, "Tests last/[1,2]"}].
284last(Config) when is_list(Config) ->
285    Ref = proplists:get_value(connection_ref, Config),
286    Table = proplists:get_value(tableName, Config),
287
288    {updated, _} = odbc:sql_query(Ref,
289				  "CREATE TABLE " ++ Table ++
290				  " (ID integer)"),
291
292    {updated, Count} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
293				  " VALUES(1)"),
294    true = odbc_test_lib:check_row_count(1, Count),
295    {updated, NewCount} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
296				  " VALUES(2)"),
297    true = odbc_test_lib:check_row_count(1, NewCount),
298    {ok, _} = odbc:select_count(Ref, "SELECT * FROM " ++ Table),
299
300    LastResult = ?RDBMS:selected_ID(2, last),
301    LastResult = odbc:last(Ref),
302
303    LastResult = odbc:last(Ref, ?TIMEOUT),
304    {'EXIT', {function_clause, _}} = (catch odbc:last(Ref, -1)),
305    ok.
306
307%%-------------------------------------------------------------------------
308next() ->
309    [{doc, "Tests next/[1,2]"}].
310next(Config) when is_list(Config) ->
311    Ref = proplists:get_value(connection_ref, Config),
312    Table = proplists:get_value(tableName, Config),
313
314    {updated, _} = odbc:sql_query(Ref,
315				  "CREATE TABLE " ++ Table ++
316				  " (ID integer)"),
317
318    {updated, Count} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
319				  " VALUES(1)"),
320    true = odbc_test_lib:check_row_count(1, Count),
321    {updated, NewCount} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
322				  " VALUES(2)"),
323    true = odbc_test_lib:check_row_count(1, NewCount),
324    {ok, _} = odbc:select_count(Ref, "SELECT * FROM " ++ Table),
325
326    NextResult = ?RDBMS:selected_ID(1, next),
327    NextResult = odbc:next(Ref),
328    NextResult2 = ?RDBMS:selected_ID(2, next),
329    NextResult2 = odbc:next(Ref, ?TIMEOUT),
330    {'EXIT', {function_clause, _}} = (catch odbc:next(Ref, -1)),
331    ok.
332%%-------------------------------------------------------------------------
333prev() ->
334    [{doc, "Tests prev/[1,2]"}].
335prev(Config) when is_list(Config) ->
336    Ref = proplists:get_value(connection_ref, Config),
337    Table = proplists:get_value(tableName, Config),
338
339    {updated, _} = odbc:sql_query(Ref,
340				  "CREATE TABLE " ++ Table ++
341				  " (ID integer)"),
342
343    {updated, Count} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
344				  " VALUES(1)"),
345    true = odbc_test_lib:check_row_count(1, Count),
346    {updated, NewCount} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
347				  " VALUES(2)"),
348    true = odbc_test_lib:check_row_count(1, NewCount),
349
350    {ok, _} = odbc:select_count(Ref, "SELECT * FROM " ++ Table),
351
352    odbc:last(Ref), % Position cursor last so there will be a prev
353    PrevResult = ?RDBMS:selected_ID(1, prev),
354    PrevResult = odbc:prev(Ref),
355
356    odbc:last(Ref), % Position cursor last so there will be a prev
357    PrevResult = odbc:prev(Ref, ?TIMEOUT),
358    {'EXIT', {function_clause, _}} = (catch odbc:prev(Ref, -1)),
359    ok.
360%%-------------------------------------------------------------------------
361select_next() ->
362    [{doc, "Tests select/[4,5] with CursorRelation = next "}].
363select_next(suit) -> [];
364select_next(Config) when is_list(Config) ->
365    Ref = proplists:get_value(connection_ref, Config),
366    Table = proplists:get_value(tableName, Config),
367
368    {updated, _} = odbc:sql_query(Ref,
369				  "CREATE TABLE " ++ Table ++
370				  " (ID integer)"),
371
372    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
373				  " VALUES(1)"),
374    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
375				  " VALUES(2)"),
376    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
377				  " VALUES(3)"),
378    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
379				  " VALUES(4)"),
380    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
381				  " VALUES(5)"),
382
383    {ok, _} = odbc:select_count(Ref, "SELECT * FROM " ++ Table),
384
385    SelectResult1 = ?RDBMS:selected_next_N(1),
386    SelectResult1 = odbc:select(Ref, next, 3),
387
388    %% Test that selecting stops at the end of the result set
389    SelectResult2 = ?RDBMS:selected_next_N(2),
390    SelectResult2 = odbc:select(Ref, next, 3, ?TIMEOUT),
391    {'EXIT',{function_clause, _}} =
392	(catch odbc:select(Ref, next, 2, -1)),
393
394    %% If you try fetching data beyond the the end of result set,
395    %% you get an empty list.
396    {selected, Fields, []} = odbc:select(Ref, next, 1),
397
398    ["ID"] = odbc_test_lib:to_upper(Fields),
399    ok.
400
401%%-------------------------------------------------------------------------
402select_relative() ->
403    [{doc, "Tests select/[4,5] with CursorRelation = relative "}].
404select_relative(suit) -> [];
405select_relative(Config) when is_list(Config) ->
406    Ref = proplists:get_value(connection_ref, Config),
407    Table = proplists:get_value(tableName, Config),
408
409    {updated, _} = odbc:sql_query(Ref,
410				  "CREATE TABLE " ++ Table ++
411				  " (ID integer)"),
412
413    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
414				  " VALUES(1)"),
415    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
416				  " VALUES(2)"),
417    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
418				  " VALUES(3)"),
419    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
420				  " VALUES(4)"),
421    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
422				  " VALUES(5)"),
423    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
424				  " VALUES(6)"),
425    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
426				  " VALUES(7)"),
427    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
428				  " VALUES(8)"),
429
430    {ok, _} = odbc:select_count(Ref, "SELECT * FROM " ++ Table),
431
432    SelectResult1 = ?RDBMS:selected_relative_N(1),
433    SelectResult1 = odbc:select(Ref, {relative, 2}, 3),
434
435    %% Test that selecting stops at the end of the result set
436    SelectResult2 = ?RDBMS:selected_relative_N(2),
437    SelectResult2 = odbc:select(Ref, {relative, 3}, 3, ?TIMEOUT),
438    {'EXIT',{function_clause, _}} =
439	(catch odbc:select(Ref, {relative, 3} , 2, -1)),
440    ok.
441
442%%-------------------------------------------------------------------------
443select_absolute() ->
444    [{doc, "Tests select/[4,5] with CursorRelation = absolute "}].
445select_absolute(suit) -> [];
446select_absolute(Config) when is_list(Config) ->
447    Ref = proplists:get_value(connection_ref, Config),
448    Table = proplists:get_value(tableName, Config),
449
450    {updated, _} = odbc:sql_query(Ref,
451				  "CREATE TABLE " ++ Table ++
452				  " (ID integer)"),
453
454    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
455				  " VALUES(1)"),
456    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
457				  " VALUES(2)"),
458    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
459				  " VALUES(3)"),
460    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
461				  " VALUES(4)"),
462    {updated, 1} = odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
463				  " VALUES(5)"),
464    {ok, _} = odbc:select_count(Ref, "SELECT * FROM " ++ Table),
465
466    SelectResult1 = ?RDBMS:selected_absolute_N(1),
467    SelectResult1 = odbc:select(Ref, {absolute, 1}, 3),
468
469    %% Test that selecting stops at the end of the result set
470    SelectResult2 = ?RDBMS:selected_absolute_N(2),
471    SelectResult2 = odbc:select(Ref, {absolute, 1}, 6, ?TIMEOUT),
472    {'EXIT',{function_clause, _}} =
473	(catch odbc:select(Ref, {absolute, 1}, 2, -1)),
474    ok.
475
476%%-------------------------------------------------------------------------
477create_table_twice() ->
478    [{doc, "Test what happens if you try to create the same table twice."}].
479create_table_twice(Config) when is_list(Config) ->
480    Ref = proplists:get_value(connection_ref, Config),
481    Table = proplists:get_value(tableName, Config),
482
483    {updated, _} =
484	odbc:sql_query(Ref,
485		       "CREATE TABLE " ++ Table ++
486		       " (ID integer, DATA varchar(10))"),
487    {error, Error} =
488	odbc:sql_query(Ref,
489		       "CREATE TABLE " ++ Table ++
490		       " (ID integer, DATA varchar(10))"),
491    is_driver_error(Error),
492    ok.
493
494%%-------------------------------------------------------------------------
495delete_table_twice() ->
496    [{doc, "Test what happens if you try to delete the same table twice."}].
497delete_table_twice(Config) when is_list(Config) ->
498    Ref = proplists:get_value(connection_ref, Config),
499    Table = proplists:get_value(tableName, Config),
500
501    {updated, _} =
502	odbc:sql_query(Ref,
503		       "CREATE TABLE " ++ Table ++
504		       " (ID integer, DATA varchar(10))"),
505    {updated, _} = odbc:sql_query(Ref, "DROP TABLE " ++ Table),
506    {error, Error} = odbc:sql_query(Ref, "DROP TABLE " ++ Table),
507    is_driver_error(Error),
508    ok.
509
510%-------------------------------------------------------------------------
511duplicate_key() ->
512    [{doc, "Test what happens if you try to use the same key twice"}].
513duplicate_key(suit) -> [];
514duplicate_key(Config) when is_list(Config) ->
515    Ref = proplists:get_value(connection_ref, Config),
516    Table = proplists:get_value(tableName, Config),
517
518    {updated, _} =
519	odbc:sql_query(Ref,
520		       "CREATE TABLE " ++ Table ++
521		       " (ID integer, DATA char(10), PRIMARY KEY(ID))"),
522
523    {updated, 1} =
524	odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'bar')"),
525
526    {error, Error} =
527	odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'foo')"),
528    is_driver_error(Error),
529    ok.
530
531%%-------------------------------------------------------------------------
532not_connection_owner() ->
533    [{doc, "Test what happens if a process that did not start the connection"
534	   " tries to acess it."}].
535not_connection_owner(Config) when is_list(Config) ->
536    Ref = proplists:get_value(connection_ref, Config),
537    Table = proplists:get_value(tableName, Config),
538
539    spawn_link(?MODULE, not_owner, [self(), Ref, Table]),
540
541    receive
542	continue ->
543	    ok
544    end.
545
546not_owner(Pid, Ref, Table) ->
547    {error, process_not_owner_of_odbc_connection} =
548	odbc:sql_query(Ref, "CREATE TABLE " ++ Table ++ " (ID integer)"),
549
550    {error, process_not_owner_of_odbc_connection} =
551	odbc:disconnect(Ref),
552
553    Pid ! continue.
554
555%%-------------------------------------------------------------------------
556no_result_set() ->
557    [{doc, "Tests what happens if you try to use a function that needs an "
558      "associated result set when there is none."}].
559no_result_set(Config) when is_list(Config) ->
560    Ref = proplists:get_value(connection_ref, Config),
561
562    {error, result_set_does_not_exist} = odbc:first(Ref),
563    {error, result_set_does_not_exist} = odbc:last(Ref),
564    {error, result_set_does_not_exist} = odbc:next(Ref),
565    {error, result_set_does_not_exist} = odbc:prev(Ref),
566    {error, result_set_does_not_exist} = odbc:select(Ref, next, 1),
567    {error, result_set_does_not_exist} =
568	odbc:select(Ref, {absolute, 2}, 1),
569    {error, result_set_does_not_exist} =
570	odbc:select(Ref, {relative, 2}, 1),
571    ok.
572%%-------------------------------------------------------------------------
573query_error() ->
574    [{doc, "Test what happens if there is an error in the query."}].
575query_error(Config) when is_list(Config) ->
576    Ref = proplists:get_value(connection_ref, Config),
577    Table = proplists:get_value(tableName, Config),
578
579    {updated, _} =
580	odbc:sql_query(Ref,
581		       "CREATE TABLE " ++ Table ++
582		       " (ID integer, DATA char(10), PRIMARY KEY(ID))"),
583    {updated, 1} =
584	odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'bar')"),
585
586    {error, _} =
587	odbc:sql_query(Ref, "INSERT INTO " ++ Table ++ " VALUES(1,'bar')"),
588
589    {error, _} =
590	odbc:sql_query(Ref, "INSERT ONTO " ++ Table ++ " VALUES(1,'bar')"),
591    ok.
592
593%%-------------------------------------------------------------------------
594multiple_select_result_sets() ->
595    [{doc, "Test what happens if you have a batch of select queries."}].
596multiple_select_result_sets(Config) when is_list(Config) ->
597    case ?RDBMS of
598	sqlserver ->
599	    Ref = proplists:get_value(connection_ref, Config),
600	    Table = proplists:get_value(tableName, Config),
601
602	    {updated, _} =
603		odbc:sql_query(Ref,
604			       "CREATE TABLE " ++ Table ++
605			       " (ID integer, DATA varchar(10), "
606			       "PRIMARY KEY(ID))"),
607	    {updated, 1} =
608		odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
609			       " VALUES(1,'bar')"),
610
611	    {updated, 1} =
612		odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
613			       " VALUES(2, 'foo')"),
614
615	    MultipleResult = ?RDBMS:multiple_select(),
616
617	    MultipleResult =
618		odbc:sql_query(Ref, "SELECT * FROM " ++ Table ++
619			       "; SELECT DATA FROM "++ Table ++
620			       " WHERE ID=2"),
621	    ok;
622	_ ->
623	    {skip, "multiple result_set not supported"}
624    end.
625
626%%-------------------------------------------------------------------------
627multiple_mix_result_sets() ->
628    [{doc, "Test what happens if you have a batch of select and other type of"
629      " queries."}].
630multiple_mix_result_sets(Config) when is_list(Config) ->
631    case ?RDBMS of
632	sqlserver ->
633	    Ref = proplists:get_value(connection_ref, Config),
634	    Table = proplists:get_value(tableName, Config),
635
636	    {updated, _} =
637		odbc:sql_query(Ref,
638			       "CREATE TABLE " ++ Table ++
639			       " (ID integer, DATA varchar(10), "
640			       "PRIMARY KEY(ID))"),
641	    {updated, 1} =
642		odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
643			       " VALUES(1,'bar')"),
644
645	    MultipleResult = ?RDBMS:multiple_mix(),
646
647	    MultipleResult =
648		odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
649			       " VALUES(2,'foo'); UPDATE " ++ Table ++
650			       " SET DATA = 'foobar' WHERE ID =1;SELECT "
651			       "* FROM "
652			       ++ Table ++ ";DELETE FROM " ++ Table ++
653			       " WHERE ID =1; SELECT DATA FROM " ++ Table),
654	    ok;
655	_ ->
656	    {skip, "multiple result_set not supported"}
657    end.
658%%-------------------------------------------------------------------------
659multiple_result_sets_error() ->
660    [{doc, "Test what happens if one of the batched queries fails."}].
661multiple_result_sets_error(Config) when is_list(Config) ->
662    case ?RDBMS of
663	sqlserver ->
664	    Ref = proplists:get_value(connection_ref, Config),
665	    Table = proplists:get_value(tableName, Config),
666
667	    {updated, _} =
668		odbc:sql_query(Ref,
669			       "CREATE TABLE " ++ Table ++
670			       " (ID integer, DATA varchar(10), "
671			       "PRIMARY KEY(ID))"),
672	    {updated, 1} =
673		odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
674			       " VALUES(1,'bar')"),
675
676	    {error, Error} =
677		odbc:sql_query(Ref, "INSERT INTO " ++ Table ++
678			       " VALUES(1,'foo'); SELECT * FROM " ++ Table),
679	    is_driver_error(Error),
680
681	    {error, NewError} =
682		odbc:sql_query(Ref, "SELECT * FROM "
683			       ++ Table ++ ";INSERT INTO " ++ Table ++
684		       " VALUES(1,'foo')"),
685	    is_driver_error(NewError),
686	    ok;
687	_ ->
688	    {skip, "multiple result_set not supported"}
689    end.
690
691%%-------------------------------------------------------------------------
692param_insert_tiny_int()->
693    [{doc,"Test insertion of tiny ints by parameterized queries."}].
694param_insert_tiny_int(Config) when is_list(Config) ->
695    case ?RDBMS of
696	sqlserver ->
697	    Ref = proplists:get_value(connection_ref, Config),
698	    Table = proplists:get_value(tableName, Config),
699
700	    {updated, _} =
701		odbc:sql_query(Ref,
702			       "CREATE TABLE " ++ Table ++
703			       " (FIELD TINYINT)"),
704
705	    {updated, Count} =
706		odbc:param_query(Ref, "INSERT INTO " ++ Table ++
707				 "(FIELD) VALUES(?)",
708				 [{sql_tinyint, [1, 2]}],
709				 ?TIMEOUT),%Make sure to test timeout clause
710
711	    true = odbc_test_lib:check_row_count(2, Count),
712
713	    InsertResult = ?RDBMS:param_select_tiny_int(),
714
715	    InsertResult =
716		odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
717
718	    {'EXIT',{badarg,odbc,param_query,'Params'}} =
719		(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
720				"(FIELD) VALUES(?)",
721					[{sql_tinyint, [1, "2"]}])),
722	    ok;
723	_  ->
724	    {skip, "Type tiniyint not supported"}
725    end.
726%%-------------------------------------------------------------------------
727param_insert_small_int()->
728    [{doc,"Test insertion of small ints by parameterized queries."}].
729param_insert_small_int(Config) when is_list(Config) ->
730    Ref = proplists:get_value(connection_ref, Config),
731    Table = proplists:get_value(tableName, Config),
732
733    {updated, _} =
734	odbc:sql_query(Ref,
735		       "CREATE TABLE " ++ Table ++
736		       " (FIELD SMALLINT)"),
737
738    {updated, Count} =
739	odbc:param_query(Ref, "INSERT INTO " ++ Table ++
740			 "(FIELD) VALUES(?)", [{sql_smallint, [1, 2]}],
741			 ?TIMEOUT), %% Make sure to test timeout clause
742
743    true = odbc_test_lib:check_row_count(2, Count),
744
745    InsertResult = ?RDBMS:param_select_small_int(),
746
747    InsertResult =
748	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
749
750    {'EXIT',{badarg,odbc,param_query,'Params'}} =
751	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
752				"(FIELD) VALUES(?)",
753				[{sql_smallint, [1, "2"]}])),
754    ok.
755
756%%-------------------------------------------------------------------------
757param_insert_int()->
758    [{doc,"Test insertion of ints by parameterized queries."}].
759param_insert_int(Config) when is_list(Config) ->
760    Ref = proplists:get_value(connection_ref, Config),
761    Table = proplists:get_value(tableName, Config),
762
763    {updated, _} =
764	odbc:sql_query(Ref,
765		       "CREATE TABLE " ++ Table ++
766		       " (FIELD INT)"),
767
768    Int = ?RDBMS:small_int_max() + 1,
769
770    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
771				   "(FIELD) VALUES(?)",
772				   [{sql_integer, [1, Int]}]),
773    true = odbc_test_lib:check_row_count(2, Count),
774
775    InsertResult = ?RDBMS:param_select_int(),
776
777    InsertResult =
778	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
779
780    {'EXIT',{badarg,odbc,param_query,'Params'}} =
781	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
782				"(FIELD) VALUES(?)",
783				[{sql_integer, [1, "2"]}])),
784    ok.
785
786%%-------------------------------------------------------------------------
787param_insert_integer()->
788    [{doc,"Test insertion of integers by parameterized queries."}].
789param_insert_integer(Config) when is_list(Config) ->
790    Ref = proplists:get_value(connection_ref, Config),
791    Table = proplists:get_value(tableName, Config),
792
793    {updated, _} =
794	odbc:sql_query(Ref,
795		       "CREATE TABLE " ++ Table ++
796		       " (FIELD INTEGER)"),
797
798    Int = ?RDBMS:small_int_max() + 1,
799
800    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
801				    "(FIELD) VALUES(?)",
802				    [{sql_integer, [1, Int]}]),
803    true = odbc_test_lib:check_row_count(2, Count),
804
805    InsertResult = ?RDBMS:param_select_int(),
806
807    InsertResult =
808	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
809
810    {'EXIT',{badarg,odbc,param_query,'Params'}} =
811	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
812				"(FIELD) VALUES(?)",
813				[{sql_integer, [1, 2.3]}])),
814    ok.
815
816%%-------------------------------------------------------------------------
817param_insert_decimal()->
818    [{doc,"Test insertion of decimal numbers by parameterized queries."}].
819param_insert_decimal(Config) when is_list(Config) ->
820    Ref = proplists:get_value(connection_ref, Config),
821    Table = proplists:get_value(tableName, Config),
822
823    {updated, _} =
824	odbc:sql_query(Ref,
825		       "CREATE TABLE " ++ Table ++
826		       " (FIELD DECIMAL (3,0))"),
827
828    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
829				    "(FIELD) VALUES(?)",
830				    [{{sql_decimal, 3, 0}, [1, 2]}]),
831    true = odbc_test_lib:check_row_count(2, Count),
832
833    InsertResult = ?RDBMS:param_select_decimal(),
834
835    InsertResult =
836	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
837
838    {'EXIT',{badarg,odbc,param_query,'Params'}} =
839	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
840				"(FIELD) VALUES(?)",
841				[{{sql_decimal, 3, 0}, [1, "2"]}])),
842
843
844    odbc:sql_query(Ref, "DROP TABLE " ++ Table),
845
846    {updated, _} =
847	odbc:sql_query(Ref,
848		       "CREATE TABLE " ++ Table ++
849		       " (FIELD DECIMAL (3,1))"),
850
851    {updated, NewCount} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
852					   "(FIELD) VALUES(?)",
853				    [{{sql_decimal, 3, 1}, [0.25]}]),
854    true = odbc_test_lib:check_row_count(1, NewCount),
855
856    {selected, Fields, [{Value}]} =
857	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
858
859    ["FIELD"] = odbc_test_lib:to_upper(Fields),
860
861    odbc_test_lib:match_float(Value, 0.3, 0.01),
862
863    ok.
864
865%%-------------------------------------------------------------------------
866param_insert_numeric()->
867    [{doc,"Test insertion of numeric numbers by parameterized queries."}].
868param_insert_numeric(Config) when is_list(Config) ->
869    Ref = proplists:get_value(connection_ref, Config),
870    Table = proplists:get_value(tableName, Config),
871
872    {updated, _} =
873	odbc:sql_query(Ref,
874		       "CREATE TABLE " ++ Table ++
875		       " (FIELD NUMERIC (3,0))"),
876
877    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
878				   "(FIELD) VALUES(?)",
879				   [{{sql_numeric,3,0}, [1, 2]}]),
880
881    true = odbc_test_lib:check_row_count(2, Count),
882
883    InsertResult = ?RDBMS:param_select_numeric(),
884
885    InsertResult =
886	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
887
888    {'EXIT',{badarg,odbc,param_query,'Params'}} =
889	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
890				"(FIELD) VALUES(?)",
891				[{{sql_decimal, 3, 0}, [1, "2"]}])),
892
893    odbc:sql_query(Ref, "DROP TABLE " ++ Table),
894
895    {updated, _} =
896	odbc:sql_query(Ref,
897		       "CREATE TABLE " ++ Table ++
898		       " (FIELD NUMERIC (3,1))"),
899
900    {updated, NewCount} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
901				    "(FIELD) VALUES(?)",
902				    [{{sql_numeric, 3, 1}, [0.25]}]),
903
904    true = odbc_test_lib:check_row_count(1, NewCount),
905
906    {selected, Fileds, [{Value}]} =
907	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
908
909    ["FIELD"] = odbc_test_lib:to_upper(Fileds),
910
911    odbc_test_lib:match_float(Value, 0.3, 0.01),
912    ok.
913
914%%-------------------------------------------------------------------------
915param_insert_char()->
916    [{doc,"Test insertion of fixed length string by parameterized queries."}].
917param_insert_char(Config) when is_list(Config) ->
918    Ref = proplists:get_value(connection_ref, Config),
919    Table = proplists:get_value(tableName, Config),
920
921    {updated, _} =
922	odbc:sql_query(Ref,
923		       "CREATE TABLE " ++ Table ++
924		       " (FIELD CHAR (10))"),
925
926    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
927				   "(FIELD) VALUES(?)",
928				   [{{sql_char, 10},
929				     ["foofoofoof", "0123456789"]}]),
930    true = odbc_test_lib:check_row_count(2, Count),
931
932    {selected,Fileds,[{"foofoofoof"}, {"0123456789"}]} =
933	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
934
935    ["FIELD"] = odbc_test_lib:to_upper(Fileds),
936
937    {error, _} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
938				  "(FIELD) VALUES(?)",
939				  [{{sql_char, 10},
940				    ["foo", "01234567890"]}]),
941
942    {'EXIT',{badarg,odbc,param_query,'Params'}} =
943	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
944				"(FIELD) VALUES(?)",
945				[{{sql_char, 10}, ["1", 2.3]}])),
946    ok.
947
948%%-------------------------------------------------------------------------
949param_insert_character()->
950    [{doc,"Test insertion of fixed length string by parameterized queries."}].
951param_insert_character(Config) when is_list(Config) ->
952    Ref = proplists:get_value(connection_ref, Config),
953    Table = proplists:get_value(tableName, Config),
954
955    {updated, _} =
956	odbc:sql_query(Ref,
957		       "CREATE TABLE " ++ Table ++
958		       " (FIELD CHARACTER (10))"),
959
960    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
961				   "(FIELD) VALUES(?)",
962				   [{{sql_char, 10},
963				     ["foofoofoof", "0123456789"]}]),
964
965    true = odbc_test_lib:check_row_count(2, Count),
966
967    {selected, Fileds, [{"foofoofoof"}, {"0123456789"}]} =
968	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
969
970    ["FIELD"] = odbc_test_lib:to_upper(Fileds),
971
972    {error, _} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
973				  "(FIELD) VALUES(?)",
974				  [{{sql_char, 10},
975				    ["foo", "01234567890"]}]),
976
977    {'EXIT',{badarg,odbc,param_query,'Params'}} =
978	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
979				"(FIELD) VALUES(?)",
980				[{{sql_char, 10}, ["1", 2]}])),
981    ok.
982
983%%------------------------------------------------------------------------
984param_insert_char_varying()->
985    [{doc,"Test insertion of variable length strings by parameterized queries."}].
986param_insert_char_varying(Config) when is_list(Config) ->
987    Ref = proplists:get_value(connection_ref, Config),
988    Table = proplists:get_value(tableName, Config),
989
990    {updated, _} =
991	odbc:sql_query(Ref,
992		       "CREATE TABLE " ++ Table ++
993		       " (FIELD CHAR VARYING(10))"),
994
995    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
996				   "(FIELD) VALUES(?)",
997				   [{{sql_varchar, 10},
998				     ["foo", "0123456789"]}]),
999
1000    true = odbc_test_lib:check_row_count(2, Count),
1001
1002    {selected, Fileds, [{"foo"}, {"0123456789"}]} =
1003	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
1004
1005    ["FIELD"] = odbc_test_lib:to_upper(Fileds),
1006
1007    {error, _} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1008				  "(FIELD) VALUES(?)",
1009				  [{{sql_varchar, 10},
1010				    ["foo", "01234567890"]}]),
1011
1012    {'EXIT',{badarg,odbc,param_query,'Params'}} =
1013	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1014				"(FIELD) VALUES(?)",
1015				[{{sql_varchar, 10}, ["1", 2.3]}])),
1016    ok.
1017
1018%%-------------------------------------------------------------------------
1019param_insert_character_varying()->
1020    [{doc,"Test insertion of variable length strings by parameterized queries."}].
1021param_insert_character_varying(Config) when is_list(Config) ->
1022    Ref = proplists:get_value(connection_ref, Config),
1023    Table = proplists:get_value(tableName, Config),
1024
1025    {updated, _} =
1026	odbc:sql_query(Ref,
1027		       "CREATE TABLE " ++ Table ++
1028		       " (FIELD CHARACTER VARYING(10))"),
1029
1030
1031    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1032				   "(FIELD) VALUES(?)",
1033				   [{{sql_varchar, 10},
1034				     ["foo", "0123456789"]}]),
1035
1036    true = odbc_test_lib:check_row_count(2, Count),
1037
1038    {selected, Fileds, [{"foo"}, {"0123456789"}]} =
1039	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
1040
1041    ["FIELD"] = odbc_test_lib:to_upper(Fileds),
1042
1043    {error, _} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1044				  "(FIELD) VALUES(?)",
1045				  [{{sql_varchar, 10},
1046				    ["foo", "01234567890"]}]),
1047
1048    {'EXIT',{badarg,odbc,param_query,'Params'}} =
1049	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1050				"(FIELD) VALUES(?)",
1051				[{{sql_varchar, 10}, ["1", 2]}])),
1052    ok.
1053%%-------------------------------------------------------------------------
1054param_insert_float()->
1055    [{doc,"Test insertion of floats by parameterized queries."}].
1056param_insert_float(Config) when is_list(Config) ->
1057    Ref = proplists:get_value(connection_ref, Config),
1058    Table = proplists:get_value(tableName, Config),
1059
1060    {updated, _} =
1061	odbc:sql_query(Ref,
1062		       "CREATE TABLE " ++ Table ++
1063		       " (FIELD FLOAT(5))"),
1064
1065    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1066				    "(FIELD) VALUES(?)",
1067				    [{{sql_float,5}, [1.3, 1.2]}]),
1068
1069    true = odbc_test_lib:check_row_count(2, Count),
1070
1071    {selected, Fileds, [{Float1},{Float2}]} =
1072	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
1073
1074    ["FIELD"] = odbc_test_lib:to_upper(Fileds),
1075
1076    case (odbc_test_lib:match_float(Float1, 1.3, 0.000001) and
1077	  odbc_test_lib:match_float(Float2, 1.2, 0.000001)) of
1078	true ->
1079	    ok;
1080	false ->
1081	    ct:fail(float_numbers_do_not_match)
1082    end,
1083
1084    {'EXIT',{badarg,odbc,param_query,'Params'}} =
1085	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1086				"(FIELD) VALUES(?)",
1087				[{{sql_float, 5}, [1.0, "2"]}])),
1088    ok.
1089
1090%%-------------------------------------------------------------------------
1091param_insert_real()->
1092    [{doc,"Test insertion of real numbers by parameterized queries."}].
1093param_insert_real(Config) when is_list(Config) ->
1094    Ref = proplists:get_value(connection_ref, Config),
1095    Table = proplists:get_value(tableName, Config),
1096
1097    {updated, _} =
1098	odbc:sql_query(Ref,
1099		       "CREATE TABLE " ++ Table ++
1100		       " (FIELD REAL)"),
1101
1102    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1103				   "(FIELD) VALUES(?)",
1104				   [{sql_real, [1.3, 1.2]}]),
1105
1106    true = odbc_test_lib:check_row_count(2, Count),
1107
1108    %_InsertResult = ?RDBMS:param_select_real(),
1109
1110    {selected, Fileds, [{Real1},{Real2}]} =
1111	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
1112
1113    ["FIELD"] = odbc_test_lib:to_upper(Fileds),
1114
1115    case (odbc_test_lib:match_float(Real1, 1.3, 0.000001) and
1116	  odbc_test_lib:match_float(Real2, 1.2, 0.000001)) of
1117	true ->
1118	    ok;
1119	false ->
1120	    ct:fail(real_numbers_do_not_match)
1121    end,
1122
1123    {'EXIT',{badarg,odbc,param_query,'Params'}} =
1124	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1125				"(FIELD) VALUES(?)",
1126				[{sql_real,[1.0, "2"]}])),
1127    ok.
1128
1129%%-------------------------------------------------------------------------
1130param_insert_double()->
1131    [{doc,"Test insertion of doubles by parameterized queries."}].
1132param_insert_double(Config) when is_list(Config) ->
1133    Ref = proplists:get_value(connection_ref, Config),
1134    Table = proplists:get_value(tableName, Config),
1135
1136    {updated, _} =
1137	odbc:sql_query(Ref,
1138		       "CREATE TABLE " ++ Table ++
1139		       " (FIELD DOUBLE PRECISION)"),
1140
1141    {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1142				   "(FIELD) VALUES(?)",
1143				   [{sql_double, [1.3, 1.2]}]),
1144
1145    true = odbc_test_lib:check_row_count(2, Count),
1146
1147    {selected, Fileds, [{Double1},{Double2}]} =
1148	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
1149
1150    ["FIELD"] = odbc_test_lib:to_upper(Fileds),
1151
1152    case (odbc_test_lib:match_float(Double1, 1.3, 0.000001) and
1153	  odbc_test_lib:match_float(Double2, 1.2, 0.000001)) of
1154	true ->
1155	    ok;
1156	false ->
1157	    ct:fail(double_numbers_do_not_match)
1158    end,
1159
1160    {'EXIT',{badarg,odbc,param_query,'Params'}} =
1161	(catch odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1162				"(FIELD) VALUES(?)",
1163				[{sql_double, [1.0, "2"]}])),
1164    ok.
1165
1166%%-------------------------------------------------------------------------
1167param_insert_mix()->
1168    [{doc,"Test insertion of a mixture of datatypes by parameterized queries."}].
1169param_insert_mix(Config) when is_list(Config) ->
1170    Ref = proplists:get_value(connection_ref, Config),
1171    Table = proplists:get_value(tableName, Config),
1172
1173    {updated, _} =
1174	odbc:sql_query(Ref,
1175		       "CREATE TABLE " ++ Table ++
1176		       " (ID INTEGER, DATA CHARACTER VARYING(10),"
1177		       " PRIMARY KEY(ID))"),
1178
1179    {updated, Count}  = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1180				    "(ID, DATA) VALUES(?, ?)",
1181				    [{sql_integer, [1, 2]},
1182				     {{sql_varchar, 10}, ["foo", "bar"]}]),
1183
1184    true = odbc_test_lib:check_row_count(2, Count),
1185
1186    InsertResult = ?RDBMS:param_select_mix(),
1187
1188    InsertResult =
1189	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
1190    ok.
1191%%-------------------------------------------------------------------------
1192param_update()->
1193    [{doc,"Test parameterized update query."}].
1194param_update(Config) when is_list(Config) ->
1195    Ref = proplists:get_value(connection_ref, Config),
1196    Table = proplists:get_value(tableName, Config),
1197
1198    {updated, _} =
1199	odbc:sql_query(Ref,
1200		       "CREATE TABLE " ++ Table ++
1201		       " (ID INTEGER, DATA CHARACTER VARYING(10),"
1202		       " PRIMARY KEY(ID))"),
1203
1204    {updated, Count}  = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1205				    "(ID, DATA) VALUES(?, ?)",
1206				    [{sql_integer, [1, 2, 3]},
1207				     {{sql_varchar, 10},
1208				      ["foo", "bar", "baz"]}]),
1209
1210    true = odbc_test_lib:check_row_count(3, Count),
1211
1212    {updated, NewCount}  = odbc:param_query(Ref, "UPDATE " ++ Table ++
1213				    " SET DATA = 'foobar' WHERE ID = ?",
1214				    [{sql_integer, [1, 2]}]),
1215
1216     true = odbc_test_lib:check_row_count(2, NewCount),
1217
1218    UpdateResult = ?RDBMS:param_update(),
1219
1220    UpdateResult =
1221	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
1222    ok.
1223
1224%%-------------------------------------------------------------------------
1225delete_nonexisting_row() ->		% OTP-5759
1226    [{doc, "Make a delete...where with false conditions (0 rows deleted). ",
1227     "This used to give an error message (see ticket OTP-5759)."}].
1228delete_nonexisting_row(Config) when is_list(Config) ->
1229    Ref = proplists:get_value(connection_ref, Config),
1230    Table = proplists:get_value(tableName, Config),
1231
1232    {updated, _} =
1233	odbc:sql_query(Ref, "CREATE TABLE " ++ Table
1234		       ++ " (ID INTEGER, DATA CHARACTER VARYING(10))"),
1235    {updated, Count} =
1236	odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1237			 "(ID, DATA) VALUES(?, ?)",
1238			 [{sql_integer, [1, 2, 3]},
1239			  {{sql_varchar, 10}, ["foo", "bar", "baz"]}]),
1240
1241    true = odbc_test_lib:check_row_count(3, Count),
1242
1243    {updated, NewCount} =
1244	odbc:sql_query(Ref, "DELETE FROM " ++ Table ++ " WHERE ID = 8"),
1245
1246    true = odbc_test_lib:check_row_count(0, NewCount),
1247
1248    {updated, _} =
1249	odbc:sql_query(Ref, "DROP TABLE "++ Table),
1250
1251    ok.
1252
1253%%-------------------------------------------------------------------------
1254param_delete() ->
1255    [{doc,"Test parameterized delete query."}].
1256param_delete(Config) when is_list(Config) ->
1257    Ref = proplists:get_value(connection_ref, Config),
1258    Table = proplists:get_value(tableName, Config),
1259
1260    {updated, _} =
1261	odbc:sql_query(Ref,
1262		       "CREATE TABLE " ++ Table ++
1263		       " (ID INTEGER, DATA CHARACTER VARYING(10),"
1264		       " PRIMARY KEY(ID))"),
1265
1266    {updated, Count}  = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1267				    "(ID, DATA) VALUES(?, ?)",
1268				    [{sql_integer, [1, 2, 3]},
1269				     {{sql_varchar, 10},
1270				      ["foo", "bar", "baz"]}]),
1271    true = odbc_test_lib:check_row_count(3, Count),
1272
1273    {updated, NewCount}  = odbc:param_query(Ref, "DELETE FROM " ++ Table ++
1274				    " WHERE ID = ?",
1275				    [{sql_integer, [1, 2]}]),
1276
1277    true = odbc_test_lib:check_row_count(2, NewCount),
1278
1279    UpdateResult = ?RDBMS:param_delete(),
1280
1281    UpdateResult =
1282	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
1283    ok.
1284
1285
1286%%-------------------------------------------------------------------------
1287param_select() ->
1288    [{doc,"Test parameterized select query."}].
1289param_select(Config) when is_list(Config) ->
1290    Ref = proplists:get_value(connection_ref, Config),
1291    Table = proplists:get_value(tableName, Config),
1292
1293    {updated, _} =
1294	odbc:sql_query(Ref,
1295		       "CREATE TABLE " ++ Table ++
1296		       " (ID INTEGER, DATA CHARACTER VARYING(10),"
1297		       " PRIMARY KEY(ID))"),
1298
1299    {updated, Count}  = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1300				    "(ID, DATA) VALUES(?, ?)",
1301				    [{sql_integer, [1, 2, 3]},
1302				     {{sql_varchar, 10},
1303				      ["foo", "bar", "foo"]}]),
1304
1305    true = odbc_test_lib:check_row_count(3, Count),
1306
1307    SelectResult = ?RDBMS:param_select(),
1308
1309    SelectResult = odbc:param_query(Ref, "SELECT * FROM " ++ Table ++
1310				    " WHERE DATA = ?",
1311				    [{{sql_varchar, 10}, ["foo"]}]),
1312    ok.
1313
1314%%-------------------------------------------------------------------------
1315param_select_empty_params() ->
1316    [{doc,"Test parameterized select query with no parameters."}].
1317param_select_empty_params(Config) when is_list(Config) ->
1318    Ref = proplists:get_value(connection_ref, Config),
1319    Table = proplists:get_value(tableName, Config),
1320
1321    {updated, _} =
1322	odbc:sql_query(Ref,
1323		       "CREATE TABLE " ++ Table ++
1324		       " (ID INTEGER, DATA CHARACTER VARYING(10),"
1325		       " PRIMARY KEY(ID))"),
1326
1327    {updated, Count}  = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1328				    "(ID, DATA) VALUES(?, ?)",
1329				    [{sql_integer, [1, 2, 3]},
1330				     {{sql_varchar, 10},
1331				      ["foo", "bar", "foo"]}]),
1332
1333    true = odbc_test_lib:check_row_count(3, Count),
1334
1335    SelectResult = ?RDBMS:param_select(),
1336
1337    SelectResult = odbc:param_query(Ref, "SELECT * FROM " ++ Table ++
1338				    " WHERE DATA = \'foo\'",
1339				    []),
1340    ok.
1341
1342%%-------------------------------------------------------------------------
1343param_delete_empty_params() ->
1344    [{doc,"Test parameterized delete query with no parameters."}].
1345param_delete_empty_params(Config) when is_list(Config) ->
1346    Ref = proplists:get_value(connection_ref, Config),
1347    Table = proplists:get_value(tableName, Config),
1348
1349    {updated, _} =
1350	odbc:sql_query(Ref,
1351		       "CREATE TABLE " ++ Table ++
1352		       " (ID INTEGER, DATA CHARACTER VARYING(10),"
1353		       " PRIMARY KEY(ID))"),
1354
1355    {updated, Count}  = odbc:param_query(Ref, "INSERT INTO " ++ Table ++
1356				    "(ID, DATA) VALUES(?, ?)",
1357				    [{sql_integer, [1, 2, 3]},
1358				     {{sql_varchar, 10},
1359				      ["foo", "bar", "baz"]}]),
1360    true = odbc_test_lib:check_row_count(3, Count),
1361
1362    {updated, NewCount}  = odbc:param_query(Ref, "DELETE FROM " ++ Table ++
1363				    " WHERE ID = 1 OR ID = 2",
1364				    []),
1365
1366    true = odbc_test_lib:check_row_count(2, NewCount),
1367
1368    UpdateResult = ?RDBMS:param_delete(),
1369
1370    UpdateResult =
1371	odbc:sql_query(Ref, "SELECT * FROM " ++ Table),
1372    ok.
1373
1374%%-------------------------------------------------------------------------
1375describe_integer() ->
1376    [{doc,"Test describe_table/[2,3] for integer columns."}].
1377describe_integer(Config) when is_list(Config) ->
1378    Ref = proplists:get_value(connection_ref, Config),
1379    Table = proplists:get_value(tableName, Config),
1380
1381    {updated, _} =
1382	odbc:sql_query(Ref,
1383		       "CREATE TABLE " ++ Table ++
1384		       " (myint1 SMALLINT, myint2 INT, myint3 INTEGER)"),
1385
1386    Decs = ?RDBMS:describe_integer(),
1387    %% Make sure to test timeout clause
1388    Decs = odbc:describe_table(Ref, Table, ?TIMEOUT),
1389    ok.
1390
1391%%-------------------------------------------------------------------------
1392describe_string() ->
1393    [{doc,"Test describe_table/[2,3] for string columns."}].
1394describe_string(Config) when is_list(Config) ->
1395    Ref = proplists:get_value(connection_ref, Config),
1396    Table = proplists:get_value(tableName, Config),
1397
1398    {updated, _} =
1399	odbc:sql_query(Ref,
1400		       "CREATE TABLE " ++ Table ++
1401		       " (str1 char(10), str2 character(10), "
1402		       "str3 CHAR VARYING(10), str4 "
1403		       "CHARACTER VARYING(10))"),
1404
1405    Decs = ?RDBMS:describe_string(),
1406
1407    Decs = odbc:describe_table(Ref, Table),
1408    ok.
1409
1410%%-------------------------------------------------------------------------
1411describe_floating() ->
1412    [{doc,"Test describe_table/[2,3] for floting columns."}].
1413describe_floating(Config) when is_list(Config) ->
1414    Ref = proplists:get_value(connection_ref, Config),
1415    Table = proplists:get_value(tableName, Config),
1416
1417    {updated, _} =
1418	odbc:sql_query(Ref,
1419		       "CREATE TABLE " ++ Table ++
1420		       " (f FLOAT(5), r REAL, "
1421		       "d DOUBLE PRECISION)"),
1422
1423    Decs = ?RDBMS:describe_floating(),
1424
1425    Decs = odbc:describe_table(Ref, Table),
1426    ok.
1427
1428%%-------------------------------------------------------------------------
1429describe_dec_num() ->
1430    [{doc,"Test describe_table/[2,3] for decimal and numerical columns"}].
1431describe_dec_num(Config) when is_list(Config) ->
1432
1433    Ref = proplists:get_value(connection_ref, Config),
1434    Table = proplists:get_value(tableName, Config),
1435
1436    {updated, _} =
1437	odbc:sql_query(Ref,
1438		       "CREATE TABLE " ++ Table ++
1439		       " (mydec DECIMAL(9,3), mynum NUMERIC(9,2))"),
1440
1441    Decs = ?RDBMS:describe_dec_num(),
1442
1443    Decs = odbc:describe_table(Ref, Table),
1444    ok.
1445
1446
1447%%-------------------------------------------------------------------------
1448describe_timestamp() ->
1449    [{doc,"Test describe_table/[2,3] for tinmestap columns"}].
1450describe_timestamp(Config) when is_list(Config) ->
1451
1452    Ref = proplists:get_value(connection_ref, Config),
1453    Table = proplists:get_value(tableName, Config),
1454
1455    {updated, _} =  % Value == 0 || -1 driver dependent!
1456	odbc:sql_query(Ref,  "CREATE TABLE " ++ Table ++
1457		       ?RDBMS:create_timestamp_table()),
1458
1459    Decs = ?RDBMS:describe_timestamp(),
1460
1461    Decs = odbc:describe_table(Ref, Table),
1462    ok.
1463
1464%%-------------------------------------------------------------------------
1465describe_no_such_table() ->
1466    [{doc,"Test what happens if you try to describe a table that does not exist."}].
1467describe_no_such_table(Config) when is_list(Config) ->
1468
1469    Ref = proplists:get_value(connection_ref, Config),
1470    Table = proplists:get_value(tableName, Config),
1471
1472    {error, _ } = odbc:describe_table(Ref, Table),
1473    ok.
1474
1475%%-------------------------------------------------------------------------
1476%% Internal functions
1477%%-------------------------------------------------------------------------
1478
1479is_driver_error(Error) ->
1480    case is_list(Error) of
1481	true ->
1482	    ct:pal("Driver error ~p~n", [Error]),
1483	    ok;
1484	false ->
1485	    ct:fail(Error)
1486    end.
1487is_supported_multiple_resultsets(sqlserver) ->
1488    true;
1489is_supported_multiple_resultsets(_) ->
1490    false.
1491