aboutsummaryrefslogtreecommitdiffstats
path: root/cfrontend
diff options
context:
space:
mode:
authorXavier Leroy <xavier.leroy@college-de-france.fr>2022-02-11 17:49:36 +0100
committerXavier Leroy <xavier.leroy@college-de-france.fr>2022-02-11 18:53:41 +0100
commit9d3521b4db46773239a2c5f9f6970de826075508 (patch)
tree21a8b9ab578608db717ea439ecd5e923237f0ac1 /cfrontend
parent38b0425d524cd3e7260ac46e13153f007e8bc00d (diff)
downloadcompcert-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.ml29
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 =