/src-extra/tests/Database/HsSqlPpp/Tests/junk/ExtensionTests.lhs

  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)