/src-extra/tests/Database/HsSqlPpp/Tests/junk/ExtensionTests.lhs
Haskell | 178 lines | 175 code | 3 blank | 0 comment | 11 complexity | 3d54011529b800187a93e07bb973b6ae MD5 | raw file
Possible License(s): BSD-3-Clause
1 2 3Set of tests for the old chaosextensions, in the process of being 4replaced 5 6> module Database.HsSqlPpp.Tests.ExtensionTests (extensionTests) where 7> 8> import Test.HUnit 9> import Test.Framework 10> import Test.Framework.Providers.HUnit 11> --import Debug.Trace 12> 13> import Database.HsSqlPpp.Parser 14> import Database.HsSqlPpp.Annotation 15> import ChaosExtensions 16> import Database.HsSqlPpp.Ast 17> --import Database.HsSqlPpp.PrettyPrinter.PrettyPrinter 18> 19> extensionTests :: Test.Framework.Test 20> extensionTests = 21> testGroup "extensionTests" (mapCheckExtension [ 22> t rewriteCreateVars 23> "select create_var('varname','vartype');" 24> "create table varname_table (\n\ 25> \ varname vartype);\n\ 26> \create function get_varname() returns vartype as $a$\n\ 27> \ select * from varname_table;\n\ 28> \$a$ language sql stable;\n\ 29> \create function check_con_varname_table_varname_key() returns boolean as $a$\n\ 30> \begin\n\ 31> \ return true;\n\ 32> \end;\n\ 33> \$a$ language plpgsql stable;\n\ 34> \/*drop function if exists varname_table_constraint_trigger_operator();\n\ 35> \create function varname_table_constraint_trigger_operator() returns trigger as $a$\n\ 36> \begin\n\ 37> \ null;\n\ 38> \end;\n\ 39> \$a$ language plpgsql;*/\n\ 40> \create function check_con_varname_table_01_tuple() returns boolean as $a$\n\ 41> \begin\n\ 42> \ return true;\n\ 43> \end;\n\ 44> \$a$ language plpgsql stable;\n\ 45> \drop function if exists varname_table_constraint_trigger_operator();\n\ 46> \create function varname_table_constraint_trigger_operator() returns trigger as $a$\n\ 47> \begin\n\ 48> \ null;\n\ 49> \end;\n\ 50> \$a$ language plpgsql;" 51> 52> ,t addReadonlyTriggers 53> "select set_relvar_type('stuff','readonly');" 54> "create function check_stuff_d_readonly() returns trigger as $a$\n\ 55> \begin\n\ 56> \ if (not (false)) then\n\ 57> \ raise exception 'delete on base_relvar_metadata violates transition constraint base_relvar_metadata_d_readonly';\n\ 58> \ end if;\n\ 59> \return null;\n\ 60> \end;\n\ 61> \$a$ language plpgsql volatile;\n\ 62> \create function check_stuff_i_readonly() returns trigger as $a$\n\ 63> \begin\n\ 64> \ if (not (false)) then\n\ 65> \ raise exception 'delete on base_relvar_metadata violates transition constraint base_relvar_metadata_d_readonly';\n\ 66> \ end if;\n\ 67> \ return null;\n\ 68> \end;\n\ 69> \$a$ language plpgsql volatile;\n\ 70> \create function check_stuff_u_readonly() returns trigger as $a$\n\ 71> \begin\n\ 72> \ if (not (false)) then\n\ 73> \ raise exception 'delete on base_relvar_metadata violates transition constraint base_relvar_metadata_d_readonly';\n\ 74> \ end if;\n\ 75> \ return null;\n\ 76> \end;\n\ 77> \$a$ language plpgsql volatile;" 78> 79> ,t createClientActionWrapper 80> "select create_client_action_wrapper('actname', $$actcall()$$);" 81> "create function action_actname() returns void as $a$\n\ 82> \begin\n\ 83> \ perform action_actcall();\n\ 84> \end;\n\ 85> \$a$ language plpgsql;" 86> ,t createClientActionWrapper 87> "select create_client_action_wrapper('actname', $$actcall('test')$$);" 88> "create function action_actname() returns void as $a$\n\ 89> \begin\n\ 90> \ perform action_actcall('test');\n\ 91> \end;\n\ 92> \$a$ language plpgsql;" 93> ,t addNotifyTriggers 94> "select set_relvar_type('stuff','data');" 95> "create function stuff_changed() returns trigger as $a$\n\ 96> \begin\n\ 97> \ notify stuff;\n\ 98> \ return null;\n\ 99> \end;\n\ 100> \$a$ language plpgsql;" 101> ,t addConstraint 102> "select add_constraint('name', 'true', array['t1', 't2']);" 103> "create function check_con_name() returns boolean as $a$\n\ 104> \begin\n\ 105> \ return true;\n\ 106> \end;\n\ 107> \$a$ language plpgsql stable;\n\ 108> \drop function if exists t1_constraint_trigger_operator();\n\ 109> \create function t1_constraint_trigger_operator() returns trigger as $a$\n\ 110> \begin\n\ 111> \ null;\n\ 112> \end;\n\ 113> \$a$ language plpgsql;\n\ 114> \drop function if exists t2_constraint_trigger_operator();\n\ 115> \create function t2_constraint_trigger_operator() returns trigger as $a$\n\ 116> \begin\n\ 117> \ null;\n\ 118> \end;\n\ 119> \$a$ language plpgsql;" 120> ,t addKey 121> "select add_key('tbl', 'attr');" 122> "create function check_con_tbl_attr_key() returns boolean as $a$\n\ 123> \begin\n\ 124> \ return true;\n\ 125> \end;\n\ 126> \$a$ language plpgsql stable;\n\ 127> \/*drop function if exists tbl_constraint_trigger_operator();\n\ 128> \create function tbl_constraint_trigger_operator() returns trigger as $a$\n\ 129> \begin\n\ 130> \ null;\n\ 131> \end;\n\ 132> \$a$ language plpgsql;*/" 133> ,t addKey 134> "select add_key('tbl', array['attr1','attr2']);" 135> "create function check_con_tbl_attr1_attr2_key() returns boolean as $a$\n\ 136> \begin\n\ 137> \ return true;\n\ 138> \end;\n\ 139> \$a$ language plpgsql stable;\n\ 140> \/*drop function if exists tbl_constraint_trigger_operator();\n\ 141> \create function tbl_constraint_trigger_operator() returns trigger as $a$\n\ 142> \begin\n\ 143> \ null;\n\ 144> \end;\n\ 145> \$a$ language plpgsql;*/" 146> ,t zeroOneTuple 147> "select constrain_to_zero_or_one_tuple('tbl');" 148> "create function check_con_tbl_01_tuple() returns boolean as $a$\n\ 149> \begin\n\ 150> \ return true;\n\ 151> \end;\n\ 152> \$a$ language plpgsql stable;\n\ 153> \drop function if exists tbl_constraint_trigger_operator();\n\ 154> \create function tbl_constraint_trigger_operator() returns trigger as $a$\n\ 155> \begin\n\ 156> \ null;\n\ 157> \end;\n\ 158> \$a$ language plpgsql;" 159> 160> -- add_foreign_key 161> -- constrain zero one 162> -- add constraint 163> 164> ]) 165> 166> where 167> t a b c = (a,b,c) 168> mapCheckExtension = map (\(a,b,c) -> checkExtension a b c) 169> checkExtension :: (StatementList -> StatementList) -> String -> String -> Test.Framework.Test 170> checkExtension f stxt ttxt = testCase ("check " ++ stxt) $ 171> case (do 172> sast <- parseSql "" stxt 173> let esast = f sast 174> --trace (printSql esast) $ return () 175> tast <- parseSql "" ttxt 176> return (tast,esast)) of 177> Left e -> assertFailure $ show e 178> Right (ts,es) -> assertEqual "" (stripAnnotations ts) (stripAnnotations es)