* synchronize with trunk

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

.gitattributes

@@ -3326,7 +3326,9 @@ packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.res -text
 packages/fcl-web/examples/restbridge/demorestbridge.lpi svneol=native#text/plain
 packages/fcl-web/examples/restbridge/demorestbridge.pp svneol=native#text/plain
 packages/fcl-web/examples/restbridge/expenses-data.sql svneol=native#text/plain
+packages/fcl-web/examples/restbridge/expenses-fb.sql svneol=native#text/plain
 packages/fcl-web/examples/restbridge/expenses-pq.sql svneol=native#text/plain
+packages/fcl-web/examples/restbridge/expenses-sqlite.sql svneol=native#text/plain
 packages/fcl-web/examples/routing-session/routingsessiondemo.lpi svneol=native#text/plain
 packages/fcl-web/examples/routing-session/routingsessiondemo.lpr svneol=native#text/plain
 packages/fcl-web/examples/routing/README svneol=native#text/plain
@@ -3460,6 +3462,7 @@ packages/fcl-web/src/jsonrpc/fpextdirect.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/fpjsonrpc.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/readme.txt svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/webjsonrpc.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestado.pp svneol=native#text/plain
 packages/fcl-web/src/restbridge/sqldbrestauth.pp svneol=native#text/plain
 packages/fcl-web/src/restbridge/sqldbrestauthini.pp svneol=native#text/plain
 packages/fcl-web/src/restbridge/sqldbrestbridge.pp svneol=native#text/plain

compiler/powerpc64/nppcmat.pas

@@ -169,7 +169,7 @@ var
       end;
     end else begin
       cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, divCgOps[is_signed(right.resultdef)], OS_INT,
-        tordconstnode(right).value, numerator, resultreg);
+        tordconstnode(right).value.svalue, numerator, resultreg);
       cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, tordconstnode(right).value.svalue, resultreg,
         resultreg);
       cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, resultreg);
@@ -202,7 +202,7 @@ begin
   if (cs_opt_level1 in current_settings.optimizerswitches) and (right.nodetype = ordconstn) then begin
     if (nodetype = divn) then
       cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, divCgOps[is_signed(right.resultdef)],
-        size, tordconstnode(right).value, numerator, resultreg)
+        size, tordconstnode(right).value.svalue, numerator, resultreg)
     else
       genOrdConstNodeMod;
     done := true;

compiler/systems/t_bsd.pas

@@ -126,11 +126,13 @@ Constructor TLinkerBSD.Create;
 begin
   Inherited Create;
   if not Dontlinkstdlibpath Then
-   if not(target_info.system in systems_darwin) then
-     LibrarySearchPath.AddPath(sysrootpath,'/lib;/usr/lib;/usr/X11R6/lib',true)
-   else
+   if target_info.system in systems_darwin then
      { Mac OS X doesn't have a /lib }
      LibrarySearchPath.AddPath(sysrootpath,'/usr/lib',true)
+   else if target_info.system in systems_openbsd then
+     LibrarySearchPath.AddPath(sysrootpath,'/usr/lib;${X11BASE}/lib;${LOCALBASE}/lib',true)
+   else
+     LibrarySearchPath.AddPath(sysrootpath,'/lib;/usr/lib;/usr/X11R6/lib',true);
 end;
 
 
@@ -682,7 +684,8 @@ begin
      { when we have -static for the linker the we also need libgcc }
      if (cs_link_staticflag in current_settings.globalswitches) then
       LinkRes.Add('-lgcc');
-     if linkdynamic and (Info.DynamicLinker<>'') then
+     if linkdynamic and (Info.DynamicLinker<>'') and
+        not(target_info.system in systems_openbsd) then
       LinkRes.AddFileName(Info.DynamicLinker);
      if not LdSupportsNoResponseFile then
        LinkRes.Add(')');
@@ -798,8 +801,7 @@ begin
    end;
 
 { Use -nopie on OpenBSD }
-  if (target_info.system in systems_openbsd) and
-     (target_info.system <> system_x86_64_openbsd) then
+  if (target_info.system in systems_openbsd) then
     Info.ExtraOptions:=Info.ExtraOptions+' -nopie';
 
 { -N seems to be needed on NetBSD/earm }

compiler/utils/ppuutils/ppudump.pp

@@ -1936,7 +1936,7 @@ type
   end;
   tprocopt=record
     mask : tprocoption;
-    str  : string[31];
+    str  : string[34];
   end;
 const
   {proccalloptionStr  is also in globtype unit }

compiler/utils/ppuutils/ppuout.pp

@@ -1210,7 +1210,7 @@ begin
   while FOutBufPos > 0 do begin
     len:=FileWrite(FOutFileHandle, FOutBuf[i], FOutBufPos);
     if len < 0 then
-      raise Exception.CreateFmt('Error writing to file: ', [SysErrorMessage(GetLastOSError)]);
+      raise Exception.CreateFmt('Error writing to file: %s', [ {$if declared(GetLastOSError) } SysErrorMessage(GetLastOSError) {$else} 'I/O error' {$endif} ]);
     Inc(i, len);
     Dec(FOutBufPos, len);
   end;

packages/fcl-passrc/src/pasresolver.pp

@@ -4711,8 +4711,13 @@ begin
           begin
           // give a hint
           if Data^.Proc.Parent is TPasMembersType then
-            LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
-              [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
+            begin
+            if El.Visibility=visStrictPrivate then
+            else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then
+            else
+              LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
+                [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
+            end;
           end;
       fpkMethod:
         // method hides a non proc
@@ -4803,7 +4808,11 @@ begin
             if (Data^.Proc.Parent is TPasMembersType) then
               begin
               ProcScope:=Proc.CustomData as TPasProcedureScope;
-              if (ProcScope.ImplProc<>nil)  // not abstract, external
+              if (Proc.Visibility=visStrictPrivate)
+                  or ((Proc.Visibility=visPrivate)
+                    and (Proc.GetModule<>Data^.Proc.GetModule)) then
+                // a private private is hidden by definition -> no hint
+              else if (ProcScope.ImplProc<>nil)  // not abstract, external
                   and (not ProcHasImplElements(ProcScope.ImplProc)) then
                 // hidden method has implementation, but no statements -> useless
                 // -> do not give a hint for hiding this useless method
@@ -4812,9 +4821,12 @@ begin
                   and (Data^.Proc.ClassType=Proc.ClassType) then
                 // do not give a hint for hiding a constructor
               else
+                begin
+                //writeln('TPasResolver.OnFindProc Proc=',Proc.PathName,' Data^.Proc=',Data^.Proc.PathName,' ',Proc.Visibility);
                 LogMsg(20171118214523,mtHint,
                   nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
                   [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
+                end;
               end;
             end;
           Abort:=true;

packages/fcl-passrc/src/pscanner.pp

@@ -2733,9 +2733,9 @@ begin
   FCurSourceFile := FileResolver.FindSourceFile(AFilename);
   FCurFilename := AFilename;
   AddFile(FCurFilename);
-{$IFDEF HASFS}
+  {$IFDEF HASFS}
   FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(FCurFilename));
-{$ENDIF}
+  {$ENDIF}
   if LogEvent(sleFile) then
     DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(AFileName)],True);
 end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -557,6 +557,7 @@ type
     Procedure TestClass_MethodOverloadUnit;
     Procedure TestClass_HintMethodHidesNonVirtualMethod;
     Procedure TestClass_HintMethodHidesNonVirtualMethodWithoutBody_NoHint;
+    Procedure TestClass_NoHintMethodHidesPrivateMethod;
     Procedure TestClass_MethodReintroduce;
     Procedure TestClass_MethodOverloadArrayOfTClass;
     Procedure TestClass_ConstructorHidesAncestorWarning;
@@ -933,6 +934,7 @@ type
     Procedure TestTypeHelper_String;
     Procedure TestTypeHelper_Boolean;
     Procedure TestTypeHelper_Double;
+    Procedure TestTypeHelper_DoubleAlias;
     Procedure TestTypeHelper_Constructor_NewInstance;
     Procedure TestTypeHelper_Interface;
     Procedure TestTypeHelper_Interface_ConstructorFail;
@@ -9507,6 +9509,47 @@ begin
   CheckResolverUnexpectedHints(true);
 end;
 
+procedure TTestResolver.TestClass_NoHintMethodHidesPrivateMethod;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  private',
+    '    procedure DoIt(p: pointer);',
+    '  end;',
+    '']),
+    LinesToStr([
+    'procedure TObject.DoIt(p: pointer);',
+    'begin',
+    '  if p=nil then ;',
+    'end;',
+    '']) );
+  StartProgram(true);
+  Add([
+  'uses unit2;',
+  'type',
+  '  TAnimal = class',
+  '  strict private',
+  '    procedure Fly(p: pointer);',
+  '  end;',
+  '  TBird = class(TAnimal)',
+  '    procedure DoIt(i: longint);',
+  '    procedure Fly(b: boolean);',
+  '  end;',
+  'procedure TAnimal.Fly(p: pointer);',
+  'begin',
+  '  if p=nil then ;',
+  'end;',
+  'procedure TBird.DoIt(i: longint); begin end;',
+  'procedure TBird.Fly(b: boolean); begin end;',
+  'var b: TBird;',
+  'begin',
+  '  b.DoIt(3);']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
 procedure TTestResolver.TestClass_MethodReintroduce;
 begin
   StartProgram(false);
@@ -17541,6 +17584,32 @@ begin
 end;
 
 procedure TTestResolver.TestTypeHelper_Double;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  Float = double;',
+  '  THelper = type helper for float',
+  '    const NPI = 3.141592;',
+  '    function ToStr: String;',
+  '  end;',
+  'function THelper.ToStr: String;',
+  'begin',
+  'end;',
+  'var',
+  '  a,b: Float;',
+  '  s: string;',
+  'begin',
+  '  s:=(a * b.NPI).ToStr;',
+  '  s:=(a * float.NPI).ToStr;',
+  '  s:=float.NPI.ToStr;',
+  '  s:=3.2.ToStr;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestTypeHelper_DoubleAlias;
 begin
   StartProgram(false);
   Add([

packages/fcl-web/examples/restbridge/expenses-fb.sql

@@ -0,0 +1,86 @@
+create domain bool smallint check (value in (1,0,Null));
+
+create table ExpenseTypes (
+  etID bigint not null,
+  etName varchar(50) not null,
+  etDescription varchar(100) not null,
+  etMaxAmount decimal(10,2),
+  etCost decimal(10,2) default 1,
+  etActive bool default 1 not null
+);
+
+
+create table Users (
+  uID bigint not null,
+  uLogin varchar(50) not null,
+  uFullName varchar(100) not null,
+  uPassword varchar(100) not null,
+  uActive bool default 1 not null
+);
+
+create table Projects (
+  pID bigint not null,
+  pName varchar(50) not null,
+  pDescription varchar(100) not null,
+  pActive bool default 1 not null
+);
+
+create table Expenses (
+  eID bigint not null,
+  eUserFK bigint not null,
+  eProjectFK bigint not null,
+  eTypeFK bigint not null,
+  eAmount decimal(10,2) not null,
+  eDate date default 'today' not null,
+  eComment varchar(1024)
+);
+
+create sequence seqExpenseTypesID;
+create sequence seqUsersID;
+create sequence seqProjectsID;
+create sequence seqExpenseID;
+
+alter table ExpenseTypes add constraint pkExpenseTypes primary key (etID);
+alter table Users add constraint pkUsers primary key (uID);
+alter table Projects add constraint pkProjects primary key (pID);
+alter table Expenses add  constraint pkExpenses primary key (eID);
+
+SET TERM ^ ;
+CREATE TRIGGER ExpenseTypesID FOR ExpenseTypes ACTIVE
+BEFORE INSERT POSITION 0
+AS
+begin
+  if (NEW.etID is null)  then
+    NEW.etID=GEN_ID(seqExpenseTypesID,1);
+end^
+
+CREATE TRIGGER ExpensesID FOR Expenses ACTIVE
+BEFORE INSERT POSITION 0
+AS
+begin
+  if (NEW.eID is null)  then
+    NEW.eID=GEN_ID(seqExpenseID,1);
+end^
+
+CREATE TRIGGER ProjectsID FOR Projects ACTIVE
+BEFORE INSERT POSITION 0
+AS
+begin
+  if (NEW.pID is null)  then
+    NEW.pID=GEN_ID(seqProjectsID,1);
+end^
+
+CREATE TRIGGER UsersID FOR Users ACTIVE
+BEFORE INSERT POSITION 0
+AS
+begin
+  if (NEW.uID is null)  then
+    NEW.uID=GEN_ID(seqUsersID,1);
+end^
+
+set term ^ ;
+
+COMMIT ;
+
+
+

packages/fcl-web/examples/restbridge/expenses-pq.sql

@@ -1,4 +1,4 @@
-drop table ExpenseTypes;
+create sequence seqExpenseTypesID;
 create table ExpenseTypes (
   etID bigint not null default nextval('seqExpenseTypesID'),
   etName varchar(50) not null,
@@ -25,8 +25,6 @@ create table Projects (
   pActive boolean not null default true
 );
 
-create sequence seqExpenseTypesID;
-
 create sequence seqExpenseID;
 drop table Expenses;
 create table Expenses (

packages/fcl-web/examples/restbridge/expenses-sqlite.sql

@@ -0,0 +1,41 @@
+create table t2(id integer primary key autoincrement);
+insert into  sqlite_sequence (name,seq) values ('seqExpenseTypesID',1);
+insert into  sqlite_sequence (name,seq) values ('seqExpenseID',1);
+insert into  sqlite_sequence (name,seq) values ('seqUsersID',1);
+insert into  sqlite_sequence (name,seq) values ('seqProjectsID',1);
+drop table t2;
+ 
+create table ExpenseTypes (
+  etID bigint primary key,
+  etName varchar(50) not null,
+  etDescription varchar(100) not null,
+  etMaxAmount decimal(10,2),
+  etCost decimal(10,2) default 1,
+  etActive boolean not null default true
+);
+
+create table Users (
+  uID bigint primary key,
+  uLogin varchar(50) not null,
+  uFullName varchar(100) not null,
+  uPassword varchar(100) not null,
+  uActive boolean not null default true 
+);
+
+create table Projects (
+  pID bigint primary key,
+  pName varchar(50) not null,
+  pDescription varchar(100) not null,
+  pActive boolean not null default true
+);
+
+create table Expenses (
+  eID bigint primary key,
+  eUserFK bigint not null,
+  eProjectFK bigint not null,
+  eTypeFK bigint not null,
+  eAmount decimal(10,2) not null,
+  eDate date not null default CURRENT_DATE,
+  eComment varchar(1024)
+);
+

packages/fcl-web/fpmake.pp

@@ -353,6 +353,13 @@ begin
       AddUnit('sqldbrestconst');
       end;
     T:=P.Targets.AddUnit('sqldbrestxml.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestado.pp');
     With T.Dependencies do  
       begin
       AddUnit('sqldbrestio');

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

@@ -0,0 +1,376 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST bridge : ADO-styled XML input/output
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sqldbrestado;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DateUtils, db,fpjson, dom, XMLRead, XMLWrite,sqldbrestschema,sqldbrestio, sqldbrestbridge;
+
+Type
+
+  { TADOInputStreamer }
+
+  TADOInputStreamer = Class(TRestInputStreamer)
+  private
+    FDataName: UTF8String;
+    FRowName: UTF8String;
+    FXML: TXMLDocument;
+    FPacket : TDOMElement;
+    FData : TDOMElement; // Equals FPacket
+    FRow : TDOMElement;
+  Protected
+    function GetNodeText(N: TDOmNode): UnicodeString;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    Function SelectObject(aIndex : Integer) : Boolean; override;
+    function GetContentField(aName: UTF8string): TJSONData; override;
+    procedure InitStreaming; override;
+    Property XML : TXMLDocument Read FXML;
+    Property Packet : TDOMElement Read FPacket;
+    Property Data : TDOMElement Read FData;
+    Property Row : TDOMElement Read FRow;
+    Property DataName : UTF8String Read FDataName Write FDataName;
+    Property RowName : UTF8String Read FRowName Write FRowName;
+  end;
+
+  { TADOOutputStreamer }
+
+  TADOOutputStreamer = Class(TRestOutputStreamer)
+  Private
+    FDataName: UTF8String;
+    FRowName: UTF8String;
+    FXML: TXMLDocument;
+    FData : TDOMElement; // Equals FRoot
+    FRow: TDOMElement;
+    FRoot: TDomElement;
+    function CreateXSD: TDomElement;
+  Public
+    procedure EndData; override;
+    procedure EndRow; override;
+    procedure FinalizeOutput; override;
+    procedure StartData; override;
+    procedure StartRow; override;
+    // Return Nil for null field.
+    function FieldToXML(aPair: TRestFieldPair): TDOMElement; virtual;
+    procedure WriteField(aPair: TRestFieldPair); override;
+    procedure WriteMetadata(aFieldList: TRestFieldPairArray); override;
+    Procedure CreateErrorContent(aCode : Integer; Const aMessage: String); override;
+    Property XML : TXMLDocument Read FXML;
+    Property Data : TDOMelement Read FData;
+    Property Row : TDOMelement Read FRow;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    function RequireMetadata : Boolean; override;
+    procedure InitStreaming; override;
+    Property DataName : UTF8String Read FDataName Write FDataName;
+    Property RowName : UTF8String Read FRowName Write FRowName;
+  end;
+
+implementation
+
+uses sqldbrestconst;
+
+{ TADOInputStreamer }
+
+destructor TADOInputStreamer.Destroy;
+begin
+  FreeAndNil(FXML);
+  inherited Destroy;
+end;
+
+class function TADOInputStreamer.GetContentType: String;
+begin
+  Result:='text/xml';
+end;
+
+function TADOInputStreamer.SelectObject(aIndex: Integer): Boolean;
+
+Var
+  N : TDomNode;
+  NN : UnicodeString;
+begin
+  Result:=False;
+  NN:=UTF8Decode(RowName);
+  N:=FData.FindNode(NN);
+  While (aIndex>0) and (N<>Nil) and (N.NodeName<>NN) and (N.NodeType<>ELEMENT_NODE) do
+    begin
+    N:=N.NextSibling;
+    Dec(aIndex);
+    end;
+  Result:=(aIndex=0) and (N<>Nil);
+  If Result then
+    FRow:=N as TDomElement
+  else
+    FRow:=Nil;
+end;
+
+function TADOInputStreamer.GetNodeText(N: TDOmNode): UnicodeString;
+
+Var
+  V : TDomNode;
+
+begin
+  Result:='';
+  V:=N.FirstChild;
+  While (V<>Nil) and (V.NodeType<>TEXT_NODE) do
+    V:=V.NextSibling;
+  If Assigned(V) then
+    Result:=V.NodeValue;
+end;
+
+function TADOInputStreamer.GetContentField(aName: UTF8string): TJSONData;
+
+Var
+  NN : UnicodeString;
+  N : TDomNode;
+begin
+  NN:=UTF8Decode(aName);
+  N:=FRow.FindNode(NN);
+  if Assigned(N) and (N.NodeType=ELEMENT_NODE) then
+    Result:=TJSONString.Create(UTF8Encode(GetNodeText(N)));
+end;
+
+procedure TADOInputStreamer.InitStreaming;
+
+Var
+  Msg : String;
+  NN : UnicodeString;
+
+begin
+  if DataName='' then
+    DataName:='Data';
+  if RowName='' then
+    RowName:='Row';
+  FreeAndNil(FXML);
+  if Stream.Size<=0 then
+    exit;
+  try
+    ReadXMLFile(FXML,Stream);
+  except
+    On E : Exception do
+      begin
+      Msg:=E.Message;
+      FXML:=Nil;
+      end;
+  end;
+  if (FXML=Nil)  then
+    Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsInvalidContent),SErrInvalidXMLInput,[Msg]);
+  FPacket:=FXML.DocumentElement;
+  NN:=UTF8Decode(DataName);
+  if FPacket.NodeName<>NN then
+    Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsInvalidContent),SErrInvalidXMLInput,[SErrMissingDocumentRoot]);
+  FData:=FPacket;
+end;
+
+{ TADOOutputStreamer }
+
+
+procedure TADOOutputStreamer.EndData;
+begin
+  FData:=Nil;
+end;
+
+procedure TADOOutputStreamer.EndRow;
+begin
+  FRow:=Nil;
+end;
+
+procedure TADOOutputStreamer.FinalizeOutput;
+
+begin
+  xmlwrite.WriteXML(FXML,Stream);
+  FreeAndNil(FXML);
+end;
+
+procedure TADOOutputStreamer.StartData;
+begin
+  // Rows are straight under the Data packet
+  FData:=FRoot;
+end;
+
+procedure TADOOutputStreamer.StartRow;
+begin
+  if (FRow<>Nil) then
+    Raise ESQLDBRest.Create(Statuses.GetStatusCode(rsError),SErrDoubleRowStart);
+  FRow:=FXML.CreateElement(UTF8Decode(RowName));
+  FData.AppendChild(FRow);
+end;
+
+function TADOOutputStreamer.FieldToXML(aPair: TRestFieldPair): TDOMElement;
+
+Var
+  F : TField;
+  S : UTF8String;
+
+begin
+  Result:=Nil;
+  F:=aPair.DBField;;
+  If (aPair.RestField.FieldType=rftUnknown) then
+    raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsError),SErrUnsupportedRestFieldType, [aPair.RestField.PublicName]);
+  If (F.IsNull) then
+    Exit;
+  S:=FieldToString(aPair.RestField.FieldType,F);
+  Result:=FXML.CreateElement(UTF8Decode(aPair.RestField.PublicName));
+  Result.AppendChild(FXML.CreateTextNode(UTF8Decode(S)));
+end;
+
+procedure TADOOutputStreamer.WriteField(aPair: TRestFieldPair);
+
+Var
+  D : TDOMElement;
+  N : UTF8String;
+
+begin
+  N:=aPair.RestField.PublicName;
+  if FRow=Nil then
+    Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsError),SErrFieldWithoutRow,[N]);
+  D:=FieldToXML(aPair);
+  if (D=Nil) and (not HasOption(ooSparse)) then
+    D:=FXML.CreateElement(UTF8Decode(aPair.RestField.PublicName));
+  if D<>Nil then
+    FRow.AppendChild(D);
+end;
+
+function TADOOutputStreamer.CreateXSD: TDomElement;
+
+// Create XSD and append to root. Return element to which field list must be appended.
+
+Var
+  SN,N,E,TLN : TDomElement;
+
+begin
+  SN:=FXML.CreateElement('xs:schema');
+  SN['id']:=Utf8Decode(DataName);
+  SN['xmlns']:='';
+  SN['xmlns:xs']:='http://www.w3.org/2001/XMLSchema';
+  SN['xmlns:msdata']:= 'urn:schemas-microsoft-com:xml-msdata';
+  FRoot.AppendChild(SN);
+  // Add table list with 1 table.
+  // Element
+  N:=FXML.CreateElement('xs:element');
+  SN.AppendChild(N);
+  N['name']:=UTF8Decode(DataName);
+  N['msdata:IsDataSet']:='true';
+  N['msdata:UseCurrentLocale']:='true';
+  // element is a complex type
+  TLN:=FXML.CreateElement('xs:complexType');
+  N.AppendChild(TLN);
+  // Complex type is a choice (0..Unbounded] of records
+  N:=FXML.CreateElement('xs:choice');
+  TLN.AppendChild(N);
+  N['minOccurs']:='0';
+  N['maxOccurs']:='unbounded';
+  // Each record is an element
+  E:=FXML.CreateElement('xs:element');
+  N.AppendChild(E);
+  E['name']:=Utf8Decode(RowName);
+  // Record is a complex type of fields
+  N:=FXML.CreateElement('xs:complexType');
+  E.AppendChild(N);
+  // Fields are a sequence. To this sequence, the fields may be appended.
+  Result:=FXML.CreateElement('xs:sequence');
+  N.AppendChild(Result);
+end;
+
+Const
+  XMLPropTypeNames : Array [TRestFieldType] of string = (
+   'unknown',          { rtfUnknown }
+   'xs:int',          { rftInteger }
+   'xs:int',          { rftLargeInt}
+   'xs:double',       { rftFloat }
+   'xs:dateTime',     { rftDate }
+   'xs:dateTime',     { rftTime }
+   'xs:dateTime',     { rftDateTime }
+   'xs:string',       { rftString }
+   'xs:boolean',      { rftBoolean }
+   'xs:base64Binary'  { rftBlob }
+  );
+
+procedure TADOOutputStreamer.WriteMetadata(aFieldList: TRestFieldPairArray);
+
+Var
+  FMetadata : TDOMElement;
+  F : TDomElement;
+  P : TREstFieldPair;
+  I : integer;
+  S : Utf8String;
+  K : TRestFieldType;
+
+begin
+  FMetadata:=CreateXSD;
+  For I:=0 to Length(aFieldList)-1 do
+    begin
+    P:=aFieldList[i];
+    K:=P.RestField.FieldType;
+    S:=XMLPropTypeNames[K];
+    F:=FXML.CreateElement('xs:element');
+    F['name']:=Utf8Decode(P.Restfield.PublicName);
+    F['type']:=Utf8decode(S);
+    F['minOccurs']:='0';
+    FMetaData.AppendChild(F);
+    end;
+end;
+
+class function TADOOutputStreamer.GetContentType: String;
+begin
+  Result:='text/xml';
+end;
+
+function TADOOutputStreamer.RequireMetadata: Boolean;
+begin
+  Result:=True;
+end;
+
+procedure TADOOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
+
+Var
+  ErrorObj : TDomElement;
+
+begin
+  ErrorObj:=FXML.CreateElement(UTF8Decode(GetString(rpErrorRoot)));
+  ErrorObj['code']:=UTF8Decode(IntToStr(aCode));
+  ErrorObj['message']:=UTF8Decode(aMessage);
+  FRoot.AppendChild(ErrorObj);
+end;
+
+destructor TADOOutputStreamer.Destroy;
+begin
+  FreeAndNil(FXML);
+  inherited Destroy;
+end;
+
+procedure TADOOutputStreamer.InitStreaming;
+
+begin
+  FXML:=TXMLDocument.Create;
+  FXML.XMLStandalone:=True;
+  if DataName='' then
+    DataName:='Data';
+  FRoot:=FXML.CreateElement('Data');
+  FXML.AppendChild(FRoot);
+  if RowName='' then
+    RowName:='Row';
+end;
+
+Initialization
+  TADOInputStreamer.RegisterStreamer('ado');
+  TADOOutputStreamer.RegisterStreamer('ado');
+end.
+

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

@@ -56,6 +56,7 @@ Type
     constructor Create(ACollection: TCollection); override;
     Destructor Destroy; override;
     Procedure Assign(Source: TPersistent); override;
+    Procedure ConfigConnection(aConn : TSQLConnection); virtual;
   Published
     // Always use this connection instance
     Property SingleConnection : TSQLConnection Read FConnection Write SetConnection;
@@ -160,7 +161,9 @@ Type
     Class Var FIOClass : TRestIOClass;
     Class Var FDBHandlerClass : TSQLDBRestDBHandlerClass;
   private
+    FCORSAllowCredentials: Boolean;
     FCORSAllowedOrigins: String;
+    FCORSMaxAge: Integer;
     FDispatchOptions: TRestDispatcherOptions;
     FInputFormat: String;
     FCustomViewResource : TSQLDBRestResource;
@@ -252,6 +255,7 @@ Type
     // General HTTP handling
     procedure DoRegisterRoutes; virtual;
     procedure DoHandleEvent(IsBefore : Boolean;IO: TRestIO); virtual;
+    function ResolvedCORSAllowedOrigins: String; virtual;
     procedure HandleCORSRequest(aConnection: TSQLDBRestConnection; IO: TRestIO); virtual;
     procedure HandleResourceRequest(aConnection : TSQLDBRestConnection; IO: TRestIO); virtual;
     procedure DoHandleRequest(IO: TRestIO); virtual;
@@ -296,6 +300,10 @@ Type
     Property EnforceLimit : Integer Read FEnforceLimit Write FEnforceLimit;
     // Domains that are allowed to use this REST service
     Property CORSAllowedOrigins: String Read FCORSAllowedOrigins  Write FCORSAllowedOrigins;
+    // Access-Control-Max-Age header value. Set to zero not to send the header
+    Property CORSMaxAge : Integer Read FCORSMaxAge Write FCORSMaxAge;
+    // Access-Control-Allow-Credentials header value. Set to zero not to send the header
+    Property CORSAllowCredentials : Boolean Read FCORSAllowCredentials Write FCORSAllowCredentials;
     // Called when Basic authentication is sufficient.
     Property OnBasicAuthentication : TBasicAuthenticationEvent Read FOnBasicAuthentication Write FOnBasicAuthentication;
     // Allow a particular resource or not.
@@ -623,6 +631,8 @@ begin
   FOutputOptions:=allOutputOptions;
   FDispatchOptions:=DefaultDispatcherOptions;
   FStatus:=CreateRestStatusConfig;
+  FCORSMaxAge:=SecsPerDay;
+  FCORSAllowCredentials:=True;
 end;
 
 destructor TSQLDBRestDispatcher.Destroy;
@@ -683,7 +693,10 @@ Var
 begin
   Result:=TSQLDBRestResource.Create(Nil);
   Result.ResourceName:='metaData';
-  Result.AllowedOperations:=[roGet];
+  if rdoHandleCORS in DispatchOptions then
+    Result.AllowedOperations:=[roGet,roOptions,roHead]
+  else
+    Result.AllowedOperations:=[roGet,roHead];
   Result.Fields.AddField('name',rftString,[foRequired]);
   Result.Fields.AddField('schemaName',rftString,[foRequired]);
   for O in TRestOperation do
@@ -704,7 +717,10 @@ Var
 begin
   Result:=TSQLDBRestResource.Create(Nil);
   Result.ResourceName:='metaDataField';
-  Result.AllowedOperations:=[roGet];
+  if rdoHandleCORS in DispatchOptions then
+    Result.AllowedOperations:=[roGet,roOptions,roHead]
+  else
+    Result.AllowedOperations:=[roGet,roHead];
   Result.Fields.AddField('name',rftString,[]);
   Result.Fields.AddField('type',rftString,[]);
   Result.Fields.AddField('maxlen',rftInteger,[]);
@@ -864,14 +880,7 @@ begin
     if (Result=Nil) then
       begin
       Result:=CreateConnection;
-      Result.CharSet:=aConnection.CharSet;
-      Result.HostName:=aConnection.HostName;
-      Result.DatabaseName:=aConnection.DatabaseName;
-      Result.UserName:=aConnection.UserName;
-      Result.Password:=aConnection.Password;
-      Result.Params:=Aconnection.Params;
-      if Result is TRestSQLConnector then
-        TRestSQLConnector(Result).ConnectorType:=aConnection.ConnectionType;
+      aConnection.ConfigConnection(Result);
       aConnection.SingleConnection:=Result;
       end;
     end;
@@ -1162,7 +1171,14 @@ begin
       raise ESQLDBRest.Create(FStatus.GetStatusCode(rsInvalidParam), SErrNoSQLStatement); // Should never happen.
     Result:=CreateCustomViewDataset(IO,RN,aOwner);
     end
+end;
 
+function TSQLDBRestDispatcher.ResolvedCORSAllowedOrigins: String;
+
+begin
+  Result:=FCORSAllowedOrigins;
+  if Result='' then
+     Result:='*';
 end;
 
 procedure TSQLDBRestDispatcher.HandleCORSRequest(aConnection : TSQLDBRestConnection; IO : TRestIO);
@@ -1184,12 +1200,13 @@ begin
     end
   else
     begin
-    S:=FCORSAllowedOrigins;
-    if S='' then
-      S:='*';
-    IO.Response.SetCustomHeader('Access-Control-Allow-Origin',S);
+    IO.Response.SetCustomHeader('Access-Control-Allow-Origin',ResolvedCORSAllowedOrigins);
     S:=IO.Resource.GetHTTPAllow;
     IO.Response.SetCustomHeader('Access-Control-Allow-Methods',S);
+    IO.Response.SetCustomHeader('Access-Control-Allow-Headers','x-requested-with, content-type, authorization');
+    if CorsMaxAge>0 then
+      IO.Response.SetCustomHeader('Access-Control-Max-Age',IntToStr(CorsMaxAge));
+    IO.Response.SetCustomHeader('Access-Control-Allow-Credentials',BoolToStr(CORSAllowCredentials,'true','false'));
     IO.Response.Code:=FStatus.GetStatusCode(rsCORSOK);
     IO.Response.CodeText:='OK';
     end;
@@ -1209,6 +1226,8 @@ begin
   try
     IO.SetConn(Conn,TR);
     Try
+      if (rdoHandleCORS in DispatchOptions) then
+        IO.Response.SetCustomHeader('Access-Control-Allow-Origin',ResolvedCORSAllowedOrigins);
       if not AuthenticateRequest(IO,True) then
         exit;
       if Not CheckResourceAccess(IO) then
@@ -1836,6 +1855,18 @@ begin
     inherited Assign(Source);
 end;
 
+procedure TSQLDBRestConnection.ConfigConnection(aConn: TSQLConnection);
+begin
+  aConn.CharSet:=Self.CharSet;
+  aConn.HostName:=Self.HostName;
+  aConn.DatabaseName:=Self.DatabaseName;
+  aConn.UserName:=Self.UserName;
+  aConn.Password:=Self.Password;
+  aConn.Params:=Self.Params;
+  if aConn is TSQLConnector then
+    TSQLConnector(aConn).ConnectorType:=Self.ConnectionType;
+end;
+
 
 Procedure InitSQLDBRest;
 

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

@@ -708,6 +708,8 @@ procedure TRestOutputStreamer.SetOutputOptions(AValue: TRestOutputOptions);
 begin
   if FOutputOptions=AValue then Exit;
   FOutputOptions:=AValue;
+  if RequireMetadata then
+    Include(FOutputOptions,ooMetadata);
 end;
 
 procedure TRestOutputStreamer.CreateErrorContent(aCode: Integer;

packages/pastojs/src/fppas2js.pp

@@ -5064,6 +5064,14 @@ begin
                   or IsExternalClass_Name(ToClass,'Object') then
                 // TJSFunction(@Proc) or TJSFunction(ProcVar)
                 exit(cExact);
+              end
+            else if FromTypeEl.ClassType=TPasClassType then
+              begin
+              if TPasClassType(FromTypeEl).IsExternal
+                  and (msDelphi in CurrentParser.CurrentModeswitches)
+                  and not (bsObjectChecks in CurrentParser.Scanner.CurrentBoolSwitches) then
+                // ExtClass(ExtClass)  -> allow in mode delphi and no objectchecks
+                exit(cAliasExact); // $mode delphi
               end;
             end;
           end;
@@ -8030,16 +8038,18 @@ var
   var
     Call: TJSCallExpression;
   begin
-    if AssignContext=nil then exit;
-    if AssignContext.LeftResolved.LoTypeEl is TPasRecordType then
+    if AssignContext<>nil then
       begin
-      // aRecord:=right  ->  aRecord.$assign(right)
-      Call:=CreateCallExpression(El);
-      AssignContext.Call:=Call;
-      Call.Expr:=CreateDotNameExpr(El,Result,TJSString(GetBIName(pbifnRecordAssign)));
-      Call.AddArg(AssignContext.RightSide);
-      AssignContext.RightSide:=nil;
-      Result:=Call;
+      if AssignContext.LeftResolved.LoTypeEl is TPasRecordType then
+        begin
+        // aRecord:=right  ->  aRecord.$assign(right)
+        Call:=CreateCallExpression(El);
+        AssignContext.Call:=Call;
+        Call.Expr:=CreateDotNameExpr(El,Result,TJSString(GetBIName(pbifnRecordAssign)));
+        Call.AddArg(AssignContext.RightSide);
+        AssignContext.RightSide:=nil;
+        Result:=Call;
+        end;
       end;
   end;
 
@@ -8155,8 +8165,8 @@ begin
     end;
     end; // property redirect
 
-  if (AContext.Access=caAssign)
-      and aResolver.IsClassField(Decl) then
+  if aResolver.IsClassField(Decl)
+      and (AContext.Access in [caAssign,caByReference]) then
     begin
     // writing a class var  -> aClass.VarName
     PathExpr:=CreateReferencePathExpr(Decl.Parent,AContext);

packages/pastojs/src/pas2jscompiler.pp

@@ -129,6 +129,7 @@ type
     coUseStrict,
     coWriteDebugLog,
     coWriteMsgToStdErr,
+    coPrecompile, // create precompile file
     // optimizations
     coEnumValuesAsNumbers,
     coKeepNotUsedPrivates,
@@ -180,6 +181,7 @@ const
     'Use strict',
     'Write pas2jsdebug.log',
     'Write messages to StdErr',
+    'Create precompiled units',
     'Enum values as numbers',
     'Keep not used private declarations',
     'Keep not used declarations (WPO)',
@@ -1309,7 +1311,6 @@ begin
 end;
 
 function TPas2jsCompilerFile.IsUnitReadFromPCU: Boolean;
-
 begin
   Result:=Assigned(PCUSupport) and PCUSupport.HasReader;
 end;
@@ -1337,7 +1338,8 @@ begin
     {$IFDEF ReallyVerbose}
     writeln('TPas2jsCompilerFile.ReaderFinished analyzed ',UnitFilename,' ScopeModule=',GetObjName(UseAnalyzer.ScopeModule));
     {$ENDIF}
-    if Assigned(PCUSupport) and Not PCUSupport.HasReader then
+    if Assigned(PCUSupport) and Not PCUSupport.HasReader
+        and (coPrecompile in Compiler.Options) then
       PCUSupport.WritePCU;
   except
     on E: ECompilerTerminate do
@@ -2771,7 +2773,6 @@ end;
 
 procedure TPas2JSConfigSupport.LoadConfig(Const aFileName: String);
 type
-
   TSkip = (
     skipNone,
     skipIf,
@@ -2982,17 +2983,14 @@ begin
 end;
 
 procedure TPas2jsCompiler.HandleOptionPCUFormat(aValue: String);
-
 begin
-  ParamFatal('No PCU support in this compiler for '+aValue);
+  ParamFatal('No support in this compiler for precompiled format '+aValue);
 end;
 
 function TPas2jsCompiler.HandleOptionPaths(C: Char; aValue: String;
   FromCmdLine: Boolean): Boolean;
-
 Var
   ErrorMsg: String;
-
 begin
   Result:=True;
   case c of
@@ -3007,10 +3005,8 @@ begin
 end;
 
 function TPas2jsCompiler.HandleOptionOptimization(C: Char; aValue: String): Boolean;
-
 Var
   Enable: Boolean;
-
 begin
   Result:=True;
   case C of
@@ -4053,7 +4049,6 @@ begin
     RaiseInternalError(20170504161340,'internal error: TPas2jsCompiler.Run FileCount>0');
 
   try
-
     // set working directory, need by all relative filenames
     SetWorkingDir(aWorkingDir);
 

packages/pastojs/src/pas2jsfilecache.pp

@@ -257,7 +257,7 @@ type
     function FindCustomJSFileName(const aFilename: string): String; override;
     function FindUnitJSFileName(const aUnitFilename: string): String; override;
     function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override;
-    function FindIncludeFileName(const aFilename: string): String; override;
+    function FindIncludeFileName(const aFilename, ModuleDir: string): String; override;
     function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddSrcUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
@@ -1812,7 +1812,8 @@ begin
     UsePointDirectory, true, RelPath);
 end;
 
-function TPas2jsFilesCache.FindIncludeFileName(const aFilename: string): String;
+function TPas2jsFilesCache.FindIncludeFileName(const aFilename,
+  ModuleDir: string): String;
 
   function SearchCasedInIncPath(const Filename: string): string;
   var
@@ -1820,9 +1821,9 @@ function TPas2jsFilesCache.FindIncludeFileName(const aFilename: string): String;
   begin
     // file name is relative
     // first search in the same directory as the unit
-    if BaseDirectory<>'' then
+    if ModuleDir<>'' then
       begin
-      Result:=BaseDirectory+Filename;
+      Result:=IncludeTrailingPathDelimiter(ModuleDir)+Filename;
       if SearchLowUpCase(Result) then exit;
       end;
     // then search in include path

packages/pastojs/src/pas2jsfs.pp

@@ -96,7 +96,7 @@ Type
     function FindSourceFileName(const aFilename: string): String; virtual; abstract;
   Public
     // Public Abstract. Must be overridden
-    function FindIncludeFileName(const aFilename: string): String; virtual; abstract;
+    function FindIncludeFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
     function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract;
     Function FileExists(Const aFileName: String): Boolean; virtual; abstract;
     function FindUnitJSFileName(const aUnitFilename: string): String; virtual; abstract;
@@ -416,7 +416,7 @@ var
   Filename: String;
 begin
   Result:=nil;
-  Filename:=FS.FindIncludeFileName(aFilename);
+  Filename:=FS.FindIncludeFileName(aFilename,BaseDirectory);
   if Filename='' then exit;
   try
     Result:=FindSourceFile(Filename);
@@ -433,7 +433,7 @@ end;
 function TPas2jsFSResolver.FindIncludeFileName(const aFilename: string): String;
 
 begin
-  Result:=FS.FindIncludeFileName(aFilename);
+  Result:=FS.FindIncludeFileName(aFilename,BaseDirectory);
 end;
 
 

packages/pastojs/src/pas2jslogger.pp

@@ -37,7 +37,9 @@ uses
   {$IFDEF HASFILESYSTEM}
   pas2jsfileutils,
   {$ENDIF}
-  Classes, SysUtils, PasTree, PScanner, jstree, jsbase, jswriter, fpjson;
+  Types, Classes, SysUtils,
+  PasTree, PScanner,
+  jstree, jsbase, jswriter, fpjson;
 
 const
   ExitCodeErrorInternal = 1; // internal error
@@ -123,7 +125,7 @@ type
     FLastMsgNumber: integer;
     FLastMsgTxt: string;
     FLastMsgType: TMessageType;
-    FMsgNumberDisabled: array of Integer;// sorted ascending
+    FMsgNumberDisabled: TIntegerDynArray;// sorted ascending
     FMsg: TFPList; // list of TPas2jsMessage
     FOnFormatPath: TPScannerFormatPathEvent;
     FOnLog: TPas2jsLogEvent;
@@ -144,11 +146,14 @@ type
     procedure SetOutputFilename(AValue: string);
     procedure SetSorted(AValue: boolean);
     procedure DoLogRaw(const Msg: string; SkipEncoding : Boolean);
-    function Concatenate(Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
   Protected
     // so it can be overridden
     function CreateTextWriter(const aFileName: string): TTextWriter; virtual;
   public
+    {$IFDEF EnableLogFile}
+    LogFile: TStringList;
+    procedure LogF(args: array of const);
+    {$ENDIF}
     constructor Create;
     destructor Destroy; override;
     procedure RegisterMsg(MsgType: TMessageType; MsgNumber: integer; Pattern: string);
@@ -185,6 +190,7 @@ type
     procedure CloseDebugLog;
     procedure DebugLogWriteLn(Msg: string); overload;
     function GetEncodingCaption: string;
+    class function Concatenate(Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
   public
     property Encoding: string read FEncoding write SetEncoding; // normalized
     property MsgCount: integer read GetMsgCount;
@@ -610,6 +616,26 @@ end;
 
 procedure TPas2jsLogger.SetMsgNumberDisabled(MsgNumber: integer; AValue: boolean
   );
+  {$IF defined(FPC) and (FPC_FULLVERSION<30101)}
+  procedure Delete(var A: TIntegerDynArray; Index, Count: integer); overload;
+  var
+    i: Integer;
+  begin
+    for i:=Index+Count to length(A)-1 do
+      A[i-Count]:=A[i];
+    SetLength(A,length(A)-Count);
+  end;
+
+  procedure Insert(Item: integer; var A: TIntegerDynArray; Index: integer); overload;
+  var
+    i: Integer;
+  begin
+    SetLength(A,length(A)+1);
+    for i:=length(A)-1 downto Index+1 do
+      A[i]:=A[i-1];
+    A[Index]:=Item;
+  end;
+  {$ENDIF}
 var
   InsertPos, OldCount: Integer;
 begin
@@ -621,25 +647,13 @@ begin
     if (InsertPos<OldCount) and (FMsgNumberDisabled[InsertPos]=MsgNumber) then
       exit; // already disabled
     // insert into array
-    {$IF defined(FPC) and (FPC_FULLVERSION<30101)}
-    SetLength(FMsgNumberDisabled,OldCount+1);
-    FMsgNumberDisabled[InsertPos]:=MsgNumber;
-    {$ELSE}
     Insert(MsgNumber,FMsgNumberDisabled,InsertPos);
-    {$ENDIF}
   end else begin
     // disable
     InsertPos:=FindMsgNumberDisabled(MsgNumber,false);
     if InsertPos<0 then exit;
     // delete from array
-    {$IF defined(FPC) and (FPC_FULLVERSION<30101)}
-    if InsertPos+1<OldCount then
-      Move(FMsgNumberDisabled[InsertPos+1],FMsgNumberDisabled[InsertPos],
-           SizeOf(Integer)*(OldCount-InsertPos-1));
-    SetLength(FMsgNumberDisabled,OldCount-1);
-    {$ELSE}
     Delete(FMsgNumberDisabled,InsertPos,1);
-    {$ENDIF}
   end;
 end;
 
@@ -705,63 +719,6 @@ begin
   end;
 end;
 
-function TPas2jsLogger.Concatenate(
-  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
-var
-  s: String;
-  i: Integer;
-  {$IFDEF Pas2JS}
-  V: JSValue;
-  {$ELSE}
-  V: TVarRec;
-  {$ENDIF}
-begin
-  s:='';
-  for i:=Low(Args) to High(Args) do
-  begin
-    V:=Args[i];
-    {$IFDEF Pas2JS}
-    case jsTypeOf(V) of
-    'boolean':
-      if V then s+='true' else s+='false';
-    'number':
-      if isInteger(V) then
-        s+=str(NativeInt(V))
-      else
-        s+=str(Double(V));
-    'string':
-      s+=String(V);
-    else continue;
-    end;
-    {$ELSE}
-    case V.VType of
-      vtInteger:      s += IntToStr(V.VInteger);
-      vtBoolean:      s += BoolToStr(V.VBoolean);
-      vtChar:         s += V.VChar;
-      {$ifndef FPUNONE}
-      vtExtended:     ; //  V.VExtended^;
-      {$ENDIF}
-      vtString:       s += V.VString^;
-      vtPointer:      ; //  V.VPointer;
-      vtPChar:        s += V.VPChar;
-      vtObject:       ; //  V.VObject;
-      vtClass:        ; //  V.VClass;
-      vtWideChar:     s += AnsiString(V.VWideChar);
-      vtPWideChar:    s += AnsiString(V.VPWideChar);
-      vtAnsiString:   s += AnsiString(V.VAnsiString);
-      vtCurrency:     ; //  V.VCurrency^);
-      vtVariant:      ; //  V.VVariant^);
-      vtInterface:    ; //  V.VInterface^);
-      vtWidestring:   s += AnsiString(WideString(V.VWideString));
-      vtInt64:        s += IntToStr(V.VInt64^);
-      vtQWord:        s += IntToStr(V.VQWord^);
-      vtUnicodeString:s += AnsiString(UnicodeString(V.VUnicodeString));
-    end;
-    {$ENDIF}
-  end;
-  Result:=s;
-end;
-
 constructor TPas2jsLogger.Create;
 begin
   FMsg:=TFPList.Create;
@@ -906,6 +863,63 @@ begin
     Result:='utf-8';
 end;
 
+class function TPas2jsLogger.Concatenate(
+  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
+var
+  s: String;
+  i: Integer;
+  {$IFDEF Pas2JS}
+  V: JSValue;
+  {$ELSE}
+  V: TVarRec;
+  {$ENDIF}
+begin
+  s:='';
+  for i:=Low(Args) to High(Args) do
+  begin
+    V:=Args[i];
+    {$IFDEF Pas2JS}
+    case jsTypeOf(V) of
+    'boolean':
+      if V then s+='true' else s+='false';
+    'number':
+      if isInteger(V) then
+        s+=str(NativeInt(V))
+      else
+        s+=str(Double(V));
+    'string':
+      s+=String(V);
+    else continue;
+    end;
+    {$ELSE}
+    case V.VType of
+      vtInteger:      s += IntToStr(V.VInteger);
+      vtBoolean:      s += BoolToStr(V.VBoolean);
+      vtChar:         s += V.VChar;
+      {$ifndef FPUNONE}
+      vtExtended:     ; //  V.VExtended^;
+      {$ENDIF}
+      vtString:       s += V.VString^;
+      vtPointer:      ; //  V.VPointer;
+      vtPChar:        s += V.VPChar;
+      vtObject:       ; //  V.VObject;
+      vtClass:        ; //  V.VClass;
+      vtWideChar:     s += AnsiString(V.VWideChar);
+      vtPWideChar:    s += AnsiString(V.VPWideChar);
+      vtAnsiString:   s += AnsiString(V.VAnsiString);
+      vtCurrency:     ; //  V.VCurrency^);
+      vtVariant:      ; //  V.VVariant^);
+      vtInterface:    ; //  V.VInterface^);
+      vtWidestring:   s += AnsiString(WideString(V.VWideString));
+      vtInt64:        s += IntToStr(V.VInt64^);
+      vtQWord:        s += IntToStr(V.VQWord^);
+      vtUnicodeString:s += AnsiString(UnicodeString(V.VUnicodeString));
+    end;
+    {$ENDIF}
+  end;
+  Result:=s;
+end;
+
 procedure TPas2jsLogger.LogPlain(const Msg: string);
 var
   s: String;
@@ -1059,7 +1073,7 @@ begin
   end;
 end;
 
-Function TPas2jsLogger.CreateTextWriter(const aFileName : string) : TTextWriter;
+function TPas2jsLogger.CreateTextWriter(const aFileName: string): TTextWriter;
 
 begin
 {$IFDEF HASFILESYSTEM}
@@ -1069,6 +1083,16 @@ begin
 {$ENDIF}
 end;
 
+{$IFDEF EnableLogFile}
+procedure TPas2jsLogger.LogF(args: array of const);
+begin
+  if LogFile=nil then
+    LogFile:=TStringList.Create;
+  LogFile.Add(TPas2jsLogger.Concatenate(args));
+  LogFile.SaveToFile('c:\tmp\libpas2jsparams.txt');
+end;
+{$ENDIF}
+
 procedure TPas2jsLogger.OpenOutputFile;
 begin
 {$IFDEF HASFILESYSTEM}

packages/pastojs/src/pas2jspcucompiler.pp

@@ -81,7 +81,8 @@ Type
   Protected
     procedure WritePrecompiledFormats; override;
     function CreateCompilerFile(const PasFileName, PCUFilename: String): TPas2jsCompilerFile; override;
-    procedure HandleOptionPCUFormat(Value: string) ; override;
+    procedure HandleOptionPCUFormat(Value: string); override;
+    property PrecompileFormat: TPas2JSPrecompileFormat read FPrecompileFormat;
   end;
 
 implementation
@@ -436,6 +437,7 @@ begin
     PF:=PrecompileFormats[i];
     if not SameText(Value,PF.Ext) then continue;
     FPrecompileFormat:=PrecompileFormats[i];
+    Options:=Options+[coPrecompile];
     Found:=true;
   end;
   if not Found then
@@ -445,13 +447,13 @@ end;
 { TPas2jsPCUCompilerFile }
 
 function TPas2jsPCUCompilerFile.CreatePCUSupport: TPCUSupport;
-
 Var
   PF: TPas2JSPrecompileFormat;
-
 begin
   // Note that if no format was preset, no files will be written
   PF:=(Compiler as TPas2jsPCUCompiler).FPrecompileFormat;
+  if (PF=nil) and (PrecompileFormats.Count>0) then
+    PF:=PrecompileFormats[0];
   if PF<>Nil then
     Result:=TFilerPCUSupport.Create(Self,PF)
   else

packages/pastojs/tests/tcmodules.pas

@@ -591,6 +591,7 @@ type
     Procedure TestExternalClass_TypeCastToJSObject;
     Procedure TestExternalClass_TypeCastStringToExternalString;
     Procedure TestExternalClass_TypeCastToJSFunction;
+    Procedure TestExternalClass_TypeCastDelphiUnrelated;
     Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
     Procedure TestExternalClass_BracketAccessor;
     Procedure TestExternalClass_BracketAccessor_Call;
@@ -3700,6 +3701,7 @@ procedure TTestModule.TestProc_Asm;
 begin
   StartProgram(false);
   Add([
+  '{$mode delphi}',
   'function DoIt: longint;',
   'begin;',
   '  asm',
@@ -3715,6 +3717,10 @@ begin
   '    s = "end";',
   '  end;',
   'end;',
+  'procedure Fly;',
+  'asm',
+  '  return;',
+  'end;',
   'begin']);
   ConvertProgram;
   CheckSource('TestProc_Asm',
@@ -3730,8 +3736,11 @@ begin
     '  s = ''end'';',
     '  s = "end";',
     '  return Result;',
-    '};'
-    ]),
+    '};',
+    'this.Fly = function () {',
+    '  return;',
+    '};',
+    '']),
     LinesToStr([
     ''
     ]));
@@ -12008,7 +12017,7 @@ begin
   '    class var vI: longint;',
   '    class var Sub: TObject;',
   '    constructor Create;',
-  '    class function GetIt(Par: longint): tobject;',
+  '    class function GetIt(var Par: longint): tobject;',
   '  end;',
   'constructor tobject.create;',
   'begin',
@@ -12016,12 +12025,13 @@ begin
   '  Self.vi:=Self.vi+1;',
   '  inc(vi);',
   'end;',
-  'class function tobject.getit(par: longint): tobject;',
+  'class function tobject.getit(var par: longint): tobject;',
   'begin',
-  '  vi:=vi+par;',
-  '  Self.vi:=Self.vi+par;',
+  '  vi:=vi+3;',
+  '  Self.vi:=Self.vi+4;',
   '  inc(vi);',
   '  Result:=self.sub;',
+  '  GetIt(vi);',
   'end;',
   'var Obj: tobject;',
   'begin',
@@ -12049,10 +12059,19 @@ begin
     '  };',
     '  this.GetIt = function(Par){',
     '    var Result = null;',
-    '    $mod.TObject.vI = this.vI + Par;',
-    '    $mod.TObject.vI = this.vI + Par;',
+    '    $mod.TObject.vI = this.vI + 3;',
+    '    $mod.TObject.vI = this.vI + 4;',
     '    $mod.TObject.vI += 1;',
     '    Result = this.Sub;',
+    '    this.GetIt({',
+    '      p: $mod.TObject,',
+    '      get: function () {',
+    '          return this.p.vI;',
+    '        },',
+    '      set: function (v) {',
+    '          this.p.vI = v;',
+    '        }',
+    '    });',
     '    return Result;',
     '  };',
     '});',
@@ -16583,6 +16602,43 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExternalClass_TypeCastDelphiUnrelated;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''Object'' end;',
+  '  TJSWindow = class external name ''Window''(TJSObject)',
+  '    procedure Open;',
+  '  end;',
+  '  TJSEventTarget = class external name ''Event''(TJSObject)',
+  '    procedure Execute;',
+  '  end;',
+  'procedure Fly;',
+  'var',
+  '  w: TJSWindow;',
+  '  e: TJSEventTarget;',
+  'begin',
+  '  w:=TJSWindow(e);',
+  '  e:=TJSEventTarget(w);',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_TypeCastDelphiUnrelated',
+    LinesToStr([ // statements
+    'this.Fly = function () {',
+    '  var w = null;',
+    '  var e = null;',
+    '  w = e;',
+    '  e = w;',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_CallClassFunctionOfInstanceFail;
 begin
   StartProgram(false);

packages/pastojs/tests/tcunitsearch.pas

@@ -143,6 +143,7 @@ type
     procedure TestUS_Program_FU;
     procedure TestUS_Program_FU_o;
     procedure TestUS_Program_FE_o;
+    procedure TestUS_IncludeSameDir;
 
     procedure TestUS_UsesInFile;
     procedure TestUS_UsesInFile_Duplicate;
@@ -695,6 +696,27 @@ begin
   AssertNotNull('foo.js not found',FindFile('foo.js'));
 end;
 
+procedure TTestCLI_UnitSearch.TestUS_IncludeSameDir;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddFile('sub/defines.inc',[
+    '{$Define foo}',
+    '']);
+  AddUnit('sub/unit1.pas',
+  ['{$I defines.inc}',
+   '{$ifdef foo}',
+   'var a: longint;',
+   '{$endif}'],
+  ['']);
+  AddFile('test1.pas',[
+    'uses unit1;',
+    'begin',
+    '  a:=3;',
+    'end.']);
+  AddDir('lib');
+  Compile(['test1.pas','-Fusub','-FElib','-ofoo.js']);
+end;
+
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile;
 begin
   AddUnit('system.pp',[''],['']);

packages/sqlite/tests/testapiv3x.pp

@@ -10,7 +10,7 @@ const
 
 var
  rc       : Integer;
- db       : PPsqlite3;
+ db       : Psqlite3;
  sql      : string;
  pzErrMsg : PChar;
  
@@ -77,7 +77,11 @@ begin
    then writeln(Format('SQL error: %s', [pzErrMsg^]));
   finally sqlite3_close(db); end;
 
-  sleep(5000);
+{$ifdef Windows}
+  writeln('Hit enter to exit');
+  Readln;
+{$endif}
+
 end.
 
 

rtl/bsd/ostypes.inc

@@ -87,6 +87,9 @@ TYPE
         st_qspare1    : cint64;            // was recursive change detect
         st_qspare2    : cint64;
 {$else dragonfly}
+{$ifdef openbsd}
+        st_mode       : mode_t;            // inode protection mode
+{$endif openbsd}
         st_dev        : dev_t;             // inode's device
 {$ifdef darwin_new_iostructs}
         st_mode       : mode_t;            // inode protection mode
@@ -99,16 +102,15 @@ TYPE
         st_ino        : ino_t;             // inode's number
 {$else not netbsd}
         st_ino        : ino_t;             // inode's number
+{$ifndef openbsd}
         st_mode       : mode_t;            // inode protection mode
+{$endif not openbsd}
 {$endif not netbsd}
         st_nlink      : nlink_t;           // number of hard links
 {$endif}
         st_uid        : uid_t;             // user ID of the file's owner
         st_gid        : gid_t;             // group ID of the file's group
         st_rdev       : dev_t;             // device type
-{$ifdef openbsd}
-        st_padd0      : cint;
-{$endif}
         st_atime      : time_t;            // time of last access
         st_atimensec  : clong;             // nsec of last access
         st_mtime      : time_t;            // time of last data modification
@@ -144,8 +146,19 @@ TYPE
    pStat = ^stat;
 
   { directory services }
-{$ifndef darwin_new_iostructs}
-{$ifdef dragonfly}
+{$if defined(darwin_new_iostructs)}
+   {$packrecords 4}
+   { available on Mac OS X 10.6 and later, and used by all iPhoneOS versions }
+   dirent  = record
+        d_fileno      : cuint64;                        // file number of entry
+        d_seekoff     : cuint64;                        // seek offset (optional, used by servers)
+        d_reclen      : cuint16;                        // length of this record
+        d_namlen      : cuint16;                        // length of string in d_name
+        d_type        : cuint8;                         // file type, see below
+        d_name        : array[0..PATH_MAX-1] of char;        // name must be no longer than this
+   end;
+   {$packrecords c}
+{$elseif defined(dragonfly)}
    dirent  = record
         d_fileno      : ino_t;                          // file number of entry
         d_namlen      : cuint16;                        // strlen (d_name)
@@ -154,28 +167,25 @@ TYPE
         d_unused2     : cuint32;                        // reserved
         d_name        : array[0..255] of char;          // name, null terminated
    end;
-{$else}
+{$elseif defined(openbsd)}
    dirent  = record
-        d_fileno      : cuint32;                        // file number of entry
+        d_fileno      : ino_t;
+        d_off         : off_t;
         d_reclen      : cuint16;                        // length of this record
         d_type        : cuint8;                         // file type, see below
         d_namlen      : cuint8;                         // length of string in d_name
+        d_padding     : array[0..3] of cuint8;
         d_name        : array[0..(255 + 1)-1] of char;  // name must be no longer than this
    end;
-{$endif}
-{$else not darwin_new_iostructs}
-   {$packrecords 4}
-   { available on Mac OS X 10.6 and later, and used by all iPhoneOS versions }
+{$else}
    dirent  = record
-        d_fileno      : cuint64;                        // file number of entry
-        d_seekoff     : cuint64;                        // seek offset (optional, used by servers)
+        d_fileno      : cuint32;                        // file number of entry
         d_reclen      : cuint16;                        // length of this record
-        d_namlen      : cuint16;                        // length of string in d_name
         d_type        : cuint8;                         // file type, see below
-        d_name        : array[0..PATH_MAX-1] of char;        // name must be no longer than this
+        d_namlen      : cuint8;                         // length of string in d_name
+        d_name        : array[0..(255 + 1)-1] of char;  // name must be no longer than this
    end;
-   {$packrecords c}
-{$endif darwin_new_iostructs}
+{$endif}
    TDirent = dirent;
    pDirent = ^dirent;
 
@@ -185,6 +195,11 @@ TYPE
         dd_size   : clong;        // amount of data returned by getdirentries
         dd_buf    : pchar;        // data buffer
         dd_len    : cint;         // size of data buffer
+{$ifdef openbsd}
+        dd_curpos : off_t;
+        dd_lock   : pointer;
+        dd_rewind : clong;
+{$else not openbsd}
 {$ifdef netbsdpowerpc}
         dd_pad1   : cint;
         dd_seek   : cint64;        // magic cookie returned by getdirentries
@@ -197,6 +212,7 @@ TYPE
         __dd_lock : pthread_mutex_t; // for thread locking
         __dd_td : pointer;        // telldir position recording
 {$endif}
+{$endif not openbsd}
    end;
    TDir    = dir;
    pDir    = ^dir;

rtl/win/sysosh.inc

@@ -22,7 +22,7 @@ type
   THandle = DWord;
   ULONG_PTR = DWord;
 {$endif CPU64}
-  TThreadID = THandle;
+  TThreadID = DWord;
   SIZE_T = ULONG_PTR;
 
   { the fields of this record are os dependent  }

rtl/win/wininc/defines.inc

@@ -49,6 +49,7 @@
   const
      UNICODE_NULL = WCHAR(#0);
      MAX_PATH = 260;
+     TLS_OUT_OF_INDEXES = DWORD($FFFFFFFF);
      LF_FACESIZE = 32;
      LF_FULLFACESIZE = 64;
      ELF_VENDOR_SIZE = 4;

utils/pas2js/docs/translation.html

@@ -745,7 +745,9 @@ function(){
         JS object. Since Pas2js 1.3 only values are copied,
         keeping the object, so pointer of record is compatible.</li>
       <li>Since record types are JS objects it is possible to typecast a record type
-      to the JS Object, e.g. TJSObject(TPoint)</li>
+      to the JS Object, e.g. <i>TJSObject(TPoint)</i>.
+      Note that you cannot typecast directly to a <i>TJSObject</i> descendant.
+      You can use <i>TJSWindow(TJSObject(aRecord))</i>.</li>
       <li>A pointer of record is simply a reference.
         <ul>
           <li><i>p:=@r</i> translates to <i>p=r</i></li>
@@ -1818,7 +1820,8 @@ function(){
         <li>ClassType(IntfVar) - can be unrelated, nil if invalid</li>
         <li>IntfType(ObjVar) - nil if not found,
           COM: if ObjVar has delegate uses _AddRef</li>
-        <li>TJSObject(IntfTypeOrVar)</li>
+        <li>TJSObject(IntfTypeOrVar). Note that you cannot typecast directly
+        to a <i>TJSObject</i> descendant. You can use <i>TJSWindow(TJSObject(IntfType))</i>.</li>
         <li>jsvalue(intfvar)</li>
       </ul>
     <li>Assign operator:</li>
@@ -2703,7 +2706,9 @@ End.
       call <i>aJSString.fromCharCode()</i>.</li>
       <li>An external class can descend from another external class.</li>
       <li>Since class types are JS objects it is possible to typecast a class type
-      to the JS Object, e.g. TJSObject(TObject)</li>
+      to the JS Object, e.g. <i>TJSObject(TObject)</i>.
+      Note that you cannot typecast directly to a <i>TJSObject</i> descendant
+      in $mode objfpc. You can use <i>TJSWindow(TJSObject(ExtClassInstance))</i>.</li>
       <li>You can typecast function addresses and function references to JS
       function, e.g. <i>TJSFunction(@SomeProc)</i>, <i>TJSFunction(OnClick)</i>.
       Keep in mind that typecasting a method address creates a function wrapper