Fix C11 generic warnings

Partially cherry-picked from 898fdf1.

Author: coslu

src/check.ml

@@ -278,6 +278,7 @@ let rec checkType (t: typ) (ctx: ctxType) =
         (fun (an, at, aa) ->
           checkType at CTFArg;
           checkAttributes aa) (argsToList targs)
+  | TDefault -> ()
 
 (* Check that a type is a promoted integral type *)
 and checkIntegralType (t: typ) =
@@ -618,7 +619,12 @@ and checkExp (isconst: bool) (e: exp) : typ =
           (* | TComp _ -> E.s (bug "Cast of a composite type") *)
           | TVoid _ -> E.s (bug "Cast of a void type")
           | _ -> tres
-      end)
+      end
+      | Generic (exp, lst) -> 
+          let typ = checkExp false exp in
+          List.iter (fun (t, e) -> checkType t CTExp; ignore (checkExp false e)) lst;
+          typ
+      )
     () (* The argument of withContext *)
 
 and checkInit  (i: init) : typ =

src/cil.ml

@@ -1960,7 +1960,14 @@ let rec typeOf (e: exp) : typ =
         TArray (t,_, a) -> TPtr(t, a)
      | _ -> E.s (E.bug "typeOf: StartOf on a non-array")
   end
-  | Generic (e, lst) -> match lst with (t, e1) :: rest -> typeOf e1 | _ -> voidType (* TODO: implement properly *)
+  | Generic (exp, lst) -> 
+      let typeOfExp = typeOf exp in
+      let rec findType lst = 
+        match lst with 
+        [] -> voidType
+        | (t, e) :: rest -> if t = typeOfExp then typeOf e else findType rest
+      in 
+      findType lst
 
 and typeOfInit (i: init) : typ =
   match i with

src/ext/pta/ptranal.ml

@@ -257,6 +257,7 @@ and analyze_expr (e : exp ) : A.tau =
       | SizeOfE _ -> A.bottom ()
       | Imag __ -> A.bottom ()
       | Real __ -> A.bottom ()
+      | Generic (_, _) -> failwith "not implemented yet"
  in
   H.add expressions e result;
   result

src/frontc/cabs2cil.ml

@@ -543,6 +543,9 @@ let docEnv () =
   H.iter (fun k d -> acc := (k, d) :: !acc) env;
   docList ~sep:line (fun (k, d) -> dprintf "  %s -> %a" k doone d) () !acc
 
+  let rec stripParenLocal e = match e with
+  | A.PAREN e2 -> stripParenLocal e2
+  | _ -> e
 
 
 (* Add a new variable. Do alpha-conversion if necessary *)
@@ -666,6 +669,7 @@ let rec stripConstLocalType (t: typ) : typ =
       let a' = dc a in if a != a' then TVoid a' else t
   | TBuiltin_va_list a ->
       let a' = dc a in if a != a' then TBuiltin_va_list a' else t
+  | TDefault -> t
 
 
 let constFoldTypeVisitor = object (self)
@@ -4847,24 +4851,29 @@ and doExp (asconst: bool)   (* This expression is used as a constant *)
     | A.EXPR_PATTERN _ -> E.s (E.bug "EXPR_PATTERN in cabs2cil input")
 
     | A.GENERIC (expr, lst) -> 
-        let get_exp tupel = match tupel with _, e, _ -> e in
-        let exp = get_exp (doExp false expr (AExp None)) in
-        let rec make_cil_list cabs_l cil_l = match cabs_l with 
+        let get_exp (_, e, _) = e in
+        let exp = get_exp (doExp false (stripParenLocal expr) (AExp None)) in
+        let cil_list = 
+          let rec make_cil_list cabs_l cil_l = match cabs_l with 
           | [] -> cil_l
-          | (s, e) :: rest -> make_cil_list rest (((doOnlyType s JUSTBASE),get_exp (doExp false e (AExp None))) :: cil_l) 
+          | (s, e) :: rest -> make_cil_list rest (((doOnlyType s JUSTBASE),get_exp (doExp false (stripParenLocal e) (AExp None))) :: cil_l) 
+          in
+          make_cil_list lst [] 
         in
-        let cil_list = make_cil_list lst [] in
         let exp_typ = typeOf exp in
         let default_typ = ref voidType in
         let typ = 
-          let rec get_typ l = match l with 
+          let rec get_typ lst = match lst with 
             | (TDefault, e) :: rest -> default_typ := typeOf e; get_typ rest
             | (t, e) :: rest -> if t = exp_typ then typeOf e else get_typ rest
-            | [] -> !default_typ
+            | [] -> 
+              if !default_typ = voidType then 
+                E.s(error "Controlling expression of generic selection is not compatible with any association")
+              else !default_typ
           in
           get_typ cil_list
         in
-        finishExp empty (Generic(exp, (make_cil_list lst []))) typ
+        finishExp empty (Generic(exp, (cil_list))) typ
 
   with e when continueOnError -> begin
     (*ignore (E.log "error in doExp (%s)" (Printexc.to_string e));*)
@@ -6833,11 +6842,6 @@ and doStatement (s : A.statement) : chunk =
     consLabel "booo_statement" empty (convLoc (C.get_statementloc s)) false
   end
 
-
-let rec stripParenLocal e = match e with
-  | A.PAREN e2 -> stripParenLocal e2
-  | _ -> e
-
 class stripParenClass : V.cabsVisitor = object (self)
   inherit V.nopCabsVisitor
 

src/frontc/cprint.ml

@@ -196,6 +196,7 @@ and print_type_spec = function
       (print_enum_items enum_items)
   | TtypeofE e -> printl ["__typeof__";"("]; print_expression e; print ") "
   | TtypeofT (s,d) -> printl ["__typeof__";"("]; print_onlytype (s, d); print ") "
+  | Tdefault -> print "default "
 
 
 (* print "struct foo", but with specified keyword and a list of
@@ -403,6 +404,7 @@ and get_operator exp =
   | TYPE_SIZEOF _ -> ("", 16)
   | EXPR_ALIGNOF exp -> ("", 16)
   | TYPE_ALIGNOF _ -> ("", 16)
+  | GENERIC _ -> ("", 16)
   | IMAG exp -> ("", 16)
   | REAL exp -> ("", 16)
   | CLASSIFYTYPE exp -> ("", 16)
@@ -538,6 +540,20 @@ and print_expression_level (lvl: int) (exp : expression) =
       printl ["__alignof__";"("];
       print_onlytype (bt, dt);
       print ")"
+  | GENERIC (exp, lst) -> 
+      let print_generic_list l =
+        match l with 
+        [] -> ()
+        | (s, e) :: tl ->
+          print ", ";
+          print_onlytype (s, JUSTBASE); 
+          print ": ";
+          print_expression_level 0 e;
+      in
+      printl ["_Generic";"("];
+      print_expression_level 0 exp;
+      print_generic_list lst;
+      print ")"
   | IMAG exp ->
       printl ["__imag__";"("];
       print_expression_level 0 exp;