diff options
| author | Bernhard Schommer <bschommer@users.noreply.github.com> | 2017-10-17 12:54:13 +0200 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2017-10-17 12:54:13 +0200 |
| commit | a0f238a3d270edd7042d9852d43e3ec5b9602af2 (patch) | |
| tree | 8209f90d0862f2971ea9803e887439d046138b7a /cparser/Cutil.ml | |
| parent | ccf1983c3fe334fa82fa81ff7e3067e93b3d6c0c (diff) | |
| download | compcert-kvx-a0f238a3d270edd7042d9852d43e3ec5b9602af2.tar.gz compcert-kvx-a0f238a3d270edd7042d9852d43e3ec5b9602af2.zip | |
Check recursively for const for modifiable lvalues (#32)
Check recursively for const for modifiable lvalues
According to 6.3.2.1 a modifiable lvalue is an lvalue that does
have a const-qualified type, and if it is a union or structure it
does not have any member, including any member of all contained
strutures or union, with a const-qualified type.
The new check for modifiable lvalue additionally checks this now
instead of only testing for toplevel const.
Bug 22420
Diffstat (limited to 'cparser/Cutil.ml')
| -rw-r--r-- | cparser/Cutil.ml | 17 |
1 files changed, 15 insertions, 2 deletions
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 586b4a92..9bc11141 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -179,7 +179,7 @@ let rec attributes_of_type env t = | TUnion(s, a) -> let ci = Env.find_union env s in add_attributes ci.ci_attr a | TEnum(s, a) -> - let ei = Env.find_enum env s in add_attributes ei.ei_attr a + let ei = Env.find_enum env s in add_attributes ei.ei_attr a (* Changing the attributes of a type (at top-level) *) (* Same hack as above for array types. *) @@ -937,10 +937,23 @@ let rec is_lvalue e = whose type is not const, neither an array type, nor a function type, nor an incomplete type. *) +let rec is_const_type env ty = + List.mem AConst (attributes_of_type env ty) || + begin match unroll env ty with + | TStruct(s, a) -> + let ci = Env.find_struct env s in + List.exists (fun m -> is_const_type env m.fld_typ) ci.ci_members + | TUnion(s, a) -> + let ci = Env.find_union env s in + List.exists (fun m -> is_const_type env m.fld_typ) ci.ci_members + | _ -> + false + end + let is_modifiable_lvalue env e = is_lvalue e - && not (List.mem AConst (attributes_of_type env e.etyp)) && not (incomplete_type env e.etyp) + && not (is_const_type env e.etyp) && begin match unroll env e.etyp with | TFun _ | TArray _ -> false | _ -> true |