addfile ./scripts/GenerateKeywords.hs hunk ./scripts/GenerateKeywords.hs 1 +-- Generate lexer patterns (reimplementation) +-- input := tokenlist +-- tokenlist := tokenspec [,\n] tokenlist | +-- tokenspec := (tletters | tctor tletters+) @__? +-- tctor := ctor | (composite ctor) +import Data.Maybe +import Data.Char +import qualified Data.Text as T +import System.IO +import System.Environment +import Data.List as L +import Data.Ord + +parseInput :: String -> [[String]] +parseInput = map (map T.unpack) . + catMaybes . + map (parseTokenSpec . T.strip) . + T.split (','==) . T.intercalate (T.pack ",") . + T.lines . T.pack + +parseTokenSpec t | T.null t = Nothing + | T.head t == '(' = + let (tokexpr,tokenstr) = T.break (==')') t + in Just $ parseTokenSpec' (T.snoc tokexpr ')') (T.words $ T.tail tokenstr) + | otherwise = + let (tokexpr:tokens) = T.words t + in Just $ parseTokenSpec' tokexpr tokens + +parseTokenSpec' tokexpr tokenlist = + case T.unpack (last (tokexpr:tokenlist)) of + "@__" -> addReservedTokens (parseTokenSpec'' tokexpr (init tokenlist)) + _ -> parseTokenSpec'' tokexpr tokenlist + +parseTokenSpec'' tokexpr [] = [tokexpr, tokexpr] +parseTokenSpec'' tokexpr ts = tokexpr : ts + +addReservedTokens [tokexpr, tok] = tokexpr : [us `T.append` tok, tok, us `T.append` tok `T.append` us ] + where us = T.pack "__" +addReservedTokens list = error $ "addReservedTokens" ++ show list + +expandInput = sortBy (comparing (dropWhile (=='_') . snd)) . concatMap expand + where + expand (t:ts) = [ (t,t') | t' <- ts ] + +genOutput (ttok,tstr) = + "idkwtok " ++ pattern ++ " = tok " ++ (show$length tstr) ++ " " ++ (genTok ttok) + where + genTok ts@('(':_) = ts + genTok (t:ts) = "CTok" ++ (toUpper t : ts) + pattern = "(" ++ L.intercalate " : " (map charPat tstr) ++ " : [])" + charPat c = '\'' : c : '\'' : [] + +run ifile ofile = do + inp <-readFile ifile + let tokens = parseInput inp + withFile ofile WriteMode $ \handle -> do + hPutStrLn handle $ "-- Tokens: " ++ unwords (concatMap tail tokens) + mapM_ (hPutStrLn handle) ((map genOutput . expandInput) tokens) + +main = do + arguments <- getArgs + let (ifile,ofile) = + case arguments of + [a,b]-> (a,b) + _ -> error "Usage: GenerateKeywords.hs tokenlist.txt tokenlist.hs" + run ifile ofile addfile ./scripts/tokenlist.txt hunk ./scripts/tokenlist.txt 1 +alignof @__, asm @__, auto +break, bool _Bool, +case, char, const @__, continue, complex _Complex __complex__ +default, do, double, +else, enum, extern, +float, for, goto, +if, inline @__, int, int128 __int128, long, noreturn _Noreturn, +register, restrict @__, return +short, signed @__, sizeof, static, struct, switch, +typedef, typeof @__, thread __thread, +union, unsigned, void, volatile @__, +while, +label __label__ +(CTokGnuC GnuCAttrTok) __attribute __attribute__ +(CTokGnuC GnuCExtTok) __extension__ +(CTokGnuC GnuCComplexReal) __real __real__ +(CTokGnuC GnuCComplexImag) __imag __imag__ +(CTokGnuC GnuCVaArg) __builtin_va_arg +(CTokGnuC GnuCOffsetof) __builtin_offsetof +(CTokGnuC GnuCTyCompat) __builtin_types_compatible_p move ./src/derive-2.4.2.patch ./src/derive/derive-2.4.2.patch hunk ./src/derive.sh 6 - (cd derive && ghc -O --make -o Derive Derive.hs) + (cd derive && make) hunk ./src/derive.sh 9 - echo "Warning: Could not find ${DERIVE}, and derive >= 2.5 is not installed">&2 - echo "Press Enter to download, patch and build derive-${DERIVE_PATCH_VERSION}.">&2 - read - cabal unpack derive-${DERIVE_PATCH_VERSION} - pushd derive-${DERIVE_PATCH_VERSION} - patch -p1 < ../derive-${DERIVE_PATCH_VERSION}.patch - cabal configure - cabal build - popd - echo "Installing ${DERIVE}" - cp derive-${DERIVE_PATCH_VERSION}/dist/build/derive/derive "${DERIVE}" + echo "Warning: Could not find ${DERIVE}, and derive >= 2.5 is not installed">&2 + echo "Please install derive 2.5.* (tested with 2.5.23)" >&2 + exit 1 hunk ./src/derive/Data/Derive/Annotated.hs 35 - return [ InstDecl noLoc [] (qname "Annotated") [TyCon $ qname (dataDeclName dat)] (map InsDecl [ FunBind annotDecls, FunBind amapDecls ]) ] + return [ InstDecl noLoc -- SrcLoc + Nothing -- Maybe Overlap + [] -- TyVarBind + [] -- Context + (qname "Annotated") -- QName + [TyCon $ qname (dataDeclName dat)] -- [Type] + (map InsDecl [ FunBind annotDecls, FunBind amapDecls ]) ] -- [InstDecl] hunk ./src/derive/Data/Derive/Annotated.hs 72 -ctorArgs :: CtorDecl -> DeriveM [(Integer,BangType)] +-- remove Bang or unpack annotation +fromBangType :: Type -> Type +fromBangType (TyBang _ ty) = fromBangType ty +fromBangType ty = ty + +-- constructor arguments +ctorArgs :: CtorDecl -> DeriveM [(Integer,Type)] hunk ./src/derive/Data/Derive/Annotated.hs 82 -selectDelegateArg :: [(Integer, BangType)] -> DeriveM Type +selectDelegateArg :: [(Integer, Type)] -> DeriveM Type hunk ./src/derive/Data/Derive/Annotated.hs 91 -selectPolyArg :: [(Integer, BangType)] -> DeriveM (Integer, Name) +selectPolyArg :: [(Integer, Type)] -> DeriveM (Integer, Name) hunk ./src/derive/Data/Derive/Annotated.hs 101 -funDecl funName patterns rhs = Match noLoc (Ident funName) patterns Nothing (UnGuardedRhs rhs) (BDecls []) +funDecl funName patterns rhs = Match noLoc (Ident funName) patterns Nothing (UnGuardedRhs rhs) Nothing hunk ./src/derive/Data/Derive/Annotated.hs 118 +instance Functor DeriveM where + fmap f (DOk a) = DOk (f a) + fmap _ (DErr msg) = DErr msg +instance Applicative DeriveM where + pure x = DOk x + mf <*> ma = case (mf, ma) of + (DOk f, DOk a) -> DOk (f a) + (DErr msg, _) -> DErr msg + (_, DErr msg) -> DErr msg hunk ./src/derive/Data/Derive/CNode.hs 87 -instanceContext reqs cls dat defs = InstDecl noLoc ctx className [hed] (map InsDecl defs) +instanceContext reqs cls dat defs = InstDecl noLoc Nothing [] ctx className [hed] (map InsDecl defs) hunk ./src/derive/Data/Derive/CNode.hs 95 +-- remove Bang or unpack annotation +fromBangType :: Type -> Type +fromBangType (TyBang _ ty) = fromBangType ty +fromBangType ty = ty + hunk ./src/derive/DeriveTest.hs 27 - --------------------------------------------------------- --- DERIVES GENERATED CODE --- DO NOT MODIFY BELOW THIS LINE --- CHECKSUM: 629656574 - -instance CNode ExplicitNodeInfo - where nodeInfo (ExplicitNodeInfo1 nodeinfo _) = nodeinfo - nodeInfo (ExplicitNodeInfo2 _ nodeinfo) = nodeinfo - nodeInfo (ExplicitNodeInfo3 _ nodeinfo _) = nodeinfo -instance Pos ExplicitNodeInfo - where posOf x = posOfNode (nodeInfo x) - -instance CNode OneArgNodeInfo - where nodeInfo (ExplicitNodeInfo4 _ nodeinfo) = nodeinfo - nodeInfo (Delegator d) = nodeInfo d -instance Pos OneArgNodeInfo - where posOf x = posOfNode (nodeInfo x) - -instance CNode t1 => CNode (PolyVarNodeInfo t1) - where nodeInfo (PolyCon2 _ _ t) = nodeInfo t - nodeInfo (PolyCon1 _ t) = nodeInfo t - nodeInfo (PolyCon0 d) = nodeInfo d - nodeInfo (PolyDelegator d) = nodeInfo d -instance CNode t1 => Pos (PolyVarNodeInfo t1) - where posOf x = posOfNode (nodeInfo x) +-- GENERATED START + +instance CNode ExplicitNodeInfo where + nodeInfo (ExplicitNodeInfo1 n _) = n + nodeInfo (ExplicitNodeInfo2 _ n) = n + nodeInfo (ExplicitNodeInfo3 _ n _) = n +instance Pos ExplicitNodeInfo where + posOf x = posOf (nodeInfo x) + +instance CNode OneArgNodeInfo where + nodeInfo (ExplicitNodeInfo4 _ n) = n + nodeInfo (Delegator d) = nodeInfo d +instance Pos OneArgNodeInfo where + posOf x = posOf (nodeInfo x) + +instance CNode t1 => CNode (PolyVarNodeInfo t1) where + nodeInfo (PolyCon2 _ _ n) = nodeInfo n + nodeInfo (PolyCon1 _ n) = nodeInfo n + nodeInfo (PolyCon0 d) = nodeInfo d + nodeInfo (PolyDelegator d) = nodeInfo d +instance CNode t1 => Pos (PolyVarNodeInfo t1) where + posOf x = posOf (nodeInfo x) +-- GENERATED STOP addfile ./src/derive/DeriveTest.hs.expect hunk ./src/derive/DeriveTest.hs.expect 1 +{-# LANGUAGE DeriveDataTypeable #-} + +module DeriveTest where +import Language.C.Data.Node +import Language.C.Data.Position +import Data.Data +data ExplicitNodeInfo = ExplicitNodeInfo1 NodeInfo Int + | ExplicitNodeInfo2 Int NodeInfo + | ExplicitNodeInfo3 Int NodeInfo Int + deriving (Data,Typeable {-! ,CNode !-}) +data OneArgNodeInfo = ExplicitNodeInfo4 Int NodeInfo + | Delegator ExplicitNodeInfo + deriving (Data,Typeable {-! ,CNode !-}) +data PolyVarNodeInfo a = PolyCon2 Int Int a + | PolyCon1 Int a + | PolyCon0 a + | PolyDelegator OneArgNodeInfo + deriving (Data,Typeable {-! ,CNode !-}) + +-- -- Should fail +-- data PolyVarNodeInfo a b = PolyCon2 Int Int a +-- | PolyCon1 a b +-- deriving (Data,Typeable {-! CNode !-}) +-- + + +-- GENERATED START + +instance CNode ExplicitNodeInfo where + nodeInfo (ExplicitNodeInfo1 n _) = n + nodeInfo (ExplicitNodeInfo2 _ n) = n + nodeInfo (ExplicitNodeInfo3 _ n _) = n +instance Pos ExplicitNodeInfo where + posOf x = posOf (nodeInfo x) + +instance CNode OneArgNodeInfo where + nodeInfo (ExplicitNodeInfo4 _ n) = n + nodeInfo (Delegator d) = nodeInfo d +instance Pos OneArgNodeInfo where + posOf x = posOf (nodeInfo x) + +instance CNode t1 => CNode (PolyVarNodeInfo t1) where + nodeInfo (PolyCon2 _ _ n) = nodeInfo n + nodeInfo (PolyCon1 _ n) = nodeInfo n + nodeInfo (PolyCon0 d) = nodeInfo d + nodeInfo (PolyDelegator d) = nodeInfo d +instance CNode t1 => Pos (PolyVarNodeInfo t1) where + posOf x = posOf (nodeInfo x) +-- GENERATED STOP addfile ./src/derive/Makefile hunk ./src/derive/Makefile 1 +GHC=ghc +GHC_FLAGS=-O +DERIVE_TARGET=Derive +.PHONY: all clean +all: $(DERIVE_TARGET) +$(DERIVE_TARGET): | objdir + $(GHC) $(GHC_FLAGS) --make -outputdir objdir -o $(DERIVE_TARGET) $(DERIVE_TARGET).hs +objdir: + mkdir -p $@ +test: $(DERIVE_TARGET) + ./$(DERIVE_TARGET) -a DeriveTest.hs + diff DeriveTest.hs.expect DeriveTest.hs +clean: + rm -f $(DERIVE_TARGET) + rm -rf objdir hunk ./examples/ComputeSize.hs 115 -genSizeTest typeDefs tys = either (error.show) fromExtDecl $ - parseC (inputStreamFromString test) (initPos "genSizeTest") +genSizeTest typeDefs tys = + either (\e -> error $ "Failed to parse " ++ test ++ ": " ++ show e) + fromExtDecl + (parseC (inputStreamFromString test) (initPos "genSizeTest")) hunk ./examples/ComputeSize.hs 131 - getTagStr ref@(NamedRef _) tag = - Just (show tag ++ " " ++ show ref) + getTagStr (NamedRef name) tag = + Just (show tag ++ " " ++ identToString name) hunk ./examples/DumpAst.hs 18 - let usageErr = (hPutStrLn stderr (usageMsg "./ParseAndPrint") >> exitWith (ExitFailure 1)) - args <- getArgs - when (length args < 1) usageErr - let (opts,input_file) = (init args, last args) - ast <- errorOnLeftM "Parse Error" $ parseCFile (newGCC "gcc") Nothing opts input_file - putStrLn $ (decorate (shows (fmap (const ShowPlaceholder) ast)) "") + let usageErr = (hPutStrLn stderr (usageMsg "./ParseAndPrint") >> exitWith (ExitFailure 1)) + args <- getArgs + when (length args < 1) usageErr + let (opts,input_file) = (init args, last args) + ast <- errorOnLeftM "Parse Error" $ parseCFile (newGCC "gcc") Nothing opts input_file + putStrLn $ (decorate (shows (fmap (const ShowPlaceholder) ast)) "") hunk ./examples/Makefile 3 -EXAMPLES=ParseAndPrint ScanFile SearchDef TypeCheck ComputeSize dump_ast +EXAMPLES=ParseAndPrint ScanFile SearchDef TypeCheck ComputeSize DumpAst hunk ./examples/Makefile 8 -# requires package haskell-src -no_haskell_src=$(shell ghc-pkg list | grep -q haskell-src; echo $$?) -ifeq ($(no_haskell_src),0) -dump_ast: DumpAst -else -dump_ast: - @echo "Note: skipping DumpAst, no haskell-src available" -endif - -clean: - rm -f *.o *.hi $(EXAMPLES) +demo_compute_size: + gcc -DDEBUG compute_size.c -o compute_size.bin && ./compute_size.bin + ./ComputeSize 'comp' compute_size.c | gcc -x c -o compute_size_hs.bin - && \ + ./compute_size_hs.bin + +clean: clean_tmp + rm -f $(EXAMPLES) hunk ./examples/Makefile 16 - rm -f *.o *.hi + rm -f *.o *.hi *.bin hunk ./examples/compute_size.c 1 +#ifdef DEBUG hunk ./examples/compute_size.c 3 +#endif hunk ./examples/compute_size.c 5 -typedef struct __attribute__((packed)) - { char x; short y; } - T; +typedef struct __attribute__((packed)) + { char x; short y; } + T; hunk ./examples/compute_size.c 9 - bool b4; short b5; bool b6; } + bool b4; short b5; bool b6; } hunk ./examples/compute_size.c 11 -union u1 { - T x; - /* packed for struct/union fields: smallest possible alignment, i.e. do not add padding zeros to align the pointer +union u1 { + T x; + /* packed for struct/union fields: smallest possible alignment, i.e. do not add padding zeros to align the pointer hunk ./examples/compute_size.c 21 -{ +{ hunk ./examples/compute_size.c 24 + hunk ./examples/compute_size.c 32 -struct s { - struct k { short b1 : 8, b2: 9, b3: 8, b4 : 7;} x; +struct s { + struct k { short b1 : 8, b2: 9, b3: 8, b4 : 7;} x; hunk ./examples/compute_size.c 38 -int main() + +int main() hunk ./examples/compute_size.c 41 + #ifdef DEBUG hunk ./examples/compute_size.c 49 + #endif hunk ./examples/compute_size.c 51 + hunk ./src/Language/C/Analysis/AstAnalysis.hs 95 - let (VarDeclInfo name is_inline storage_spec attrs ty declr_node) = var_decl_info + let (VarDeclInfo name fun_spec storage_spec attrs ty declr_node) = var_decl_info hunk ./src/Language/C/Analysis/AstAnalysis.hs 102 - let var_decl = VarDecl name (DeclAttrs is_inline fun_storage attrs) ty' + let var_decl = VarDecl name (DeclAttrs fun_spec fun_storage attrs) ty' hunk ./src/Language/C/Analysis/AstAnalysis.hs 158 - (VarDeclInfo name is_inline storage_spec attrs ty declr_node) <- analyseVarDecl' handle_sue_def declspecs declr [] Nothing - checkValidTypeDef is_inline storage_spec attrs + (VarDeclInfo name fun_attrs storage_spec attrs ty declr_node) <- analyseVarDecl' handle_sue_def declspecs declr [] Nothing + checkValidTypeDef fun_attrs storage_spec attrs hunk ./src/Language/C/Analysis/AstAnalysis.hs 164 - checkValidTypeDef True _ _ = astError node_info "inline specifier for typeDef" + checkValidTypeDef fun_attrs _ _ | fun_attrs /= noFunctionAttrs = + astError node_info "inline specifier for typeDef" hunk ./src/Language/C/Analysis/AstAnalysis.hs 194 -extFunProto (VarDeclInfo var_name is_inline storage_spec attrs ty node_info) = +extFunProto (VarDeclInfo var_name fun_spec storage_spec attrs ty node_info) = hunk ./src/Language/C/Analysis/AstAnalysis.hs 198 - let decl = VarDecl var_name (DeclAttrs is_inline (funDeclLinkage old_fun) attrs) ty + let decl = VarDecl var_name (DeclAttrs fun_spec (funDeclLinkage old_fun) attrs) ty hunk ./src/Language/C/Analysis/AstAnalysis.hs 224 -extVarDecl (VarDeclInfo var_name is_inline storage_spec attrs typ node_info) init_opt = +extVarDecl (VarDeclInfo var_name fun_spec storage_spec attrs typ node_info) init_opt = hunk ./src/Language/C/Analysis/AstAnalysis.hs 227 - let vardecl = VarDecl var_name (DeclAttrs is_inline storage attrs) typ + let vardecl = VarDecl var_name (DeclAttrs fun_spec storage attrs) typ hunk ./src/Language/C/Analysis/AstAnalysis.hs 233 - globalStorage _ | is_inline = astError node_info "invalid `inline' specifier external variable" + globalStorage _ | (fun_spec /= noFunctionAttrs) = + astError node_info "invalid function specifier for external variable" hunk ./src/Language/C/Analysis/AstAnalysis.hs 257 - isFuncDef (FunctionDef fd) = not $ isInline $ declAttrs fd + isFuncDef (FunctionDef fd) = not $ (isInline . functionAttrs) fd hunk ./src/Language/C/Analysis/AstAnalysis.hs 259 - isInline (DeclAttrs inl _ _) = inl hunk ./src/Language/C/Analysis/AstAnalysis.hs 263 -localVarDecl (VarDeclInfo var_name is_inline storage_spec attrs typ node_info) init_opt = +localVarDecl (VarDeclInfo var_name fun_attrs storage_spec attrs typ node_info) init_opt = hunk ./src/Language/C/Analysis/AstAnalysis.hs 266 - let vardecl = VarDecl var_name (DeclAttrs is_inline storage attrs) typ + let vardecl = VarDecl var_name (DeclAttrs fun_attrs storage attrs) typ hunk ./src/Language/C/Analysis/AstAnalysis.hs 272 - localStorage _ - | is_inline = astError node_info "invalid `inline' specifier for local variable" hunk ./src/Language/C/Analysis/Builtins.hs 16 - (DeclAttrs False (Auto False) []) + (DeclAttrs noFunctionAttrs (Auto False) []) hunk ./src/Language/C/Analysis/Builtins.hs 18 - fnAttrs = DeclAttrs False (FunLinkage ExternalLinkage) [] - varAttrs = DeclAttrs False (Static InternalLinkage False) [] + fnAttrs = DeclAttrs noFunctionAttrs (FunLinkage ExternalLinkage) [] + varAttrs = DeclAttrs noFunctionAttrs (Static InternalLinkage False) [] hunk ./src/Language/C/Analysis/Debug.hs 128 - pretty (DeclAttrs inline storage attrs) = - (if inline then (text "inline") else empty) <+> - (hsep $ [ pretty storage, pretty attrs]) + pretty (DeclAttrs fun_attrs storage attrs) = + hsep $ [ pretty fun_attrs, pretty storage, pretty attrs] + hunk ./src/Language/C/Analysis/Debug.hs 160 +instance Pretty FunctionAttrs where + pretty fattrs = hsep [pIf isInline "inline", pIf isNoreturn "_Noreturn"] + where + pIf pred txt = if pred fattrs then text txt else empty + hunk ./src/Language/C/Analysis/DeclAnalysis.hs 21 - canonicalStorageSpec, StorageSpec(..),hasThreadLocalSpec, isTypeDef, + canonicalStorageSpec, StorageSpec(..), hasThreadLocalSpec, isTypeDef, hunk ./src/Language/C/Analysis/DeclAnalysis.hs 56 - (VarDeclInfo name is_inline storage_spec attrs ty declr_node) <- analyseVarDecl' True declspecs declr [] Nothing - when (is_inline) $ throwTravError (badSpecifierError node "parameter declaration with inline specifier") + (VarDeclInfo name fun_spec storage_spec attrs ty declr_node) <- analyseVarDecl' True declspecs declr [] Nothing + when (isInline fun_spec || isNoreturn fun_spec) $ + throwTravError (badSpecifierError node "parameter declaration with function specifier") hunk ./src/Language/C/Analysis/DeclAnalysis.hs 71 - let vd = VarDecl name (DeclAttrs False storage attrs) ty in + let vd = VarDecl name (DeclAttrs noFunctionAttrs storage attrs) ty in hunk ./src/Language/C/Analysis/DeclAnalysis.hs 86 - do let (storage_specs, _attrs, typequals, typespecs, is_inline) = + do let (storage_specs, _attrs, typequals, typespecs, funspecs) = hunk ./src/Language/C/Analysis/DeclAnalysis.hs 88 - when is_inline $ astError node "member declaration with inline specifier" + when (not (null funspecs)) $ astError node "member declaration with function specifier" hunk ./src/Language/C/Analysis/DeclAnalysis.hs 95 - (VarDecl NoName (DeclAttrs False NoStorage []) ty) + (VarDecl NoName (DeclAttrs noFunctionAttrs NoStorage []) ty) hunk ./src/Language/C/Analysis/DeclAnalysis.hs 104 - let (VarDeclInfo name is_inline storage_spec attrs ty declr_node) = var_decl + let (VarDeclInfo name fun_spec storage_spec attrs ty declr_node) = var_decl hunk ./src/Language/C/Analysis/DeclAnalysis.hs 106 - checkValidMemberSpec is_inline storage_spec - return $ MemberDecl (VarDecl name (DeclAttrs False NoStorage attrs) ty) bit_field_size_opt node + checkValidMemberSpec fun_spec storage_spec + return $ MemberDecl (VarDecl name (DeclAttrs noFunctionAttrs NoStorage attrs) ty) + bit_field_size_opt node hunk ./src/Language/C/Analysis/DeclAnalysis.hs 117 - checkValidMemberSpec is_inline storage_spec = - do when (is_inline) $ astError node "member declaration with inline specifier" + checkValidMemberSpec fun_spec storage_spec = + do when (fun_spec /= noFunctionAttrs) $ astError node "member declaration with inline specifier" hunk ./src/Language/C/Analysis/DeclAnalysis.hs 131 -data VarDeclInfo = VarDeclInfo VarName Bool {- is-inline? -} StorageSpec Attributes Type NodeInfo +data VarDeclInfo = VarDeclInfo VarName FunctionAttrs StorageSpec Attributes Type NodeInfo hunk ./src/Language/C/Analysis/DeclAnalysis.hs 137 - do let (storage_specs, attrs, type_quals, type_specs, inline) = + do let (storage_specs, attrs, type_quals, type_specs, funspecs) = hunk ./src/Language/C/Analysis/DeclAnalysis.hs 140 - analyseVarDecl handle_sue_def storage_specs attrs type_quals canonTySpecs inline + analyseVarDecl handle_sue_def storage_specs attrs type_quals canonTySpecs funspecs hunk ./src/Language/C/Analysis/DeclAnalysis.hs 146 - TypeSpecAnalysis -> Bool -> + TypeSpecAnalysis -> [CFunSpec] -> hunk ./src/Language/C/Analysis/DeclAnalysis.hs 148 -analyseVarDecl handle_sue_def storage_specs decl_attrs typequals canonTySpecs inline +analyseVarDecl handle_sue_def storage_specs decl_attrs typequals canonTySpecs fun_specs hunk ./src/Language/C/Analysis/DeclAnalysis.hs 159 - return $ VarDeclInfo name inline storage_spec attrs' typ node + return $ VarDeclInfo name function_spec storage_spec attrs' typ node hunk ./src/Language/C/Analysis/DeclAnalysis.hs 161 - isInlineSpec (CInlineQual _) = True - isInlineSpec _ = False - + updateFunSpec (CInlineQual _) f = f { isInline = True } + updateFunSpec (CNoreturnQual _) f = f { isNoreturn = True } + function_spec = foldr updateFunSpec noFunctionAttrs fun_specs hunk ./src/Language/C/Analysis/DeclAnalysis.hs 191 - | (not (null storagespec) || inline) = astError node "storage specifier for type declaration" + | (not (null storagespec) || not (null funspecs)) = + astError node "storage or function specifier for type declaration" hunk ./src/Language/C/Analysis/DeclAnalysis.hs 201 - (storagespec, attrs_decl, typequals, typespecs, inline) = partitionDeclSpecs declspecs + (storagespec, attrs_decl, typequals, typespecs, funspecs) = partitionDeclSpecs declspecs hunk ./src/Language/C/Analysis/DeclAnalysis.hs 409 - go (CInlineQual node) (_tq,_attrs) = astError node "unexpected inline qualifier" + go (CFunSpecQual fs) (_tq,_attrs) = astError (nodeInfo fs) "unexpected function specifier for type" hunk ./src/Language/C/Analysis/Export.hs 190 -exportDeclAttrs (DeclAttrs inline storage attrs) = - (if inline then [CTypeQual (CInlineQual ni)] else []) +exportDeclAttrs (DeclAttrs fun_attrs storage attrs) = + map (CTypeQual . CFunSpecQual) (exportFunAttrs fun_attrs) hunk ./src/Language/C/Analysis/Export.hs 195 +-- | export function attributes to C function specifiers +exportFunAttrs :: FunctionAttrs -> [CFunSpec] +exportFunAttrs fattrs = catMaybes [inlQual, noretQual] + where + inlQual = if isInline fattrs then Just (CInlineQual ni) else Nothing + noretQual = if isNoreturn fattrs then Just (CNoreturnQual ni) else Nothing + hunk ./src/Language/C/Analysis/SemRep.hs 33 +FunctionAttrs(..), functionAttrs, noFunctionAttrs, hunk ./src/Language/C/Analysis/SemRep.hs 255 - getVarDecl (AnonBitField ty _ _) = VarDecl NoName (DeclAttrs False NoStorage []) ty + getVarDecl (AnonBitField ty _ _) = VarDecl NoName (DeclAttrs noFunctionAttrs NoStorage []) ty hunk ./src/Language/C/Analysis/SemRep.hs 281 -data DeclAttrs = DeclAttrs Bool Storage Attributes - -- ^ @DeclAttrs inline storage attrs@ +data DeclAttrs = DeclAttrs FunctionAttrs Storage Attributes + -- ^ @DeclAttrs fspecs storage attrs@ hunk ./src/Language/C/Analysis/SemRep.hs 289 +-- | get the `function attributes' of a declaration +functionAttrs :: (Declaration d) => d -> FunctionAttrs +functionAttrs d = case declAttrs d of (DeclAttrs fa _ _) -> fa + +-- Function attributes (inline, noreturn) +data FunctionAttrs = FunctionAttrs { isInline :: Bool, isNoreturn :: Bool } + deriving (Eq, Ord, Typeable, Data) + +noFunctionAttrs :: FunctionAttrs +noFunctionAttrs = FunctionAttrs { isInline = False, isNoreturn = False } + + hunk ./src/Language/C/Analysis/SemRep.hs 490 - (DeclAttrs False NoStorage []) + (DeclAttrs noFunctionAttrs NoStorage []) hunk ./src/Language/C/Analysis/SemRep.hs 580 - hunk ./src/Language/C/Analysis/SemRep.hs 583 - hunk ./src/Language/C/Analysis/SemRep.hs 586 - hunk ./src/Language/C/Analysis/SemRep.hs 591 - hunk ./src/Language/C/Analysis/SemRep.hs 594 - hunk ./src/Language/C/Analysis/SemRep.hs 601 - hunk ./src/Language/C/Analysis/SemRep.hs 604 - hunk ./src/Language/C/Analysis/SemRep.hs 606 - hunk ./src/Language/C/Analysis/SemRep.hs 609 - hunk ./src/Language/C/Analysis/SemRep.hs 611 - hunk ./src/Language/C/Analysis/SemRep.hs 614 - hunk ./src/Language/C/Analysis/SemRep.hs 616 - hunk ./src/Language/C/Analysis/SemRep.hs 619 - hunk ./src/Language/C/Analysis/SemRep.hs 622 - hunk ./src/Language/C/Analysis/SemRep.hs 625 - hunk ./src/Language/C/Analysis/SemRep.hs 628 - hunk ./src/Language/C/Analysis/SemRep.hs 631 - hunk ./src/Language/C/Analysis/SemRep.hs 633 - hunk ./src/Language/C/Analysis/SemRep.hs 636 - hunk ./src/Language/C/Analysis/SemRep.hs 638 - hunk ./src/Language/C/Analysis/SemRep.hs 641 - hunk ./src/Language/C/Analysis/SemRep.hs 643 - hunk ./src/Language/C/Analysis/SemRep.hs 646 - hunk ./src/Language/C/Analysis/SemRep.hs 648 - hunk ./src/Language/C/Analysis/SemRep.hs 651 - hunk ./src/Language/C/Analysis/SemRep.hs 653 - hunk ./src/Language/C/Analysis/SemRep.hs 656 - hunk ./src/Language/C/Analysis/SemRep.hs 658 - hunk ./src/Language/C/Analysis/SemRep.hs 661 - hunk ./src/Language/C/Analysis/SemRep.hs 663 - hunk ./src/Language/C/Analysis/SemRep.hs 666 - hunk ./src/Language/C/Analysis/SemRep.hs 668 - hunk ./src/Language/C/Parser/Lexer.x 268 --- using the script GenerateKeywordMatch.hs (in /src) +-- using the script GenerateKeywords.hs (in /scripts) hunk ./src/Language/C/Parser/Lexer.x 276 -if, inline @__, int, __int128, long, +if, inline @__, int, __int128, long, noreturn _Noreturn, hunk ./src/Language/C/Parser/Lexer.x 291 --- Tokens: alignof __alignof __alignof__ asm __asm __asm__ __attribute __attribute__ auto _Bool break __builtin_offsetof __builtin_types_compatible_p __builtin_va_arg case char _Complex __complex__ const __const __const__ continue default do double else enum __extension__ extern float for goto if __imag __imag__ inline __inline __inline__ int __int128 __label__ long __real __real__ register __restrict __restrict__ return short signed __signed __signed__ sizeof static struct switch __thread typedef typeof __typeof __typeof__ union unsigned void volatile __volatile __volatile__ while +-- Tokens: alignof __alignof __alignof__ asm __asm __asm__ __attribute __attribute__ auto _Bool break __builtin_offsetof __builtin_types_compatible_p __builtin_va_arg case char _Complex __complex__ const __const __const__ continue default do double else enum __extension__ extern float for goto if __imag __imag__ inline __inline __inline__ int __int128 __label__ long _Noreturn __real __real__ register __restrict __restrict__ return short signed __signed __signed__ sizeof static struct switch __thread typedef typeof __typeof __typeof__ union unsigned void volatile __volatile __volatile__ while hunk ./src/Language/C/Parser/Lexer.x 293 -idkwtok ('_' : 'C' : 'o' : 'm' : 'p' : 'l' : 'e' : 'x' : []) = tok 8 CTokComplex +idkwtok ('_' : 'N' : 'o' : 'r' : 'e' : 't' : 'u' : 'r' : 'n' : []) = tok 9 CTokNoreturn hunk ./src/Language/C/Parser/Lexer.x 302 -idkwtok ('a' : 'u' : 't' : 'o' : []) = tok 4 CTokAuto -idkwtok ('b' : 'r' : 'e' : 'a' : 'k' : []) = tok 5 CTokBreak hunk ./src/Language/C/Parser/Lexer.x 305 -idkwtok ('c' : 'a' : 's' : 'e' : []) = tok 4 CTokCase -idkwtok ('c' : 'h' : 'a' : 'r' : []) = tok 4 CTokChar +idkwtok ('_' : 'C' : 'o' : 'm' : 'p' : 'l' : 'e' : 'x' : []) = tok 8 CTokComplex hunk ./src/Language/C/Parser/Lexer.x 310 +idkwtok ('_' : '_' : 'e' : 'x' : 't' : 'e' : 'n' : 's' : 'i' : 'o' : 'n' : '_' : '_' : []) = tok 13 (CTokGnuC GnuCExtTok) +idkwtok ('_' : '_' : 'i' : 'm' : 'a' : 'g' : []) = tok 6 (CTokGnuC GnuCComplexImag) +idkwtok ('_' : '_' : 'i' : 'm' : 'a' : 'g' : '_' : '_' : []) = tok 8 (CTokGnuC GnuCComplexImag) +idkwtok ('_' : '_' : 'i' : 'n' : 'l' : 'i' : 'n' : 'e' : []) = tok 8 CTokInline +idkwtok ('i' : 'n' : 'l' : 'i' : 'n' : 'e' : []) = tok 6 CTokInline +idkwtok ('_' : '_' : 'i' : 'n' : 'l' : 'i' : 'n' : 'e' : '_' : '_' : []) = tok 10 CTokInline +idkwtok ('_' : '_' : 'i' : 'n' : 't' : '1' : '2' : '8' : []) = tok 8 CTokInt128 +idkwtok ('_' : '_' : 'l' : 'a' : 'b' : 'e' : 'l' : '_' : '_' : []) = tok 9 CTokLabel +idkwtok ('_' : '_' : 'r' : 'e' : 'a' : 'l' : []) = tok 6 (CTokGnuC GnuCComplexReal) +idkwtok ('_' : '_' : 'r' : 'e' : 'a' : 'l' : '_' : '_' : []) = tok 8 (CTokGnuC GnuCComplexReal) +idkwtok ('_' : '_' : 'r' : 'e' : 's' : 't' : 'r' : 'i' : 'c' : 't' : []) = tok 10 CTokRestrict +idkwtok ('r' : 'e' : 's' : 't' : 'r' : 'i' : 'c' : 't' : []) = tok 8 CTokRestrict +idkwtok ('_' : '_' : 'r' : 'e' : 's' : 't' : 'r' : 'i' : 'c' : 't' : '_' : '_' : []) = tok 12 CTokRestrict +idkwtok ('_' : '_' : 's' : 'i' : 'g' : 'n' : 'e' : 'd' : []) = tok 8 CTokSigned +idkwtok ('s' : 'i' : 'g' : 'n' : 'e' : 'd' : []) = tok 6 CTokSigned +idkwtok ('_' : '_' : 's' : 'i' : 'g' : 'n' : 'e' : 'd' : '_' : '_' : []) = tok 10 CTokSigned +idkwtok ('_' : '_' : 't' : 'h' : 'r' : 'e' : 'a' : 'd' : []) = tok 8 CTokThread +idkwtok ('_' : '_' : 't' : 'y' : 'p' : 'e' : 'o' : 'f' : []) = tok 8 CTokTypeof +idkwtok ('t' : 'y' : 'p' : 'e' : 'o' : 'f' : []) = tok 6 CTokTypeof +idkwtok ('_' : '_' : 't' : 'y' : 'p' : 'e' : 'o' : 'f' : '_' : '_' : []) = tok 10 CTokTypeof +idkwtok ('_' : '_' : 'v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : []) = tok 10 CTokVolatile +idkwtok ('v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : []) = tok 8 CTokVolatile +idkwtok ('_' : '_' : 'v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : '_' : '_' : []) = tok 12 CTokVolatile +idkwtok ('a' : 'u' : 't' : 'o' : []) = tok 4 CTokAuto +idkwtok ('b' : 'r' : 'e' : 'a' : 'k' : []) = tok 5 CTokBreak +idkwtok ('c' : 'a' : 's' : 'e' : []) = tok 4 CTokCase +idkwtok ('c' : 'h' : 'a' : 'r' : []) = tok 4 CTokChar hunk ./src/Language/C/Parser/Lexer.x 343 -idkwtok ('_' : '_' : 'e' : 'x' : 't' : 'e' : 'n' : 's' : 'i' : 'o' : 'n' : '_' : '_' : []) = tok 13 (CTokGnuC GnuCExtTok) hunk ./src/Language/C/Parser/Lexer.x 348 -idkwtok ('_' : '_' : 'i' : 'm' : 'a' : 'g' : []) = tok 6 (CTokGnuC GnuCComplexImag) -idkwtok ('_' : '_' : 'i' : 'm' : 'a' : 'g' : '_' : '_' : []) = tok 8 (CTokGnuC GnuCComplexImag) -idkwtok ('_' : '_' : 'i' : 'n' : 'l' : 'i' : 'n' : 'e' : []) = tok 8 CTokInline -idkwtok ('i' : 'n' : 'l' : 'i' : 'n' : 'e' : []) = tok 6 CTokInline -idkwtok ('_' : '_' : 'i' : 'n' : 'l' : 'i' : 'n' : 'e' : '_' : '_' : []) = tok 10 CTokInline hunk ./src/Language/C/Parser/Lexer.x 349 -idkwtok ('_' : '_' : 'i' : 'n' : 't' : '1' : '2' : '8' : []) = tok 8 CTokInt128 -idkwtok ('_' : '_' : 'l' : 'a' : 'b' : 'e' : 'l' : '_' : '_' : []) = tok 9 CTokLabel hunk ./src/Language/C/Parser/Lexer.x 350 -idkwtok ('_' : '_' : 'r' : 'e' : 'a' : 'l' : []) = tok 6 (CTokGnuC GnuCComplexReal) -idkwtok ('_' : '_' : 'r' : 'e' : 'a' : 'l' : '_' : '_' : []) = tok 8 (CTokGnuC GnuCComplexReal) hunk ./src/Language/C/Parser/Lexer.x 351 -idkwtok ('_' : '_' : 'r' : 'e' : 's' : 't' : 'r' : 'i' : 'c' : 't' : []) = tok 10 CTokRestrict -idkwtok ('r' : 'e' : 's' : 't' : 'r' : 'i' : 'c' : 't' : []) = tok 8 CTokRestrict -idkwtok ('_' : '_' : 'r' : 'e' : 's' : 't' : 'r' : 'i' : 'c' : 't' : '_' : '_' : []) = tok 12 CTokRestrict hunk ./src/Language/C/Parser/Lexer.x 353 -idkwtok ('_' : '_' : 's' : 'i' : 'g' : 'n' : 'e' : 'd' : []) = tok 8 CTokSigned -idkwtok ('s' : 'i' : 'g' : 'n' : 'e' : 'd' : []) = tok 6 CTokSigned -idkwtok ('_' : '_' : 's' : 'i' : 'g' : 'n' : 'e' : 'd' : '_' : '_' : []) = tok 10 CTokSigned hunk ./src/Language/C/Parser/Lexer.x 357 -idkwtok ('_' : '_' : 't' : 'h' : 'r' : 'e' : 'a' : 'd' : []) = tok 8 CTokThread hunk ./src/Language/C/Parser/Lexer.x 358 -idkwtok ('_' : '_' : 't' : 'y' : 'p' : 'e' : 'o' : 'f' : []) = tok 8 CTokTypeof -idkwtok ('t' : 'y' : 'p' : 'e' : 'o' : 'f' : []) = tok 6 CTokTypeof -idkwtok ('_' : '_' : 't' : 'y' : 'p' : 'e' : 'o' : 'f' : '_' : '_' : []) = tok 10 CTokTypeof hunk ./src/Language/C/Parser/Lexer.x 361 -idkwtok ('_' : '_' : 'v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : []) = tok 10 CTokVolatile -idkwtok ('v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : []) = tok 8 CTokVolatile -idkwtok ('_' : '_' : 'v' : 'o' : 'l' : 'a' : 't' : 'i' : 'l' : 'e' : '_' : '_' : []) = tok 12 CTokVolatile hunk ./src/Language/C/Parser/Parser.y 206 -"__int128" { CTokInt128 _ } +"__int128" { CTokInt128 _ } hunk ./src/Language/C/Parser/Parser.y 209 +"_Noreturn" { CTokNoreturn _ } hunk ./src/Language/C/Parser/Parser.y 556 -type_qualifier :- const | volatile | restrict | inline +type_qualifier :- const | volatile | restrict | inline | _Noreturn hunk ./src/Language/C/Parser/Parser.y 759 --- A mixture of type qualifiers (const, volatile, restrict, inline) and storage class specifiers --- (extern, static, auto, register, __thread), in any order, but containing at least one storage class specifier. +-- A mixture of type qualifiers (const, volatile, restrict), function specifiers (inline, +-- _Noreturn) and storage class specifiers (extern, static, auto, register, __thread), +-- in any order, but containing at least one storage class specifier. hunk ./src/Language/C/Parser/Parser.y 1189 --- parse C type qualifier (C99 6.7.3) +-- parse C type qualifier (C99 6.7.3) and function specifier (C11 6.7.4) hunk ./src/Language/C/Parser/Parser.y 1196 - | inline {% withNodeInfo $1 $ CInlineQual } - --- a list containing at least one type_qualifier (const, volatile, restrict, inline) + | inline {% withNodeInfo $1 $ CFunSpecQual . CInlineQual } + | "_Noreturn" {% withNodeInfo $1 $ CFunSpecQual . CNoreturnQual } + +-- a list containing at least one type_qualifier (const, volatile, restrict, inline, _Noreturn) hunk ./src/Language/C/Parser/Tokens.hs 102 - | CTokLabel !PosLength -- `__label__' + | CTokLabel !PosLength -- `__label__ + | CTokNoreturn !PosLength -- `_Noreturn' hunk ./src/Language/C/Parser/Tokens.hs 224 +posLenOfTok (CTokNoreturn pos ) = pos hunk ./src/Language/C/Parser/Tokens.hs 323 + showsPrec _ (CTokNoreturn _ ) = showString "_Noreturn" hunk ./src/Language/C/Pretty.hs 255 - pretty (CInlineQual _) = text "inline" + pretty (CFunSpecQual fspec) = pretty fspec hunk ./src/Language/C/Pretty.hs 258 +instance Pretty CFunSpec where + pretty (CInlineQual _) = text "inline" + pretty (CNoreturnQual _) = text "_Noreturn" + hunk ./src/Language/C/Syntax/AST.hs 36 - CStorageSpec, CTypeSpec, isSUEDef, CTypeQual, CAttr, - CDeclarationSpecifier(..), CStorageSpecifier(..), CTypeSpecifier(..), + CStorageSpec, CTypeSpec, isSUEDef, CTypeQual, CFunSpec, CAttr, + CFunctionSpecifier(..), CDeclarationSpecifier(..), CStorageSpecifier(..), CTypeSpecifier(..), hunk ./src/Language/C/Syntax/AST.hs 394 - , [CTypeQualifier a], [CTypeSpecifier a], Bool) -partitionDeclSpecs = foldr deals ([],[],[],[],False) where - deals (CTypeQual (CInlineQual _)) (sts,ats,tqs,tss,_) = (sts,ats,tqs,tss,True) - deals (CStorageSpec sp) (sts,ats,tqs,tss,inline) = (sp:sts,ats,tqs,tss,inline) - deals (CTypeQual (CAttrQual attr)) (sts,ats,tqs,tss,inline) = (sts,attr:ats,tqs,tss,inline) - deals (CTypeQual tq) (sts,ats,tqs,tss,inline) = (sts,ats,tq:tqs,tss,inline) - deals (CTypeSpec ts) (sts,ats,tqs,tss,inline) = (sts,ats,tqs,ts:tss,inline) + , [CTypeQualifier a], [CTypeSpecifier a] + , [CFunctionSpecifier a] ) +partitionDeclSpecs = foldr deals ([],[],[],[],[]) where + deals (CTypeQual (CFunSpecQual fs)) (sts,ats,tqs,tss,fss) = (sts,ats,tqs,tss,fs:fss) + deals (CStorageSpec sp) (sts,ats,tqs,tss,fss) = (sp:sts,ats,tqs,tss,fss) + deals (CTypeQual (CAttrQual attr)) (sts,ats,tqs,tss,fss) = (sts,attr:ats,tqs,tss,fss) + deals (CTypeQual tq) (sts,ats,tqs,tss,fss) = (sts,ats,tq:tqs,tss,fss) + deals (CTypeSpec ts) (sts,ats,tqs,tss,fss) = (sts,ats,tqs,ts:tss,fss) hunk ./src/Language/C/Syntax/AST.hs 451 --- @const@, @volatile@ and @restrict@ type qualifiers and @inline@ function specifier. --- Additionally, @__attribute__@ annotations for declarations and declarators. +-- @const@, @volatile@ and @restrict@ type qualifiers +-- Additionally, @__attribute__@ annotations for declarations and declarators, and +-- function specifiers hunk ./src/Language/C/Syntax/AST.hs 459 - | CInlineQual a + | CFunSpecQual (CFunctionSpecifier a) hunk ./src/Language/C/Syntax/AST.hs 463 +-- | C function specifiers (C99 6.7.4) +-- +-- function specifiers @inline@ and @_Noreturn@ +type CFunSpec = CFunctionSpecifier NodeInfo +data CFunctionSpecifier a + = CInlineQual a + | CNoreturnQual a + deriving (Show, Data,Typeable {-! ,CNode ,Functor ,Annotated !-}) + hunk ./src/Language/C/Syntax/AST.hs 740 - -instance (CNode t1) => CNode (CTranslationUnit t1) where +instance CNode t1 => CNode (CTranslationUnit t1) where hunk ./src/Language/C/Syntax/AST.hs 742 - -instance (CNode t1) => Pos (CTranslationUnit t1) where +instance CNode t1 => Pos (CTranslationUnit t1) where hunk ./src/Language/C/Syntax/AST.hs 745 - hunk ./src/Language/C/Syntax/AST.hs 749 - hunk ./src/Language/C/Syntax/AST.hs 753 - -instance (CNode t1) => CNode (CExternalDeclaration t1) where +instance CNode t1 => CNode (CExternalDeclaration t1) where hunk ./src/Language/C/Syntax/AST.hs 757 - -instance (CNode t1) => Pos (CExternalDeclaration t1) where +instance CNode t1 => Pos (CExternalDeclaration t1) where hunk ./src/Language/C/Syntax/AST.hs 760 - hunk ./src/Language/C/Syntax/AST.hs 765 - hunk ./src/Language/C/Syntax/AST.hs 773 - -instance (CNode t1) => CNode (CFunctionDef t1) where +instance CNode t1 => CNode (CFunctionDef t1) where hunk ./src/Language/C/Syntax/AST.hs 775 - -instance (CNode t1) => Pos (CFunctionDef t1) where +instance CNode t1 => Pos (CFunctionDef t1) where hunk ./src/Language/C/Syntax/AST.hs 778 - hunk ./src/Language/C/Syntax/AST.hs 784 - hunk ./src/Language/C/Syntax/AST.hs 789 - -instance (CNode t1) => CNode (CDeclaration t1) where +instance CNode t1 => CNode (CDeclaration t1) where hunk ./src/Language/C/Syntax/AST.hs 791 - -instance (CNode t1) => Pos (CDeclaration t1) where +instance CNode t1 => Pos (CDeclaration t1) where hunk ./src/Language/C/Syntax/AST.hs 794 - hunk ./src/Language/C/Syntax/AST.hs 798 - -instance (CNode t1) => CNode (CDeclarator t1) where +instance CNode t1 => CNode (CDeclarator t1) where hunk ./src/Language/C/Syntax/AST.hs 800 - -instance (CNode t1) => Pos (CDeclarator t1) where +instance CNode t1 => Pos (CDeclarator t1) where hunk ./src/Language/C/Syntax/AST.hs 803 - hunk ./src/Language/C/Syntax/AST.hs 809 - hunk ./src/Language/C/Syntax/AST.hs 814 - -instance (CNode t1) => CNode (CDerivedDeclarator t1) where +instance CNode t1 => CNode (CDerivedDeclarator t1) where hunk ./src/Language/C/Syntax/AST.hs 818 - -instance (CNode t1) => Pos (CDerivedDeclarator t1) where +instance CNode t1 => Pos (CDerivedDeclarator t1) where hunk ./src/Language/C/Syntax/AST.hs 821 - hunk ./src/Language/C/Syntax/AST.hs 829 - hunk ./src/Language/C/Syntax/AST.hs 833 - -instance (CNode t1) => CNode (CStatement t1) where +instance CNode t1 => CNode (CStatement t1) where hunk ./src/Language/C/Syntax/AST.hs 850 - -instance (CNode t1) => Pos (CStatement t1) where +instance CNode t1 => Pos (CStatement t1) where hunk ./src/Language/C/Syntax/AST.hs 853 - hunk ./src/Language/C/Syntax/AST.hs 887 - -instance (CNode t1) => CNode (CAssemblyStatement t1) where +instance CNode t1 => CNode (CAssemblyStatement t1) where hunk ./src/Language/C/Syntax/AST.hs 889 - -instance (CNode t1) => Pos (CAssemblyStatement t1) where +instance CNode t1 => Pos (CAssemblyStatement t1) where hunk ./src/Language/C/Syntax/AST.hs 892 - hunk ./src/Language/C/Syntax/AST.hs 899 - hunk ./src/Language/C/Syntax/AST.hs 904 - -instance (CNode t1) => CNode (CAssemblyOperand t1) where +instance CNode t1 => CNode (CAssemblyOperand t1) where hunk ./src/Language/C/Syntax/AST.hs 906 - -instance (CNode t1) => Pos (CAssemblyOperand t1) where +instance CNode t1 => Pos (CAssemblyOperand t1) where hunk ./src/Language/C/Syntax/AST.hs 909 - hunk ./src/Language/C/Syntax/AST.hs 913 - hunk ./src/Language/C/Syntax/AST.hs 918 - -instance (CNode t1) => CNode (CCompoundBlockItem t1) where +instance CNode t1 => CNode (CCompoundBlockItem t1) where hunk ./src/Language/C/Syntax/AST.hs 922 - -instance (CNode t1) => Pos (CCompoundBlockItem t1) where +instance CNode t1 => Pos (CCompoundBlockItem t1) where hunk ./src/Language/C/Syntax/AST.hs 925 - hunk ./src/Language/C/Syntax/AST.hs 930 - hunk ./src/Language/C/Syntax/AST.hs 938 - -instance (CNode t1) => CNode (CDeclarationSpecifier t1) where +instance CNode t1 => CNode (CDeclarationSpecifier t1) where hunk ./src/Language/C/Syntax/AST.hs 942 - -instance (CNode t1) => Pos (CDeclarationSpecifier t1) where +instance CNode t1 => Pos (CDeclarationSpecifier t1) where hunk ./src/Language/C/Syntax/AST.hs 945 - hunk ./src/Language/C/Syntax/AST.hs 950 - hunk ./src/Language/C/Syntax/AST.hs 958 - -instance (CNode t1) => CNode (CStorageSpecifier t1) where +instance CNode t1 => CNode (CStorageSpecifier t1) where hunk ./src/Language/C/Syntax/AST.hs 965 - -instance (CNode t1) => Pos (CStorageSpecifier t1) where +instance CNode t1 => Pos (CStorageSpecifier t1) where hunk ./src/Language/C/Syntax/AST.hs 968 - hunk ./src/Language/C/Syntax/AST.hs 976 - hunk ./src/Language/C/Syntax/AST.hs 990 - -instance (CNode t1) => CNode (CTypeSpecifier t1) where +instance CNode t1 => CNode (CTypeSpecifier t1) where hunk ./src/Language/C/Syntax/AST.hs 1008 - -instance (CNode t1) => Pos (CTypeSpecifier t1) where +instance CNode t1 => Pos (CTypeSpecifier t1) where hunk ./src/Language/C/Syntax/AST.hs 1011 - hunk ./src/Language/C/Syntax/AST.hs 1030 - hunk ./src/Language/C/Syntax/AST.hs 1066 - -instance (CNode t1) => CNode (CTypeQualifier t1) where +instance CNode t1 => CNode (CTypeQualifier t1) where hunk ./src/Language/C/Syntax/AST.hs 1070 - nodeInfo (CInlineQual d) = nodeInfo d + nodeInfo (CFunSpecQual d) = nodeInfo d hunk ./src/Language/C/Syntax/AST.hs 1072 - -instance (CNode t1) => Pos (CTypeQualifier t1) where +instance CNode t1 => Pos (CTypeQualifier t1) where hunk ./src/Language/C/Syntax/AST.hs 1075 - hunk ./src/Language/C/Syntax/AST.hs 1079 - fmap _f (CInlineQual a1) = CInlineQual (_f a1) + fmap _f (CFunSpecQual a1) = CFunSpecQual (fmap _f a1) hunk ./src/Language/C/Syntax/AST.hs 1082 - hunk ./src/Language/C/Syntax/AST.hs 1086 - annotation (CInlineQual n) = n + annotation (CFunSpecQual n) = annotation n hunk ./src/Language/C/Syntax/AST.hs 1091 + amap f (CFunSpecQual n) = CFunSpecQual (amap f n) + amap f (CAttrQual n) = CAttrQual (amap f n) + +instance CNode t1 => CNode (CFunctionSpecifier t1) where + nodeInfo (CInlineQual d) = nodeInfo d + nodeInfo (CNoreturnQual d) = nodeInfo d +instance CNode t1 => Pos (CFunctionSpecifier t1) where + posOf x = posOf (nodeInfo x) + +instance Functor CFunctionSpecifier where + fmap _f (CInlineQual a1) = CInlineQual (_f a1) + fmap _f (CNoreturnQual a1) = CNoreturnQual (_f a1) + +instance Annotated CFunctionSpecifier where + annotation (CInlineQual n) = n + annotation (CNoreturnQual n) = n hunk ./src/Language/C/Syntax/AST.hs 1108 - amap f (CAttrQual n) = CAttrQual (amap f n) - - -instance (CNode t1) => CNode (CStructureUnion t1) where + amap f (CNoreturnQual a_1) = CNoreturnQual (f a_1) + +instance CNode t1 => CNode (CStructureUnion t1) where hunk ./src/Language/C/Syntax/AST.hs 1112 - -instance (CNode t1) => Pos (CStructureUnion t1) where +instance CNode t1 => Pos (CStructureUnion t1) where hunk ./src/Language/C/Syntax/AST.hs 1115 - hunk ./src/Language/C/Syntax/AST.hs 1120 - hunk ./src/Language/C/Syntax/AST.hs 1125 - -instance (CNode t1) => CNode (CEnumeration t1) where +instance CNode t1 => CNode (CEnumeration t1) where hunk ./src/Language/C/Syntax/AST.hs 1127 - -instance (CNode t1) => Pos (CEnumeration t1) where +instance CNode t1 => Pos (CEnumeration t1) where hunk ./src/Language/C/Syntax/AST.hs 1130 - hunk ./src/Language/C/Syntax/AST.hs 1136 - hunk ./src/Language/C/Syntax/AST.hs 1140 - -instance (CNode t1) => CNode (CInitializer t1) where +instance CNode t1 => CNode (CInitializer t1) where hunk ./src/Language/C/Syntax/AST.hs 1143 - -instance (CNode t1) => Pos (CInitializer t1) where +instance CNode t1 => Pos (CInitializer t1) where hunk ./src/Language/C/Syntax/AST.hs 1146 - hunk ./src/Language/C/Syntax/AST.hs 1152 - -instance (CNode t1) => CNode (CPartDesignator t1) where +instance CNode t1 => CNode (CPartDesignator t1) where hunk ./src/Language/C/Syntax/AST.hs 1156 - -instance (CNode t1) => Pos (CPartDesignator t1) where +instance CNode t1 => Pos (CPartDesignator t1) where hunk ./src/Language/C/Syntax/AST.hs 1159 - hunk ./src/Language/C/Syntax/AST.hs 1165 - hunk ./src/Language/C/Syntax/AST.hs 1173 - -instance (CNode t1) => CNode (CAttribute t1) where +instance CNode t1 => CNode (CAttribute t1) where hunk ./src/Language/C/Syntax/AST.hs 1175 - -instance (CNode t1) => Pos (CAttribute t1) where +instance CNode t1 => Pos (CAttribute t1) where hunk ./src/Language/C/Syntax/AST.hs 1178 - hunk ./src/Language/C/Syntax/AST.hs 1181 - hunk ./src/Language/C/Syntax/AST.hs 1185 - -instance (CNode t1) => CNode (CExpression t1) where +instance CNode t1 => CNode (CExpression t1) where hunk ./src/Language/C/Syntax/AST.hs 1207 - -instance (CNode t1) => Pos (CExpression t1) where +instance CNode t1 => Pos (CExpression t1) where hunk ./src/Language/C/Syntax/AST.hs 1210 - hunk ./src/Language/C/Syntax/AST.hs 1254 - -instance (CNode t1) => CNode (CBuiltinThing t1) where +instance CNode t1 => CNode (CBuiltinThing t1) where hunk ./src/Language/C/Syntax/AST.hs 1258 - -instance (CNode t1) => Pos (CBuiltinThing t1) where +instance CNode t1 => Pos (CBuiltinThing t1) where hunk ./src/Language/C/Syntax/AST.hs 1261 - hunk ./src/Language/C/Syntax/AST.hs 1269 - hunk ./src/Language/C/Syntax/AST.hs 1279 - -instance (CNode t1) => CNode (CConstant t1) where +instance CNode t1 => CNode (CConstant t1) where hunk ./src/Language/C/Syntax/AST.hs 1284 - -instance (CNode t1) => Pos (CConstant t1) where +instance CNode t1 => Pos (CConstant t1) where hunk ./src/Language/C/Syntax/AST.hs 1287 - hunk ./src/Language/C/Syntax/AST.hs 1293 - hunk ./src/Language/C/Syntax/AST.hs 1303 - -instance (CNode t1) => CNode (CStringLiteral t1) where +instance CNode t1 => CNode (CStringLiteral t1) where hunk ./src/Language/C/Syntax/AST.hs 1305 - -instance (CNode t1) => Pos (CStringLiteral t1) where +instance CNode t1 => Pos (CStringLiteral t1) where hunk ./src/Language/C/Syntax/AST.hs 1308 - hunk ./src/Language/C/Syntax/AST.hs 1311 - hunk ./test/bin/clear_test_suite 8 -# Calls: +# Calls: hunk ./test/bin/clear_test_suite 32 - + hunk ./test/bin/clear_test_suite 37 + hunk ./test/bin/setup 7 -# Calls: +# Calls: hunk ./test/bin/setup 12 - exit 1 + exit 1 hunk ./test/harness/Makefile 1 -TESTS=analysis_enum analysis_ext_decls analysis_local_decls analysis_type_check attributes \ - bug5_dos_newline bugn6_empty_file bug21_sem_typedef bug22_file_permission_cpp bug30_preserve_int_repr bug31_pp_if_else \ +TESTS=analysis_enum \ + analysis_ext_decls \ + analysis_local_decls \ + analysis_type_check attributes \ + bug5_dos_newline bugn6_empty_file bug21_sem_typedef \ + bug22_file_permission_cpp bug30_preserve_int_repr bug31_pp_if_else \ hunk ./test/harness/Makefile 8 - bug20160302_int128 + bug20160302_int128 \ + bug20160314_noreturn addfile ./test/suite/README hunk ./test/suite/README 1 +# Install gcc.dg test suite +RURL=https://github.com/gcc-mirror/gcc.git +RPATH=gcc/testsuite/gcc.dg +git clone $RURL gcc-mirror +mv gcc-mirror/$RPATH gcc.dg +rm -rf gcc-mirror addfile ./test/suite/classify-dg.sh hunk ./test/suite/classify-dg.sh 1 +#!/bin/bash +source ./configuration + +BASE_DIR=`pwd` +cd gcc.dg +DG_DIR=`pwd` + +for cf in `find . -name '*.c'`; do + cd $DG_DIR/`dirname $cf` + f=`basename $cf` + echo "Processing $f" + grep -e "^$f" $BASE_DIR/dg-ignore.txt + if [ $? -eq 0 ]; then echo " ... skipped"; continue; fi + + COMPLIANCE= + gcc -fsyntax-only -ansi -pedantic-errors $f 2>/dev/null + if [ $? -eq 0 ] ; then COMPLIANCE=c89; fi + if [ -z $COMPLIANCE ] ; then + gcc -fsyntax-only -std=c99 -pedantic-errors $f 2>/dev/null + if [ $? -eq 0 ] ; then COMPLIANCE=c99; fi + fi + if [ -z $COMPLIANCE ] ; then + gcc -fsyntax-only -std=gnu9x -pedantic-errors $f 2>/dev/null + if [ $? -eq 0 ] ; then COMPLIANCE=gnu99; fi + fi + if [ -z $COMPLIANCE ] ; then + gcc -fsyntax-only -std=c11 -pedantic-errors $f 2>/dev/null + if [ $? -eq 0 ] ; then COMPLIANCE=c11; fi + fi + if [ -z $COMPLIANCE ] ; then + gcc -fsyntax-only -std=gnu11 -pedantic-errors $f 2>/dev/null + if [ $? -eq 0 ] ; then COMPLIANCE=gnu11; fi + fi + if [ -z $COMPLIANCE ] ; then + gcc -fsyntax-only -std=gnu9x $f 2>/dev/null + if [ $? -eq 0 ] ; then COMPLIANCE=incompliant; fi + fi + if [ ! -z $COMPLIANCE ] ; then + echo "[INFO] Classified Test $f as ($COMPLIANCE)" + mkdir -p "$BASE_DIR/gcc-dg-$COMPLIANCE" + cp "$DG_DIR/$cf" "$BASE_DIR/gcc-dg-$COMPLIANCE/./" + fi +done hunk ./test/suite/dg-ignore.txt 38 -c90-init-1.c obsolete use of designated initializer without `=' +c90-init-1.c obsolete use of designated initializer without `=' hunk ./test/suite/dg-ignore.txt 41 + +pr69522.c gcc bug (5.3.0 does not termiante) + hunk ./test/suite/run-dg-list.sh 32 - exit 1 + exit 1 hunk ./test/suite/run-dg.sh 2 -source ./configuration - -TEST_SUITES="gcc-dg-incompliant gcc-dg-c89 gcc-dg-c99 gcc-dg-gnu99" -for t in $TEST_SUITES; do - echo "Cleaning test suite $t" - bash clear_test_suite $t -done - -BASE_DIR=`pwd` -cd gcc.dg -DG_DIR=`pwd` - -for cf in `find . -name '*.c'`; do - cd $DG_DIR/`dirname $cf` - f=`basename $cf` - - grep -e "^$f" $BASE_DIR/dg-ignore.txt - if [ $? -eq 0 ]; then echo " ... skipped"; continue; fi - - COMPLIANCE= - gcc -fsyntax-only -ansi -pedantic-errors $f 2>/dev/null - if [ $? -eq 0 ] ; then COMPLIANCE=c89; fi - if [ -z $COMPLIANCE ] ; then - gcc -fsyntax-only -std=c99 -pedantic-errors $f 2>/dev/null - if [ $? -eq 0 ] ; then COMPLIANCE=c99; fi - fi - if [ -z $COMPLIANCE ] ; then - gcc -fsyntax-only -std=gnu9x -pedantic-errors $f 2>/dev/null - if [ $? -eq 0 ] ; then COMPLIANCE=gnu99; fi - fi - if [ -z $COMPLIANCE ] ; then - gcc -fsyntax-only -std=gnu9x $f 2>/dev/null - if [ $? -eq 0 ] ; then COMPLIANCE=incompliant; fi - fi - if [ ! -z $COMPLIANCE ] ; then - echo "[INFO] Running Test $f ($COMPLIANCE)" - source $CTEST_BINDIR/set_test_suite gcc-dg-$COMPLIANCE - export CTEST_DRIVER=CRoundTrip - bash run-test $f - fi +for t in gcc-dg-* ; do + echo "-----------------------" + echo "Running gcc dg suite $t" + echo "-----------------------" + ./run-suite.sh $t `find gcc.dg -name '*.h' | xargs dirname | sort | uniq | sed 's/^/-I..\//'` addfile ./test/suite/run-suite.sh hunk ./test/suite/run-suite.sh 1 +#!/bin/bash +source ./configuration + +if [ -z "$1" ] ; then + echo "Usage: ./run-suite.sh .." >&2 + exit 1 +fi +TEST_SUITE=$1 +shift +bash clear_test_suite $TEST_SUITE +source $CTEST_BINDIR/set_test_suite $TEST_SUITE +export CTEST_DRIVER=CRoundTrip + +pushd $TEST_SUITE +for cf in `find . -name '*.c'`; do + echo "[INFO] Running Test $TEST_SUITE::$cf" + bash run-test $@ $cf +done hunk ./src/Language/C/Analysis/AstAnalysis.hs 246 + globalStorage ThreadSpec = return $ (Static ExternalLinkage True, True) hunk ./src/Language/C/Analysis/AstAnalysis.hs 274 + localStorage ThreadSpec = return $ (Auto True,True)