Browse Source

* fix crash when checking load nodes during inlining in case they don't
have a symtable set (happens for internally generated labels, like
$raiseaddr) (mantis #34442)

git-svn-id: trunk@40008 -

Jonas Maebe 6 years ago
parent
commit
60277dda09
3 changed files with 336 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 2 0
      compiler/ncal.pas
  3. 333 0
      tests/webtbs/tw34442.pp

+ 1 - 0
.gitattributes

@@ -16405,6 +16405,7 @@ tests/webtbs/tw34380.pp svneol=native#text/plain
 tests/webtbs/tw3441.pp svneol=native#text/plain
 tests/webtbs/tw3441.pp svneol=native#text/plain
 tests/webtbs/tw3443.pp svneol=native#text/plain
 tests/webtbs/tw3443.pp svneol=native#text/plain
 tests/webtbs/tw3444.pp svneol=native#text/plain
 tests/webtbs/tw3444.pp svneol=native#text/plain
+tests/webtbs/tw34442.pp svneol=native#text/plain
 tests/webtbs/tw3456.pp svneol=native#text/plain
 tests/webtbs/tw3456.pp svneol=native#text/plain
 tests/webtbs/tw3457.pp svneol=native#text/plain
 tests/webtbs/tw3457.pp svneol=native#text/plain
 tests/webtbs/tw3460.pp svneol=native#text/plain
 tests/webtbs/tw3460.pp svneol=native#text/plain

+ 2 - 0
compiler/ncal.pas

@@ -4586,6 +4586,8 @@ implementation
         { this is just to play it safe, there are more safe situations }
         { this is just to play it safe, there are more safe situations }
         if (n.nodetype = derefn) or
         if (n.nodetype = derefn) or
            ((n.nodetype = loadn) and
            ((n.nodetype = loadn) and
+            { can be nil in case of internally generated labels like $raiseaddr }
+            assigned(tloadnode(n).symtable) and
             { globals and fields of (possibly global) objects could always be changed in the callee }
             { globals and fields of (possibly global) objects could always be changed in the callee }
             ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or
             ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or
             { statics can only be modified by functions in the same unit }
             { statics can only be modified by functions in the same unit }

+ 333 - 0
tests/webtbs/tw34442.pp

@@ -0,0 +1,333 @@
+{ %norun }
+
+{$mode delphi}
+
+uses
+  sysutils;
+
+{$define use_inline }
+
+function IndyMin(const AValueOne, AValueTwo: Int32): Int32;
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
+begin
+  if AValueOne > AValueTwo then begin
+    Result := AValueTwo;
+  end else begin
+    Result := AValueOne;
+  end;
+end;
+
+function IndyMin(const AValueOne, AValueTwo: Int64): Int64;
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
+begin
+  if AValueOne > AValueTwo then begin
+    Result := AValueTwo;
+  end else begin
+    Result := AValueOne;
+  end;
+end;
+
+function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16;
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
+begin
+  if AValueOne > AValueTwo then begin
+    Result := AValueTwo;
+  end else begin
+    Result := AValueOne;
+  end;
+end;
+
+
+function IndyMax(const AValueOne, AValueTwo: Int64): Int64;
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
+begin
+  if AValueOne < AValueTwo then begin
+    Result := AValueTwo;
+  end else begin
+    Result := AValueOne;
+  end;
+end;
+
+function IndyMax(const AValueOne, AValueTwo: Int32): Int32;
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
+begin
+  if AValueOne < AValueTwo then begin
+    Result := AValueTwo;
+  end else begin
+    Result := AValueOne;
+  end;
+end;
+
+function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16;
+{$IFDEF USE_INLINE}inline;{$ENDIF} overload;
+begin
+  if AValueOne < AValueTwo then begin
+    Result := AValueTwo;
+  end else begin
+    Result := AValueOne;
+  end;
+end;
+
+
+
+function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer;
+{$IFDEF USE_INLINE}inline;{$ENDIF}
+var
+  LAvailable: Integer;
+begin
+  Assert(AIndex >= 1);
+  LAvailable := IndyMax(Length(ABuffer)-AIndex+1, 0);
+  if ALength < 0 then begin
+    Result := LAvailable;
+  end else begin
+    Result := IndyMin(LAvailable, ALength);
+  end;
+end;
+
+
+function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean;
+{$IFDEF USE_INLINE}inline;{$ENDIF}
+begin
+  if ACharPos < 1 then begin
+    raise Exception.Create('Invalid ACharPos');{ do not localize }
+  end;
+  Result := ACharPos <= Length(AString);
+  if Result then begin
+    Result := AString[ACharPos] = AValue;
+  end;
+end;
+
+
+{$HINTS OFF}
+function IsNumeric(const AString: string): Boolean; overload;
+var
+  LCode: Integer;
+  LVoid: Int64;
+begin
+  Val(AString, LVoid, LCode);
+  Result := LCode = 0;
+end;
+{$HINTS ON}
+
+function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean; overload;
+var
+  I: Integer;
+  LLen: Integer;
+begin
+  Result := False;
+  LLen := IndyLength(AString, ALength, AIndex);
+  if LLen > 0 then begin
+    for I := 0 to LLen-1 do begin
+      if not IsNumeric(AString[AIndex+i]) then begin
+        Exit;
+      end;
+    end;
+    Result := True;
+  end;
+end;
+
+function IsNumeric(const AChar: Char): Boolean; overload;
+{$IFDEF USE_INLINE}inline;{$ENDIF}
+begin
+  // TODO: under XE3.5+, use TCharHelper.IsDigit() instead
+  // TODO: under D2009+, use TCharacter.IsDigit() instead
+
+  // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
+  Result := (AChar >= '0') and (AChar <= '9'); {Do not Localize}
+end;
+
+
+function StripNo(const AData : String): String; inline;
+var
+  i : Integer;
+  LPos : Integer;
+begin
+  LPos := 1;
+  for i := 1 to Length(AData) do begin
+    LPos := i;
+    if (not IsNumeric(AData[i])) and (not CharEquals(AData, i, ',')) then begin
+      Break;
+    end;
+  end;
+  Result := Copy(AData, LPos, Length(AData));
+end;
+
+function TextStartsWith(const S, SubS: string): Boolean;
+var
+  LLen: Integer;
+  {$IFDEF WINDOWS}
+    {$IFDEF COMPARE_STRING_MISMATCH}
+  LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
+  P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
+    {$ENDIF}
+  {$ENDIF}
+begin
+  LLen := Length(SubS);
+  Result := LLen <= Length(S);
+  if Result then
+  begin
+    {$IFDEF DOTNET}
+    Result := System.String.Compare(S, 0, SubS, 0, LLen, True) = 0;
+    {$ELSE}
+      {$IFDEF WINDOWS}
+        {$IFDEF COMPARE_STRING_MISMATCH}
+    // explicit convert to Ansi/Unicode
+    LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
+    LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
+    LLen := Length(LSubS);
+    Result := LLen <= Length(LS);
+    if Result then begin
+      P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
+      P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
+      Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
+    end;
+        {$ELSE}
+    Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S), LLen, PChar(SubS), LLen) = 2;
+        {$ENDIF}
+      {$ELSE}
+    Result := AnsiCompareText(Copy(S, 1, LLen), SubS) = 0;
+      {$ENDIF}
+    {$ENDIF}
+  end;
+end;
+
+procedure IdDelete(var s: string; AOffset, ACount: Integer);
+{$IFDEF USE_INLINE}inline;{$ENDIF}
+begin
+  Delete(s, AOffset, ACount);
+end;
+
+function TextEndsWith(const S, SubS: string): Boolean;
+var
+  LLen: Integer;
+  {$IFDEF WINDOWS}
+    {$IFDEF COMPARE_STRING_MISMATCH}
+  LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
+  P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
+    {$ELSE}
+  P: PChar;
+    {$ENDIF}
+  {$ENDIF}
+begin
+  LLen := Length(SubS);
+  Result := LLen <= Length(S);
+  if Result then
+  begin
+    {$IFDEF DOTNET}
+    Result := System.String.Compare(S, Length(S)-LLen, SubS, 0, LLen, True) = 0;
+    {$ELSE}
+      {$IFDEF WINDOWS}
+        {$IFDEF COMPARE_STRING_MISMATCH}
+    // explicit convert to Ansi/Unicode
+    LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
+    LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
+    LLen := Length(LSubS);
+    Result := LLen <= Length(S);
+    if Result then begin
+      P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
+      P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
+      Inc(P1, Length(LS)-LLen);
+      Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
+    end;
+        {$ELSE}
+    P := PChar(S);
+    Inc(P, Length(S)-LLen);
+    Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P, LLen, PChar(SubS), LLen) = 2;
+        {$ENDIF}
+      {$ELSE}
+    Result := AnsiCompareText(Copy(S, Length(S)-LLen+1, LLen), SubS) = 0;
+      {$ENDIF}
+    {$ENDIF}
+  end;
+end;
+
+const
+  IdFetchDelimDefault = ' ';    {Do not Localize}
+  IdFetchDeleteDefault = True;
+  IdFetchCaseSensitiveDefault = True;
+
+function FetchCaseInsensitive(var AInput: string; const ADelim: string;
+  const ADelete: Boolean): string;
+{$IFDEF USE_INLINE}inline;{$ENDIF}
+var
+  LPos: Integer;
+begin
+  if ADelim = #0 then begin
+    // AnsiPos does not work with #0
+    LPos := Pos(ADelim, AInput);
+  end else begin
+    //? may be AnsiUpperCase?
+    LPos := Pos(UpperCase(ADelim), UpperCase(AInput));
+  end;
+  if LPos = 0 then begin
+    Result := AInput;
+    if ADelete then begin
+      AInput := '';    {Do not Localize}
+    end;
+  end else begin
+    Result := Copy(AInput, 1, LPos - 1);
+    if ADelete then begin
+      //faster than Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
+      //remaining part is larger than the deleted
+      AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
+    end;
+  end;
+end;
+
+function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
+  const ADelete: Boolean = IdFetchDeleteDefault;
+	  const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
+{$IFDEF USE_INLINE}inline;{$ENDIF}
+var
+  LPos: Integer;
+begin
+  if ACaseSensitive then begin
+    if ADelim = #0 then begin
+      // AnsiPos does not work with #0
+      LPos := Pos(ADelim, AInput);
+    end else begin
+      LPos := Pos(ADelim, AInput);
+    end;
+    if LPos = 0 then begin
+      Result := AInput;
+      if ADelete then begin
+        AInput := '';    {Do not Localize}
+      end;
+    end
+    else begin
+      Result := Copy(AInput, 1, LPos - 1);
+      if ADelete then begin
+        //slower Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
+        //remaining part is larger than the deleted
+        AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
+      end;
+    end;
+  end else begin
+    Result := FetchCaseInsensitive(AInput, ADelim, ADelete);
+  end;
+end;
+
+function ExtractRecFormat(const ARecFM : String): String;
+  {$IFDEF USE_INLINE} inline; {$ENDIF}
+begin
+  Result := ARecFM;
+  if TextStartsWith(Result, '<') then begin
+    IdDelete(Result, 1, 1);
+  end;
+  if TextEndsWith(Result, '>') then begin
+    Result := Fetch(Result, '>');
+  end;
+end;
+
+
+procedure test;
+var
+  LTmp: string;
+  s: string;
+begin
+  LTmp:='ac';
+  s:=ExtractRecFormat(StripNo(LTmp));
+end;
+
+begin
+end.