From 60277dda091464b1d7d71eefac92fa227da19835 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sun, 21 Oct 2018 15:53:46 +0000 Subject: [PATCH] * 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 - --- .gitattributes | 1 + compiler/ncal.pas | 2 + tests/webtbs/tw34442.pp | 333 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 336 insertions(+) create mode 100644 tests/webtbs/tw34442.pp diff --git a/.gitattributes b/.gitattributes index 3a2912c65f..952c53e48a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -16405,6 +16405,7 @@ tests/webtbs/tw34380.pp svneol=native#text/plain tests/webtbs/tw3441.pp svneol=native#text/plain tests/webtbs/tw3443.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/tw3457.pp svneol=native#text/plain tests/webtbs/tw3460.pp svneol=native#text/plain diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 89dd038b6f..2528197896 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -4586,6 +4586,8 @@ implementation { this is just to play it safe, there are more safe situations } if (n.nodetype = derefn) or ((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 } ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or { statics can only be modified by functions in the same unit } diff --git a/tests/webtbs/tw34442.pp b/tests/webtbs/tw34442.pp new file mode 100644 index 0000000000..46f602f076 --- /dev/null +++ b/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.