~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/r9c_tests_SUITE_data/src/mnesia/mnesia.hrl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
%% ``The contents of this file are subject to the Erlang Public License,
 
2
%% Version 1.1, (the "License"); you may not use this file except in
 
3
%% compliance with the License. You should have received a copy of the
 
4
%% Erlang Public License along with this software. If not, it can be
 
5
%% retrieved via the world wide web at http://www.erlang.org/.
 
6
%% 
 
7
%% Software distributed under the License is distributed on an "AS IS"
 
8
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
9
%% the License for the specific language governing rights and limitations
 
10
%% under the License.
 
11
%% 
 
12
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 
13
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 
14
%% AB. All Rights Reserved.''
 
15
%% 
 
16
%%     $Id: mnesia.hrl,v 1.1 2008/12/17 09:53:37 mikpe Exp $
 
17
%%
 
18
 
 
19
-define(APPLICATION, mnesia).
 
20
 
 
21
-define(ets_lookup(Tab, Key), ets:lookup(Tab, Key)).
 
22
-define(ets_lookup_element(Tab, Key, Pos), ets:lookup_element(Tab, Key, Pos)).
 
23
-define(ets_insert(Tab, Rec), ets:insert(Tab, Rec)).
 
24
-define(ets_delete(Tab, Key), ets:delete(Tab, Key)).
 
25
-define(ets_match_delete(Tab, Pat), ets:match_delete(Tab, Pat)).
 
26
-define(ets_match_object(Tab, Pat), ets:match_object(Tab, Pat)).
 
27
-define(ets_match(Tab, Pat), ets:match(Tab, Pat)).
 
28
-define(ets_info(Tab, Item), ets:info(Tab, Item)).
 
29
-define(ets_update_counter(Tab, Key, Incr), ets:update_counter(Tab, Key, Incr)).
 
30
-define(ets_first(Tab), ets:first(Tab)).
 
31
-define(ets_next(Tab, Key), ets:next(Tab, Key)).
 
32
-define(ets_last(Tab), ets:last(Tab)).
 
33
-define(ets_prev(Tab, Key), ets:prev(Tab, Key)).
 
34
-define(ets_slot(Tab, Pos), ets:slot(Tab, Pos)).
 
35
-define(ets_new_table(Tab, Props), ets:new(Tab, Props)).
 
36
-define(ets_delete_table(Tab), ets:delete(Tab)).
 
37
-define(ets_fixtable(Tab, Bool), ets:fixtable(Tab, Bool)).
 
38
 
 
39
-define(catch_val(Var), (catch ?ets_lookup_element(mnesia_gvar, Var, 2))).
 
40
 
 
41
%% It's important that counter is first, since we compare tid's
 
42
 
 
43
-record(tid, 
 
44
        {counter,         %% serial no for tid
 
45
         pid}).           %%  owner of tid
 
46
 
 
47
 
 
48
-record(tidstore,         
 
49
        {store,           %% current ets table for tid
 
50
         up_stores = [],  %% list of upper layer stores for nested trans
 
51
         level = 1}).     %% transaction level
 
52
 
 
53
-define(unique_cookie, {erlang:now(), node()}).
 
54
 
 
55
-record(cstruct, {name,                            % Atom
 
56
                  type = set,                      % set | bag
 
57
                  ram_copies = [],                 % [Node]
 
58
                  disc_copies = [],                % [Node]
 
59
                  disc_only_copies = [],           % [Node]
 
60
                  load_order = 0,                  % Integer
 
61
                  access_mode = read_write,        % read_write | read_only
 
62
                  index = [],                      % [Integer]
 
63
                  snmp = [],                       % Snmp Ustruct
 
64
                  local_content = false,           % true | false
 
65
                  record_name = {bad_record_name}, % Atom (Default = Name)
 
66
                  attributes = [key, val],         % [Atom]
 
67
                  user_properties = [],            % [Record]
 
68
                  frag_properties = [],            % [{Key, Val]
 
69
                  cookie = ?unique_cookie,         % Term
 
70
                  version = {{2, 0}, []}}).        % {{Integer, Integer}, [Node]}
 
71
 
 
72
%% Record for the head structure in Mnesia's log files
 
73
%% 
 
74
%% The definition of this record may *NEVER* be changed
 
75
%% since it may be written to very old backup files.
 
76
%% By holding this record definition stable we can be
 
77
%% able to comprahend backups from timepoint 0. It also
 
78
%% allows us to use the backup format as an interchange
 
79
%% format between Mnesia releases.
 
80
 
 
81
-record(log_header,{log_kind,
 
82
                    log_version,
 
83
                    mnesia_version,
 
84
                    node,
 
85
                    now}).
 
86
 
 
87
%% Commit records stored in the transaction log
 
88
-record(commit, {node,
 
89
                 decision, % presume_commit | Decision
 
90
                 ram_copies = [],
 
91
                 disc_copies = [],
 
92
                 disc_only_copies = [],
 
93
                 snmp = [],
 
94
                 schema_ops = []
 
95
                }).
 
96
 
 
97
-record(decision, {tid,
 
98
                   outcome, % presume_abort | committed
 
99
                   disc_nodes,
 
100
                   ram_nodes}).
 
101
 
 
102
%% Maybe cyclic wait
 
103
-record(cyclic, {node = node(),
 
104
                 oid,  % {Tab, Key}
 
105
                 op,   % read | write
 
106
                 lock, % read | write
 
107
                 lucky
 
108
                }).
 
109
 
 
110
%% Managing conditional debug functions
 
111
 
 
112
-ifdef(debug).
 
113
    -define(eval_debug_fun(I, C),
 
114
            mnesia_lib:eval_debug_fun(I, C, ?FILE, ?LINE)).
 
115
-else.
 
116
    -define(eval_debug_fun(I, C), ok).
 
117
-endif.    
 
118