Detect and reject "&" operator applied to "register" local variable or to a bit field.

3 files changed, 34 insertions, 0 deletions

diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index 846010b3..221bd7cc 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -574,6 +574,19 @@ let is_function_type env t =
   | TFun _ -> true
   | _ -> false
 
+(* Find the info for a field access *)
+
+let field_of_dot_access env t m =
+  match unroll env t with
+  | TStruct(id, _) -> Env.find_struct_member env (id, m)
+  | TUnion(id, _) -> Env.find_union_member env (id, m)
+  | _ -> assert false
+
+let field_of_arrow_access env t m =
+  match unroll env t with
+  | TPtr(t, _) | TArray(t, _, _) -> field_of_dot_access env t m
+  | _ -> assert false
+
 (* Ranking of integer kinds *)
 
 let integer_rank = function
diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli
index 9d41f8fa..b1f77944 100644
--- a/cparser/Cutil.mli
+++ b/cparser/Cutil.mli
@@ -195,6 +195,10 @@ val fundef_typ: fundef -> typ
 val int_representable: int64 -> int -> bool -> bool
   (* Is the given int64 representable with the given number of bits and
      signedness? *)
+val field_of_dot_access: Env.t -> typ -> string -> field
+  (* Return the field info for a [x.field] access *)
+val field_of_arrow_access: Env.t -> typ -> string -> field
+  (* Return the field info for a [x->field] access *)
 
 (* Constructors *)
 
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index a1dd552b..ae0ba17b 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -1406,6 +1406,23 @@ let elab_expr loc env a =
       let b1 = elab a1 in
       if not (is_lvalue b1 || is_function_type env b1.etyp) then
         err "argument of '&' is not an l-value";
+      begin match b1.edesc with
+      | EVar id ->
+          begin match wrap Env.find_ident loc env id with
+          | Env.II_ident(Storage_register, _) ->
+              err "address of register variable '%s' requested" id.name
+          | _ -> ()
+          end
+      | EUnop(Odot f, b2) ->
+          let fld = wrap2 field_of_dot_access loc env b2.etyp f in
+          if fld.fld_bitfield <> None then
+            err "address of bit-field '%s' requested" f
+      | EUnop(Oarrow f, b2) ->
+          let fld = wrap2 field_of_arrow_access loc env b2.etyp f in
+          if fld.fld_bitfield <> None then
+            err "address of bit-field '%s' requested" f
+      | _ -> ()
+      end;
       { edesc = EUnop(Oaddrof, b1); etyp = TPtr(b1.etyp, []) }
 
   | UNARY(MEMOF, a1) ->