diff options
author | Xavier Leroy <xavier.leroy@college-de-france.fr> | 2022-02-11 17:49:36 +0100 |
---|---|---|
committer | Xavier Leroy <xavier.leroy@college-de-france.fr> | 2022-02-11 18:53:41 +0100 |
commit | 9d3521b4db46773239a2c5f9f6970de826075508 (patch) | |
tree | 21a8b9ab578608db717ea439ecd5e923237f0ac1 /cfrontend | |
parent | 38b0425d524cd3e7260ac46e13153f007e8bc00d (diff) | |
download | compcert-kvx-9d3521b4db46773239a2c5f9f6970de826075508.tar.gz compcert-kvx-9d3521b4db46773239a2c5f9f6970de826075508.zip |
Check for arguments of struct/union type passed to a vararg function
If any are found, make sure that `-fstruct-passing` was given.
Previously, we used to check the fixed arguments (as part of a call to
`checkFunctionType`) but not the variable arguments.
Diffstat (limited to 'cfrontend')
-rw-r--r-- | cfrontend/C2C.ml | 29 |
1 files changed, 16 insertions, 13 deletions
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 3c71718c..7c6a4994 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -520,19 +520,21 @@ let convertFkind k a : coq_type = if not !Clflags.option_flongdouble then unsupported "'long double' type"; Tfloat (F64, a) +let checkResultType env ty = + if (not !Clflags.option_fstruct_passing) && Cutil.is_composite_type env ty + then unsupported "function returning a struct or union \ + (consider adding option [-fstruct-passing])" + +let checkArgumentType env ty = + if (not !Clflags.option_fstruct_passing) && Cutil.is_composite_type env ty + then unsupported "function parameter of struct or union type \ + (consider adding option [-fstruct-passing])" + let checkFunctionType env tres targs = - if not !Clflags.option_fstruct_passing then begin - if Cutil.is_composite_type env tres then - unsupported "function returning a struct or union (consider adding option [-fstruct-passing])"; - begin match targs with - | None -> () - | Some l -> - List.iter - (fun (id, ty) -> - if Cutil.is_composite_type env ty then - unsupported "function parameter of struct or union type (consider adding option [-fstruct-passing])") - l - end + checkResultType env tres; + begin match targs with + | None -> () + | Some l -> List.iter (fun (id, ty) -> checkArgumentType env ty) l end let rec convertTyp env ?bitwidth t = @@ -965,12 +967,13 @@ let rec convertExpr env e = | None -> error "wrong type for function part of a call" | Some(tres, targs, va) -> - checkFunctionType env tres targs; if targs = None && not !Clflags.option_funprototyped then unsupported "call to unprototyped function (consider adding option [-funprototyped])"; if va && not !Clflags.option_fvararg_calls then unsupported "call to variable-argument function (consider adding option [-fvararg-calls])" end; + checkResultType env e.etyp; + List.iter (fun arg -> checkArgumentType env arg.etyp) args; ewrap (Ctyping.ecall (convertExpr env fn) (convertExprList env args)) and convertLvalue env e = |