From 272a5b812b72f4c3e409ccdbeaf3476d95c4b552 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Tue, 15 Mar 2016 15:07:47 +0100 Subject: Deactivate warning 27 and added back removed code. The code was mostly there for documentation effort. So warning 27 is deactivated again. Bug 18349 --- cparser/Cutil.ml | 56 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 28 insertions(+), 28 deletions(-) (limited to 'cparser/Cutil.ml') diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 19f6d29a..1bbb8e98 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -73,7 +73,7 @@ let rec find_custom_attributes (names: string list) (al: attributes) = let rec remove_custom_attributes (names: string list) (al: attributes) = match al with | [] -> [] - | Attr(name, _) :: tl when List.mem name names -> + | Attr(name, args) :: tl when List.mem name names -> remove_custom_attributes names tl | a :: tl -> a :: remove_custom_attributes names tl @@ -137,12 +137,12 @@ let rec unroll env t = let rec attributes_of_type env t = match t with | TVoid a -> a - | TInt(_, a) -> a - | TFloat(_, a) -> a - | TPtr(_, a) -> a - | TArray(ty, _, a) -> add_attributes a (attributes_of_type env ty) - | TFun(_, _,_, a) -> a - | TNamed(_, _) -> attributes_of_type env (unroll env t) + | TInt(ik, a) -> a + | TFloat(fk, a) -> a + | TPtr(ty, a) -> a + | TArray(ty, sz, a) -> add_attributes a (attributes_of_type env ty) + | TFun(ty, params, vararg, a) -> a + | TNamed(s, a) -> attributes_of_type env (unroll env t) | TStruct(s, a) -> let ci = Env.find_struct env s in add_attributes ci.ci_attr a | TUnion(s, a) -> @@ -162,7 +162,7 @@ let rec change_attributes_type env (f: attributes -> attributes) t = | TArray(ty, sz, a) -> TArray(change_attributes_type env f ty, sz, f a) | TFun(ty, params, vararg, a) -> TFun(ty, params, vararg, f a) - | TNamed(_, _) -> + | TNamed(s, a) -> let t1 = unroll env t in let t2 = change_attributes_type env f t1 in if t2 = t1 then t else t2 (* avoid useless expansion *) @@ -174,7 +174,7 @@ let remove_attributes_type env attr t = change_attributes_type env (fun a -> remove_attributes a attr) t let erase_attributes_type env t = - change_attributes_type env (fun _ -> []) t + change_attributes_type env (fun a -> []) t (* Remove all attributes from type that are not contained in attr *) let strip_attributes_type t attr = @@ -224,7 +224,7 @@ let alignas_attribute al = let rec alignas_attr accu = function | [] -> accu | AAlignas n :: al -> alignas_attr (max n accu) al - | _ :: al -> alignas_attr accu al + | a :: al -> alignas_attr accu al in alignas_attr 0 al (* Type compatibility *) @@ -260,14 +260,14 @@ let combine_types mode env t1 t2 = | None, _ -> sz2 | _, None -> sz1 | Some n1, Some n2 -> if n1 = n2 then Some n2 else raise Incompat - and comp_conv (_, ty) = + and comp_conv (id, ty) = match unroll env ty with - | TInt(kind, _) -> + | TInt(kind, attr) -> begin match kind with | IBool | IChar | ISChar | IUChar | IShort | IUShort -> raise Incompat | _ -> () end - | TFloat(kind, _) -> + | TFloat(kind, attr) -> begin match kind with | FFloat -> raise Incompat | _ -> () @@ -295,7 +295,7 @@ let combine_types mode env t1 t2 = | Some l1, None -> List.iter comp_conv l1; (params1, vararg1) | Some l1, Some l2 -> if List.length l1 <> List.length l2 then raise Incompat; - let comp_param (_, ty1) (id2, ty2) = + let comp_param (id1, ty1) (id2, ty2) = (id2, comp AttrIgnoreTop ty1 ty2) in (Some(List.map2 comp_param l1 l2), comp_base vararg1 vararg2) in @@ -309,8 +309,8 @@ let combine_types mode env t1 t2 = TUnion(comp_base s1 s2, comp_attr m a1 a2) | TEnum(s1, a1), TEnum(s2, a2) -> TEnum(comp_base s1 s2, comp_attr m a1 a2) - | TEnum(s,a1), TInt(_,a2) - | TInt(_,a2), TEnum (s,a1) -> + | TEnum(s,a1), TInt(enum_ikind,a2) + | TInt(enum_ikind,a2), TEnum (s,a1) -> TEnum(s,comp_attr m a1 a2) | _, _ -> raise Incompat @@ -432,7 +432,7 @@ let alignof_struct_union env members = | None -> None | Some a -> align_rec (max a al) rem end else begin - let (_, a, ml') = pack_bitfields ml in + let (s, a, ml') = pack_bitfields ml in align_rec (max a al) ml' end in align_rec 1 members @@ -471,7 +471,7 @@ let rec sizeof env t = | TInt(ik, _) -> Some(sizeof_ikind ik) | TFloat(fk, _) -> Some(sizeof_fkind fk) | TPtr(_, _) -> Some(!config.sizeof_ptr) - | TArray(_, None, _) -> None + | TArray(ty, None, _) -> None | TArray(ty, Some n, _) as t' -> begin match sizeof env ty with | None -> None @@ -721,7 +721,7 @@ let pointer_decay env t = let unary_conversion env t = match unroll env t with (* Promotion of small integer types *) - | TInt(kind, _) -> + | TInt(kind, attr) -> begin match kind with | IBool | IChar | ISChar | IUChar | IShort | IUShort -> TInt(IInt, []) @@ -729,13 +729,13 @@ let unary_conversion env t = TInt(kind, []) end (* Enums are like signed ints *) - | TEnum(_, _) -> TInt(enum_ikind, []) + | TEnum(id, attr) -> TInt(enum_ikind, []) (* Arrays and functions decay automatically to pointers *) | TArray(ty, _, _) -> TPtr(ty, []) | TFun _ as ty -> TPtr(ty, []) (* Float types and pointer types lose their attributes *) - | TFloat(kind, _) -> TFloat(kind, []) - | TPtr(ty, _) -> TPtr(ty, []) + | TFloat(kind, attr) -> TFloat(kind, []) + | TPtr(ty, attr) -> TPtr(ty, []) (* Other types should not occur, but in doubt... *) | _ -> t @@ -859,7 +859,7 @@ let type_of_constant = function let rec is_lvalue e = match e.edesc with - | EVar _ -> true + | EVar id -> true | EUnop((Oderef | Oarrow _), _) -> true | EUnop(Odot _, e') -> is_lvalue e' | EBinop(Oindex, _, _, _) -> true @@ -905,8 +905,8 @@ let is_debug_stmt s = Custom attributes can safely be dropped or added. *) let valid_assignment_attr afrom ato = - let (afromstd, _) = List.partition attr_is_standard afrom - and (atostd,_) = List.partition attr_is_standard ato in + let (afromstd, afromcustom) = List.partition attr_is_standard afrom + and (atostd, atocustom) = List.partition attr_is_standard ato in incl_attributes afromstd atostd (* Check that an assignment is allowed *) @@ -1031,11 +1031,11 @@ let rec default_init env ty = match unroll env ty with | TInt _ | TEnum _ -> Init_single (intconst 0L IInt) - | TFloat(_, _) -> + | TFloat(fk, _) -> Init_single floatconst0 - | TPtr(_, _) -> + | TPtr(ty, _) -> Init_single nullconst - | TArray(_, _, _) -> + | TArray(ty, sz, _) -> Init_array [] | TStruct(id, _) -> let rec default_init_fields = function -- cgit