Browse Source

* fix length(<dyn. type>)=0 optimization, resolves #36215

git-svn-id: trunk@43343 -
florian 5 years ago
parent
commit
cb67577002
3 changed files with 147 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 1 1
      compiler/nadd.pas
  3. 145 0
      tests/webtbs/tw36215.pp

+ 1 - 0
.gitattributes

@@ -17852,6 +17852,7 @@ tests/webtbs/tw3617.pp svneol=native#text/plain
 tests/webtbs/tw3619.pp svneol=native#text/plain
 tests/webtbs/tw3619.pp svneol=native#text/plain
 tests/webtbs/tw36196.pp svneol=native#text/pascal
 tests/webtbs/tw36196.pp svneol=native#text/pascal
 tests/webtbs/tw3621.pp svneol=native#text/plain
 tests/webtbs/tw3621.pp svneol=native#text/plain
+tests/webtbs/tw36215.pp svneol=native#text/pascal
 tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
 tests/webtbs/tw3650.pp svneol=native#text/plain
 tests/webtbs/tw3650.pp svneol=native#text/plain

+ 1 - 1
compiler/nadd.pas

@@ -468,7 +468,7 @@ implementation
                 ctypeconvnode.create_internal(
                 ctypeconvnode.create_internal(
                   cderefnode.create(
                   cderefnode.create(
                     caddnode.create_internal(subn,ctypeconvnode.create_internal(tinlinenode(n1).left.getcopy,voidpointertype),
                     caddnode.create_internal(subn,ctypeconvnode.create_internal(tinlinenode(n1).left.getcopy,voidpointertype),
-                      cordconstnode.create(0,sizesinttype,false))
+                      cordconstnode.create(sizesinttype.size,sizesinttype,false))
                   ),sizesinttype
                   ),sizesinttype
                 ),
                 ),
               cordconstnode.create(len,sizesinttype,false))
               cordconstnode.create(len,sizesinttype,false))

+ 145 - 0
tests/webtbs/tw36215.pp

@@ -0,0 +1,145 @@
+program IntArrayCode;
+{$MODE OBJFPC}
+{$R+}
+{$OPTIMIZATION ON}
+
+uses SysUtils;
+
+type
+  TIntegerArray = array of Integer;
+  TSeparator = (tlSpace=0, tlComma=1, tlTab=2, tlAny, tlDetect);
+
+var
+  EmptyArray: TIntegerArray = nil;
+
+function TryReadIntegerTabbedLine(Separator: TSeparator; s, Last: PAnsiChar; V: array of PInteger; out nFields: Integer; var SeparatorCount: TIntegerArray):PAnsiChar;
+var
+  P, B, Start: PAnsiChar;
+  Value: Integer;
+  IsString, Negative: Boolean;
+begin
+  nFields := 0;
+  Result := nil;
+  if s = nil then
+    Exit; { No values read }
+  P := s;
+  while (nFields < Length(V)) and (V[nFields] <> nil) do begin
+    while (P <> Last) and (P^ = ' ') do
+      Inc(p);
+    if (P = Last) or (P^ = #0) then
+      Exit
+    else if P^ in [#10,#13] then
+      Break
+    else if (P^ = #9) then begin
+      if Separator in [tlComma, tlSpace] then
+        Continue { Treat as white space }
+      else if Separator = tlDetect then
+        Inc(SeparatorCount[Ord(tlTab)]);
+      Inc(P) { Empty field }
+    end else if P^ = ',' then begin
+      if Separator in [tlSpace, tlTab] then
+        Break { Start of string field }
+      else if Separator = tlDetect then
+        Inc(SeparatorCount[Ord(tlComma)]);
+      Inc(P) { Empty field }
+    end else begin
+      Start := P;
+      IsString := False;
+      Value := 0;
+      Negative := P^ = '-';
+      if P^ in ['+', '-'] then
+        Inc(P);
+      while not IsString and (P <> Last) and (P^ in ['0'..'9']) do begin
+        if Value <= High(Integer) div 10 then
+          Value := Value*10 + Ord(P^)-Ord('0')
+        else
+          IsString := True;
+        Inc(P);
+      end;
+      while (P <> Last) and not (P^ in [#0, ' ', #9, ',', #10, #13]) do begin
+        IsString := True;
+        Inc(P);
+      end;
+      if not IsString then begin
+        if Negative then
+          Value := -Value;
+        V[nFields]^ := Value;
+      end;
+      B := P;
+      while (P <> Last) and ((P^ = ' ') or ((Separator in [tlSpace, tlComma]) and (P^ = #9))) do
+        Inc(P);
+      if (P <> Last) and not IsString then
+        if P^ = #9 then begin
+          if Separator = tlDetect then
+            Inc(SeparatorCount[Ord(tlTab)]);
+          Inc(P); { Non-empty field }
+        end else if P^ = ',' then begin
+          if Separator in [tlSpace, tlTab] then
+            Break { Start of string field }
+          else if Separator = tlDetect then
+            Inc(SeparatorCount[Ord(tlComma)]);
+          Inc(P); { Non-empty field }
+        end else if (Separator = tlDetect) and (B <> P) then
+          Inc(SeparatorCount[Ord(tlSpace)]);
+      if IsString then begin
+        P := Start;
+        Break;
+      end;
+    end;
+    Inc(nFields);
+  end;
+  if (P = Last) or (P^ = #0) then
+    Result := nil
+  else
+    Result := P;
+end;
+
+function SkipLineEnding(var P: PAnsiChar):Boolean;
+begin
+  Result := True;
+  case P^ of
+    #10: if (P+1)^ = #13 then
+           Inc(P,2)
+         else
+           Inc(P);
+    #13: if (P+1)^ = #10 then
+           Inc(P,2)
+         else
+           Inc(P);
+  else
+    Result := False;
+  end;
+end;
+
+function ReadIntegerArray(S: AnsiString): TIntegerArray;
+var
+  P: PAnsiChar;
+  V, nRows, nFields: Integer;
+begin
+  Result := nil;
+  nRows := 0;
+  P := PAnsiChar(S);
+  while P^ <> #0 do begin
+    P := TryReadIntegerTabbedLine(tlAny, P, nil, [@V], nFields, EmptyArray);
+    if nFields > 0 then begin
+      if nRows >= Length(Result) then
+        if Length(Result) = 0 then { Length read from wrong placer? }
+          SetLength(Result, 16)
+        else
+          SetLength(Result, Length(Result)*2);
+      Result[nRows] := V;
+      Inc(nRows);
+    end;
+    if P = nil then
+      Break;
+    while not (P^ in [#10, #13]) do
+      Inc(P);
+    SkipLineEnding(P);
+  end;
+  SetLength(Result, nRows);
+end;
+
+begin
+  WriteLn(Length(ReadIntegerArray('-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10'-1'#10)));
+end.
+