Add instance methods instrumentation

flow-storm · May 2, 2024 · 7dc062d · 7dc062d
1 parent 89a3fac
commit 7dc062d
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 6 deletions.
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
@@ -1197,14 +1197,17 @@ static class QualifiedMethodExpr implements Expr {
 	private final String methodName;
 	private final MethodKind kind;
 
+	public final IPersistentVector coord;
+
 	private enum MethodKind {
 		CTOR, INSTANCE, STATIC
 	}
 
-	public QualifiedMethodExpr(Class methodClass, Symbol sym){
+	public QualifiedMethodExpr(Class methodClass, Symbol sym, IPersistentVector coord){
 		c = methodClass;
 		methodSymbol = sym;
 		hintedSig = tagsToClasses(paramTagsOf(sym));
+		this.coord = coord;
 		if(sym.name.startsWith(".")) {
 			kind = MethodKind.INSTANCE;
 			methodName = sym.name.substring(1);
@@ -1264,6 +1267,7 @@ private static FnExpr buildThunk(C context, QualifiedMethodExpr qmexpr) {
 		}
 
 		ISeq thunkForm = RT.listStar(Symbol.intern("fn"), Symbol.intern(thunkName), RT.seq(form));
+		thunkForm = (ISeq)Utils.addCoordMeta(thunkForm, qmexpr.coord);
 		return (FnExpr) analyzeSeq(context, thunkForm, thunkName);
 	}
 
@@ -4334,7 +4338,7 @@ private static Expr toHostExpr(QualifiedMethodExpr qmexpr, String source, int li
 			Executable method = QualifiedMethodExpr.resolveHintedMethod(qmexpr.c, qmexpr.methodName, qmexpr.kind, qmexpr.hintedSig);
 			switch(qmexpr.kind) {
 				case CTOR:
-					return new NewExpr(qmexpr.c, (Constructor) method, args, line, column);
+					return new NewExpr(qmexpr.c, (Constructor) method, args, line, column, coord);
 				case INSTANCE:
 					return new InstanceMethodExpr(source, line, column, tag, (Expr) RT.first(args),
 							qmexpr.c, munge(qmexpr.methodName), (java.lang.reflect.Method) method,
@@ -4348,7 +4352,7 @@ qmexpr.c, munge(qmexpr.methodName), (java.lang.reflect.Method) method,
 		else {
 			switch(qmexpr.kind) {
 				case CTOR:
-					return new NewExpr(qmexpr.c, args, line, column);
+					return new NewExpr(qmexpr.c, args, line, column, coord);
 				case INSTANCE:
 					return new InstanceMethodExpr(source, line, column, tag, (Expr) RT.first(args), qmexpr.c,
                         munge(qmexpr.methodName), PersistentVector.create(RT.next(args)), tailPosition, coord);
@@ -7964,7 +7968,7 @@ private static Expr analyzeSymbol(Symbol sym) {
 				if(Reflector.getField(c, sym.name, true) != null)
 					return new StaticFieldExpr(lineDeref(), columnDeref(), c, sym.name, tag);
 				else
-					return new QualifiedMethodExpr(c, sym);
+					return new QualifiedMethodExpr(c, sym, Utils.coordOf(sym));
 				}
 
 			}

diff --git a/test/clojure/test_clojure/storm_bodies.clj b/test/clojure/test_clojure/storm_bodies.clj
@@ -148,7 +148,7 @@
             [:fn-call "clojure.test-clojure.storm-test-code.bodies" "method-value/invoke--Integer-parseInt--GEN-ID" ["2"] -277140200]
             [:bind "arg1" "2" ""]
             [:expr-exec 2 "3,1,1"]
-            [:fn-return 2 "3,1,1"]
+            [:fn-return 2 "3,1,1"] ;; WRONG @nocheckin
             [:expr-exec [4 2] "3,2"]
             [:expr-exec [4 2] "3"]
             [:fn-return [4 2] ""]]    
@@ -178,6 +178,29 @@
             [:fn-return 174 ""]]    
            (u/capture)) "captured traces should match.")))
 
+(deftest instance-methods-test
+  (let [r (b/instance-methods)]
+    (is (= r ["A" "B" "C"]) "function return should be right")
+    (is (= [[:fn-call "clojure.test-clojure.storm-test-code.bodies" "instance-methods" [] -385971727]
+            [:bind "strs" ["a" "b" "c"] "3"]
+            [:expr-exec ["a" "b" "c"] "3,2,2"]
+            [:fn-call "clojure.test-clojure.storm-test-code.bodies" "instance-methods/invoke--String--DOT-toUpperCase--GEN-ID" ["a"] -385971727]
+            [:bind "this" "a" ""]
+            [:expr-exec "A" "3,2,1"]
+            [:fn-return "A" "3,2,1"]
+            [:fn-call "clojure.test-clojure.storm-test-code.bodies" "instance-methods/invoke--String--DOT-toUpperCase--GEN-ID" ["b"] -385971727]
+            [:bind "this" "b" ""]
+            [:expr-exec "B" "3,2,1"]
+            [:fn-return "B" "3,2,1"]
+            [:fn-call "clojure.test-clojure.storm-test-code.bodies" "instance-methods/invoke--String--DOT-toUpperCase--GEN-ID" ["c"] -385971727]
+            [:bind "this" "c" ""]
+            [:expr-exec "C" "3,2,1"]
+            [:fn-return "C" "3,2,1"]
+            [:expr-exec ["A" "B" "C"] "3,2"]
+            [:expr-exec ["A" "B" "C"] "3"]
+            [:fn-return ["A" "B" "C"] ""]]
+           (u/capture)) "captured traces should match")))
+
 ;; (deftest interop-test
 ;;   (let [r (b/interopter #js {:num 2 :f (fn f [x] x)})]
 ;;     (is (= 42 r) "function return should be right.")

diff --git a/test/clojure/test_clojure/storm_test_code/bodies.clj b/test/clojure/test_clojure/storm_test_code/bodies.clj
@@ -50,7 +50,7 @@
 
 (defn constructor []
   (str (String. "ctor")
-       (^[byte*] String/new (byte-array [64 64]))))
+       (^[byte/1] String/new (byte-array [64 64]))))
 
 (defn method-value []
   (let [parser ^[String] Integer/parseInt]
@@ -63,6 +63,10 @@
         b (bit-shift-left n 2)]
     (+ e l b)))
 
+(defn instance-methods []
+  (let [strs ["a" "b" "c"]]
+    (mapv String/.toUpperCase strs)))
+
 (defn interopter [o]
   ;; TODO
   )