* synchronize with trunk

git-svn-id: branches/unicodekvm@41674 -

.gitattributes

@@ -2106,6 +2106,8 @@ packages/fcl-db/examples/showcsv.pp svneol=native#text/plain
 packages/fcl-db/examples/sqlite3extdemo.pp svneol=native#text/plain
 packages/fcl-db/examples/sqlite3loadlib.lpr svneol=native#text/plain
 packages/fcl-db/examples/sqlparser.pp svneol=native#text/plain
+packages/fcl-db/examples/sqlshell.lpi svneol=native#text/plain
+packages/fcl-db/examples/sqlshell.pas svneol=native#text/plain
 packages/fcl-db/examples/tsamytable.pp svneol=native#text/plain
 packages/fcl-db/examples/typesafetable.sql svneol=native#text/plain
 packages/fcl-db/fpmake.pp svneol=native#text/plain
@@ -3318,6 +3320,8 @@ packages/fcl-web/examples/jsonrpc/extdirect/extdirect.in svneol=native#text/plai
 packages/fcl-web/examples/jsonrpc/extdirect/wmext.lfm svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/extdirect/wmext.pp svneol=native#text/plain
 packages/fcl-web/examples/restbridge/README.txt svneol=native#text/plain
+packages/fcl-web/examples/restbridge/cmdclient/cmdclient.lpi svneol=native#text/plain
+packages/fcl-web/examples/restbridge/cmdclient/cmdclient.pas svneol=native#text/plain
 packages/fcl-web/examples/restbridge/delphiclient/frmmain.dfm svneol=native#text/plain
 packages/fcl-web/examples/restbridge/delphiclient/frmmain.pas svneol=native#text/plain
 packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dpr svneol=native#text/plain
@@ -3500,6 +3504,8 @@ packages/fcl-xml/Makefile.fpc svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-xml/buildfclxml.lpi svneol=native#text/plain
 packages/fcl-xml/buildfclxml.pp svneol=native#text/plain
+packages/fcl-xml/examples/reducexml.lpi svneol=native#text/plain
+packages/fcl-xml/examples/reducexml.pp svneol=native#text/plain
 packages/fcl-xml/examples/test.html svneol=native#text/html
 packages/fcl-xml/examples/testhtml.pp svneol=native#text/plain
 packages/fcl-xml/fpmake.pp svneol=native#text/plain
@@ -16579,6 +16585,7 @@ tests/webtbs/tw3506.pp svneol=native#text/plain
 tests/webtbs/tw35139.pp svneol=native#text/plain
 tests/webtbs/tw35139a.pp svneol=native#text/plain
 tests/webtbs/tw35149.pp svneol=native#text/plain
+tests/webtbs/tw35187.pp svneol=native#text/pascal
 tests/webtbs/tw3523.pp svneol=native#text/plain
 tests/webtbs/tw3529.pp svneol=native#text/plain
 tests/webtbs/tw3531.pp svneol=native#text/plain

compiler/aarch64/racpugas.pas

@@ -485,8 +485,8 @@ Unit racpugas;
                       useszr:=false;
                       for i:=low(instr.operands) to pred(opnr) do
                         begin
-                          if (instr.operands[1].opr.typ=OPR_REGISTER) then
-                            case getsupreg(instr.operands[1].opr.reg) of
+                          if (instr.operands[i].opr.typ=OPR_REGISTER) then
+                            case getsupreg(instr.operands[i].opr.reg) of
                               RS_XZR:
                                 useszr:=true;
                               RS_SP:
@@ -494,7 +494,10 @@ Unit racpugas;
                             end;
                         end;
                       result:=valid_shifter_operand(instr.opcode,useszr,usessp,instr.Is64bit,sm,instr.operands[opnr].opr.shifterop.shiftimm);
-                    end
+                      if result then
+                        instr.Ops:=opnr;
+                    end;
+                  break;
                 end;
           end;
       end;

compiler/systems/t_bsd.pas

@@ -789,7 +789,9 @@ begin
 
    if(not(target_info.system in systems_darwin) and
       (cs_profile in current_settings.moduleswitches)) or
-     ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
+     ((Info.DynamicLinker<>'') and
+      ((not SharedLibFiles.Empty) or
+       (target_info.system in systems_openbsd))) then
    DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
 
   if CShared Then
@@ -800,8 +802,9 @@ begin
      DynLinKStr:=DynLinkStr+' -dynamic'; // one dash!
    end;
 
-{ Use -nopie on OpenBSD }
-  if (target_info.system in systems_openbsd) then
+{ Use -nopie on OpenBSD if PIC support is turned off }
+  if (target_info.system in systems_openbsd) and
+     not(cs_create_pic in current_settings.moduleswitches) then
     Info.ExtraOptions:=Info.ExtraOptions+' -nopie';
 
 { -N seems to be needed on NetBSD/earm }

compiler/x86/aoptx86.pas

@@ -3484,44 +3484,44 @@ unit aoptx86;
                       MatchOpType(taicpu(hp1),top_const,top_reg) and
                       (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then
                       begin
-                        taicpu(p).opcode := A_MOV;
+                        //taicpu(p).opcode := A_MOV;
                         case taicpu(p).opsize Of
                           S_BL:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var13',p);
-                              taicpu(p).changeopsize(S_L);
+                              taicpu(hp1).changeopsize(S_L);
                               taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ff);
                             end;
                           S_WL:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var14',p);
-                              taicpu(p).changeopsize(S_L);
+                              taicpu(hp1).changeopsize(S_L);
                               taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ffff);
                             end;
                           S_BW:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var15',p);
-                              taicpu(p).changeopsize(S_W);
+                              taicpu(hp1).changeopsize(S_W);
                               taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ff);
                             end;
 {$ifdef x86_64}
                           S_BQ:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var16',p);
-                              taicpu(p).changeopsize(S_Q);
+                              taicpu(hp1).changeopsize(S_Q);
                               taicpu(hp1).loadConst(
                                 0, taicpu(hp1).oper[0]^.val and $ff);
                             end;
                           S_WQ:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var17',p);
-                              taicpu(p).changeopsize(S_Q);
+                              taicpu(hp1).changeopsize(S_Q);
                               taicpu(hp1).loadConst(0, taicpu(hp1).oper[0]^.val and $ffff);
                             end;
                           S_LQ:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var18',p);
-                              taicpu(p).changeopsize(S_Q);
+                              taicpu(hp1).changeopsize(S_Q);
                               taicpu(hp1).loadConst(
                                 0, taicpu(hp1).oper[0]^.val and $ffffffff);
                             end;

packages/fcl-db/examples/sqlshell.lpi

@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="sqlshell"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="sqlshell.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="sqlshell"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-db/examples/sqlshell.pas

@@ -0,0 +1,296 @@
+{$mode objfpc}
+{$h+}
+uses
+  custapp, sysutils, strutils, classes, db, sqldb, bufdataset, XMLDatapacketReader,
+  sqlite3conn, pqconnection, ibconnection, mssqlconn, oracleconnection,mysql55conn,mysql40conn,mysql51conn,mysql50conn;
+
+Const
+  CmdSep = [' ',#9,#10,#13,#12];
+
+type
+
+  { TSQLShellApplication }
+
+  TSQLShellApplication = class(TCustomApplication)
+  Private
+    FConn : TSQLConnection;
+    FTR : TSQLTransaction;
+    FQuery : TSQLQuery;
+    FConnType : String;
+    FCharset : String;
+    FDatabaseName: String;
+    FHostName : string;
+    FUserName : String;
+    FPassword : String;
+    FPort : INteger;
+    FAutoCommit : Boolean;
+    procedure ConnectToDatabase;
+    procedure DisconnectFromDatabase;
+    procedure ExecuteCommand(const ASQL: UTF8String);
+    procedure ExecuteSystemCommand(const S : UTF8String);
+    procedure MaybeCommit;
+    procedure MaybeRollBack;
+    function ParseArgs: Boolean;
+    procedure RunCommandLoop;
+    procedure SaveLast(FN: String);
+    procedure Usage(const Err: String);
+    procedure WriteHelp;
+  Protected
+    procedure DoRun; override;
+    Property Conn : TSQLConnection Read FConn;
+    Property AutoCommit : Boolean Read FAutoCommit;
+  end;
+
+
+Procedure TSQLShellApplication.ConnectToDatabase;
+
+begin
+  FConn:=TSQLConnector.Create(Self);
+  TSQLConnector(FConn).ConnectorType:=FConnType;
+  FTR:=TSQLTransaction.Create(Self);
+  Conn.Transaction:=FTR;
+  Conn.DatabaseName:=FDatabaseName;
+  Conn.HostName:=FHostName;
+  Conn.UserName:=FUserName;
+  Conn.Password:=FPassword;
+  Conn.Connected:=True;
+  if FCharset<>'' then
+    Conn.CharSet:=FCharset;
+end;
+
+
+Procedure TSQLShellApplication.DisconnectFromDatabase;
+
+begin
+  FreeAndNil(FTr);
+  FreeAndNil(FConn);
+end;
+
+Procedure TSQLShellApplication.ExecuteCommand(Const ASQL : UTF8String);
+
+Var
+  Q : TSQLQuery;
+  F : TField;
+  
+begin
+  FreeAndNil(FQuery);
+  Q:=TSQLQuery.Create(Conn);
+  Q.Database:=Conn;
+  Q.Transaction:=FTr;
+  if not FTR.Active then
+    FTR.StartTransaction;
+  Q.SQL.Text:=aSQL;
+  Q.Prepare;
+  if Q.StatementType<>stSelect then
+    begin
+    Q.ExecSQL;
+    Writeln('Rows affected : ',Q.RowsAffected);
+    if AutoCommit then
+      (Q.Transaction as TSQLTransaction).Commit;
+    Q.Free;
+    end
+  else
+    begin
+    Q.Open;
+    Write('|');
+    For F in Q.Fields do
+      Write(' ',F.FieldName,' |');
+    Writeln;
+    While not Q.EOF do
+      begin
+      Write('|');
+      For F in Q.Fields do
+        Write(F.AsString,' |');
+      Writeln;
+      Q.Next;
+      end;
+    FQuery:=Q;
+    end;
+end;
+
+Procedure TSQLShellApplication.SaveLast(FN : String);
+
+begin
+  FN:=Trim(FN);
+  if FN='' then
+    begin
+    Write('Type filename to save data: ');
+    Readln(fn);
+    end;
+  if (FN<>'') then
+    FQuery.SaveToFile(FN,dfXML);
+end;
+
+Procedure TSQLShellApplication.MaybeCommit;
+begin
+  if FTR.Active then
+    FTR.Commit;
+end;
+
+Procedure TSQLShellApplication.MaybeRollBack;
+begin
+  if FTR.Active then
+    FTR.Commit;
+end;
+
+Procedure TSQLShellApplication.ExecuteSystemCommand(Const S : UTF8String);
+
+Var
+  Cmd,Args : String;
+
+begin
+  Cmd:=ExtractWord(1,S,CmdSep);
+  Args:=S;
+  Delete(Args,1,Length(Cmd)+Pos(Cmd,Args)-1);
+  While (Length(Args)>0) and (Args[1] in CmdSep) do
+    Delete(Args,1,1);
+  case Cmd of
+   'a','autocommit' :
+      FAutoCommit:=Not FAutoCommit;
+   'q','quit' :
+      begin
+      MaybeCommit;
+      Terminate;
+      end;
+   'x','exit' :
+      begin
+      MaybeRollBack;
+      Terminate;
+      end;
+   'c','commit' :
+      MaybeCommit;
+   'r','collback':
+      MaybeRollBack;
+   's',
+   'save' : SaveLast(Args);
+   '?','h','help' : WriteHelp;
+  end;
+end;
+
+Procedure TSQLShellApplication.WriteHelp;
+
+begin
+  Writeln('Commands : ');
+  Writeln('\a \autocommit  Toggle autocommit (Current autocommit :',FAutoCommit,')');
+  Writeln('\c \commit      commit');
+  Writeln('\h \help        this help');
+  Writeln('\q \quit        commit and quit');
+  Writeln('\r \rollback    commit');
+  Writeln('\x \exit        RollBack and quit');
+  Writeln('\s \save [FN]   Save result of last select to XML file');
+end;
+
+Procedure TSQLShellApplication.RunCommandLoop;
+
+Var
+  S : UTF8String;
+
+begin
+  Writeln('Enter commands, end with \q. \?, \h or \help for help.');
+  Repeat
+    Write('SQL > ');
+    Readln(S);
+    try
+      While (Length(S)>0) and (S[1] in CmdSep) do
+        Delete(S,1,1);
+      if Copy(S,1,1)='\' then
+        begin
+        Delete(S,1,1);
+        ExecuteSystemCommand(S)
+        end
+      else
+        ExecuteCommand(S)
+    except
+      On E : Exception do
+        Writeln(Format('Error %s executing command : %s',[E.ClassName,E.Message]));
+    end;
+  until Terminated;
+  Terminate;
+end;
+
+Procedure  TSQLShellApplication.Usage(Const Err : String);
+
+Var
+  L : TStrings;
+  S : String;
+
+begin
+  if (Err<>'') then
+    Writeln('Error : ',Err);
+  Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h --help           This help text.');
+  Writeln('-t --type=TYPE      Set connection type.');
+  Writeln('-d --database=DB    Set database name.');
+  Writeln('-H --hostname=DB    Set database hostname.');
+  Writeln('-u --username=NAME  Set database user name.');
+  Writeln('-p --password=PWD   Set database user password.');
+  Writeln('-c --charset=SET    Set database character set.');
+  Writeln('-P --port=N         Set database connection port.');
+  Writeln('Known connection types for this binary:');
+  L:=TStringList.Create;
+  try
+    GetConnectionList(L);
+    for S in L do
+      Writeln('  ',S);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TSQLShellApplication.ParseArgs : Boolean;
+
+Var
+  S : String;
+
+begin
+  Result:=False;
+  S:=CheckOptions('hH:d:t:u:p:c:P:',['help','hostname:','database:','type:','username:','password:','c:charset','port']);
+  if (S<>'') or (HasOption('h','help')) then
+    begin
+    Usage(S);
+    exit;
+    end;
+  FConnType:=GetOptionValue('t','type');
+  FHostName:=GetOptionValue('H','hostname');
+  FDatabaseName:=GetOptionValue('d','database');
+  FUserName:=GetOptionValue('u','user');
+  FPassword:=GetOptionValue('p','password');
+  FCharset:=GetOptionValue('c','charset');
+  if HasOption('P','port') then
+    begin
+    FPort:=StrToIntDef(GetOptionValue('P','port'),-1);
+    if FPort=-1 then
+      Usage('Databasename not supplied');
+    exit;
+    end;
+  Result:=(FDatabaseName<>'');
+  if not Result then
+    Usage('Databasename not supplied');
+end;
+
+Procedure TSQLShellApplication.DoRun;
+
+begin
+  StopOnException:=True;
+  if Not ParseArgs then
+    begin
+    terminate;
+    exit;
+    end;
+  ConnectToDatabase;
+  RunCommandLoop;
+  DisconnectFromDatabase;
+end;
+
+begin
+  With TSQLShellApplication.Create(Nil) do
+    try
+      Initialize;
+      Run;
+    finally
+      Free;
+    end;
+end.
+
+

packages/fcl-db/src/base/xmldatapacketreader.pp

@@ -133,7 +133,7 @@ procedure TXMLDatapacketReader.LoadFieldDefs(var AnAutoIncValue: integer);
     else result := '';
   end;
 
-var i           : integer;
+var i,s           : integer;
     AFieldDef   : TFieldDef;
     iFieldType  : TFieldType;
     FTString    : string;
@@ -160,7 +160,11 @@ begin
       AFieldDef := Dataset.FieldDefs.AddFieldDef;
       AFieldDef.DisplayName:=GetNodeAttribute(AFieldNode,'fieldname');
       AFieldDef.Name:=GetNodeAttribute(AFieldNode,'attrname');
-      AFieldDef.Size:=StrToIntDef(GetNodeAttribute(AFieldNode,'width'),0);
+      // Difference in casing between CDS and bufdataset...
+      S:=StrToIntDef(GetNodeAttribute(AFieldNode,'width'),-1);
+      if (S=-1) then
+        S:=StrToIntDef(GetNodeAttribute(AFieldNode,'WIDTH'),0);
+      AFieldDef.Size:=s;
       FTString:=GetNodeAttribute(AFieldNode,'fieldtype');
       SubFTString:=GetNodeAttribute(AFieldNode,'subtype');
       if SubFTString<>'' then

packages/fcl-web/examples/restbridge/cmdclient/cmdclient.lpi

@@ -0,0 +1,57 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="SQLDB Rest Bridge client application"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="cmdclient.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="cmdclient"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/restbridge/cmdclient/cmdclient.pas

@@ -0,0 +1,166 @@
+program cmdclient;
+
+{$mode objfpc}{$H+}
+
+uses
+  cwstring,Classes, SysUtils, CustApp, fphttpclient, db, bufdataset, XMLDatapacketReader;
+
+type
+
+  { TSQLDBRestClientApplication }
+
+  TSQLDBRestClientApplication = class(TCustomApplication)
+  Private
+    FURL: String;
+    FUserName: string;
+    FPassword: string;
+    FShowRaw : Boolean;
+  protected
+    procedure RunQuery(aDataset: TBufDataset);
+    Procedure ShowData(aDataset: TDataset);
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp; virtual;
+  end;
+
+{ TSQLDBRestClientApplication }
+
+procedure TSQLDBRestClientApplication.RunQuery(aDataset : TBufDataset);
+
+Var
+  C : TFPHTTPClient;
+  S : TStringStream;
+  U : String;
+
+begin
+  U:=FURL;
+  S:=Nil;
+  C:=TFPHTTPClient.Create(Self);
+  try
+    C.UserName:=FUserName;
+    C.Password:=FPassword;
+    S:=TStringStream.Create;
+    if Pos('?',U)=0 then
+      U:=U+'?'
+    else
+      U:=U+'&';
+    U:=U+'fmt=buf';
+    C.Get(U,S);
+    if FShowRaw then
+      begin
+      Writeln('Raw request data:');
+      Writeln('---');
+      Writeln(S.Datastring);
+      Writeln('---');
+      end;
+    S.Position:=0;
+    aDataset.LoadFromStream(S,dfXML);
+  finally
+    S.Free;
+    C.Free;
+  end;
+end;
+
+procedure TSQLDBRestClientApplication.ShowData(aDataset: TDataset);
+
+Var
+  I : Integer;
+  F : TField;
+  FL : Integer;
+
+begin
+  FL:=0;
+  With aDataset do
+    begin
+    For I:=0 to FieldDefs.Count-1 do
+      if Length(FieldDefs[I].Name)>FL then
+        FL:=Length(FieldDefs[I].Name);
+    While not EOF do
+      begin
+      Writeln(StringOfChar('-',FL));
+      Writeln('Record: ',RecNo:4);
+      Writeln(StringOfChar('-',FL));
+      For F in Fields do
+        With F do
+          begin
+          Write(FieldName:FL,': ');
+          if F.IsNull then
+            Writeln('<NULL>')
+          else
+            Writeln(F.AsString);
+          end;
+      Next;
+      end;
+    end;
+end;
+
+procedure TSQLDBRestClientApplication.DoRun;
+var
+  ErrorMsg: String;
+  D : TBufDataset;
+
+begin
+  // quick check parameters
+  ErrorMsg:=CheckOptions('hU:u:p:r', ['help','url:','username:','password:','raw']);
+  if ErrorMsg<>'' then begin
+    ShowException(Exception.Create(ErrorMsg));
+    Terminate;
+    Exit;
+  end;
+
+  // parse parameters
+  if HasOption('h', 'help') then begin
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+  FURL:=GetOptionValue('U','url');
+  FUserName:=GetOptionValue('u','username');
+  FPassword:=GetOptionValue('p','password');
+  FShowRaw:=HasOption('r','raw');
+  D:=TBufDataset.Create(Self);
+  try
+    RunQuery(D);
+    ShowData(D);
+  Finally
+    D.Free;
+  end;
+
+  // stop program loop
+  Terminate;
+end;
+
+constructor TSQLDBRestClientApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+destructor TSQLDBRestClientApplication.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TSQLDBRestClientApplication.WriteHelp;
+begin
+  { add your help code here }
+  writeln('Usage: ', ExeName, ' [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h --help            this message');
+  Writeln('-p --password=PWD    HTTP Basic authentication password.');
+  Writeln('-r --raw             Show raw request data');
+  Writeln('-U --url=URL         URL to get data from. Do not add format (fmt) parameter');
+  Writeln('-u --username=User   HTTP Basic authentication username');
+end;
+
+var
+  Application: TSQLDBRestClientApplication;
+begin
+  Application:=TSQLDBRestClientApplication.Create(nil);
+  Application.Title:='SQLDB Rest Bridge client application';
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-web/examples/restbridge/demorestbridge.pp

@@ -23,8 +23,7 @@ uses
   {$ENDIF}{$ENDIF}
   Classes, SysUtils, CustApp, sqldbrestbridge, fphttpapp, IBConnection, odbcconn, mysql55conn, mysql56conn, pqconnection,
   mssqlconn, oracleconnection, sqldbrestxml, sqldbrestio, sqldbrestschema, sqldbrestdata, sqldbrestjson, sqldbrestcsv, sqldbrestcds,
-  sqldbrestconst, sqldbrestauth, sqldbrestini, sqldb, sqldbrestauthini
-  ;
+  sqldbrestado,  sqldbrestconst, sqldbrestauth, sqldbrestini, sqldb, sqldbrestauthini;
 
 type
   { TXMLSQLDBRestDispatcher }
@@ -57,7 +56,7 @@ function TXMLSQLDBRestDispatcher.CreateOutputStreamer(IO: TRestIO): TRestOutputS
 begin
   io.Response.ContentStream:=TMemoryStream.Create;
   io.Response.FreeContentStream:=True;
-  Result:=TXMLOutputStreamer.Create(IO.Response.ContentStream,Strings,@IO.DoGetVariable);
+  Result:=TXMLOutputStreamer.Create(IO.Response.ContentStream,Strings,Statuses, @IO.DoGetVariable);
 end;
 
 { TRestServerDemoApplication }
@@ -91,18 +90,22 @@ begin
     Exit;
   end;
   Port:=3000;
-  FDisp:=TSQLDBRestDispatcher.Create(Self);
+  if HasOption('x','xml-only') then
+    FDisp:=TXMLSQLDBRestDispatcher.Create(Self)
+  else
+    FDisp:=TSQLDBRestDispatcher.Create(Self);
   if HasOption('c', 'config') then
     FDisp.LoadFromFile(GetOptionValue('c', 'config'),[dioSkipReadSchemas])
   else
     begin
     // create a Default setup
     FAuth:=TRestBasicAuthenticator.Create(Self);
+    // This is not the DB user !
     FAuth.DefaultUserName:='me';
     FAuth.DefaultPassword:='secret';
     FAuth.AuthenticateUserSQL.Text:='select uID from users where (uLogin=:UserName) and (uPassword=:Password)';
-    FDisp.DispatchOptions:=FDisp.DispatchOptions+[rdoConnectionInURL,rdoCustomView,rdoHandleCORS];
-    FDisp.ExposeDatabase(TPQConnectionDef.TypeName,'localhost','expensetracker','me','secret',Nil,[foFilter,foInInsert,foInUpdate,foOrderByDesc]);
+    FDisp.DispatchOptions:=FDisp.DispatchOptions+[rdoCustomView,rdoHandleCORS];
+    FDisp.ExposeDatabase(TPQConnectionDef.TypeName,'localhost','expensetracker','You','YourSecret',Nil,[foFilter,foInInsert,foInUpdate,foOrderByDesc]);
     With FDisp.Schemas[0].Schema.Resources do
       begin
       FindResourceByName('users').Fields.FindByFieldName('uID').GeneratorName:='seqUsersID';
@@ -146,6 +149,7 @@ begin
   Writeln('-c --config=File      Read config from .ini file');
   Writeln('-m --max-requests=N   Server at most N requests, then quit.');
   Writeln('-s --saveconfig=File  Write config to .ini file (ignored when -c or --config is used)');
+  Writeln('-x --xml-only         Only allow XML requests)');
 end;
 
 var

packages/fcl-web/src/restbridge/sqldbrestado.pp

@@ -195,7 +195,21 @@ end;
 procedure TADOOutputStreamer.FinalizeOutput;
 
 begin
-  xmlwrite.WriteXML(FXML,Stream);
+{$IFNDEF VER3_0}
+  if Not (ooHumanReadable in OutputOptions) then
+    begin
+    With TDOMWriter.Create(Stream,FXML) do
+      try
+        LineBreak:='';
+        IndentSize:=0;
+        WriteNode(FXML);
+      finally
+        Free;
+      end;
+    end
+  else
+{$ENDIF}
+    xmlwrite.WriteXML(FXML,Stream);
   FreeAndNil(FXML);
 end;
 

packages/fcl-web/src/restbridge/sqldbrestcds.pp

@@ -34,6 +34,7 @@ Type
   Public
     Destructor Destroy; override;
     Class Function GetContentType: String; override;
+    Class Function ForBufDataset: Boolean; virtual;
     Function SelectObject(aIndex : Integer) : Boolean; override;
     function GetContentField(aName: UTF8string): TJSONData; override;
     procedure InitStreaming; override;
@@ -53,6 +54,7 @@ Type
     FRow : TDOMElement;
     FRowData: TDOMElement;
   Protected
+    Class Function ForBufDataset: Boolean; virtual;
     Procedure SetOutputOptions(AValue: TRestOutputOptions); override;
   Public
     procedure EndData; override;
@@ -74,6 +76,20 @@ Type
     procedure InitStreaming; override;
   end;
 
+  { TBufDatasetOutputStreamer }
+
+  TBufDatasetOutputStreamer = Class(TCDSOutputStreamer)
+  Protected
+    Class Function ForBufDataset: Boolean; override;
+  end;
+
+  { TBufDatasetInputStreamer }
+
+  TBufDatasetInputStreamer = Class(TCDSInputStreamer)
+  Protected
+    Class Function ForBufDataset: Boolean; override;
+  end;
+
 implementation
 
 uses sqldbrestconst;
@@ -98,6 +114,20 @@ Const
     'bin.hex:Binary' {rftBlob}
   );
 
+{ TBufDatasetInputStreamer }
+
+class function TBufDatasetInputStreamer.ForBufDataset: Boolean;
+begin
+  Result:=True;
+end;
+
+{ TBufDatasetOutputStreamer }
+
+class function TBufDatasetOutputStreamer.ForBufDataset: Boolean;
+begin
+  Result:=True;
+end;
+
 { TCDSInputStreamer }
 
 destructor TCDSInputStreamer.Destroy;
@@ -111,6 +141,11 @@ begin
   Result:='text/xml';
 end;
 
+class function TCDSInputStreamer.ForBufDataset: Boolean;
+begin
+  Result:=False;
+end;
+
 function TCDSInputStreamer.SelectObject(aIndex: Integer): Boolean;
 
 Var
@@ -182,6 +217,11 @@ end;
 
 { TCDSOutputStreamer }
 
+class function TCDSOutputStreamer.ForBufDataset: Boolean;
+begin
+  Result:=False;
+end;
+
 procedure TCDSOutputStreamer.SetOutputOptions(AValue: TRestOutputOptions);
 begin
   Include(AValue,ooMetadata); // We always need metadata
@@ -201,6 +241,20 @@ end;
 procedure TCDSOutputStreamer.FinalizeOutput;
 
 begin
+{$IFNDEF VER3_0}
+  if Not (ooHumanReadable in OutputOptions) then
+    begin
+    With TDOMWriter.Create(Stream,FXML) do
+      try
+        LineBreak:='';
+        IndentSize:=0;
+        WriteNode(FXML);
+      finally
+        Free;
+      end;
+    end
+  else
+{$ENDIF}
   xmlwrite.WriteXML(FXML,Stream);
   FreeAndNil(FXML);
 end;
@@ -242,6 +296,7 @@ begin
   FRow[UTF8Decode(N)]:=UTF8Decode(S);
 end;
 
+
 procedure TCDSOutputStreamer.WriteMetadata(aFieldList: TRestFieldPairArray);
 
 Var
@@ -269,7 +324,11 @@ begin
          ML:=P.RestField.MaxLen;
          if ML=0 then
            ML:=255;
-         F['WIDTH']:=Utf8Decode(IntToStr(P.RestField.MaxLen));
+         if ForBufDataset then
+           F['width']:=Utf8Decode(IntToStr(P.RestField.MaxLen))
+         else
+           F['WIDTH']:=Utf8Decode(IntToStr(P.RestField.MaxLen));
+
          end;
       if (ST<>'') then
         F['subtype']:=ST;
@@ -315,6 +374,8 @@ end;
 
 Initialization
   TCDSInputStreamer.RegisterStreamer('cds');
+  TBufDatasetInputStreamer.RegisterStreamer('buf');
   TCDSOutputStreamer.RegisterStreamer('cds');
+  TBufDatasetOutputStreamer.RegisterStreamer('buf');
 end.
 

packages/fcl-web/src/restbridge/sqldbrestxml.pp

@@ -198,7 +198,21 @@ end;
 procedure TXMLOutputStreamer.FinalizeOutput;
 
 begin
-  xmlwrite.WriteXML(FXML,Stream);
+{$IFNDEF VER3_0}
+  if Not (ooHumanReadable in OutputOptions) then
+    begin
+    With TDOMWriter.Create(Stream,FXML) do
+      try
+        LineBreak:='';
+        IndentSize:=0;
+        WriteNode(FXML);
+      finally
+        Free;
+      end;
+    end
+  else
+{$ENDIF}
+    xmlwrite.WriteXML(FXML,Stream);
   FreeAndNil(FXML);
 end;
 

packages/fcl-xml/examples/reducexml.lpi

@@ -0,0 +1,47 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="reducexml"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="reducexml.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="reducexml"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+</CONFIG>

packages/fcl-xml/examples/reducexml.pp

@@ -0,0 +1,37 @@
+program reducexml;
+
+{$mode objfpc}
+{$h+}
+
+uses cwstring,SysUtils,classes,DOM,xmlutils,xmlread,xmlwrite;
+
+Var
+  D : TXMLDocument;
+  S : TFileStream;
+  W : TDOMWriter;
+  FN : String;
+ 
+
+begin
+  if paramCount=0 then
+    begin
+    Writeln('Usage : reducexml infile [outfile]');
+    halt(1);
+    end;
+  ReadXMLFile(D,ParamStr(1));
+  FN:=ParamStr(2);
+  if FN='' then
+    FN:=ChangeFileExt(ParamStr(1),'-new.xml');
+  W:=nil;  
+  S:=TFileStream.Create(FN,fmCreate);
+  try
+    W:=TDOMWriter.Create(S,D);
+    W.IndentSize:=1;
+//    W.Canonical:=True;
+    W.UseTab:=True;
+    W.WriteNode(D);
+  Finally
+    W.Free;
+    S.Free;
+  end;
+end.

packages/fcl-xml/src/xmlwrite.pp

@@ -22,33 +22,11 @@ unit XMLWrite;
 
 interface
 
-uses Classes, DOM;
+uses Classes, DOM, xmlutils;
 
-procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); overload;
-procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); overload;
-procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); overload;
-
-procedure WriteXML(Element: TDOMNode; const AFileName: String); overload;
-procedure WriteXML(Element: TDOMNode; var AFile: Text); overload;
-procedure WriteXML(Element: TDOMNode; AStream: TStream); overload;
-
-
-// ===================================================================
-
-implementation
-
-uses SysUtils, xmlutils;
-
-type
-  TXMLWriter = class;
-  TSpecialCharCallback = procedure(Sender: TXMLWriter; const s: DOMString;
-    var idx: Integer);
-
-  PAttrFixup = ^TAttrFixup;
-  TAttrFixup = record
-    Attr: TDOMNode;
-    Prefix: PHashItem;
-  end;
+Type
+  TXMLWriter = Class;
+  TSpecialCharCallback = procedure(Sender: TXMLWriter; const s: DOMString; var idx: Integer);
 
   TNodeInfo = record
     Name: XMLString;
@@ -56,8 +34,11 @@ type
 
   TNodeInfoArray = array of TNodeInfo;
 
+  { TXMLWriter }
+
   TXMLWriter = class(TObject)
   private
+    FIndentSize: Integer;
     FStream: TStream;
     FInsideTextNode: Boolean;
     FCanonical: Boolean;
@@ -72,8 +53,11 @@ type
     FScratch: TFPList;
     FNSDefs: TFPList;
     FNodes: TNodeInfoArray;
-    procedure WriteXMLDecl(const aVersion, aEncoding: XMLString;
-      aStandalone: Integer);
+    FUseTab: Boolean;
+    procedure SetCanonical(AValue: Boolean);
+    procedure SetIndentSize(AValue: Integer);
+    procedure SetLineBreak(AValue: XMLString);
+    procedure SetUseTab(AValue: Boolean);
     procedure wrtChars(Src: PWideChar; Length: Integer);
     procedure IncNesting;
     procedure DecNesting; {$IFDEF HAS_INLINE} inline; {$ENDIF}
@@ -81,33 +65,72 @@ type
     procedure wrtChr(c: WideChar); {$IFDEF HAS_INLINE} inline; {$ENDIF}
     procedure wrtIndent(EndElement: Boolean = False);
     procedure wrtQuotedLiteral(const ws: XMLString);
-    procedure ConvWrite(const s: XMLString; const SpecialChars: TSetOfChar;
-      const SpecialCharCallback: TSpecialCharCallback);
+    procedure ConvWrite(const s: XMLString; const SpecialChars: TSetOfChar; const SpecialCharCallback: TSpecialCharCallback);
     procedure WriteNSDef(B: TBinding);
-    procedure NamespaceFixup(Element: TDOMElement);
   protected
-    procedure WriteNode(Node: TDOMNode);
+    Procedure InitIndentLineBreak;
+    // Canonical does not yet quite work
+    Property Canonical : Boolean Read FCanonical Write SetCanonical;
+  public
+    constructor Create(AStream: TStream; ANameTable: THashTable);
+    destructor Destroy; override;
+    procedure WriteXMLDecl(const aVersion, aEncoding: XMLString;   aStandalone: Integer); virtual;
+    procedure WriteStartElement(const Name: XMLString); virtual;
+    procedure WriteEndElement(shortForm: Boolean); virtual;
+    procedure WriteProcessingInstruction(const Target, Data: XMLString); virtual;
+    procedure WriteEntityRef(const Name: XMLString); virtual;
+    procedure WriteAttributeString(const Name, Value: XMLString); virtual;
+    procedure WriteDocType(const Name, PubId, SysId, Subset: XMLString); virtual;
+    procedure WriteString(const Text: XMLString); virtual;
+    procedure WriteCDATA(const Text: XMLString); virtual;
+    procedure WriteComment(const Text: XMLString); virtual;
+    // Only set these before writing !
+    // Use tab character instead of space.
+    Property UseTab : Boolean Read FUseTab Write SetUseTab;
+    // Indent size in number of characters
+    Property IndentSize : Integer Read FIndentSize Write SetIndentSize;
+    // Default is system setting. Ignored when Canonical = True.
+    Property LineBreak : XMLString Read FLineBreak Write SetLineBreak;
+  end;
+
+  { TDOMWriter }
+
+  TDOMWriter = class(TXMLWriter)
+  Protected
+    procedure NamespaceFixup(Element: TDOMElement);
     procedure VisitDocument(Node: TDOMNode);
     procedure VisitDocument_Canonical(Node: TDOMNode);
     procedure VisitElement(Node: TDOMNode);
-    procedure WriteString(const Text: XMLString);
-    procedure WriteCDATA(const Text: XMLString);
-    procedure WriteComment(const Text: XMLString);
     procedure VisitFragment(Node: TDOMNode);
     procedure VisitAttribute(Node: TDOMNode);
     procedure VisitEntityRef(Node: TDOMNode);
     procedure VisitDocumentType(Node: TDOMNode);
     procedure VisitPI(Node: TDOMNode);
+  Public
+    constructor Create(AStream: TStream; aNode : TDOMNode);
+    procedure WriteNode(Node: TDOMNode);
+  end;
 
-    procedure WriteStartElement(const Name: XMLString);
-    procedure WriteEndElement(shortForm: Boolean);
-    procedure WriteProcessingInstruction(const Target, Data: XMLString);
-    procedure WriteEntityRef(const Name: XMLString);
-    procedure WriteAttributeString(const Name, Value: XMLString);
-    procedure WriteDocType(const Name, PubId, SysId, Subset: XMLString);
-  public
-    constructor Create(AStream: TStream; ANameTable: THashTable);
-    destructor Destroy; override;
+
+procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); overload;
+procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); overload;
+procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); overload;
+
+procedure WriteXML(Element: TDOMNode; const AFileName: String); overload;
+procedure WriteXML(Element: TDOMNode; var AFile: Text); overload;
+procedure WriteXML(Element: TDOMNode; AStream: TStream); overload;
+
+// ===================================================================
+
+implementation
+
+uses SysUtils;
+
+type
+  PAttrFixup = ^TAttrFixup;
+  TAttrFixup = record
+    Attr: TDOMNode;
+    Prefix: PHashItem;
   end;
 
   TTextStream = class(TStream)
@@ -142,7 +165,7 @@ begin
 end;
 
 { ---------------------------------------------------------------------
-    TXMLWriter
+    Auxiliary routines
   ---------------------------------------------------------------------}
 
 const
@@ -154,10 +177,128 @@ const
   AmpStr = '&';
   ltStr = '<';
   gtStr = '>';
+  IndentChars : Array[Boolean] of char = (' ',#9);
 
-constructor TXMLWriter.Create(AStream: TStream; ANameTable: THashTable);
+procedure AttrSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
+begin
+  case s[idx] of
+    '"': Sender.wrtStr(QuotStr);
+    '&': Sender.wrtStr(AmpStr);
+    '<': Sender.wrtStr(ltStr);
+    // This is *only* to interoperate with broken parsers out there,
+    // Delphi ClientDataset parser being one of them.
+    '>': if not Sender.FCanonical then
+           Sender.wrtStr(gtStr)
+         else
+           Sender.wrtChr('>');
+    // Escape whitespace using CharRefs to be consistent with W3 spec § 3.3.3
+    #9: Sender.wrtStr('&#x9;');
+    #10: Sender.wrtStr('&#xA;');
+    #13: Sender.wrtStr('&#xD;');
+  else
+    raise EConvertError.Create('Illegal character');
+  end;
+end;
+
+procedure TextnodeNormalCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
+begin
+  case s[idx] of
+    '<': Sender.wrtStr(ltStr);
+    '>': Sender.wrtStr(gtStr); // Required only in ']]>' literal, otherwise optional
+    '&': Sender.wrtStr(AmpStr);
+    #13:
+      begin
+        // We normalize #13#10 and #13 to FLineBreak, going somewhat
+        // beyond the specs here, see issue #13879.
+        Sender.wrtStr(Sender.FLineBreak);
+        if (idx < Length(s)) and (s[idx+1] = #10) then
+          Inc(idx);
+      end;
+    #10: Sender.wrtStr(Sender.FLineBreak);
+  else
+    raise EConvertError.Create('Illegal character');
+  end;
+end;
+
+procedure TextnodeCanonicalCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
+begin
+  case s[idx] of
+    '<': Sender.wrtStr(ltStr);
+    '>': Sender.wrtStr(gtStr);
+    '&': Sender.wrtStr(AmpStr);
+    #13: Sender.wrtStr('&#xD;');
+    #10: Sender.wrtChr(#10);
+  else
+    raise EConvertError.Create('Illegal character');
+  end;
+end;
+
+procedure CDSectSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
+  var idx: Integer);
+begin
+  if s[idx]=']' then
+  begin
+    if (idx <= Length(s)-2) and (s[idx+1] = ']') and (s[idx+2] = '>') then
+    begin
+      Sender.wrtStr(']]]]><![CDATA[>');
+      Inc(idx, 2);
+      // TODO: emit warning 'cdata-section-splitted'
+    end
+    else
+      Sender.wrtChr(']');
+  end  
+  else
+    raise EConvertError.Create('Illegal character');
+end;
+
+// clone of system.FPC_WIDESTR_COMPARE which cannot be called directly
+function Compare(const s1, s2: DOMString): integer;
 var
-  I: Integer;
+  maxi, temp: integer;
+begin
+  Result := 0;
+  if pointer(S1) = pointer(S2) then
+    exit;
+  maxi := Length(S1);
+  temp := Length(S2);
+  if maxi > temp then
+    maxi := temp;
+  Result := CompareWord(S1[1], S2[1], maxi);
+  if Result = 0 then
+    Result := Length(S1)-Length(S2);
+end;
+
+function SortNSDefs(Item1, Item2: Pointer): Integer;
+begin
+  Result := Compare(TBinding(Item1).Prefix^.Key, TBinding(Item2).Prefix^.Key);
+end;
+
+function SortAtts(Item1, Item2: Pointer): Integer;
+var
+  p1: PAttrFixup absolute Item1;
+  p2: PAttrFixup absolute Item2;
+begin
+  Result := Compare(p1^.Attr.namespaceURI, p2^.Attr.namespaceURI);
+  if Result = 0 then
+    Result := Compare(p1^.Attr.localName, p2^.Attr.localName);
+end;
+
+const
+  TextnodeCallbacks: array[boolean] of TSpecialCharCallback = (
+    @TextnodeNormalCallback,
+    @TextnodeCanonicalCallback
+  );
+
+{ ---------------------------------------------------------------------
+    TXMLWriter
+  ---------------------------------------------------------------------}
+
+
+constructor TXMLWriter.Create(AStream: TStream; ANameTable: THashTable);
+
 begin
   inherited Create;
   FStream := AStream;
@@ -165,21 +306,11 @@ begin
   FBuffer := AllocMem(512+32);
   FBufPos := FBuffer;
   FCapacity := 512;
-  // Later on, this may be put under user control
-  // for now, take OS setting
-  if FCanonical then
-    FLineBreak := #10
-  else
-    FLineBreak := sLineBreak;
-  // Initialize Indent string
-  // TODO: this must be done in setter of FLineBreak
-  SetLength(FIndent, 100);
-  FIndent[1] := FLineBreak[1];
-  if Length(FLineBreak) > 1 then
-    FIndent[2] := FLineBreak[2]
-  else
-    FIndent[2] := ' ';
-  for I := 3 to 100 do FIndent[I] := ' ';
+  FCanonical:=False;
+  FIndentSize:=2;
+  FUseTab:=False;
+  FLineBreak := sLineBreak;
+  InitIndentLineBreak;
   FNesting := 0;
   SetLength(FNodes, 16);
   FNSHelper := TNSSupport.Create(ANameTable);
@@ -277,8 +408,14 @@ begin
 end;
 
 procedure TXMLWriter.wrtIndent(EndElement: Boolean);
+
+Var
+  L : integer;
+
 begin
-  wrtChars(PWideChar(FIndent), (FNesting-ord(EndElement))*2+Length(FLineBreak));
+  L:=(FNesting-ord(EndElement))*IndentSize+Length(FLineBreak);
+  if (L>0) then
+    wrtChars(PWideChar(FIndent), L);
 end;
 
 procedure TXMLWriter.IncNesting;
@@ -288,14 +425,14 @@ begin
   Inc(FNesting);
   if FNesting >= Length(FNodes) then
     SetLength(FNodes, FNesting+8);
-  if (Length(FIndent)-Length(FLineBreak)) < 2 * FNesting then
-  begin
+  if (Length(FIndent)-Length(FLineBreak)) < IndentSize * FNesting then
+    begin
     OldLen := Length(FIndent);
-    NewLen := 4 * FNesting;
+    NewLen := (IndentSize*2) * FNesting;
     SetLength(FIndent, NewLen);
     for I := OldLen to NewLen do
-      FIndent[I] := ' ';
-  end;
+      FIndent[I] := IndentChars[UseTab];
+    end;
 end;
 
 procedure TXMLWriter.DecNesting; { inline }
@@ -324,86 +461,6 @@ begin
     wrtChars(@s[StartPos], EndPos - StartPos);
 end;
 
-procedure AttrSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
-  var idx: Integer);
-begin
-  case s[idx] of
-    '"': Sender.wrtStr(QuotStr);
-    '&': Sender.wrtStr(AmpStr);
-    '<': Sender.wrtStr(ltStr);
-    // This is *only* to interoperate with broken parsers out there,
-    // Delphi ClientDataset parser being one of them.
-    '>': if not Sender.FCanonical then
-           Sender.wrtStr(gtStr)
-         else
-           Sender.wrtChr('>');
-    // Escape whitespace using CharRefs to be consistent with W3 spec § 3.3.3
-    #9: Sender.wrtStr('&#x9;');
-    #10: Sender.wrtStr('&#xA;');
-    #13: Sender.wrtStr('&#xD;');
-  else
-    raise EConvertError.Create('Illegal character');
-  end;
-end;
-
-procedure TextnodeNormalCallback(Sender: TXMLWriter; const s: DOMString;
-  var idx: Integer);
-begin
-  case s[idx] of
-    '<': Sender.wrtStr(ltStr);
-    '>': Sender.wrtStr(gtStr); // Required only in ']]>' literal, otherwise optional
-    '&': Sender.wrtStr(AmpStr);
-    #13:
-      begin
-        // We normalize #13#10 and #13 to FLineBreak, going somewhat
-        // beyond the specs here, see issue #13879.
-        Sender.wrtStr(Sender.FLineBreak);
-        if (idx < Length(s)) and (s[idx+1] = #10) then
-          Inc(idx);
-      end;
-    #10: Sender.wrtStr(Sender.FLineBreak);
-  else
-    raise EConvertError.Create('Illegal character');
-  end;
-end;
-
-procedure TextnodeCanonicalCallback(Sender: TXMLWriter; const s: DOMString;
-  var idx: Integer);
-begin
-  case s[idx] of
-    '<': Sender.wrtStr(ltStr);
-    '>': Sender.wrtStr(gtStr);
-    '&': Sender.wrtStr(AmpStr);
-    #13: Sender.wrtStr('&#xD;');
-    #10: Sender.wrtChr(#10);
-  else
-    raise EConvertError.Create('Illegal character');
-  end;
-end;
-
-procedure CDSectSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
-  var idx: Integer);
-begin
-  if s[idx]=']' then
-  begin
-    if (idx <= Length(s)-2) and (s[idx+1] = ']') and (s[idx+2] = '>') then
-    begin
-      Sender.wrtStr(']]]]><![CDATA[>');
-      Inc(idx, 2);
-      // TODO: emit warning 'cdata-section-splitted'
-    end
-    else
-      Sender.wrtChr(']');
-  end  
-  else
-    raise EConvertError.Create('Illegal character');
-end;
-
-const
-  TextnodeCallbacks: array[boolean] of TSpecialCharCallback = (
-    @TextnodeNormalCallback,
-    @TextnodeCanonicalCallback
-  );
 
 procedure TXMLWriter.wrtQuotedLiteral(const ws: XMLString);
 var
@@ -420,26 +477,6 @@ begin
   wrtChr(Quote);
 end;
 
-procedure TXMLWriter.WriteNode(node: TDOMNode);
-begin
-  case node.NodeType of
-    ELEMENT_NODE:                VisitElement(node);
-    ATTRIBUTE_NODE:              VisitAttribute(node);
-    TEXT_NODE:                   WriteString(TDOMCharacterData(node).Data);
-    CDATA_SECTION_NODE:          WriteCDATA(TDOMCharacterData(node).Data);
-    ENTITY_REFERENCE_NODE:       VisitEntityRef(node);
-    PROCESSING_INSTRUCTION_NODE: VisitPI(node);
-    COMMENT_NODE:                WriteComment(TDOMCharacterData(node).Data);
-    DOCUMENT_NODE:
-      if FCanonical then
-        VisitDocument_Canonical(node)
-      else
-        VisitDocument(node);
-    DOCUMENT_TYPE_NODE:          VisitDocumentType(node);
-    ENTITY_NODE,
-    DOCUMENT_FRAGMENT_NODE:      VisitFragment(node);
-  end;
-end;
 
 procedure TXMLWriter.WriteNSDef(B: TBinding);
 begin
@@ -455,169 +492,31 @@ begin
   wrtChr('"');
 end;
 
-// clone of system.FPC_WIDESTR_COMPARE which cannot be called directly
-function Compare(const s1, s2: DOMString): integer;
-var
-  maxi, temp: integer;
-begin
-  Result := 0;
-  if pointer(S1) = pointer(S2) then
-    exit;
-  maxi := Length(S1);
-  temp := Length(S2);
-  if maxi > temp then
-    maxi := temp;
-  Result := CompareWord(S1[1], S2[1], maxi);
-  if Result = 0 then
-    Result := Length(S1)-Length(S2);
-end;
-
-function SortNSDefs(Item1, Item2: Pointer): Integer;
-begin
-  Result := Compare(TBinding(Item1).Prefix^.Key, TBinding(Item2).Prefix^.Key);
-end;
-
-function SortAtts(Item1, Item2: Pointer): Integer;
-var
-  p1: PAttrFixup absolute Item1;
-  p2: PAttrFixup absolute Item2;
-begin
-  Result := Compare(p1^.Attr.namespaceURI, p2^.Attr.namespaceURI);
-  if Result = 0 then
-    Result := Compare(p1^.Attr.localName, p2^.Attr.localName);
-end;
-
-procedure TXMLWriter.NamespaceFixup(Element: TDOMElement);
-var
-  B: TBinding;
-  i, j: Integer;
-  node: TDOMNode;
-  s: DOMString;
-  action: TAttributeAction;
-  p: PAttrFixup;
-begin
-  FScratch.Count := 0;
-  FNSDefs.Count := 0;
-  if Element.hasAttributes then
-  begin
-    j := 0;
-    for i := 0 to Element.Attributes.Length-1 do
-    begin
-      node := Element.Attributes[i];
-      if TDOMNode_NS(node).NSI.NSIndex = 2 then
-      begin
-        if TDOMNode_NS(node).NSI.PrefixLen = 0 then
-          s := ''
-        else
-          s := node.localName;
-        FNSHelper.DefineBinding(s, node.nodeValue, B);
-        if Assigned(B) then  // drop redundant namespace declarations
-          FNSDefs.Add(B);
-      end
-      else if FCanonical or TDOMAttr(node).Specified then
-      begin
-        // obtain a TAttrFixup record (allocate if needed)
-        if j >= FAttrFixups.Count then
-        begin
-          New(p);
-          FAttrFixups.Add(p);
-        end
-        else
-          p := PAttrFixup(FAttrFixups.List^[j]);
-        // add it to the working list
-        p^.Attr := node;
-        p^.Prefix := nil;
-        FScratch.Add(p);
-        Inc(j);
-      end;
-    end;
-  end;
-
-  FNSHelper.DefineBinding(Element.Prefix, Element.namespaceURI, B);
-  if Assigned(B) then
-    FNSDefs.Add(B);
-
-  for i := 0 to FScratch.Count-1 do
-  begin
-    node := PAttrFixup(FScratch.List^[i])^.Attr;
-    action := FNSHelper.CheckAttribute(node.Prefix, node.namespaceURI, B);
-    if action = aaBoth then
-      FNSDefs.Add(B);
-
-    if action in [aaPrefix, aaBoth] then
-      PAttrFixup(FScratch.List^[i])^.Prefix := B.Prefix;
-  end;
-
-  if FCanonical then
-  begin
-    FNSDefs.Sort(@SortNSDefs);
-    FScratch.Sort(@SortAtts);
-  end;
-
-  // now, at last, dump all this stuff.
-  for i := 0 to FNSDefs.Count-1 do
-    WriteNSDef(TBinding(FNSDefs.List^[I]));
-
-  for i := 0 to FScratch.Count-1 do
-  begin
-    wrtChr(' ');
-    with PAttrFixup(FScratch.List^[I])^ do
-    begin
-      if Assigned(Prefix) then
-      begin
-        wrtStr(Prefix^.Key);
-        wrtChr(':');
-        wrtStr(Attr.localName);
-      end
-      else
-        wrtStr(Attr.nodeName);
-
-      wrtChars('="', 2);
-      // TODO: not correct w.r.t. entities
-      ConvWrite(attr.nodeValue, AttrSpecialChars, @AttrSpecialCharCallback);
-      wrtChr('"');
-    end;
-  end;
-end;
-
-procedure TXMLWriter.VisitElement(node: TDOMNode);
-var
-  i: Integer;
-  child: TDOMNode;
-  SavedInsideTextNode: Boolean;
-begin
-  WriteStartElement(TDOMElement(node).TagName);
-
-  if nfLevel2 in node.Flags then
-    NamespaceFixup(TDOMElement(node))
-  else if node.HasAttributes then
-    for i := 0 to node.Attributes.Length - 1 do
-    begin
-      child := node.Attributes.Item[i];
-      if FCanonical or TDOMAttr(child).Specified then
-        VisitAttribute(child);
-    end;
-  Child := node.FirstChild;
-  if Child = nil then
-    WriteEndElement(True)
-  else
-  begin
-    // TODO: presence of zero-length textnodes triggers the indenting logic,
-    // while they should be ignored altogeter.
-    SavedInsideTextNode := FInsideTextNode;
-    wrtChr('>');
-    FInsideTextNode := FCanonical or (Child.NodeType in [TEXT_NODE, CDATA_SECTION_NODE]);
-    repeat
-      WriteNode(Child);
-      Child := Child.NextSibling;
-    until Child = nil;
-    if not (node.LastChild.NodeType in [TEXT_NODE, CDATA_SECTION_NODE]) then
-      wrtIndent(True);
-    FInsideTextNode := SavedInsideTextNode;
-    writeEndElement(False);
-  end;
+
+procedure TXMLWriter.InitIndentLineBreak;
+
+Var
+  I : Integer;
+
+begin
+  if FCanonical then
+    FLineBreak := #10;
+  // Initialize Indent string
+  SetLength(FIndent, 100);
+  I:=1;
+  While I<=Length(FLineBreak) do
+    begin
+    FIndent[I] := FLineBreak[I];
+    Inc(I);
+    end;
+  While I<=Length(Findent) do
+    begin
+    FIndent[I]:=IndentChars[UseTab];
+    Inc(I);
+    end;
 end;
 
+
 procedure TXMLWriter.WriteStartElement(const Name: XMLString);
 begin
   if not FInsideTextNode then
@@ -670,10 +569,6 @@ begin
   wrtChr(';');
 end;
 
-procedure TXMLWriter.VisitEntityRef(node: TDOMNode);
-begin
-  WriteEntityRef(node.NodeName);
-end;
 
 procedure TXMLWriter.WriteProcessingInstruction(const Target, Data: XMLString);
 begin
@@ -689,10 +584,6 @@ begin
   wrtStr('?>');
 end;
 
-procedure TXMLWriter.VisitPI(node: TDOMNode);
-begin
-  WriteProcessingInstruction(TDOMProcessingInstruction(node).Target, TDOMProcessingInstruction(node).Data);
-end;
 
 procedure TXMLWriter.WriteComment(const Text: XMLString);
 begin
@@ -729,7 +620,121 @@ begin
   wrtStr('?>');
 end;
 
-procedure TXMLWriter.VisitDocument(node: TDOMNode);
+procedure TXMLWriter.SetCanonical(AValue: Boolean);
+begin
+  if FCanonical=AValue then Exit;
+  FCanonical:=AValue;
+  InitIndentLineBreak;
+end;
+
+procedure TXMLWriter.SetIndentSize(AValue: Integer);
+begin
+  if FIndentSize=AValue then Exit;
+  FIndentSize:=AValue;
+  InitIndentLineBreak;
+end;
+
+procedure TXMLWriter.SetLineBreak(AValue: XMLString);
+begin
+  if FLineBreak=AValue then Exit;
+  FLineBreak:=AValue;
+  InitIndentLineBreak;
+end;
+
+procedure TXMLWriter.SetUseTab(AValue: Boolean);
+begin
+  if FUseTab=AValue then Exit;
+  FUseTab:=AValue;
+  InitIndentLineBreak;
+end;
+
+{ ---------------------------------------------------------------------
+  TDOMWriter
+  ---------------------------------------------------------------------}
+
+procedure TDOMWriter.WriteNode(node: TDOMNode);
+begin
+  case node.NodeType of
+    ELEMENT_NODE:                VisitElement(node);
+    ATTRIBUTE_NODE:              VisitAttribute(node);
+    TEXT_NODE:                   WriteString(TDOMCharacterData(node).Data);
+    CDATA_SECTION_NODE:          WriteCDATA(TDOMCharacterData(node).Data);
+    ENTITY_REFERENCE_NODE:       VisitEntityRef(node);
+    PROCESSING_INSTRUCTION_NODE: VisitPI(node);
+    COMMENT_NODE:                WriteComment(TDOMCharacterData(node).Data);
+    DOCUMENT_NODE:
+      if FCanonical then
+        VisitDocument_Canonical(node)
+      else
+        VisitDocument(node);
+    DOCUMENT_TYPE_NODE:          VisitDocumentType(node);
+    ENTITY_NODE,
+    DOCUMENT_FRAGMENT_NODE:      VisitFragment(node);
+  end;
+end;
+
+procedure TDOMWriter.VisitElement(node: TDOMNode);
+var
+  i: Integer;
+  child: TDOMNode;
+  SavedInsideTextNode: Boolean;
+begin
+  WriteStartElement(TDOMElement(node).TagName);
+
+  if nfLevel2 in node.Flags then
+    NamespaceFixup(TDOMElement(node))
+  else if node.HasAttributes then
+    for i := 0 to node.Attributes.Length - 1 do
+    begin
+      child := node.Attributes.Item[i];
+      if FCanonical or TDOMAttr(child).Specified then
+        VisitAttribute(child);
+    end;
+  Child := node.FirstChild;
+  if Child = nil then
+    WriteEndElement(True)
+  else
+  begin
+    // TODO: presence of zero-length textnodes triggers the indenting logic,
+    // while they should be ignored altogeter.
+    SavedInsideTextNode := FInsideTextNode;
+    wrtChr('>');
+    FInsideTextNode := FCanonical or (Child.NodeType in [TEXT_NODE, CDATA_SECTION_NODE]);
+    repeat
+      WriteNode(Child);
+      Child := Child.NextSibling;
+    until Child = nil;
+    if not (node.LastChild.NodeType in [TEXT_NODE, CDATA_SECTION_NODE]) then
+      wrtIndent(True);
+    FInsideTextNode := SavedInsideTextNode;
+    writeEndElement(False);
+  end;
+end;
+
+procedure TDOMWriter.VisitEntityRef(node: TDOMNode);
+begin
+  WriteEntityRef(node.NodeName);
+end;
+
+procedure TDOMWriter.VisitPI(node: TDOMNode);
+begin
+  WriteProcessingInstruction(TDOMProcessingInstruction(node).Target, TDOMProcessingInstruction(node).Data);
+end;
+
+constructor TDOMWriter.Create(AStream: TStream; aNode: TDOMNode);
+
+var
+  doc: TDOMDocument;
+begin
+  if aNode.NodeType = DOCUMENT_NODE then
+    doc := TDOMDocument(aNode)
+  else
+    doc := aNode.OwnerDocument;
+  Inherited Create(aStream,Doc.Names);
+end;
+
+
+procedure TDOMWriter.VisitDocument(node: TDOMNode);
 var
   child: TDOMNode;
 begin
@@ -760,7 +765,7 @@ begin
   wrtStr(FLineBreak);
 end;
 
-procedure TXMLWriter.VisitDocument_Canonical(Node: TDOMNode);
+procedure TDOMWriter.VisitDocument_Canonical(Node: TDOMNode);
 var
   child, root: TDOMNode;
 begin
@@ -799,32 +804,6 @@ begin
   wrtChr('"');
 end;
 
-procedure TXMLWriter.VisitAttribute(Node: TDOMNode);
-var
-  Child: TDOMNode;
-begin
-  wrtChr(' ');
-  wrtStr(TDOMAttr(Node).Name);
-  wrtChars('="', 2);
-  Child := Node.FirstChild;
-  while Assigned(Child) do
-  begin
-    case Child.NodeType of
-      ENTITY_REFERENCE_NODE:
-        VisitEntityRef(Child);
-      TEXT_NODE:
-        ConvWrite(TDOMCharacterData(Child).Data, AttrSpecialChars, @AttrSpecialCharCallback);
-    end;
-    Child := Child.NextSibling;
-  end;
-  wrtChr('"');
-end;
-
-procedure TXMLWriter.VisitDocumentType(Node: TDOMNode);
-begin
-  WriteDocType(Node.NodeName, TDOMDocumentType(Node).PublicID, TDOMDocumentType(Node).SystemID,
-               TDOMDocumentType(Node).InternalSubset);
-end;
 
 procedure TXMLWriter.WriteDocType(const Name, PubId, SysId, Subset: XMLString);
 begin
@@ -853,7 +832,7 @@ begin
   wrtChr('>');
 end;
 
-procedure TXMLWriter.VisitFragment(Node: TDOMNode);
+procedure TDOMWriter.VisitFragment(Node: TDOMNode);
 var
   Child: TDOMNode;
 begin
@@ -867,6 +846,126 @@ begin
   end;
 end;
 
+procedure TDOMWriter.VisitAttribute(Node: TDOMNode);
+var
+  Child: TDOMNode;
+begin
+  wrtChr(' ');
+  wrtStr(TDOMAttr(Node).Name);
+  wrtChars('="', 2);
+  Child := Node.FirstChild;
+  while Assigned(Child) do
+  begin
+    case Child.NodeType of
+      ENTITY_REFERENCE_NODE:
+        VisitEntityRef(Child);
+      TEXT_NODE:
+        ConvWrite(TDOMCharacterData(Child).Data, AttrSpecialChars, @AttrSpecialCharCallback);
+    end;
+    Child := Child.NextSibling;
+  end;
+  wrtChr('"');
+end;
+
+procedure TDOMWriter.VisitDocumentType(Node: TDOMNode);
+begin
+  WriteDocType(Node.NodeName, TDOMDocumentType(Node).PublicID, TDOMDocumentType(Node).SystemID,
+               TDOMDocumentType(Node).InternalSubset);
+end;
+
+procedure TDOMWriter.NamespaceFixup(Element: TDOMElement);
+var
+  B: TBinding;
+  i, j: Integer;
+  node: TDOMNode;
+  s: DOMString;
+  action: TAttributeAction;
+  p: PAttrFixup;
+begin
+  FScratch.Count := 0;
+  FNSDefs.Count := 0;
+  if Element.hasAttributes then
+  begin
+    j := 0;
+    for i := 0 to Element.Attributes.Length-1 do
+    begin
+      node := Element.Attributes[i];
+      if TDOMNode_NS(node).NSI.NSIndex = 2 then
+      begin
+        if TDOMNode_NS(node).NSI.PrefixLen = 0 then
+          s := ''
+        else
+          s := node.localName;
+        FNSHelper.DefineBinding(s, node.nodeValue, B);
+        if Assigned(B) then  // drop redundant namespace declarations
+          FNSDefs.Add(B);
+      end
+      else if FCanonical or TDOMAttr(node).Specified then
+      begin
+        // obtain a TAttrFixup record (allocate if needed)
+        if j >= FAttrFixups.Count then
+        begin
+          New(p);
+          FAttrFixups.Add(p);
+        end
+        else
+          p := PAttrFixup(FAttrFixups.List^[j]);
+        // add it to the working list
+        p^.Attr := node;
+        p^.Prefix := nil;
+        FScratch.Add(p);
+        Inc(j);
+      end;
+    end;
+  end;
+
+  FNSHelper.DefineBinding(Element.Prefix, Element.namespaceURI, B);
+  if Assigned(B) then
+    FNSDefs.Add(B);
+
+  for i := 0 to FScratch.Count-1 do
+  begin
+    node := PAttrFixup(FScratch.List^[i])^.Attr;
+    action := FNSHelper.CheckAttribute(node.Prefix, node.namespaceURI, B);
+    if action = aaBoth then
+      FNSDefs.Add(B);
+
+    if action in [aaPrefix, aaBoth] then
+      PAttrFixup(FScratch.List^[i])^.Prefix := B.Prefix;
+  end;
+
+  if FCanonical then
+  begin
+    FNSDefs.Sort(@SortNSDefs);
+    FScratch.Sort(@SortAtts);
+  end;
+
+  // now, at last, dump all this stuff.
+  for i := 0 to FNSDefs.Count-1 do
+    WriteNSDef(TBinding(FNSDefs.List^[I]));
+
+  for i := 0 to FScratch.Count-1 do
+  begin
+    wrtChr(' ');
+    with PAttrFixup(FScratch.List^[I])^ do
+    begin
+      if Assigned(Prefix) then
+      begin
+        wrtStr(Prefix^.Key);
+        wrtChr(':');
+        wrtStr(Attr.localName);
+      end
+      else
+        wrtStr(Attr.nodeName);
+
+      wrtChars('="', 2);
+      // TODO: not correct w.r.t. entities
+      ConvWrite(attr.nodeValue, AttrSpecialChars, @AttrSpecialCharCallback);
+      wrtChr('"');
+    end;
+  end;
+end;
+
 
 // -------------------------------------------------------------------
 //   Interface implementation
@@ -900,36 +999,23 @@ begin
 end;
 
 procedure WriteXML(Element: TDOMNode; var AFile: Text);
+
 var
-  s: TStream;
-  doc: TDOMDocument;
+  S : TStream;
+
 begin
-  if Element.NodeType = DOCUMENT_NODE then
-    doc := TDOMDocument(Element)
-  else
-    doc := Element.OwnerDocument;
   s := TTextStream.Create(AFile);
   try
-    with TXMLWriter.Create(s, doc.Names) do
-    try
-      WriteNode(Element);
-    finally
-      Free;
-    end;
+    WriteXML(Element,S);
   finally
     s.Free;
   end;
 end;
 
 procedure WriteXML(Element: TDOMNode; AStream: TStream);
-var
-  doc: TDOMDocument;
+
 begin
-  if Element.NodeType = DOCUMENT_NODE then
-    doc := TDOMDocument(Element)
-  else
-    doc := Element.OwnerDocument;
-  with TXMLWriter.Create(AStream, doc.Names) do
+  with TDOMWriter.Create(AStream, Element) do
   try
     WriteNode(Element);
   finally

packages/opengl/src/gl.pp

@@ -2255,27 +2255,19 @@ initialization
   SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,exOverflow, exUnderflow, exPrecision]);
   {$endif}
 
-  {$IFDEF Windows}
+  {$if defined(Windows)}
   LoadOpenGL('opengl32.dll');
-  {$ELSE}
-  {$IFDEF OS2}
+  {$elseif defined(OS2)}
   LoadOpenGL('opengl.dll');
-  {$ELSE OS2}
-  {$ifdef darwin}
+  {$elseif defined(darwin)}
   LoadOpenGL('/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib');
-  {$ELSE}
-  {$IFDEF MorphOS}
+  {$elseif defined(MorphOS)}
   InitTinyGLLibrary;
-  {$ELSE}
-  {$ifdef haiku}
+  {$elseif defined(haiku) or defined(OpenBSD)}
   LoadOpenGL('libGL.so');
   {$else}
   LoadOpenGL('libGL.so.1');
   {$endif}
-  {$ENDIF}
-  {$endif}
-  {$ENDIF OS2}
-  {$ENDIF}
 
 finalization
 

packages/opengl/src/glu.pp

@@ -67,27 +67,19 @@ uses
   GL;
 
 Const
-{$IFDEF Windows}
+{$if defined(Windows)}
   GLU_Lib = 'glu32.dll';
-{$ELSE}
-{$IFDEF OS2}
+{$elseif defined(OS2)}
   GLU_Lib = 'opengl.dll';
-{$ELSE OS2}
-{$ifdef darwin}
+{$elseif defined(darwin)}
   GLU_LIB =  '/System/Library/Frameworks/OpenGL.framework/Libraries/libGLU.dylib';
-{$else}
-{$IFDEF haiku}
+{$elseif defined(haiku) or defined(OpenBSD)}
   GLU_LIB = 'libGLU.so';
-{$ELSE}
-{$ifdef MorphOS}
+{$elseif defined(MorphOS)}
   GLU_LIB = 'tinygl.library';
 {$else}
   GLU_LIB = 'libGLU.so.1';
 {$endif}
-{$ENDIF}
-{$ENDIF}
-{$ENDIF OS2}
-{$endif}
                               
 type
   TViewPortArray = array [0..3] of GLint;

packages/opengl/src/glut.pp

@@ -759,25 +759,19 @@ end;
 
 initialization
 
-  {$IFDEF Windows}
+  {$if defined(Windows)}
   LoadGlut('glut32.dll');
-  {$ELSE}
-  {$IFDEF OS2}
+  {$elseif defined(OS2)}
   LoadGlut('glut.dll');
-  {$ELSE OS2}
-  {$ifdef darwin}
+  {$elseif defined(darwin)}
   LoadGlut('/System/Library/Frameworks/GLUT.framework/GLUT');
-  {$else}
-  {$IFDEF haiku}
+  {$elseif defined(haiku) or defined(OpenBSD)}
   LoadGlut('libglut.so');
-  {$ELSE}
-  {$IFNDEF MORPHOS}
+  {$elseif defined(MORPHOS)}
+  {nothing}
+  {$else}
   LoadGlut('libglut.so.3');
-  {$ENDIF}
-  {$ENDIF}
   {$endif}
-  {$ENDIF OS2}
-  {$ENDIF}
 
 finalization
 

packages/pastojs/src/fppas2js.pp

@@ -1300,6 +1300,13 @@ type
     function GetJSBaseTypes(aBaseType: TPas2jsBaseType): TPasUnresolvedSymbolRef; inline;
     procedure InternalAdd(Item: TPasIdentifier);
     procedure OnClearHashItem(Item, Dummy: pointer);
+  protected
+    type
+      THasAnoFuncData = record
+        Expr: TProcedureExpr;
+      end;
+      PHasAnoFuncData = ^THasAnoFuncData;
+    procedure OnHasAnonymousEl(El: TPasElement; arg: pointer);
   protected
     // overloads: fix name clashes in JS
     FOverloadScopes: TFPList; // list of TPasIdentifierScope
@@ -1426,6 +1433,7 @@ type
       false): string; override;
     function HasTypeInfo(El: TPasType): boolean; override;
     function ProcHasImplElements(Proc: TPasProcedure): boolean; override;
+    function HasAnonymousFunctions(El: TPasImplElement): boolean;
     function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope;
     function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual;
     function IsExternalBracketAccessor(El: TPasElement): boolean;
@@ -2716,6 +2724,14 @@ begin
     end;
 end;
 
+procedure TPas2JSResolver.OnHasAnonymousEl(El: TPasElement; arg: pointer);
+var
+  Data: PHasAnoFuncData absolute arg;
+begin
+  if (El=nil) or (Data^.Expr<>nil) or (El.ClassType<>TProcedureExpr) then exit;
+  Data^.Expr:=TProcedureExpr(El);
+end;
+
 function TPas2JSResolver.HasOverloadIndex(El: TPasElement;
   WithElevatedLocal: boolean): boolean;
 var
@@ -5570,6 +5586,17 @@ begin
     Result:=not Scope.EmptyJS;
 end;
 
+function TPas2JSResolver.HasAnonymousFunctions(El: TPasImplElement): boolean;
+var
+  Data: THasAnoFuncData;
+begin
+  if El=nil then
+    exit(false);
+  Data:=default(THasAnoFuncData);
+  El.ForEachCall(@OnHasAnonymousEl,@Data);
+  Result:=Data.Expr<>nil;
+end;
+
 function TPas2JSResolver.GetTopLvlProcScope(El: TPasElement
   ): TPas2JSProcedureScope;
 var
@@ -14253,7 +14280,8 @@ begin
             Call.AddArg(CreatePrimitiveDotExpr(ClassPath,PosEl));
             end;
 
-          if (ImplProc.Body.Functions.Count>0) then
+          if (ImplProc.Body.Functions.Count>0)
+              or aResolver.HasAnonymousFunctions(ImplProc.Body.Body) then
             begin
             // has nested procs -> add "var self = this;"
             FuncContext.AddLocalVar(GetBIName(pbivnSelf),FuncContext.ThisPas);

packages/pastojs/tests/tcmodules.pas

@@ -346,6 +346,7 @@ type
     Procedure TestAnonymousProc_ExceptOn;
     Procedure TestAnonymousProc_Nested;
     Procedure TestAnonymousProc_NestedAssignResult;
+    Procedure TestAnonymousProc_Class;
 
     // enums, sets
     Procedure TestEnum_Name;
@@ -4743,6 +4744,47 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestAnonymousProc_Class;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TObject = class',
+  '    Size: word;',
+  '    function GetIt: TProc;',
+  '  end;',
+  'function TObject.GetIt: TProc;',
+  'begin',
+  '  Result:=procedure',
+  '    begin',
+  '      Size:=Size;',
+  '    end;',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Class',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.Size = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetIt = function () {',
+    '    var $Self = this;',
+    '    var Result = null;',
+    '    Result = function () {',
+    '      $Self.Size = $Self.Size;',
+    '    };',
+    '    return Result;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestEnum_Name;
 begin
   StartProgram(false);

packages/paszlib/src/ziputils.pas

@@ -98,7 +98,7 @@ begin
   fp := nil;
   try
     case mode of
-      fopenread: fp  := TFileStream.Create(strpas(filename), fmOpenRead);
+      fopenread: fp  := TFileStream.Create(strpas(filename), fmOpenRead or fmShareDenyWrite);
       fopenwrite: fp := TFileStream.Create(strpas(filename), fmCreate);
       fappendwrite:
       begin

rtl/openbsd/i386/cprt0.as

@@ -108,7 +108,7 @@ ___start:
 	movb $0,(%edx)
 	movl $__progname_storage,__progname
 .L3:
-	call __init
+#	call __init
 	subl $16,%esp
 	pushl %eax
 	movl 8(%ebp),%eax

rtl/openbsd/x86_64/cprt0.as

@@ -76,7 +76,8 @@ ___start:
 	addq	$1, %rax
 	movq	%rax, __progname(%rip)
 .L6:
-	movq	$__progname_storage, -16(%rbp)
+	leaq	__progname_storage(%rip), %rax
+	movq	%rax, -16(%rbp)
 	jmp	.L7
 .L8:
 	movq	__progname(%rip), %rcx
@@ -91,21 +92,20 @@ ___start:
 	movzbl	(%rax), %eax
 	testb	%al, %al
 	je	.L9
-	movq	$__progname_storage+255, %rax
+	leaq	__progname_storage+255(%rip), %rax
 	cmpq	%rax, -16(%rbp)
 	jb	.L8
 .L9:
+	leaq	__progname_storage(%rip), %rax
+	movq	%rax, __progname(%rip)
 	movq	-16(%rbp), %rax
 	movb	$0, (%rax)
-	movq	$__progname_storage, __progname(%rip)
 .L2:
-	movl	$_mcleanup, %edi
+	movq	_mcleanup@GOTPCREL(%rip), %rdi
 	call	atexit
-	movl	$_etext, %eax
-	movq	%rax, %rsi
-	movl	$_eprol, %eax
-	movq	%rax, %rdi
-	call	monstartup
+	movq	_etext@GOTPCREL(%rip), %rsi
+	leaq	_eprol(%rip), %rdi
+	call	monstartup@plt
 	movl	$0, %eax
 	call	_init
 	movq	environ(%rip), %rdx
@@ -184,7 +184,7 @@ _strrchr:
         .comm   operatingsystem_parameter_envp,8,8
         .comm   operatingsystem_parameter_argc,8,8
         .comm   operatingsystem_parameter_argv,8,8
-	.section	.eh_frame,"a",@progbits
+	.section	.eh_frame,"a",@unwind
 .Lframe1:
 	.long	.LECIE1-.LSCIE1
 .LSCIE1:
@@ -207,7 +207,7 @@ _strrchr:
 	.long	.LEFDE1-.LASFDE1
 .LASFDE1:
 	.long	.LASFDE1-.Lframe1
-	.long	.LFB9
+	.long	.LFB9-.
 	.long	.LFE9-.LFB9
 	.uleb128 0x0
 	.byte	0x4
@@ -226,7 +226,7 @@ _strrchr:
 	.long	.LEFDE3-.LASFDE3
 .LASFDE3:
 	.long	.LASFDE3-.Lframe1
-	.long	.LFB10
+	.long	.LFB10-.
 	.long	.LFE10-.LFB10
 	.uleb128 0x0
 	.byte	0x4

rtl/openbsd/x86_64/gprt0.as

@@ -1,3 +1,11 @@
+	.section ".note.openbsd.ident", "a"
+	.p2align 2
+	.long	8
+	.long	4
+	.long	1
+	.ascii "OpenBSD\0"
+	.long	0
+	.previous
 	.file	"crt0.c"
 	.globl	__progname
 	.section	.rodata

rtl/openbsd/x86_64/prt0.as

@@ -76,7 +76,8 @@ ___start:
 	addq	$1, %rax
 	movq	%rax, __progname(%rip)
 .L6:
-	movq	$__progname_storage, -16(%rbp)
+	leaq	__progname_storage(%rip), %rax
+	movq	%rax, -16(%rbp)
 	jmp	.L7
 .L8:
 	movq	__progname(%rip), %rcx
@@ -91,13 +92,14 @@ ___start:
 	movzbl	(%rax), %eax
 	testb	%al, %al
 	je	.L9
-	movq	$__progname_storage+255, %rax
+	leaq	__progname_storage+255(%rip), %rax
 	cmpq	%rax, -16(%rbp)
 	jb	.L8
 .L9:
+	leaq	__progname_storage(%rip), %rax
+	movq	%rax, __progname(%rip)
 	movq	-16(%rbp), %rax
 	movb	$0, (%rax)
-	movq	$__progname_storage, __progname(%rip)
 .L2:
 	# movl	$_mcleanup, %edi
 	# call	atexit
@@ -185,7 +187,7 @@ _strrchr:
         .comm   operatingsystem_parameter_envp,8,8
         .comm   operatingsystem_parameter_argc,8,8
         .comm   operatingsystem_parameter_argv,8,8
-	.section	.eh_frame,"a",@progbits
+	.section	.eh_frame,"a",@unwind
 .Lframe1:
 	.long	.LECIE1-.LSCIE1
 .LSCIE1:
@@ -208,7 +210,7 @@ _strrchr:
 	.long	.LEFDE1-.LASFDE1
 .LASFDE1:
 	.long	.LASFDE1-.Lframe1
-	.long	.LFB9
+	.long	.LFB9-.
 	.long	.LFE9-.LFB9
 	.uleb128 0x0
 	.byte	0x4
@@ -227,7 +229,7 @@ _strrchr:
 	.long	.LEFDE3-.LASFDE3
 .LASFDE3:
 	.long	.LASFDE3-.Lframe1
-	.long	.LFB10
+	.long	.LFB10-.
 	.long	.LFE10-.LFB10
 	.uleb128 0x0
 	.byte	0x4

tests/test/taarch64abi.pp

@@ -23,34 +23,28 @@ begin
     Halt(3);
 end;
 
-function RetByte: byte;
-var
-  q: qword;
-begin
-  q:=$1111111112345678;
-  asm
-    ldr x0,q
-  end;
+function RetByte: byte; assembler;
+asm
+  movz    x0,#22136
+  movk    x0,#4660,lsl #16
+  movk    x0,#4369,lsl #32
+  movk    x0,#4369,lsl #48
 end;
 
-function RetWord: word;
-var
-  q: qword;
-begin
-  q:=$1111111112345678;
-  asm
-    ldr x0,q
-  end;
+function RetWord: word; assembler;
+asm
+  movz    x0,#22136
+  movk    x0,#4660,lsl #16
+  movk    x0,#4369,lsl #32
+  movk    x0,#4369,lsl #48
 end;
 
-function RetDWord: dword;
-var
-  q: qword;
-begin
-  q:=$1111111112345678;
-  asm
-    ldr x0,q
-  end;
+function RetDWord: dword; assembler;
+asm
+  movz    x0,#22136
+  movk    x0,#4660,lsl #16
+  movk    x0,#4369,lsl #32
+  movk    x0,#4369,lsl #48
 end;
 
 procedure TestParams;

tests/webtbs/tw35187.pp

@@ -0,0 +1,112 @@
+program tw35187;
+
+{ %cpu=i386,x86_64 }
+{ %opt=-O1 }
+
+{ NOTE: SIGSEGV won't trigger if GetMem is used because it allocates pages from a large pre-reserved heap. [Kit] }
+
+{$IFDEF TARGET_VALID}
+{$UNDEF TARGET_VALID}
+{$ENDIF TARGET_VALID}
+
+{$IFDEF WINDOWS}
+uses
+  Windows;
+{$DEFINE TARGET_VALID}
+{$ENDIF}
+{$IFDEF UNIX}
+uses
+  BaseUnix, SysCall;
+
+function fpmprotect(Addr: Pointer; Len: PtrUInt; Prot: LongInt): LongInt; inline;
+begin
+  fpmprotect := Do_SysCall(syscall_nr_mprotect, TSysParam(Addr), Len, Prot);
+end;
+{$DEFINE TARGET_VALID}
+{$ENDIF}
+
+{$IFNDEF TARGET_VALID}
+{$ERROR No memory allocation routine available }
+{$ENDIF TARGET_VALID}
+
+const
+  TestBlock: packed array[0..127] of Char = 'The quick brown fox jumps over the lazy dog, Victor jagt zw'#148'lf Boxk'#132'mpfer quer '#129'ber den gro'#225'en Sylter Deich.'#10#13'0123456789?!"#%'#251#253#252;
+
+  Expected: packed array[0..255] of Char = '54686520717569636B2062726F776E20666F78206A756D7073206F76657220746865206C617A7920646F672C20566963746F72206A616774207A77946C6620426F786B846D70666572207175657220816265722064656E2067726FE1656E2053796C7465722044656963682E0A0D303132333435363738393F21222325FBFDFC';
+
+  HexDigits: packed array[0..$F] of Char = '0123456789ABCDEF';
+
+var
+  Buf: packed array[0..255] of Char;
+  HexPtr: PChar;
+  P: PByte;
+  I: DWord;
+  HeapBlock, HeapMarker: PByte;
+begin
+  WriteLn(TestBlock);
+  FillChar(Buf, SizeOf(Buf), 0);
+
+  { Reserve two 4K memory pages: one that is read-write followed by one that
+    has no access rights at all and will trigger SIGSEGV if encroached }
+{$IFDEF WINDOWS}
+  HeapBlock := VirtualAlloc(
+                 VirtualAlloc(nil, 8192, MEM_RESERVE, PAGE_READWRITE),
+                 4096,
+                 MEM_COMMIT,
+                 PAGE_READWRITE
+               );
+  if not Assigned(HeapBlock) then
+    begin
+      WriteLn('Memory allocation failure');
+      Halt(1);
+    end;
+  HeapMarker := HeapBlock + 3968; { 4096 - 128 }
+{$ENDIF WINDOWS}
+{$IFDEF UNIX}
+  HeapBlock := fpmmap(nil, 8192, PROT_NONE, MAP_ANON or MAP_PRIVATE, -1, 0);
+  if not Assigned(HeapBlock) or (fpmprotect(HeapBlock, 4096, PROT_READ or PROT_WRITE) <> 0) then
+    begin
+      WriteLn('Memory allocation failure');
+      Halt(1);
+    end;
+
+  HeapMarker := HeapBlock + 3968; { 4096 - 128 }
+{$ENDIF UNIX}
+
+  Move(TestBlock, HeapMarker^, SizeOf(TestBlock));
+  HexPtr := @Buf;
+
+  for I := 0 to SizeOf(TestBlock) - 1 do
+  begin
+    P := HeapMarker + I;
+
+    HexPtr^ := HexDigits[P^ shr 4]; { first nybble }
+    Write(HexPtr^);
+    Inc(HexPtr);
+
+    { #35187: This instruction causes an access violation on the last byte
+        because it tries to read a word instead of a byte. }
+
+    HexPtr^ := HexDigits[P^ and $F]; { second nybble }
+    Write(HexPtr^);
+    Inc(HexPtr);
+  end;
+
+{$IFDEF WINDOWS}
+  VirtualFree(HeapBlock, 0, MEM_RELEASE);
+{$ENDIF WINDOWS}
+{$IFDEF UNIX}
+  fpmunmap(HeapBlock, 8192);
+{$ENDIF UNIX}
+
+  WriteLn();
+
+  for I := 0 to SizeOf(TestBlock) - 1 do
+    if Buf[I] <> Expected[I] then
+    begin
+      WriteLn('Error at index ', I, '; expected ', Expected[I], ' got ', Buf[I]);
+      Halt(1);
+    end;
+
+  WriteLn('ok');
+end.

utils/pas2js/compileserver.pp

@@ -6,7 +6,6 @@ program compileserver;
 uses
   {$IFDEF UNIX}cthreads,{$ENDIF} httpcompiler;
 
-
 Var
   Application : THTTPCompilerApplication;
 

utils/pas2js/httpcompiler.pp

@@ -6,9 +6,8 @@ unit httpcompiler;
 interface
 
 uses
-  sysutils, classes, fpjson, contnrs, syncobjs, custhttpapp, fpwebfile, httproute,
-  httpdefs, dirwatch,
-  Pas2JSFSCompiler, Pas2JSCompilerCfg;
+  sysutils, classes, fpjson, contnrs, syncobjs, fpmimetypes, custhttpapp,
+  fpwebfile, httproute, httpdefs, dirwatch, Pas2JSFSCompiler, Pas2JSCompilerCfg;
 
 Const
   nErrTooManyThreads = -1;
@@ -101,8 +100,10 @@ Type
     procedure DoRecompile(ARequest: TRequest; AResponse: TResponse);
     function ScheduleCompile(const aProjectFile: String; Options : TStrings = Nil): Integer;
     procedure StartWatch(ADir: String);
-    procedure Usage(Msg: String);
-    function GetDefaultMimetypes: string;
+  protected
+    procedure Usage(Msg: String); virtual;
+    function GetDefaultMimeTypesFile: string; virtual;
+    procedure LoadDefaultMimeTypes; virtual;
   public
     Constructor Create(AOWner : TComponent); override;
     Destructor Destroy; override;
@@ -262,13 +263,13 @@ begin
   Writeln('-q --quiet          Do not write diagnostic messages');
   Writeln('-w --watch          Watch directory for changes');
   Writeln('-c --compile[=proj] Recompile project if pascal files change. Default project is app.lpr');
-  Writeln('-m --mimetypes=file filename of mimetypes. Default is ',GetDefaultMimetypes);
+  Writeln('-m --mimetypes=file filename of mimetypes. Default is ',GetDefaultMimeTypesFile);
   Writeln('-s --simpleserver   Only serve files, do not enable compilation.');
   Halt(Ord(Msg<>''));
   {AllowWriteln-}
 end;
 
-function THTTPCompilerApplication.GetDefaultMimetypes: string;
+function THTTPCompilerApplication.GetDefaultMimeTypesFile: string;
 begin
   {$ifdef unix}
   Result:='/etc/mime.types';
@@ -281,6 +282,22 @@ begin
   {$endif}
 end;
 
+procedure THTTPCompilerApplication.LoadDefaultMimeTypes;
+begin
+  MimeTypes.AddType('application/xhtml+xml','xhtml;xht');
+  MimeTypes.AddType('text/html','htmll;htm');
+  MimeTypes.AddType('text/plain','txt');
+  MimeTypes.AddType('application/javascript','js');
+  MimeTypes.AddType('text/plain','map');
+  MimeTypes.AddType('application/json','json');
+  MimeTypes.AddType('image/png','png');
+  MimeTypes.AddType('image/jpeg','jpeg;jpg');
+  MimeTypes.AddType('image/gif','gif');
+  MimeTypes.AddType('image/jp2','jp2');
+  MimeTypes.AddType('image/tiff','tiff;tif');
+  MimeTypes.AddType('application/pdf','pdf');
+end;
+
 constructor THTTPCompilerApplication.Create(AOWner: TComponent);
 begin
   inherited Create(AOWner);
@@ -547,8 +564,15 @@ begin
   if HasOption('m','mimetypes') then
     MimeTypesFile:=GetOptionValue('m','mimetypes');
   if MimeTypesFile='' then
-    MimeTypesFile:=GetDefaultMimetypes;
-  if (MimeTypesFile<>'') and not FileExists(MimeTypesFile) then
+    begin
+    MimeTypesFile:=GetDefaultMimeTypesFile;
+    if not FileExists(MimeTypesFile) then
+      begin
+      MimeTypesFile:='';
+      LoadDefaultMimeTypes;
+      end;
+    end
+  else if not FileExists(MimeTypesFile) then
     Log(etWarning,'mimetypes file not found: '+MimeTypesFile);
   FBaseDir:=D;
   if not ServeOnly then