Debugger: Fix parsing class with nested record / array of record

git-svn-id: trunk@43317 -

debugger/gdbtypeinfo.pp

@@ -2310,7 +2310,7 @@ var
   {%region    * Class * }
   procedure DoClass;
   var
-    n, i: Integer;
+    n, i, j, l: Integer;
     S, S2: String;
 
     Name: String;
@@ -2387,16 +2387,36 @@ var
         else begin
           Name := GetPart(['    '], [' '], S);
           S2 := GetPart([' : '], [';'], S);
-          if (lowercase(copy(S2, 1, 7)) = 'record ') then begin
+          l := Length(S2);
+          j := 1;
+          while true do begin
+            while (j <= l) and (S2[j] in ['^','(', ' ']) do inc(j);
+            if (lowercase(copy(S2, j, 7)) = 'array [') then begin
+              inc(j, 8+3);
+              while (j <= l) and
+                    not ( (S2[j-3] = ' ') and (S2[j-2] in ['o','O']) and (S2[j-1] in ['f','F']) and (S2[j] = ' ') )
+              do
+                inc(j);
+              continue;
+            end;
+            break;
+          end;
+          if (lowercase(copy(S2, j, 7)) = 'record ') and
+             not( (copy(S2, j+7, 1) = ';') or (copy(S2, j+7, 6) = '{...};') )
+          then begin
             i := 1;
             while (n <  Lines.Count - 2) and (i > 0) do
             begin
               inc(n);
               S := Lines[n];
               if S = '' then Continue;
-              if pos(': record ', S) > 0 then inc(i);
+              j := pos(': record ', S);
-              if pos(' end;', S) > 0 then dec(i);
+              if (j > 0) and not( (copy(S, j+9, 1) = ';') or (copy(S, j+9, 6) = '{...};') )
-              S2 := S2 + ' ' + Trim(S);
+              then
+                inc(i);
+              S := Trim(S);
+              if (pos('end;', S) = 1) or (pos('end)', S) = 1) then dec(i);
+              S2 := S2 + ' ' + S;
             end;
           end;
           DBGType := TGDBType.Create(skSimple, S2);

debugger/test/Gdbmi/TestApps/WatchesPrgStruct.inc

@@ -423,8 +423,26 @@
 
   {%region  TYPE}
     {$IFDEF Global_Type}
+      TFooStatArray = Array[3..7] of boolean;
+      TFooDynArray = Array of boolean;
+      TString25 = string[25];
+      TFooTestRecord = record x1:boolean; x2:integer; xr: record x1:boolean; x2:integer; end; end;
+
       TFoo = class
       private
+        a1: TFooStatArray;
+        a2: TFooDynArray;
+        a3: Array[3..7, 2..4] of boolean;
+        a4: Array of Array of boolean;
+        a5: array [1..2] of record x1:boolean; x2:integer; xr: record x1:boolean; x2:integer; end; end;
+        a6: array [1..2,3..4] of record x1:boolean; x2:integer; xr: record x1:boolean; x2:integer; end; end;
+        a7: array of record x1:boolean; x2:integer; xr: record x1:boolean; x2:integer; end; end;
+        a8: array of array of record x1:boolean; x2:integer; xr: record x1:boolean; x2:integer; end; end;
+        r1: record x1:boolean; x2:integer; xr: record x1:boolean; x2:integer; end; end;
+        r2: TFooTestRecord;
+        s1: string[25];
+        s2: TString25;
+
         function GetValueInt: Integer;
         procedure SetValueInt(AValue: Integer);
       public

debugger/test/Gdbmi/testbase.pas

@@ -34,6 +34,7 @@ const
 
   stDwarf2All = [stDwarf, stDwarfSet];
   stDwarfAll  = [stDwarf, stDwarfSet, stDwarf3];
+  stSymAll = [stStabs, stDwarf, stDwarfSet, stDwarf3];
 
 type
 

debugger/test/Gdbmi/testwatches.pas

@@ -62,7 +62,8 @@ type
 
      fTstSkip,       // Do not run test
      fTstSkipDwarf3,
-     fTpMtch
+     fTpMtch,
+     fTExpectNotFound
     );
   TWatchExpectationFlags = set of TWatchExpectationFlag;
 
@@ -103,6 +104,14 @@ const
 
 type
 
+  TFullTypeMemberExpectationResult = record
+    Name: string;
+    ExpTypeName: string;
+    ExpKind: TDBGSymbolKind;
+    Flgs: TWatchExpectationFlags;
+  end;
+  TFullTypeMemberExpectationResultArray = array of TFullTypeMemberExpectationResult;
+
   PWatchExpectation= ^TWatchExpectation;
   TWatchExpectationResult = record
     ExpMatch: string;
@@ -110,6 +119,7 @@ type
     ExpTypeName: string;
     Flgs: TWatchExpectationFlags;
     MinGdb, MinFpc: Integer;
+    FullTypesExpect: TFullTypeMemberExpectationResultArray;
   end;
 
   TWatchExpectation = record
@@ -128,6 +138,8 @@ type
   TTestWatches = class(TGDBTestCase)
   private
     FWatches: TcurrentWatches;
+    Frx: TRegExpr;
+
 
     ExpectBreakFooGdb: TWatchExpectationArray;    // direct commands to gdb, to check assumptions  // only Exp and Mtch
     ExpectBreakSubFoo: TWatchExpectationArray;    // Watches, evaluated in SubFoo (nested)
@@ -212,6 +224,11 @@ type
     procedure UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes; AMinGdb: Integer);
     procedure UpdResMinFpc(AWatchExp: PWatchExpectation; ASymbolTypes: TSymbolTypes; AMinFpc: Integer);
 
+    procedure AddMemberExpect(AWatchExp: PWatchExpectation;
+      AName, ATpNm: string; AFlgs: TWatchExpectationFlags; AnExpKind: TDBGSymbolKind;
+      ASymbolTypes: TSymbolTypes = stSymAll
+    );
+
     procedure AddExpectBreakFooGdb;
     procedure AddExpectBreakFooAll;
     procedure AddExpectBreakFooArray;
@@ -498,6 +515,23 @@ begin
       UpdResMinFpc(AWatchExp, i, AMinFpc);
 end;
 
+procedure TTestWatches.AddMemberExpect(AWatchExp: PWatchExpectation; AName, ATpNm: string;
+  AFlgs: TWatchExpectationFlags; AnExpKind: TDBGSymbolKind; ASymbolTypes: TSymbolTypes);
+var
+  i: TSymbolType;
+  l: Integer;
+begin
+  for i := low(TSymbolType) to high(TSymbolType) do
+    if i in ASymbolTypes then begin
+      l := length(AWatchExp^.Result[i].FullTypesExpect);
+      SetLength(AWatchExp^.Result[i].FullTypesExpect, l + 1);
+      AWatchExp^.Result[i].FullTypesExpect[l].Name := AName;
+      AWatchExp^.Result[i].FullTypesExpect[l].ExpTypeName := ATpNm;
+      AWatchExp^.Result[i].FullTypesExpect[l].ExpKind := AnExpKind;
+      AWatchExp^.Result[i].FullTypesExpect[l].Flgs := AFlgs;
+    end;
+end;
+
 procedure TTestWatches.UpdResMinGdb(AWatchExp: PWatchExpectation; ASymbolType: TSymbolType;
   AMinGdb: Integer);
 begin
@@ -893,6 +927,14 @@ begin
 //  if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
 
 
+  // Full type info
+  r := AddFmtDef('ArgTFoo', [defFullTypeInfo],   Match_ArgTFoo,     skClass,   'TFoo',  []);
+  AddMemberExpect(r, 'ValueInt', 'Integer|LongInt', [fTpMtch], skSimple);
+  AddMemberExpect(r, 'a1', 'TFooStatArray', [], skSimple);
+  AddMemberExpect(r, 'a2', 'TFooDynArray', [], skSimple);
+  AddMemberExpect(r, 'a3', 'array', [fTpMtch], skSimple);
+  AddMemberExpect(r, 'x1', '', [fTExpectNotFOund], skSimple);
+
   {%endregion    * Classes * }
 
   {%region    * Strings * }
@@ -1954,6 +1996,7 @@ var
   dbg: TGDBMIDebugger;
   Only: Integer;
   OnlyName, OnlyNamePart: String;
+  MemberTests: TFullTypeMemberExpectationResultArray;
 
   function SkipTest(const Data: TWatchExpectation): Boolean;
   begin
@@ -1985,6 +2028,20 @@ var
     IgnoreFlags: TWatchExpectationFlags;
     IgnoreAll, IgnoreData, IgnoreKind, IgnoreKindPtr, IgnoreTpName: boolean;
     IgnoreText: String;
+    i, j: Integer;
+    fld: TDBGField;
+
+    function CmpNames(TestName, Exp, Got: String; Match: Boolean): Boolean;
+    begin
+      if Match then begin
+        if Frx = nil then Frx := TRegExpr.Create;
+        Frx.ModifierI := true;
+        Frx.Expression := Exp;
+        TestTrue(TestName + ' matches '+Exp+' but was '+Got,  Frx.Exec(Got), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
+       end
+       else TestEquals(TestName + ' equals ',  LowerCase(Exp), LowerCase(Got), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
+    end;
+
   begin
     if not TestTrue('Dbg did NOT enter dsError', dbg.State <> dsError) then exit;
     rx := nil;
@@ -2055,19 +2112,47 @@ var
     if IsValid and HasTpInfo then begin
       s:='';
       if HasTpInfo then s := WV.TypeInfo.TypeName;
-      if fTpMtch  in DataRes.Flgs
+      CmpNames('TypeName', DataRes.ExpTypeName, s, fTpMtch  in DataRes.Flgs);
-      then begin
+      //if fTpMtch  in DataRes.Flgs
-        rx := TRegExpr.Create;
+      //then begin
-        rx.ModifierI := true;
+      //  rx := TRegExpr.Create;
-        rx.Expression := DataRes.ExpTypeName;
+      //  rx.ModifierI := true;
-        TestTrue(Name + ' TypeName matches '+DataRes.ExpTypeName+' but was '+s,  rx.Exec(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
+      //  rx.Expression := DataRes.ExpTypeName;
-        FreeAndNil(rx);
+      //  TestTrue(Name + ' TypeName matches '+DataRes.ExpTypeName+' but was '+s,  rx.Exec(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
-       end
+      //  FreeAndNil(rx);
-       else TestEquals(Name + ' TypeName',  LowerCase(DataRes.ExpTypeName), LowerCase(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
+      // end
+      // else TestEquals(Name + ' TypeName',  LowerCase(DataRes.ExpTypeName), LowerCase(s), DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
     end else begin
         TestTrue(Name + ' TypeName matches '+DataRes.ExpTypeName+' but STATE was <'+dbgs(WV.Validity)+'> HasTypeInfo='+dbgs(HasTpInfo)+' Val="'+s+'"',  False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);
     end;
 
+
+    MemberTests := DataRes.FullTypesExpect;
+    if Length(MemberTests) > 0 then begin
+      if HasTpInfo then begin
+        for i := 0 to Length(MemberTests) - 1 do begin
+          j := WV.TypeInfo.Fields.Count - 1;
+          while (j >= 0) and (uppercase(WV.TypeInfo.Fields[j].Name) <> UpperCase(MemberTests[i].Name)) do dec(j);
+          TestTrue(Name + ' no members with name ' +  MemberTests[i].Name,
+                   (fTExpectNotFOund  in MemberTests[i].Flgs) <> (j >= 0),
+                   DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
+          if j >= 0 then begin
+            fld := WV.TypeInfo.Fields[j];
+            if fld.DBGType <> nil then begin
+              TestTrue(Name + ' members with name ' +  MemberTests[i].Name + ' type=' + KindName[MemberTests[i].ExpKind] + ' but was ' + KindName[fld.DBGType.Kind],
+                  MemberTests[i].ExpKind = fld.DBGType.Kind, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
+              CmpNames(Name + ' members with name ' +  MemberTests[i].Name + 'TypeName',
+                       MemberTests[i].ExpTypeName, fld.DBGType.TypeName, fTpMtch  in MemberTests[i].Flgs);
+            end
+            else
+              TestTrue(Name + ' no dbgtype for members with name' +  MemberTests[i].Name, False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
+          end;
+        end;
+      end
+      else
+        TestTrue(Name + ' no typeinfo for members' , False, DataRes.MinGdb, DataRes.MinFpc, IgnoreText);;
+    end;
+
   end;
 
 var
@@ -2312,6 +2397,7 @@ begin
 
   end;
 
+  FreeAndNil(Frx);
   AssertTestErrors;
 end;