FpGdbmiDebugger: fixes typecast to class of current method / improve nested procs / tests

git-svn-id: trunk@44711 -

components/fpdebug/fpdbgdwarf.pas

@@ -1197,11 +1197,25 @@ begin
       if InfoEntry.ReadName(InfoName) and not InfoEntry.IsArtificial
       then begin
         if (CompareUtf8BothCase(PNameUpper, PNameLower, InfoName)) then begin
+          // TODO: this is a pascal sperific search order? Or not?
+          // If this is a type with a pointer or ref, need to find the pointer or ref.
+          InfoEntry.GoParent;
+          if InfoEntry.HasValidScope and
+             InfoEntry.GoNamedChildEx(PNameUpper, PNameLower)
+          then begin
+            if InfoEntry.IsAddressInStartScope(FAddress) and not InfoEntry.IsArtificial then begin
+              Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
+              exit;
+            end;
+          end;
+
+          InfoEntry.ScopeIndex := StartScopeIdx;
           Result := SymbolToValue(TFpDwarfSymbol.CreateSubClass(AName, InfoEntry));
           exit;
         end;
       end;
 
+
       tg := InfoEntry.AbbrevTag;
       if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
         if FindSymbolInStructure(AName,PNameUpper, PNameLower, InfoEntry, Result) then

components/fpdebug/fpdbgdwarffreepascal.pas

@@ -72,8 +72,8 @@ var
   StartScopeIdx: Integer;
   ParentFpVal: TFpDbgValue;
   SearchCtx: TFpDwarfFreePascalAddressContext;
-  pfp, fp, pc: TDbgPtr;
-  i: Integer;
+  par_fp, cur_fp, prev_fp, pc: TDbgPtr;
+  d, i: Integer;
   ParentFpSym: TFpDwarfSymbol;
 begin
   Result := False;
@@ -104,7 +104,6 @@ begin
 
 
   InfoEntry.ScopeIndex := StartScopeIdx;
-  // TODO: cache
   if not InfoEntry.GoNamedChildEx(@parentfp[1], @parentfp[1]) then begin
     FOuterNotFound := True;
     exit;
@@ -121,10 +120,10 @@ begin
     exit;
   end;
 
-  pfp := ParentFpVal.AsCardinal;
+  par_fp := ParentFpVal.AsCardinal;
   ParentFpSym.ReleaseReference;
-    DebugLn(['pfp=',pfp]);
-  if pfp = 0 then begin
+    DebugLn(['par_fp=',par_fp]);
+  if par_fp = 0 then begin
     DebugLn('no ordinal for parentfp');
     FOuterNotFound := True;
     exit;
@@ -133,18 +132,27 @@ begin
   i := StackFrame + 1;
   SearchCtx := TFpDwarfFreePascalAddressContext.Create(ThreadId, i, 0, Symbol, Dwarf);
 
-  fp := 0;
-  while not (fp = pfp) do begin
-    SearchCtx.StackFrame := i;
-    // TODO: get reg num via memreader name-to-num
-    if not MemManager.ReadRegister(RegFp, fp, SearchCtx) then
-      break;
-    inc(i);
-    if i > StackFrame + 100 then break; // something wrong? // TODO better check
+  cur_fp := 0;
+  if MemManager.ReadRegister(RegFp, cur_fp, Self) then begin
+    if cur_fp > par_fp then
+      d := -1  // cur_fp must go down
+    else
+      d := 1;  // cur_fp must go up
+    while not (cur_fp = par_fp) do begin
+      SearchCtx.StackFrame := i;
+      // TODO: get reg num via memreader name-to-num
+      prev_fp := cur_fp;
+      if not MemManager.ReadRegister(RegFp, cur_fp, SearchCtx) then
+        break;
+      inc(i);
+      if (cur_fp = prev_fp) or ((cur_fp < prev_fp) xor (d = -1)) then
+        break;  // wrong direction
+      if i > StackFrame + 200 then break; // something wrong? // TODO better check
+    end;
+    dec(i);
   end;
-  dec(i);
 
-  if (pfp <> fp) or
+  if (par_fp <> cur_fp) or (cur_fp = 0) or
       not MemManager.ReadRegister(RegPc, pc, SearchCtx)
   then begin
     FOuterNotFound := True;

components/lazdebuggers/lazdebuggerfpgdbmi/test/testwatches.pas

@@ -456,16 +456,21 @@ begin
     end;
 
     {%region  Fields / Glob / ... }
-    for i := 0 to 5 do begin
+    for i := 0 to 7 do begin
       case BrkIdx of
-        // Simple_NoneNested
-        4, 5: if not (i in [1]) then continue; // Only Global /// TODO: test for error
-        // Test2Method
-        8..13:  if not (i in [0, 1, 5, 6]) then continue;
-        // Class[12].Test0Method
-        6..7, 14..15: if not (i in [1]) then continue; // Only Global /// TODO: test for error
-        // Class0.Test0Method
-        16..17: if not (i in [1]) then continue; // Only Global /// TODO: test for error
+      //Class1
+        4, 5:  // Simple_NoneNested
+          if not (i in [1]) then continue;
+        6..7:  // Class1.Test0Method
+          if not (i in [1, 6]) then continue;
+      //Class2
+        8..13:  // Class2.Test2Method
+          if not (i in [0..1, 5..8]) then continue;
+        14..15:  // Class2.Test0Method
+          if not (i in [1, 6..7]) then continue;
+      //Class0
+        16..17:  // Class0.Test0Method
+          if not (i in [1]) then continue;
       end;
 
       case i of
@@ -475,8 +480,8 @@ begin
         3: s := 'VArg_';
         4: s := 'Local_';
         5: s := 'self.Field_';
-        //6: s := 'TSimpleClass1(self).Field_';
-        //7: s := 'TSimpleClass2(self).Field_';
+        6: s := 'TSimpleClass1(self).Field_';
+        7: s := 'TSimpleClass2(self).Field_';
         //8: s := 'TSimpleClass0(self).Field_';
         // 6: passed in object / var arg object
         // unit.glob