--- Merging r40191 into '.':

U    packages/fcl-js/src/jsbase.pp
U    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r40191 into '.':
 U   .
--- Merging r40195 into '.':
U    packages/fcl-web/examples/simpleserver/simpleserver.pas
--- Recording mergeinfo for merge of r40195 into '.':
 G   .
--- Merging r40203 into '.':
U    packages/fcl-js/src/jsscanner.pp
--- Recording mergeinfo for merge of r40203 into '.':
 G   .
--- Merging r40364 into '.':
U    packages/fcl-web/src/base/fphttpstatus.pas
U    packages/fcl-web/fpmake.pp
--- Recording mergeinfo for merge of r40364 into '.':
 G   .
--- Merging r40366 into '.':
G    packages/fcl-web/examples/simpleserver/simpleserver.pas
U    packages/fcl-web/examples/simpleserver/simpleserver.lpi
--- Recording mergeinfo for merge of r40366 into '.':
 G   .
--- Merging r40393 into '.':
U    packages/fcl-web/src/base/httproute.pp
--- Recording mergeinfo for merge of r40393 into '.':
 G   .
--- Merging r40395 into '.':
U    packages/fcl-web/src/base/fphttpclient.pp
--- Recording mergeinfo for merge of r40395 into '.':
 G   .
--- Merging r40592 into '.':
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r40592 into '.':
 G   .
--- Merging r40707 into '.':
U    packages/fcl-js/tests/tcwriter.pp
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r40707 into '.':
 G   .

# revisions: 40191,40195,40203,40364,40366,40393,40395,40592,40707

git-svn-id: branches/fixes_3_2@40719 -

packages/fcl-js/src/jsbase.pp

@@ -176,6 +176,7 @@ begin
     else
       exit;
     end;
+  Result:=true;
 end;
 {$else}
 var

packages/fcl-js/src/jsscanner.pp

@@ -504,22 +504,15 @@ begin
   SetLength(FCurTokenString,Len);
   if Len > 0 then
     Move(TokenStart^,FCurTokenString[1],Len);
- // Check if this is a keyword or identifier
+  // Check if this is a keyword or identifier
- // !!!: Optimize this!
+  // !!!: Optimize this!
-  I:=FirstKeyword;
+  for i:=FirstKeyword to Lastkeyword do
-  While (Result=tjsIdentifier) and (I<=Lastkeyword) do
+    if CurTokenString=TokenInfos[i] then
-    begin
-    if (CurTokenString=TokenInfos[i]) then
       begin
       Result := i;
       FCurToken := Result;
       exit;
       end;
-    {$Push}
-    {$R-}
-    I:=Succ(I);
-    {$Pop}
-    end
 end;
 
 Function TJSScanner.FetchToken: TJSToken;

packages/fcl-js/src/jswriter.pp

@@ -355,8 +355,8 @@ Var
 begin
   Result:=Length(S)*SizeOf(TJSWriterChar);
   if Result=0 then exit;
-  MinLen:=Result+FBufPos;
+  MinLen:=Result+integer(FBufPos);
-  If (MinLen>Capacity) then
+  If (MinLen>integer(Capacity)) then
     begin
     DesLen:=(FCapacity*3) div 2;
     if DesLen>MinLen then
@@ -364,7 +364,7 @@ begin
     Capacity:=MinLen;
     end;
   Move(S[1],FBuffer[FBufPos],Result);
-  FBufPos:=FBufPos+Result;
+  FBufPos:=integer(FBufPos)+Result;
 end;
 {$endif}
 
@@ -377,8 +377,8 @@ Var
 begin
   Result:=Length(S)*SizeOf(UnicodeChar);
   if Result=0 then exit;
-  MinLen:=Result+FBufPos;
+  MinLen:=Result+integer(FBufPos);
-  If (MinLen>Capacity) then
+  If (MinLen>integer(Capacity)) then
     begin
     DesLen:=(FCapacity*3) div 2;
     if DesLen>MinLen then
@@ -386,7 +386,7 @@ begin
     Capacity:=MinLen;
     end;
   Move(S[1],FBuffer[FBufPos],Result);
-  FBufPos:=FBufPos+Result;
+  FBufPos:=integer(FBufPos)+Result;
 end;
 {$endif}
 
@@ -545,8 +545,8 @@ Var
   I,J,L : Integer;
   R: TJSString;
   c: WideChar;
-
 begin
+  //system.writeln('TJSWriter.EscapeString "',S,'"');
   I:=1;
   J:=1;
   R:='';
@@ -554,7 +554,8 @@ begin
   While I<=L do
     begin
     c:=S[I];
-    if (c in [#0..#31,'"','''','/','\']) or (c>=#$ff00) then
+    if (c in [#0..#31,'"','''','/','\'])
+        or (c>=#$ff00) or ((c>=#$D800) and (c<=#$DFFF)) then
       begin
       R:=R+Copy(S,J,I-J);
       Case c of
@@ -568,7 +569,25 @@ begin
         #10 : R:=R+'\n';
         #12 : R:=R+'\f';
         #13 : R:=R+'\r';
-        #$ff00..#$ffff: R:=R+'\u'+TJSString(HexStr(ord(c),4));
+        #$D800..#$DFFF:
+          begin
+          if (I<L) then
+            begin
+            c:=S[I+1];
+            if (c>=#$D000) and (c<=#$DFFF) then
+              begin
+              inc(I,2); // surrogate, two char codepoint
+              continue;
+              end
+            else
+              // invalid UTF-16, cannot be encoded as UTF-8 -> encode as hex
+              R:=R+'\u'+TJSString(HexStr(ord(c),4));
+            end
+          else
+            // invalid UTF-16 at end of string, cannot be encoded as UTF-8 -> encode as hex
+            R:=R+'\u'+TJSString(HexStr(ord(c),4));
+          end;
+        #$FF00..#$FFFF: R:=R+'\u'+TJSString(HexStr(ord(c),4));
       end;
       J:=I+1;
       end;
@@ -576,6 +595,7 @@ begin
     end;
   R:=R+Copy(S,J,I-1);
   Result:=R;
+  //system.writeln('TJSWriter.EscapeString Result="',Result,'"');
 end;
 
 procedure TJSWriter.WriteValue(V: TJSValue);
@@ -1235,6 +1255,7 @@ procedure TJSWriter.WriteBinary(El: TJSBinary);
 Var
   S : String;
   AllowCompact, WithBrackets: Boolean;
+  ElC: TClass;
 begin
   {$IFDEF VerboseJSWriter}
   System.writeln('TJSWriter.WriteBinary SkipRoundBrackets=',FSkipRoundBrackets);
@@ -1243,6 +1264,18 @@ begin
   if WithBrackets then
     Write('(');
   FSkipRoundBrackets:=false;
+  ElC:=El.ClassType;
+  if El.A is TJSBinaryExpression then
+    if (El.A.ClassType=ElC)
+        and ((ElC=TJSLogicalOrExpression)
+        or (ElC=TJSLogicalAndExpression)
+        or (ElC=TJSBitwiseAndExpression)
+        or (ElC=TJSBitwiseOrExpression)
+        or (ElC=TJSBitwiseXOrExpression)
+        or (ElC=TJSAdditiveExpressionPlus)
+        or (ElC=TJSAdditiveExpressionMinus)
+        or (ElC=TJSMultiplicativeExpressionMul)) then
+      FSkipRoundBrackets:=true;
   WriteJS(El.A);
   Writer.CurElement:=El;
   AllowCompact:=False;
@@ -1259,6 +1292,13 @@ begin
       S:=' '+S+' ';
     end;
   FSkipRoundBrackets:=false;
+  ElC:=El.ClassType;
+  if El.B is TJSBinaryExpression then
+    if (El.B.ClassType=ElC)
+        and ((ElC=TJSLogicalOrExpression)
+        or (ElC=TJSLogicalAndExpression)) then
+      FSkipRoundBrackets:=true;
+  // Note: a+(b+c) <> a+b+c  e.g. floats, 0+string
   Write(S);
   WriteJS(El.B);
   Writer.CurElement:=El;

packages/fcl-js/tests/tcwriter.pp

@@ -180,10 +180,11 @@ type
 
   { TTestExpressionWriter }
 
-  TTestExpressionWriter= class(TTestJSWriter)
+  TTestExpressionWriter = class(TTestJSWriter)
   Protected
     Procedure TestUnary(Const Msg : String; AClass : TJSUnaryClass; Result : String);
-    Procedure TestBinary(Const Msg : String; AClass : TJSBinaryClass; Result : String;ACompact : Boolean);
+    Procedure TestBinary(Const Msg : String; AClass : TJSBinaryClass; Result : String; ACompact : Boolean);
+    Procedure TestBinaryNested(Const Msg : String; AClass : TJSBinaryClass; Result : String; ACompact : Boolean);
   Published
     Procedure TestIdent;
     Procedure TestThis;
@@ -201,8 +202,10 @@ type
     Procedure TestPostMinusMinus;
     Procedure TestBinaryLogicalOr;
     Procedure TestBinaryLogicalOrCompact;
+    Procedure TestBinaryLogicalOrNested;
     Procedure TestBinaryLogicalAnd;
     Procedure TestBinaryLogicalAndCompact;
+    Procedure TestBinaryLogicalAndNested;
     Procedure TestBinaryBitwiseOr;
     Procedure TestBinaryBitwiseOrCompact;
     Procedure TestBinaryBitwiseAnd;
@@ -237,10 +240,13 @@ type
     Procedure TestBinaryURShiftOfCompact;
     Procedure TestBinaryPlus;
     Procedure TestBinaryPlusCompact;
+    Procedure TestBinaryPlusNested;
     Procedure TestBinaryMinus;
     Procedure TestBinaryMinusCompact;
+    Procedure TestBinaryMinusNested;
     Procedure TestBinaryMultiply;
     Procedure TestBinaryMultiplyCompact;
+    Procedure TestBinaryMultiplyNested;
     Procedure TestBinaryDivide;
     Procedure TestBinaryDivideCompact;
     Procedure TestBinaryMod;
@@ -291,6 +297,23 @@ begin
   AssertWrite(Msg,Result,U);
 end;
 
+procedure TTestExpressionWriter.TestBinaryNested(const Msg: String;
+  AClass: TJSBinaryClass; Result: String; ACompact: Boolean);
+var
+  U: TJSBinary;
+begin
+  if ACompact then
+    Writer.Options:=Writer.Options+[woCompact];
+  U:=AClass.Create(0,0);
+  U.A:=AClass.Create(0,0);
+  TJSBinary(U.A).A:=CreateIdent('a');
+  TJSBinary(U.A).B:=CreateIdent('b');
+  U.B:=AClass.Create(0,0);
+  TJSBinary(U.B).A:=CreateIdent('c');
+  TJSBinary(U.B).B:=CreateIdent('d');
+  AssertWrite(Msg,Result,U);
+end;
+
 procedure TTestExpressionWriter.TestIdent;
 
 begin
@@ -373,6 +396,11 @@ begin
   TestBinary('logical or',TJSLogicalOrExpression,'(a||b)',True);
 end;
 
+procedure TTestExpressionWriter.TestBinaryLogicalOrNested;
+begin
+  TestBinaryNested('logical or',TJSLogicalOrExpression,'(a||b||c||d)',True);
+end;
+
 procedure TTestExpressionWriter.TestBinaryLogicalAnd;
 begin
   TestBinary('logical or',TJSLogicalAndExpression,'(a && b)',False);
@@ -383,6 +411,11 @@ begin
   TestBinary('logical or',TJSLogicalAndExpression,'(a&&b)',True);
 end;
 
+procedure TTestExpressionWriter.TestBinaryLogicalAndNested;
+begin
+  TestBinaryNested('logical and',TJSLogicalAndExpression,'(a&&b&&c&&d)',True);
+end;
+
 procedure TTestExpressionWriter.TestBinaryBitwiseOr;
 begin
   TestBinary('Bitwise or',TJSBitwiseOrExpression,'(a | b)',False);
@@ -553,6 +586,11 @@ begin
   TestBinary('A plus B',TJSAdditiveExpressionPlus,'(a+b)',True);
 end;
 
+procedure TTestExpressionWriter.TestBinaryPlusNested;
+begin
+  TestBinaryNested('(A+B)+(C+D)',TJSAdditiveExpressionPlus,'(a+b+(c+d))',True);
+end;
+
 procedure TTestExpressionWriter.TestBinaryMinus;
 begin
   TestBinary('A minus B',TJSAdditiveExpressionMinus,'(a - b)',False);
@@ -563,6 +601,11 @@ begin
   TestBinary('A minus B',TJSAdditiveExpressionMinus,'(a-b)',True);
 end;
 
+procedure TTestExpressionWriter.TestBinaryMinusNested;
+begin
+  TestBinaryNested('(A-B)-(C-D)',TJSAdditiveExpressionMinus,'(a-b-(c-d))',True);
+end;
+
 procedure TTestExpressionWriter.TestBinaryMultiply;
 begin
   TestBinary('A multiply B',TJSMultiplicativeExpressionMul,'(a * b)',False);
@@ -573,6 +616,11 @@ begin
   TestBinary('A multiply B',TJSMultiplicativeExpressionMul,'(a*b)',True);
 end;
 
+procedure TTestExpressionWriter.TestBinaryMultiplyNested;
+begin
+  TestBinaryNested('(A*B)*(C*D)',TJSMultiplicativeExpressionMul,'(a*b*(c*d))',True);
+end;
+
 procedure TTestExpressionWriter.TestBinaryDivide;
 begin
   TestBinary('A divide B',TJSMultiplicativeExpressionDiv,'(a / b)',False);
@@ -2594,7 +2642,7 @@ Var
   S : AnsiString;
   p: Integer;
 begin
-  S:=FTextWriter.AsAnsistring;
+  S:=FTextWriter.AsString;
   if S=Result then exit;
   p:=1;
   while (p<=length(S)) and (p<=length(Result)) and (S[p]=Result[p]) do inc(p);

packages/fcl-web/examples/simpleserver/simpleserver.lpi

@@ -39,6 +39,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../src/base"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
   </CompilerOptions>

packages/fcl-web/examples/simpleserver/simpleserver.pas

@@ -46,6 +46,7 @@ begin
   Writeln('-i --indexpage=name Directory index page to use (default: index.html)');
   Writeln('-n --noindexpage    Do not allow index page.');
   Writeln('-p --port=NNNN      TCP/IP port to listen on (default is 3000)');
+  Writeln('-m --mimetypes=file path of mime.types, default under unix: /etc/mime.types');
   Writeln('-q --quiet          Do not write diagnostic messages');
   Halt(Ord(Msg<>''));
 end;
@@ -65,8 +66,24 @@ begin
   if D='' then
     D:=GetCurrentDir;
   Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
+
+  if HasOption('m','mimetypes') then
+    MimeTypesFile:=GetOptionValue('m','mimetypes');
 {$ifdef unix}
-  MimeTypesFile:='/etc/mime.types';
+  if MimeTypesFile='' then
+    begin
+    MimeTypesFile:='/etc/mime.types';
+    if not FileExists(MimeTypesFile) then
+      begin
+      {$ifdef darwin}
+      MimeTypesFile:='/private/etc/apache2/mime.types';
+      if not FileExists(MimeTypesFile) then
+      {$endif}
+        MimeTypesFile:='';
+      end;
+    end;
+  if (MimeTypesFile<>'') and not FileExists(MimeTypesFile) then
+    Log(etWarning,'mimetypes file not found: '+MimeTypesFile);
 {$endif}
   TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
   TSimpleFileModule.OnLog:=@Log;

packages/fcl-web/fpmake.pp

@@ -182,6 +182,11 @@ begin
         OSes:=[Win32,Win64];
         Dependencies.AddUnit('custhttpsys');
       end;
+    with P.Targets.AddUnit('fphttpstatus.pas') do
+      begin
+        Dependencies.AddUnit('fphttpserver');
+        Dependencies.AddUnit('HTTPDefs');
+      end;
     T:=P.Targets.AddUnit('fcgigate.pp');
     T.ResourceStrings:=true;
     With T.Dependencies do

packages/fcl-web/src/base/fphttpclient.pp

@@ -1376,7 +1376,7 @@ procedure TFPCustomHTTPClient.HTTPMethod(const AMethod, AURL: String;
   Stream: TStream; const AllowedResponseCodes: array of Integer);
 
 Var
-  M,L,NL : String;
+  M,L,NL,RNL : String;
   RC : Integer;
   RR : Boolean; // Repeat request ?
 
@@ -1399,17 +1399,22 @@ begin
         if (RC>MaxRedirects) then
           Raise EHTTPClient.CreateFmt(SErrMaxRedirectsReached,[RC]);
         NL:=GetHeader(FResponseHeaders,'Location');
-        if Not Assigned(FOnRedirect) then
+        if Assigned(FOnRedirect) then
-          L:=NL
-        else
           FOnRedirect(Self,L,NL);
+        if (not IsAbsoluteURI(NL)) and ResolveRelativeURI(L,NL,RNL) then
+          NL:=RNL;
         if (RedirectForcesGET(FResponseStatusCode)) then
           M:='GET';
-        L:=NL;
         // Request has saved cookies in sentcookies.
-        FreeAndNil(FCookies);
+        if ParseURI(L).Host=ParseURI(NL).Host then
-        FCookies:=FSentCookies;
+          FreeAndNil(FSentCookies)
-        FSentCookies:=Nil;
+        else
+          begin
+          FreeAndNil(FCookies);
+          FCookies:=FSentCookies;
+          FSentCookies:=Nil;
+          end;
+        L:=NL;
         end;
       end;
     if (FResponseStatusCode=401) then

packages/fcl-web/src/base/fphttpstatus.pas

@@ -171,13 +171,13 @@ begin
       HTTPEncode(ARequest.Connection.Server.AdminMail) +
       '">' +
       HTTPEncode(name) +
-      '</a> Port ' + ARequest.ServerPort +
+      '</a> Port ' + IntToStr(ARequest.ServerPort) +
       '</address>'
   else
     Result := prefix + '<address>' + ARequest.Connection.Server.ServerBanner +
       ' Server at ' +
       ARequest.Connection.Server.AdminMail +
-      ' Port ' + ARequest.ServerPort +
+      ' Port ' + IntToStr(ARequest.ServerPort) +
       '</address>';
 end;
 

packages/fcl-web/src/base/httproute.pp

@@ -422,7 +422,7 @@ Var
 begin
   Result:=High(TRouteMethod);
   MN:=Uppercase(S);
-  While (Result>=Low(TRouteMethod)) and (RouteMethodNames[Result]<>MN) do
+  While (Result>Low(TRouteMethod)) and (RouteMethodNames[Result]<>MN) do
     Result:=Pred(Result);
   if Result=rmAll then Result:=rmUnknown;
 end;