Adding testcases

Author: vidit-od

plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs

@@ -142,9 +142,10 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p
             -- Perform rename
             let newName = mkTcOcc $ T.unpack newNameText
                 filesRefs = collectWith locToUri refs
+                oldOccNames = HS.fromList $ map nameOccName oldNames
                 getFileEdit (uri, locations) = do
                     verTxtDocId <- liftIO $ runAction "rename: getVersionedTextDoc" state $ getVersionedTextDoc (TextDocumentIdentifier uri)
-                    getSrcEdit state verTxtDocId (replaceRefs newName locations)
+                    getSrcEdit state verTxtDocId (replaceRefs newName locations oldOccNames)
             fileEdits <- mapM getFileEdit filesRefs
             pure $ InL $ fold fileEdits
 
@@ -214,10 +215,10 @@ getSrcEdit state verTxtDocId updatePs = do
 replaceRefs ::
     OccName ->
     HashSet Location ->
+    HashSet OccName ->
     ParsedSource ->
     ParsedSource
-replaceRefs newName refs = everywhere $
-    -- there has to be a better way...
+replaceRefs newName refs oldOccNames = everywhere $
     mkT (replaceLoc @AnnListItem) `extT`
     -- replaceLoc @AnnList `extT` -- not needed
     -- replaceLoc @AnnParen `extT` -- not needed
@@ -228,8 +229,11 @@ replaceRefs newName refs = everywhere $
     where
         replaceLoc :: forall an. LocatedAn an RdrName -> LocatedAn an RdrName
         replaceLoc (L srcSpan oldRdrName)
-            | isRef (locA srcSpan) = L srcSpan $ replace oldRdrName
+            | isRef (locA srcSpan)
+            , isTarget oldRdrName
+            = L srcSpan $ replace oldRdrName
         replaceLoc lOldRdrName = lOldRdrName
+
         replace :: RdrName -> RdrName
         replace (Qual modName _) = Qual modName newName
         replace _                = Unqual newName
@@ -239,6 +243,10 @@ replaceRefs newName refs = everywhere $
             Just loc -> loc `HS.member` refs
             Nothing  -> False
 
+        -- Only replace RdrNames whose OccName matches a rename target, preventing
+        -- co-located field selectors from being incorrectly renamed.
+        isTarget :: RdrName -> Bool
+        isTarget rdrName = rdrNameOcc rdrName `HS.member` oldOccNames
 ---------------------------------------------------------------------------------------------------
 -- Reference finding
 
@@ -250,38 +258,23 @@ refsAtName ::
     Name ->
     ExceptT PluginError m [Location]
 refsAtName state nfp targetName = do
-    -- Get local references from current file's HieAST
-    ast <- handleGetHieAst state nfp
-    let localRefs = nameLocs targetName ast
-
-    -- Query HieDb for global matches (by OccName)
-    ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras
-    dbCandidates <- liftIO $ withHieDb $ \hieDb ->
-        fmap (mapMaybe rowToLoc) $
-          case nameModule_maybe targetName of
-            Just mod -> findReferences hieDb True (nameOccName targetName) (Just $ moduleName mod) (Just $ moduleUnit mod) []
-            Nothing  -> findReferences hieDb True (nameOccName targetName) Nothing Nothing []
-
-    -- Filter candidates by exact Name identity
-    filteredDbRefs <- filterM (matchesExactName state targetName) dbCandidates
-    pure $ localRefs ++ filteredDbRefs
-
-matchesExactName ::
-    MonadIO m =>
-    IdeState ->
-    Name ->
-    Location ->
-    ExceptT PluginError m Bool
-matchesExactName state targetName loc = do
-    (file, pos) <- locToFilePos loc
-    namesAtPos <- getNamesAtPos state file pos
-    pure $ targetName `elem` namesAtPos
-
-nameLocs :: Name -> HieAstResult -> [Location]
-nameLocs name (HAR _ _ rm _ _) =
-    concatMap (map (realSrcSpanToLocation . fst))
-              (M.lookup (Right name) rm)
-
+    HAR{refMap} <- handleGetHieAst state nfp
+
+    let localRefs =
+            case M.lookup (Right targetName) refMap of
+            Nothing    -> []
+            Just spans -> [ realSrcSpanToLocation sp | (sp, _) <- spans]
+
+  -- Only query HieDb if it's a global name
+    globalRefs <-
+        case nameModule_maybe targetName of
+            Nothing -> pure []
+            Just mod -> do
+                ShakeExtras{withHieDb} <- liftIO $ runAction "Rename.HieDb" state getShakeExtras
+                liftIO $ withHieDb $ \hieDb ->
+                    fmap (mapMaybe rowToLoc) $ findReferences hieDb True (nameOccName targetName) (Just $ moduleName mod) (Just $ moduleUnit mod) []
+
+    pure (localRefs ++ globalRefs)
 ---------------------------------------------------------------------------------------------------
 -- Util
 

plugins/hls-rename-plugin/test/Main.hs

@@ -111,12 +111,78 @@ tests = testGroup "Rename"
 
         -- Make sure renaming succeeds
         rename doc (Position 3 0) "foo'"
+    , goldenWithCrossModuleRename True "Cross Module (Declaration)" "CrossMaster" "CrossFunctionClient" (Position 2 2) "fooRenamed"
+    , goldenWithCrossModuleRename True "Cross Module (Referenced)" "CrossFunctionClient" "CrossMaster" (Position 4 11) "crossfooRenamed"
+    , goldenWithCrossModuleRename True "Cross Module Qualified (Declaration)" "CrossMaster" "CrossQualifiedClient" (Position 2 2) "newFoo"
+    , goldenWithCrossModuleRename True "Cross Module Qualified (Referenced)" "CrossQualifiedClient" "CrossMaster" (Position 4 22) "crossfooRenamed"
+    , goldenWithCrossModuleSession True "Cross Error : No export list" "CrossMasterTwo" "CrossFunctionClientTwo" $ \masterDoc _clientDoc -> do
+        let expectedError = TResponseError
+                (InR ErrorCodes_InvalidParams)
+                "rename: Invalid Params: Cannot rename symbol: module has no explicit export list and the symbol is referenced from other modules."
+                Nothing
+
+        renameExpectError expectedError masterDoc (Position 2 0) "ImpossibleRename"
+    , goldenWithCrossModuleSession False "Cross Error : Cross Moduel disabled" "CrossMaster" "CrossFunctionError" $ \masterDoc _clientDoc -> do
+        let expectedError = TResponseError
+                (InR ErrorCodes_InternalError)
+                "rename: Internal Error: Cross-module rename is disabled."
+                Nothing
+
+        renameExpectError expectedError masterDoc (Position 2 0) "ImpossibleRename"
     ]
 
 goldenWithRename :: TestName-> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
 goldenWithRename title path act =
     goldenWithHaskellDoc (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= True })] })
-       renamePlugin title testDataDir path "expected" "hs" act
+        renamePlugin title testDataDir path "expected" "hs"
+        $ \_ -> do
+            doc <- openDoc (path <.> "hs") "haskell"
+            _ <- getDocumentSymbols doc
+            _ <- waitForBuildQueue
+            act doc
+
+goldenWithCrossModuleRename :: Bool -> TestName -> FilePath -> FilePath -> Position -> String -> TestTree
+goldenWithCrossModuleRename crossModuleEnabled title primaryFile secondaryFile pos newName =
+    goldenWithHaskellDoc
+        (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= crossModuleEnabled })] })
+        renamePlugin
+        title
+        testDataDir
+        secondaryFile
+        "expected"
+        "hs"
+        $ \_ -> do
+
+            primaryDoc <- openDoc (primaryFile <.> "hs") "haskell"
+            secondaryDoc <- openDoc (secondaryFile <.> "hs") "haskell"
+
+            _ <- getDocumentSymbols primaryDoc
+            _ <- getDocumentSymbols secondaryDoc
+            _ <- waitForBuildQueue
+
+
+            rename primaryDoc pos newName
+
+goldenWithCrossModuleSession :: Bool -> TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> TextDocumentIdentifier -> Session ()) -> TestTree
+goldenWithCrossModuleSession crossModuleEnabled title primaryFile secondaryFile action =
+    goldenWithHaskellDoc
+        (def { plugins = M.fromList [("rename", def { plcConfig = "crossModule" .= crossModuleEnabled })] })
+        renamePlugin
+        title
+        testDataDir
+        secondaryFile
+        "expected"
+        "hs"
+        $ \_ -> do
+
+            primaryDoc   <- openDoc (primaryFile   <.> "hs") "haskell"
+            secondaryDoc <- openDoc (secondaryFile <.> "hs") "haskell"
+
+            _ <- getDocumentSymbols primaryDoc
+            _ <- getDocumentSymbols secondaryDoc
+            _ <- waitForBuildQueue
+
+            action primaryDoc secondaryDoc
 
 renameExpectError :: TResponseError Method_TextDocumentRename -> TextDocumentIdentifier -> Position -> Text -> Session ()
 renameExpectError expectedError doc pos newName = do

plugins/hls-rename-plugin/test/testdata/CrossFunctionClient.expected.hs

@@ -0,0 +1,5 @@
+module CrossFunctionClient where
+
+import CrossMaster
+
+bar = fooRenamed

plugins/hls-rename-plugin/test/testdata/CrossFunctionClient.hs

@@ -0,0 +1,5 @@
+module CrossFunctionClient where
+
+import CrossMaster
+
+bar = crossfoo

plugins/hls-rename-plugin/test/testdata/CrossFunctionClientTwo.expected.hs

@@ -0,0 +1,5 @@
+module CrossFunctionClientTwo where
+
+import CrossMasterTwo
+
+bar = crossfooTwo

plugins/hls-rename-plugin/test/testdata/CrossFunctionClientTwo.hs

@@ -0,0 +1,5 @@
+module CrossFunctionClientTwo where
+
+import CrossMasterTwo
+
+bar = crossfooTwo

plugins/hls-rename-plugin/test/testdata/CrossFunctionError.expected.hs

@@ -0,0 +1,5 @@
+module CrossFunctionError where
+
+import CrossMaster
+
+bar = crossfoo

plugins/hls-rename-plugin/test/testdata/CrossFunctionError.hs

@@ -0,0 +1,5 @@
+module CrossFunctionError where
+
+import CrossMaster
+
+bar = crossfoo

plugins/hls-rename-plugin/test/testdata/CrossMaster.expected.hs

@@ -0,0 +1,4 @@
+module CrossMaster (crossfooRenamed) where
+
+crossfooRenamed :: Int
+crossfooRenamed = 42

plugins/hls-rename-plugin/test/testdata/CrossMaster.hs

@@ -0,0 +1,4 @@
+module CrossMaster (crossfoo) where
+
+crossfoo :: Int
+crossfoo = 42