From 2525ef0cf03eb06f1d48115b9fe9dab2620511df Mon Sep 17 00:00:00 2001 From: xleroy Date: Sun, 18 May 2014 08:15:14 +0000 Subject: In enter_or_refine_ident: revised handling of "extern" decls. git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2499 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e --- cparser/Elab.ml | 67 ++++++++++++++++++++++++++++++++------------------------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/cparser/Elab.ml b/cparser/Elab.ml index 7824bc3..24a3709 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -75,13 +75,17 @@ let rec mmap f env = function (* To detect redefinitions within the same scope *) -let redef fn env arg = +let previous_def fn env arg = try - let (id, info) = fn env arg in - if Env.in_current_scope env id then Some(id, info) else None + Some (fn env arg) with Env.Error _ -> None +let redef fn env arg = + match previous_def fn env arg with + | None -> false + | Some(id, info) -> Env.in_current_scope env id + (* Forward declarations *) let elab_expr_f : (cabsloc -> Env.t -> Cabs.expression -> C.exp) ref @@ -546,7 +550,7 @@ and elab_parameter env (PARAM (spec, id, decl, attr, loc)) = if inl then error loc "'inline' can only appear on functions"; let id = match id with None -> "" | Some id -> id in - if id <> "" && redef Env.lookup_ident env id <> None then + if id <> "" && redef Env.lookup_ident env id then error loc "redefinition of parameter '%s'" id; (* replace array and function types by pointer types *) let ty1 = argument_conversion env1 ty in @@ -742,7 +746,7 @@ and elab_enum_item env ((s, exp), loc) nextval = error loc "value of enumerator '%s' is not a compile-time constant" s; (nextval, Some exp') in - if redef Env.lookup_ident env s <> None then + if redef Env.lookup_ident env s then error loc "redefinition of enumerator '%s'" s; if not (int_representable v (8 * sizeof_ikind enum_ikind) (is_signed_ikind enum_ikind)) then warning loc "the value of '%s' is not representable with type %a" @@ -1715,26 +1719,24 @@ let enter_typedefs loc env sto dl = List.fold_left (fun env (s, ty, init) -> if init <> NO_INIT then error loc "initializer in typedef"; - if redef Env.lookup_typedef env s <> None then + if redef Env.lookup_typedef env s then error loc "redefinition of typedef '%s'" s; let (id, env') = Env.enter_typedef env s ty in emit_elab loc (Gtypedef(id, ty)); env') env dl let enter_or_refine_ident local loc env s sto ty = - match redef Env.lookup_ident env s with - | Some(id, II_ident(old_sto, old_ty)) -> + match previous_def Env.lookup_ident env s with + | Some(id, II_ident(old_sto, old_ty)) + when sto = Storage_extern || Env.in_current_scope env id -> + if local && Env.in_current_scope env id then + error loc "redefinition of local variable '%s'" s; let new_ty = - if local then begin - error loc "redefinition of local variable '%s'" s; - ty - end else begin - match combine_types env old_ty ty with - | Some new_ty -> - new_ty - | None -> - warning loc "redefinition of '%s' with incompatible type" s; ty - end in + match combine_types env old_ty ty with + | Some new_ty -> + new_ty + | None -> + warning loc "redefinition of '%s' with incompatible type" s; ty in let new_sto = if old_sto = Storage_extern then sto else if sto = Storage_extern then old_sto else @@ -1742,12 +1744,12 @@ let enter_or_refine_ident local loc env s sto ty = warning loc "redefinition of '%s' with incompatible storage class" s; sto end in - (id, Env.add_ident env id new_sto new_ty) - | Some(id, II_enum v) -> + (id, new_sto, Env.add_ident env id new_sto new_ty) + | Some(id, II_enum v) when Env.in_current_scope env id -> error loc "illegal redefinition of enumerator '%s'" s; - (id, Env.add_ident env id sto ty) + (id, sto, Env.add_ident env id sto ty) | _ -> - Env.enter_ident env s sto ty + let (id, env') = Env.enter_ident env s sto ty in (id, sto, env') let enter_decdefs local loc env sto dl = (* Sanity checks on storage class *) @@ -1758,12 +1760,19 @@ let enter_decdefs local loc env sto dl = let rec enter_decdef (decls, env) (s, ty, init) = if sto = Storage_extern && init <> NO_INIT then error loc "'extern' declaration cannot have an initializer"; - (* function declarations are always extern *) - let sto' = - match unroll env ty with TFun _ -> Storage_extern | _ -> sto in + (* Adjust storage for function declarations *) + let sto1 = + match unroll env ty, sto with + | TFun _, Storage_default -> + Storage_extern + | TFun _, (Storage_static | Storage_register) -> + if local then error loc "invalid storage class for '%s'" s; + sto + | _, _ -> + sto in (* enter ident in environment with declared type, because initializer can refer to the ident *) - let (id, env1) = enter_or_refine_ident local loc env s sto' ty in + let (id, sto', env1) = enter_or_refine_ident local loc env s sto1 ty in (* process the initializer *) let (ty', init') = elab_initializer loc env1 s ty init in (* update environment with refined type *) @@ -1799,21 +1808,21 @@ let elab_fundef env spec name body loc = | TFun(ty_ret, Some params, vararg, attr) -> (ty_ret, params, vararg, attr) | _ -> fatal_error loc "wrong type for function definition" in (* Enter function in the environment, for recursive references *) - let (fun_id, env1) = enter_or_refine_ident false loc env s sto ty in + let (fun_id, sto1, env1) = enter_or_refine_ident false loc env s sto ty in (* Enter parameters in the environment *) let env2 = List.fold_left (fun e (id, ty) -> Env.add_ident e id Storage_default ty) (Env.new_scope env1) params in (* Define "__func__" and enter it in the environment *) let (func_ty, func_init) = __func__type_and_init s in - let (func_id, env3) = + let (func_id, _, env3) = enter_or_refine_ident true loc env2 "__func__" Storage_static func_ty in emit_elab loc (Gdecl(Storage_static, func_id, func_ty, Some func_init)); (* Elaborate function body *) let body' = !elab_funbody_f ty_ret env3 body in (* Build and emit function definition *) let fn = - { fd_storage = sto; + { fd_storage = sto1; fd_inline = inline; fd_name = fun_id; fd_attrib = attr; -- cgit v1.2.3