File: syntactic_hook.ml

package info (click to toggle)
frama-c 20161101%2Bsilicon%2Bdfsg-5
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 42,324 kB
  • ctags: 35,695
  • sloc: ml: 200,142; ansic: 31,465; makefile: 2,334; sh: 1,643; lisp: 259; python: 85; asm: 26
file content (120 lines) | stat: -rw-r--r-- 3,562 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
open Cabsvisit
open Cabshelper
open Logic_ptree
open Cil_types
open Cil
open Cabs
open Lexing

class visit = object
  inherit nopCabsVisitor
  method vstmt s =
    let loc = get_statementloc s in
    ChangeTo
      [{ stmt_ghost = false;
         stmt_node =
           CODE_ANNOT(
             AAssert([],
                     { lexpr_node =
                         PLat ({ lexpr_node = PLtrue; lexpr_loc = loc},"Pre");
                       lexpr_loc = loc}), loc)};
       s]
end

let visitor = new visit;;

Frontc.add_syntactic_transformation (Cabsvisit.visitCabsFile visitor);;

let warn_pure_exp f e =
  let loc = e.eloc in
  Kernel.warning ~source:(fst loc)
    "[SH]: function %s, pure expression %a is dropped"
    f (Printer.pp_exp) e
;;

Cabs2cil.register_ignore_pure_exp_hook warn_pure_exp;;

let warn_proto vi =
  Kernel.warning ~source:(fst vi.vdecl) "[SH]: implicit declaration for prototype %a"
    (Format.pp_print_string) vi.vname
;;

Cabs2cil.register_implicit_prototype_hook warn_proto
;;

let warn_conflict oldvi vi reason =
  Kernel.warning
    ~source:(fst vi.vdecl)
    "[SH]: conflict with declaration of %a at line %d: %s"
    Format.pp_print_string vi.vname
    (fst oldvi.vdecl).pos_lnum
    reason
;;

Cabs2cil.register_incompatible_decl_hook warn_conflict;;

let warn_distinct oldvi vi =
  Kernel.warning
    ~source:(fst vi.vdecl)
    "[SH]: definition of %a does not use exactly the same prototype as \
     declared on line %d"
    Format.pp_print_string vi.vname
    (fst oldvi.vdecl).pos_lnum
;;

Cabs2cil.register_different_decl_hook warn_distinct;;

let warn_local_func vi =
  Kernel.warning ~source:(fst vi.vdecl)
    "[SH]: definition of local function %a" Format.pp_print_string vi.vname
;;

Cabs2cil.register_local_func_hook warn_local_func;;

let warn_drop_effect olde e =
  Kernel.warning ~source:(fst e.eloc)
    "[SH]: dropping side effect in sizeof: %a is converted to %a"
    Cprint.print_expression olde
    Printer.pp_exp e
;;

Cabs2cil.register_ignore_side_effect_hook warn_drop_effect

let warn_cond_effect orig e =
  let source = fst e.expr_loc in
  Kernel.warning ~source
    "[SH]: side effect of expression %a occurs in \
     conditional part of expression %a. It is not always executed"
    Cprint.print_expression e Cprint.print_expression orig
;;

Cabs2cil.register_conditional_side_effect_hook warn_cond_effect

let process_new_global =
  let seen_vi = Cil_datatype.Varinfo.Hashtbl.create 10 in
  fun vi exists ->
    let source = fst vi.vdecl in
    Kernel.feedback ~source
      "New global node introducing identifier %s(%d)" vi.vname vi.vid;
    if exists then begin
      Kernel.feedback "New occurrence of existing identifier %s" vi.vname;
      if not (Cil_datatype.Varinfo.Hashtbl.mem seen_vi vi) then
        Kernel.fatal
          "identifier %s is supposed to have been already seen, but it has \
           not been processed through this hook." vi.vname;
      let vi' = Cil_datatype.Varinfo.Hashtbl.find seen_vi vi in
      if vi != vi' then
        Kernel.fatal
          "identifier %s(%d) is not shared with its previous occurrence %s(%d)"
          vi.vname vi.vid vi'.vname vi'.vid
    end else begin
      Kernel.feedback "First occurrence of %s" vi.vname;
      if Cil_datatype.Varinfo.Hashtbl.mem seen_vi vi then
        Kernel.fatal
          "This is supposed to be the first occurrence of %s, \
           but it is already present in the table." vi.vname;
      Cil_datatype.Varinfo.Hashtbl.add seen_vi vi vi
    end
;;

Cabs2cil.register_new_global_hook process_new_global