Check _Static_assert in struct (closes #65)

Author: sim642

src/frontc/cabs.ml

@@ -83,8 +83,8 @@ type typeSpecifier = (* Merge all specifiers into one type *)
      a forward declaration or simple reference to the type); they
      also have a list of __attribute__s that appeared between the
      keyword and the type name (definitions only) *)
-  | Tstruct of string * field_group list option * attribute list
-  | Tunion of string * field_group list option * attribute list
+  | Tstruct of string * struct_decl list option * attribute list
+  | Tunion of string * struct_decl list option * attribute list
   | Tenum of string * enum_item list option * attribute list
   | TtypeofE of expression                      (* GCC __typeof__ *)
   | TtypeofT of specifier * decl_type       (* GCC __typeof__ *)
@@ -150,6 +150,10 @@ and name_group = specifier * name list
 (* The optional expression is the bitfield *)
 and field_group = specifier * (name * expression option) list
 
+and struct_decl =
+  | FIELD_GROUP of field_group
+  | FIELD_STATIC_ASSERT of expression * string option * cabsloc
+
 (* like name_group, except the declared variables are allowed to have initializers *)
 (* e.g.: int x=1, y=2; *)
 and init_name_group = specifier * init_name list

src/frontc/cabs2cil.ml

@@ -2667,6 +2667,7 @@ let rec doSpecList (suggestedAnonName: string) (* This string will be part of
         if n = "" then E.s (error "Missing struct tag on incomplete struct");
         findCompType "struct" n []
     | [A.Tstruct (n, Some nglist, extraAttrs)] -> (* A definition of a struct *)
+      let nglist = doStructDecls nglist in
       let (specs, names) = List.split nglist in
       let n' =
         if n <> "" then n else anonStructName "struct" suggestedAnonName specs in
@@ -2678,6 +2679,7 @@ let rec doSpecList (suggestedAnonName: string) (* This string will be part of
         if n = "" then E.s (error "Missing union tag on incomplete union");
         findCompType "union" n []
     | [A.Tunion (n, Some nglist, extraAttrs)] -> (* A definition of a union *)
+        let nglist = doStructDecls nglist in
         let (specs, names) = List.split nglist in
         let n' =
           if n <> "" then n else anonStructName "union" suggestedAnonName specs in
@@ -2827,6 +2829,23 @@ let rec doSpecList (suggestedAnonName: string) (* This string will be part of
   in
   bt,!storage,!isinline,List.rev (!attrs @ (convertCVtoAttr !cvattrs))
 
+
+and doStructDecls (struct_decls: struct_decl list): field_group list =
+  List.filter_map (function
+      | FIELD_GROUP fg -> Some fg
+      | FIELD_STATIC_ASSERT (e, str, loc) ->
+        let loc = convLoc loc in
+        let d_message () = function
+          | None -> nil
+          | Some str -> dprintf ": %s" str
+        in
+        begin match isIntegerConstant e with
+          | Some 0 -> E.s (error "Static assert failed at %a%a" d_loc loc d_message str)
+          | Some _ -> None
+          | None -> E.s (error "Static assert with a non-constant at %a%a" d_loc loc d_message str)
+        end
+    ) struct_decls
+
 (* given some cv attributes, convert them into named attributes for
    uniform processing *)
 and convertCVtoAttr (src: A.cvspec list) : A.attribute list =

src/frontc/cabsvisit.ml

@@ -189,13 +189,22 @@ and childrenTypeSpecifier vis ts =
     let nel' = mapNoCopy doOneField nel in
     if s' != s || nel' != nel then (s', nel') else input
   in
+  let childrenStructDecl input =
+    match input with
+    | FIELD_GROUP fg -> 
+      let fg' = childrenFieldGroup fg in
+      if fg' != fg then FIELD_GROUP fg' else input
+    | FIELD_STATIC_ASSERT (e, str, l) ->
+      let e' = visitCabsExpression vis e in
+      if e' != e then FIELD_STATIC_ASSERT (e', str, l) else input
+  in
   match ts with
     Tstruct (n, Some fg, extraAttrs) ->
       (*(trace "sm" (dprintf "visiting struct %s\n" n));*)
-      let fg' = mapNoCopy childrenFieldGroup fg in
+      let fg' = mapNoCopy childrenStructDecl fg in
       if fg' != fg then Tstruct( n, Some fg', extraAttrs) else ts
   | Tunion (n, Some fg, extraAttrs) ->
-      let fg' = mapNoCopy childrenFieldGroup fg in
+      let fg' = mapNoCopy childrenStructDecl fg in
       if fg' != fg then Tunion( n, Some fg', extraAttrs) else ts
   | Tenum (n, Some ei, extraAttrs) ->
       let doOneEnumItem ((s, attrs, e, loc) as ei) =

src/frontc/cparser.mly

@@ -370,7 +370,7 @@ let transformOffsetOf (speclist, dtype) member =
 
 %type <spec_elem list * cabsloc> decl_spec_list
 %type <typeSpecifier * cabsloc> type_spec
-%type <Cabs.field_group list> struct_decl_list
+%type <Cabs.struct_decl list> struct_decl_list
 
 
 %type <Cabs.name> old_proto_decl
@@ -1148,13 +1148,13 @@ struct_decl_list: /* (* ISO 6.7.2. Except that we allow empty structs. We
                    */
    /* empty */                           { [] }
 |  decl_spec_list                 SEMICOLON struct_decl_list
-                                         { (fst $1,
+                                         { FIELD_GROUP (fst $1,
                                             [(missingFieldDecl, None)]) :: $3 }
 /*(* GCC allows extra semicolons *)*/
 |                                 SEMICOLON struct_decl_list
                                          { $2 }
 |  decl_spec_list field_decl_list SEMICOLON struct_decl_list
-                                          { (fst $1, $2)
+                                          { FIELD_GROUP (fst $1, $2)
                                             :: $4 }
 /*(* MSVC allows pragmas in strange places *)*/
 |  pragma struct_decl_list                { $2 }
@@ -1163,11 +1163,13 @@ struct_decl_list: /* (* ISO 6.7.2. Except that we allow empty structs. We
                                           { $3 }
 /*(* C11 allows static_assert-declaration *)*/
 |  static_assert_declaration             {
-       []
+       let (e, m, loc) = $1 in
+       [FIELD_STATIC_ASSERT (e, m, loc)]
    }
 
 |  static_assert_declaration      SEMICOLON struct_decl_list  {
-       $3
+       let (e, m, loc) = $1 in
+       FIELD_STATIC_ASSERT (e, m, loc) :: $3
    }
 
 ;

src/frontc/cprint.ml

@@ -244,13 +244,25 @@ and print_decl (n: string) = function
       comprint ")"
 
 
-and print_fields (flds : field_group list) =
+and print_fields (flds : struct_decl list) =
   if flds = [] then print " { } "
   else begin
     print " {";
     indent ();
     List.iter
-      (fun fld -> print_field_group fld; print ";"; new_line ())
+      (function
+        | FIELD_GROUP fld -> print_field_group fld; print ";"; new_line ()
+        | FIELD_STATIC_ASSERT (e, str, loc) ->
+          print "_Static_assert(";
+          print_expression e;
+          begin match str with
+            | Some str ->
+              print ",";
+              print_string str;
+            | None -> ()
+          end;
+          print ");";
+      )
       flds;
     unindent ();
     print "} "

src/frontc/patch.ml

@@ -558,12 +558,17 @@ begin
     )
 end
 
-and unifyField (pat : field_group) (tgt : field_group) : binding list =
+and unifyField (pat : struct_decl) (tgt : struct_decl) : binding list =
 begin
-  match pat,tgt with (spec1, list1), (spec2, list2) -> (
+  match pat, tgt with
+  | FIELD_GROUP (spec1, list1), FIELD_GROUP (spec2, list2) ->
     (unifySpecifiers spec1 spec2) @
     (unifyList list1 list2 unifyNameExprOpt)
-  )
+  | FIELD_STATIC_ASSERT (exp1, str1, l1), FIELD_STATIC_ASSERT (exp2, str2, l2) ->
+    (unifyExpr exp1 exp2)
+  | _, _ ->
+    if verbose then (trace "patchDebug" (dprintf "mismatching struct_decl-s\n"));
+      raise NoMatch
 end
 
 and unifyNameExprOpt (pat : name * expression option)