Merged revision(s) 48148 #67ffa45db5 from trunk:

Fix some Regression from Revision: 47581 Debugger: GDB more fixes for gdb 7.7 and up. Uppercase expressions
Do not modify string literals


........

git-svn-id: branches/fixes_1_4@48149 -

components/lazdebuggergdbmi/debugutils.pp

@@ -57,6 +57,7 @@ function Quote(const AValue: String; AForce: Boolean=False): String;
 function ConvertGdbPathAndFile(const AValue: String): String; // fix path, delim, unescape, and to utf8
 function ParseGDBString(const AValue: String): String; // remove quotes(') and convert #dd chars: #9'ab'#9'x'
 function GetLeadingAddr(var AValue: String; out AnAddr: TDBGPtr; ARemoveFromValue: Boolean = False): Boolean;
+function UpperCaseSymbols(s: string): string;
 
 procedure SmartWriteln(const s: string);
 
@@ -325,7 +326,7 @@ begin
   SetLength(Result, Dst - @Result[1]); // adjust to actual length
 end;
 
-function Unquote(const AValue: String): String;
+function UnQuote(const AValue: String): String;
 var
   len: Integer;
 begin
@@ -430,6 +431,35 @@ begin
   end;
 end;
 
+function UpperCaseSymbols(s: string): string;
+var
+  i, l: Integer;
+begin
+  Result := s;
+  i := 1;
+  l := Length(Result);
+  while (i <= l) do begin
+    if Result[i] = '''' then begin
+      inc(i);
+      while (i <= l) and (Result[i] <> '''') do
+        inc(i);
+    end
+    else
+    if Result[i] = '"' then begin
+      inc(i);
+      while (i < l) and (Result[i] <> '"') do
+        inc(i);
+    end;
+    (* uppercase due to https://sourceware.org/bugzilla/show_bug.cgi?id=17835
+       gdb 7.7 and 7.8 fail to find members, if lowercased
+       Alternative prefix with "self." if gdb returns &"Type TCLASSXXXX has no component named EXPRESSION.\n"
+    *)
+    if (i<=l) and  (Result[i] in ['a'..'z']) then
+      Result[i] := UpperCase(Result[i])[1];
+    inc(i);
+  end;
+end;
+
 function DeleteEscapeChars(const AValue: String; const AEscapeChar: Char): String;
 var
   cnt, len: Integer;

components/lazdebuggergdbmi/gdbmidebugger.pp

@@ -8250,7 +8250,7 @@ begin
   end;
 
   R := GDBMIExecResultDefault;
-  Result := ExecuteCommandFull('-gdb-set var %s := %s', [UpperCase(AExpression), S], [cfscIgnoreError], @GDBModifyDone, 0, R)
+  Result := ExecuteCommandFull('-gdb-set var %s := %s', [UpperCaseSymbols(AExpression), S], [cfscIgnoreError], @GDBModifyDone, 0, R)
         and (R.State <> dsError);
 
   FTypeRequestCache.Clear;
@@ -9110,7 +9110,7 @@ begin
   Result := False;
   if ABreakID = 0 then Exit;
 
-  Result := ExecuteCommand('-break-condition %d %s', [ABreakID, UpperCase(AnExpression)], []);
+  Result := ExecuteCommand('-break-condition %d %s', [ABreakID, UpperCaseSymbols(AnExpression)], []);
 end;
 
 { TGDBMIDebuggerCommandBreakInsert }
@@ -9153,7 +9153,7 @@ begin
     bpkData:
       begin
         if (FWatchData = '') then exit;
-        WatchExpr := UpperCase(WatchData);
+        WatchExpr := UpperCaseSymbols(WatchData);
         if FWatchScope = wpsGlobal then begin
           Result := ExecuteCommand('ptype %s', [WatchExpr], R);
           Result := Result and (R.State <> dsError);

components/lazdebuggergdbmi/gdbtypeinfo.pp

@@ -1751,8 +1751,28 @@ begin
   EndPtr := AText + ATextLen;
 
 
-  while (CurPtr < EndPtr) and not(CurPtr^ in ['[', '(', ',', '%', '&', '$', '0']) do inc(CurPtr);
+  while (CurPtr < EndPtr) and not(CurPtr^ in ['[', '(', ',', '%', '&', '$', '0', '''', '"']) do begin
-  if CurPtr = EndPtr then exit; // no fixup needed
+    if CurPtr^ = '''' then begin
+      inc(CurPtr);
+      while (CurPtr < EndPtr) and (CurPtr^ <> '''') do
+        inc(CurPtr);
+    end
+    else
+    if CurPtr^ = '"' then begin
+      inc(CurPtr);
+      while (CurPtr < EndPtr) and (CurPtr^ <> '"') do
+        inc(CurPtr);
+    end;
+    (* uppercase due to https://sourceware.org/bugzilla/show_bug.cgi?id=17835
+       gdb 7.7 and 7.8 fail to find members, if lowercased
+       Alternative prefix with "self." if gdb returns &"Type TCLASSXXXX has no component named EXPRESSION.\n"
+    *)
+    if (CurPtr < EndPtr) and (CurPtr^ in ['a'..'z']) then
+      CurPtr^ := UpperCase(CurPtr^)[1];
+    inc(CurPtr);
+  end;
+  if CurPtr = EndPtr then
+    exit; // no fixup needed
 
   CurPtr := AText;
   CurList:= TGDBExpressionPartList.Create;
@@ -2026,6 +2046,7 @@ end;
 constructor TGDBExpression.Create(ATextStr: String);
 begin
   FTextStr := ATextStr;
+  UniqueString(FTextStr);
   Create(PChar(FTextStr), length(FTextStr));
 end;
 
@@ -2232,11 +2253,7 @@ begin
   Create(skSimple, ''); // initialize
   FInternalTypeName := '';
   FEvalError := False;
-  (* uppercase due to https://sourceware.org/bugzilla/show_bug.cgi?id=17835
+  FExpression := AnExpression;
-     gdb 7.7 and 7.8 fail to find members, if lowercased
-     Alternative prefix with "self." if gdb returns &"Type TCLASSXXXX has no component named EXPRESSION.\n"
-  *)
-  FExpression := UpperCase(AnExpression);
   FOrigExpression := FExpression;
   FCreationFlags := AFlags;
   FExprEvaluateFormat := AFormat;

components/lazdebuggergdbmi/test/testgdbtype.pas

@@ -605,6 +605,10 @@ begin
 end;
 
 procedure TTestGdbType.TestExpressionBreaker;
+  procedure AssertEqualsLc(n,s1,s2: string);
+  begin
+    AssertEquals(n, LowerCase(s1), LowerCase(s2));
+  end;
 
   procedure InitExpr(e: String; var b: TGDBExpression; out r: PGDBPTypeRequest; out v: Boolean; rewritten: string = '');
   begin
@@ -614,8 +618,8 @@ procedure TTestGdbType.TestExpressionBreaker;
     debugln('##### '+e);
     DumpGExp(b);
     if rewritten <> ''
-    then AssertEquals(e+' as text', rewritten, b.Text)
+    then AssertEqualsLc(e+' as text', rewritten, b.Text)
-    else AssertEquals(e+' as text', e, b.Text);
+    else AssertEqualsLc(e+' as text', e, b.Text);
     v := b.NeedValidation(r);
     if r <> nil then DumpReq(r);
     debugln;
@@ -641,18 +645,18 @@ begin
   n := 'abc[123].x';
   InitExpr(n, b, r, v);
   AssertTrue(n + ' is array', b.Parts[0] is TGDBExpressionPartArray);
-  AssertTrue(n + ' ptype', (r <> nil) and (r^.Request = 'ptype abc'));
+  AssertTrue(n + ' ptype', (r <> nil) and (LowerCase(r^.Request) = 'ptype abc'));
 
   r^.Result := ParseTypeFromGdb('type = ^(array [0..-1] of TFoo)');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after dyn array', not v);
-  AssertEquals(n + ' text after dyn array', 'TFoo(abc^[123]).x', b.Text);
+  AssertEqualsLc(n + ' text after dyn array', 'TFoo(abc^[123]).x', b.Text);
 
   InitExpr(n, b, r, v);
   r^.Result := ParseTypeFromGdb('type = array [0..1000] of TFoo');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after stat array', not v);
-  AssertEquals(n + ' text after stat array', 'TFoo(abc[123]).x', b.Text);
+  AssertEqualsLc(n + ' text after stat array', 'TFoo(abc[123]).x', b.Text);
 
   InitExpr(n, b, r, v);
   r^.Result := ParseTypeFromGdb('type = ^TFoo');
@@ -661,14 +665,14 @@ begin
   r^.Result := ParseTypeFromGdb('type = array of TFoo');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after dyn array(dwarf)', not v);
-  AssertEquals(n + ' text after dyn array(dwarf)', 'TFoo(abc^[123]).x', b.Text);
+  AssertEqualsLc(n + ' text after dyn array(dwarf)', 'TFoo(abc^[123]).x', b.Text);
 
 
   InitExpr(n, b, r, v);
   r^.Result := ParseTypeFromGdb('type = array [0..1000] of ^TFoo');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after stat array ^TFoo', not v);
-  AssertEquals(n + ' text after stat array ^TFoo', '^TFoo(abc[123]).x', b.Text);
+  AssertEqualsLc(n + ' text after stat array ^TFoo', '^TFoo(abc[123]).x', b.Text);
 
   // with NO need for typecast
   n := 'abc[123]';
@@ -676,63 +680,63 @@ begin
   r^.Result := ParseTypeFromGdb('type = ^(array [0..-1] of TFoo)');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after dyn array', not v);
-  AssertEquals(n + ' text after dyn array', 'abc^[123]', b.Text);
+  AssertEqualsLc(n + ' text after dyn array', 'abc^[123]', b.Text);
 
   n := 'a(abc[123])';
   InitExpr(n, b, r, v);
   r^.Result := ParseTypeFromGdb('type = ^(array [0..-1] of TFoo)');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after dyn array', not v);
-  AssertEquals(n + ' text after dyn array', 'a(abc^[123])', b.Text);
+  AssertEqualsLc(n + ' text after dyn array', 'a(abc^[123])', b.Text);
 
   n := 'abc[123]+1';
   InitExpr(n, b, r, v);
   r^.Result := ParseTypeFromGdb('type = ^(array [0..-1] of TFoo)');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after dyn array', not v);
-  AssertEquals(n + ' text after dyn array', 'abc^[123]+1', b.Text);
+  AssertEqualsLc(n + ' text after dyn array', 'abc^[123]+1', b.Text);
 
   // multi index
 
   n := 'abc[123][456]';
   InitExpr(n, b, r, v);
-  AssertTrue(n + ' ptype 1', (r <> nil) and (r^.Request = 'ptype abc'));
+  AssertTrue(n + ' ptype 1', (r <> nil) and (LowerCase(r^.Request) = 'ptype abc'));
   r^.Result := ParseTypeFromGdb('type = ^(array [0..-1] of TFooA)');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after dyn array 1', v);
   //AssertTrue(n + ' ptype 2', (r <> nil) and (r^.Request = 'ptype TFooA(abc^[123])'));
-  AssertTrue(n + ' ptype 2', (r <> nil) and (r^.Request = 'ptype abc^[0]'));
+  AssertTrue(n + ' ptype 2', (r <> nil) and (LowerCase(r^.Request) = 'ptype abc^[0]'));
   r^.Result := ParseTypeFromGdb('type = ^(array [0..-1] of TFoo)');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after dyn array 2', not v);
-  //AssertEquals(n + ' text after dyn array 2', 'TFooA(abc^[123])^[456]', b.Text);
+  //AssertEqualsLc(n + ' text after dyn array 2', 'TFooA(abc^[123])^[456]', b.Text);
-  AssertEquals(n + ' text after dyn array 2', 'abc^[123]^[456]', b.Text);
+  AssertEqualsLc(n + ' text after dyn array 2', 'abc^[123]^[456]', b.Text);
 
   n := 'abc[123][456]';
   InitExpr(n, b, r, v);
   r^.Result := ParseTypeFromGdb('type = array [3..1000] of TFooA');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after stat array 1', v);
-  //AssertTrue(n + ' ptype 2a', (r <> nil) and (r^.Request = 'ptype TFooA(abc[123])'));
+  //AssertTrue(n + ' ptype 2a', (r <> nil) and (LowerCase(r^.Request) = 'ptype TFooA(abc[123])'));
-  AssertTrue(n + ' ptype 2a', (r <> nil) and (r^.Request = 'ptype abc[3]'));
+  AssertTrue(n + ' ptype 2a', (r <> nil) and (LowerCase(r^.Request) = 'ptype abc[3]'));
   r^.Result := ParseTypeFromGdb('type = ^(array [0..-1] of TFoo)');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after stat,dyn array 2', not v);
-  //AssertEquals(n + ' text after dyn array 2', 'TFooA(abc[123])^[456]', b.Text);
+  //AssertEqualsLc(n + ' text after dyn array 2', 'TFooA(abc[123])^[456]', b.Text);
-  AssertEquals(n + ' text after dyn array 2', 'abc[123]^[456]', b.Text);
+  AssertEqualsLc(n + ' text after dyn array 2', 'abc[123]^[456]', b.Text);
 
   n := 'abc[123][456]';
   InitExpr(n, b, r, v);
   r^.Result := ParseTypeFromGdb('type = ^(array [0..-1] of TFooA)');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after dyn array 1', v);
-  //AssertTrue(n + ' ptype 2b', (r <> nil) and (r^.Request = 'ptype TFooA(abc^[123])'));
+  //AssertTrue(n + ' ptype 2b', (r <> nil) and (LowerCase(r^.Request) = 'ptype TFooA(abc^[123])'));
-  AssertTrue(n + ' ptype 2b', (r <> nil) and (r^.Request = 'ptype abc^[0]'));
+  AssertTrue(n + ' ptype 2b', (r <> nil) and (LowerCase(r^.Request) = 'ptype abc^[0]'));
   r^.Result := ParseTypeFromGdb('type = array [0..1000] of TFoo');
   ContinueExpr(b, r, v);
   AssertTrue(n + ' Needexp after dyn,stat array 2', not v);
-  //AssertEquals(n + ' text after dyn array 2', 'TFooA(abc^[123])[456]', b.Text);
+  //AssertEqualsLc(n + ' text after dyn array 2', 'TFooA(abc^[123])[456]', b.Text);
-  AssertEquals(n + ' text after dyn array 2', 'abc^[123][456]', b.Text);
+  AssertEqualsLc(n + ' text after dyn array 2', 'abc^[123][456]', b.Text);
 
 
 
@@ -746,7 +750,7 @@ begin
   r^.Result := ParseTypeFromGdb('type = ^^(array [0..-1] of TRECFORARRAY1)');
   ContinueExpr(b, r, v);
   AssertTrue(n + 'No Need expr, after ^^ dyn array 1', not v);
-  AssertEquals(n + ' text after ^^ dyn array', '^^TRECFORARRAY1(qwe)[1][2]', b.Text);
+  AssertEqualsLc(n + ' text after ^^ dyn array', '^^TRECFORARRAY1(qwe)[1][2]', b.Text);
 
   n := 'qwe[3][2].a';
   InitExpr(n, b, r, v);
@@ -754,7 +758,7 @@ begin
   r^.Result := ParseTypeFromGdb('type = array [3..5] of ^(array of TRECFORARRAY1)');
   ContinueExpr(b, r, v);
   AssertTrue(n + 'No Need expr, after stat dyn array 1', not v);
-  AssertEquals(n + ' text after stat dyn array', 'TRECFORARRAY1(qwe[3]^[2]).a', b.Text);
+  AssertEqualsLc(n + ' text after stat dyn array', 'TRECFORARRAY1(qwe[3]^[2]).a', b.Text);
 
 
   n := 'qwe[3]';
@@ -766,26 +770,26 @@ begin
   r^.Result := ParseTypeFromGdb('type = char');
   ContinueExpr(b, r, v);
   AssertTrue(n + 'No Need expr', not v);
-  AssertEquals(n + ' text after', 'qwe[3]', b.Text);
+  AssertEqualsLc(n + ' text after', 'qwe[3]', b.Text);
   AssertEquals(n + ' maybe string ', True, b.MayNeedStringFix);
-  AssertEquals(n + ' text after as string', 'qwe[3-1]', b.TextStrFixed);
+  AssertEqualsLc(n + ' text after as string', 'qwe[3-1]', b.TextStrFixed);
 
 
   n := 'abc()[123]';
   InitExpr(n, b, r, v);
   AssertTrue(n + ' is array', b.Parts[0] is TGDBExpressionPartArray);
-  AssertTrue(n + ' ptype', (r <> nil) and (r^.Request = 'ptype abc()'));
+  AssertTrue(n + ' ptype', (r <> nil) and (LowerCase(r^.Request) = 'ptype abc()'));
 
 
   n := 'abc(x[1])[123]';
   InitExpr(n, b, r, v);
   AssertTrue(n + ' is array', b.Parts[0] is TGDBExpressionPartArray);
   AssertTrue(n + ' r.next', (r <> nil) and (r^.Next = nil));
-  AssertTrue(n + ' ptype', (r <> nil) and (r^.Request = 'ptype x')); // cant eval the outer array yet
+  AssertTrue(n + ' ptype', (r <> nil) and (LowerCase(r^.Request) = 'ptype x')); // cant eval the outer array yet
 
   r^.Result := ParseTypeFromGdb('type = array [0..1000] of TFoo');
   ContinueExpr(b, r, v);
-  AssertTrue(n + ' ptype outer ', (r <> nil) and (r^.Request = 'ptype abc(x[0])'));
+  AssertTrue(n + ' ptype outer ', (r <> nil) and (LowerCase(r^.Request) = 'ptype abc(x[0])'));
 
 
   n := 'abc()[x[123]]';
@@ -802,7 +806,7 @@ begin
 
   n := 'abc[1,2,3].x[1]';
   InitExpr(n, b, r, v, 'abc[1][2][3].x[1]');
-  AssertEquals(n+' toSkipArrayIdx', 'abc[0][0][0].x[0]', b.TextEx[[toSkipArrayIdx]]);
+  AssertEqualsLc(n+' toSkipArrayIdx', 'abc[0][0][0].x[0]', b.TextEx[[toSkipArrayIdx]]);
 
   n := 'abc[1,2,3].x and abc[1,2][3].y';
   InitExpr(n, b, r, v, 'abc[1][2][3].x and abc[1][2][3].y');