Browse Source

--- Merging r14080 into '.':
U rtl/win/wininc/base.inc
U rtl/win/wininc/unidef.inc
U rtl/win/wininc/defines.inc
U rtl/win/wininc/ascfun.inc
U rtl/win/wininc/unifun.inc
U rtl/win/wininc/ascdef.inc
--- Merging r14090 into '.':
U compiler/utils/ppudump.pp
--- Merging r14092 into '.':
U utils/fpcm/fpcmwr.pp
--- Merging r14099 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
U packages/fcl-db/tests/testdbbasics.pas
U packages/fcl-db/src/sqldb/sqldb.pp
U packages/fcl-db/src/base/bufdataset.pas
--- Merging r14104 into '.':
U packages/libxml/src/xmlxsd.pas
--- Merging r14105 into '.':
U packages/fcl-web/src/websession.pp
--- Merging r14106 into '.':
U packages/fcl-web/src/httpdefs.pp
--- Merging r14108 into '.':
U packages/fcl-web/src/fphttp.pp
--- Merging r14111 into '.':
U rtl/objpas/classes/streams.inc
U rtl/objpas/classes/classesh.inc
--- Merging r14112 into '.':
G packages/libxml/src/xmlxsd.pas
--- Merging r14113 into '.':
G packages/libxml/src/xmlxsd.pas
--- Merging r14119 into '.':
G packages/libxml/src/xmlxsd.pas
--- Merging r14120 into '.':
U packages/fcl-db/src/sqlite/customsqliteds.pas
--- Merging r14124 into '.':
G rtl/win/wininc/defines.inc
--- Merging r14125 into '.':
U rtl/win64/system.pp
--- Merging r14126 into '.':
U packages/libxml/src/xmlstring.inc
G packages/libxml/src/xmlxsd.pas
U packages/libxml/src/xml2.pas

# revisions: 14080,14090,14092,14099,14104,14105,14106,14108,14111,14112,14113,14119,14120,14124,14125,14126
------------------------------------------------------------------------
r14080 | marco | 2009-11-06 12:46:25 +0100 (Fri, 06 Nov 2009) | 2 lines
Changed paths:
M /trunk/rtl/win/wininc/ascdef.inc
M /trunk/rtl/win/wininc/ascfun.inc
M /trunk/rtl/win/wininc/base.inc
M /trunk/rtl/win/wininc/defines.inc
M /trunk/rtl/win/wininc/unidef.inc
M /trunk/rtl/win/wininc/unifun.inc

* Findfirstex and findfirsttransacted as per #14924

------------------------------------------------------------------------
------------------------------------------------------------------------
r14090 | pierre | 2009-11-07 01:23:04 +0100 (Sat, 07 Nov 2009) | 1 line
Changed paths:
M /trunk/compiler/utils/ppudump.pp

* add to missing CPUs
------------------------------------------------------------------------
------------------------------------------------------------------------
r14092 | pierre | 2009-11-07 02:01:31 +0100 (Sat, 07 Nov 2009) | 1 line
Changed paths:
M /trunk/utils/fpcm/fpcmwr.pp

* Fix position of fpcmade file for rtl
------------------------------------------------------------------------
------------------------------------------------------------------------
r14099 | joost | 2009-11-07 14:51:17 +0100 (Sat, 07 Nov 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/fcl-db/tests/testdbbasics.pas
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* Implemented TBufDataset.Refresh + simple test/fixed test
------------------------------------------------------------------------
------------------------------------------------------------------------
r14104 | ivost | 2009-11-08 02:50:48 +0100 (Sun, 08 Nov 2009) | 2 lines
Changed paths:
M /trunk/packages/libxml/src/xmlxsd.pas

* enhanced xml schema type parsers

------------------------------------------------------------------------
------------------------------------------------------------------------
r14105 | joost | 2009-11-08 10:23:43 +0100 (Sun, 08 Nov 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/websession.pp

* Set the cookie only when a new session is created
------------------------------------------------------------------------
------------------------------------------------------------------------
r14106 | joost | 2009-11-08 10:25:04 +0100 (Sun, 08 Nov 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/httpdefs.pp

* When there is no content, do not raise an unsupported content exception
------------------------------------------------------------------------
------------------------------------------------------------------------
r14108 | joost | 2009-11-08 12:04:59 +0100 (Sun, 08 Nov 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/fphttp.pp

* Added protected procedure THTTPContentProducer.SetRequest
------------------------------------------------------------------------
------------------------------------------------------------------------
r14111 | marco | 2009-11-08 12:47:50 +0100 (Sun, 08 Nov 2009) | 2 lines
Changed paths:
M /trunk/rtl/objpas/classes/classesh.inc
M /trunk/rtl/objpas/classes/streams.inc

* TStream.Read/writeqword. Mantis 15023

------------------------------------------------------------------------
------------------------------------------------------------------------
r14112 | ivost | 2009-11-08 13:38:44 +0100 (Sun, 08 Nov 2009) | 2 lines
Changed paths:
M /trunk/packages/libxml/src/xmlxsd.pas

* enhanced xml schema datatype parsers (booltostr is twice as fast)

------------------------------------------------------------------------
------------------------------------------------------------------------
r14113 | ivost | 2009-11-08 14:17:27 +0100 (Sun, 08 Nov 2009) | 2 lines
Changed paths:
M /trunk/packages/libxml/src/xmlxsd.pas

* implemented highspeed str to float (xml schema types)

------------------------------------------------------------------------
------------------------------------------------------------------------
r14119 | ivost | 2009-11-09 02:01:20 +0100 (Mon, 09 Nov 2009) | 2 lines
Changed paths:
M /trunk/packages/libxml/src/xmlxsd.pas

* be more verbose on exceptions

------------------------------------------------------------------------
------------------------------------------------------------------------
r14120 | blikblum | 2009-11-09 04:54:39 +0100 (Mon, 09 Nov 2009) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqlite/customsqliteds.pas

* Fix crash when using a lookup field of memo type (correctly calculate field offset)
* Ensure Field Change event is always called in Write mode (Write method is not called if new text is empty)
------------------------------------------------------------------------
------------------------------------------------------------------------
r14124 | pierre | 2009-11-09 16:41:40 +0100 (Mon, 09 Nov 2009) | 1 line
Changed paths:
M /trunk/rtl/win/wininc/defines.inc

* STD_XXX_HANDLE constants are DWORD type
------------------------------------------------------------------------
------------------------------------------------------------------------
r14125 | pierre | 2009-11-09 18:01:16 +0100 (Mon, 09 Nov 2009) | 1 line
Changed paths:
M /trunk/rtl/win64/system.pp

+ Add StartupConsoleMode as for win32
------------------------------------------------------------------------
------------------------------------------------------------------------
r14126 | ivost | 2009-11-09 21:44:10 +0100 (Mon, 09 Nov 2009) | 2 lines
Changed paths:
M /trunk/packages/libxml/src/xml2.pas
M /trunk/packages/libxml/src/xmlstring.inc
M /trunk/packages/libxml/src/xmlxsd.pas

* added more highspeed string parsing functions

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14680 -

marco 15 years ago
parent
commit
ca5f0557ed

+ 6 - 3
compiler/utils/ppudump.pp

@@ -97,7 +97,9 @@ type
         cpu_iA64,                     { 7 }
         cpu_iA64,                     { 7 }
         cpu_x86_64,                   { 8 }
         cpu_x86_64,                   { 8 }
         cpu_mips,                     { 9 }
         cpu_mips,                     { 9 }
-        cpu_arm                       { 10 }
+        cpu_arm,                      { 10 }
+        cpu_powerpc64,                { 11 }
+        cpu_avr                       { 12 }
   );
   );
 
 
 var
 var
@@ -273,8 +275,9 @@ end;
 
 
 Function Cpu2Str(w:longint):string;
 Function Cpu2Str(w:longint):string;
 const
 const
-  CpuTxt : array[tsystemcpu] of string[8]=
-    ('none','i386','m68k','alpha','powerpc','sparc','vis','ia64','x86_64','mips','arm');
+  CpuTxt : array[tsystemcpu] of string[9]=
+    ('none','i386','m68k','alpha','powerpc','sparc','vis','ia64',
+     'x86_64','mips','arm','powerpc64','avr');
 begin
 begin
   if w<=ord(high(tsystemcpu)) then
   if w<=ord(high(tsystemcpu)) then
     Cpu2Str:=CpuTxt[tsystemcpu(w)]
     Cpu2Str:=CpuTxt[tsystemcpu(w)]

+ 22 - 2
packages/fcl-db/src/base/bufdataset.pas

@@ -438,6 +438,8 @@ type
     procedure SetOnUpdateError(const aValue: TResolverErrorEvent);
     procedure SetOnUpdateError(const aValue: TResolverErrorEvent);
     procedure SetFilterText(const Value: String); override; {virtual;}
     procedure SetFilterText(const Value: String); override; {virtual;}
     procedure SetFiltered(Value: Boolean); override; {virtual;}
     procedure SetFiltered(Value: Boolean); override; {virtual;}
+    procedure InternalRefresh; override;
+    procedure BeforeRefreshOpenCursor; virtual;
   {abstracts, must be overidden by descendents}
   {abstracts, must be overidden by descendents}
     function Fetch : boolean; virtual;
     function Fetch : boolean; virtual;
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
@@ -2622,7 +2624,7 @@ begin
   inherited;
   inherited;
 
 
   // refilter dataset if filtered
   // refilter dataset if filtered
-  if IsCursorOpen and Filtered then Refresh;
+  if IsCursorOpen and Filtered then Resync([]);
 end;
 end;
 
 
 procedure TBufDataset.SetFiltered(Value: Boolean); {override;}
 procedure TBufDataset.SetFiltered(Value: Boolean); {override;}
@@ -2635,7 +2637,25 @@ begin
 
 
   // only refresh if active
   // only refresh if active
   if IsCursorOpen then
   if IsCursorOpen then
-    Refresh;
+    Resync([]);
+end;
+
+procedure TBufDataset.InternalRefresh;
+var StoreDefaultFields: boolean;
+begin
+  StoreDefaultFields:=DefaultFields;
+  SetDefaultFields(False);
+  FreeFieldBuffers;
+  ClearBuffers;
+  InternalClose;
+  BeforeRefreshOpenCursor;
+  InternalOpen;
+  SetDefaultFields(StoreDefaultFields);
+end;
+
+procedure TBufDataset.BeforeRefreshOpenCursor;
+begin
+  // Do nothing
 end;
 end;
 
 
 function TBufDataset.Fetch: boolean;
 function TBufDataset.Fetch: boolean;

+ 11 - 0
packages/fcl-db/src/sqldb/sqldb.pp

@@ -259,6 +259,7 @@ type
     Function GetDataSource : TDatasource; override;
     Function GetDataSource : TDatasource; override;
     Procedure SetDataSource(AValue : TDatasource);
     Procedure SetDataSource(AValue : TDatasource);
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
+    procedure BeforeRefreshOpenCursor; override;
   public
   public
     procedure Prepare; virtual;
     procedure Prepare; virtual;
     procedure UnPrepare; virtual;
     procedure UnPrepare; virtual;
@@ -1572,6 +1573,16 @@ begin
   TSQLConnection(DataBase).LoadBlobIntoBuffer(FieldDef, ABlobBuf, FCursor,(Transaction as tsqltransaction));
   TSQLConnection(DataBase).LoadBlobIntoBuffer(FieldDef, ABlobBuf, FCursor,(Transaction as tsqltransaction));
 end;
 end;
 
 
+procedure TCustomSQLQuery.BeforeRefreshOpenCursor;
+begin
+  // This is only necessary because TIBConnection can not re-open a
+  // prepared cursor. In fact this is wrong, but has never led to
+  // problems because in SetActive(false) queries are always
+  // unprepared. (which is also wrong, but has to be fixed later)
+  if IsPrepared then with TSQLConnection(DataBase) do
+    UnPrepareStatement(FCursor);
+end;
+
 function TCustomSQLQuery.GetStatementType : TStatementType;
 function TCustomSQLQuery.GetStatementType : TStatementType;
 
 
 begin
 begin

+ 65 - 42
packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -56,17 +56,22 @@ type
     Previous: PDataRecord;
     Previous: PDataRecord;
   end;
   end;
   
   
+  { TDSStream }
+  //todo: refactor into two or three classes
   TDSStream = class(TStream)
   TDSStream = class(TStream)
   private
   private
-    FActiveItem: PDataRecord;
+    FEditItem: PDataRecord;
     FDataset: TCustomSqliteDataset;
     FDataset: TCustomSqliteDataset;
     FFieldRow: PChar;
     FFieldRow: PChar;
     FField: TField;
     FField: TField;
     FFieldOffset: Integer;
     FFieldOffset: Integer;
     FRowSize: Integer;
     FRowSize: Integer;
     FPosition: LongInt;
     FPosition: LongInt;
+    FWriteMode: Boolean;
   public
   public
-    constructor Create(Dataset: TCustomSqliteDataset; Field: TField);
+    constructor Create(Dataset: TCustomSqliteDataset; Field: TField;
+      FieldOffset: Integer; EditItem: PDataRecord; WriteMode: Boolean);
+    destructor Destroy; override;
     function Write(const Buffer; Count: LongInt): LongInt; override;
     function Write(const Buffer; Count: LongInt): LongInt; override;
     function Read(var Buffer; Count: LongInt): LongInt; override;
     function Read(var Buffer; Count: LongInt): LongInt; override;
     function Seek(Offset: LongInt; Origin: Word): LongInt; override;
     function Seek(Offset: LongInt; Origin: Word): LongInt; override;
@@ -329,23 +334,29 @@ end;
 
 
 // TDSStream
 // TDSStream
 
 
-constructor TDSStream.Create(Dataset: TCustomSqliteDataset; Field: TField);
+constructor TDSStream.Create(Dataset: TCustomSqliteDataset; Field: TField;
+  FieldOffset: Integer; EditItem: PDataRecord; WriteMode: Boolean);
 begin
 begin
   inherited Create;
   inherited Create;
   //FPosition := 0;
   //FPosition := 0;
   FDataset := Dataset;
   FDataset := Dataset;
   FField := Field;
   FField := Field;
-  if Field.FieldNo >= 0 then
-    FFieldOffset := Field.FieldNo - 1
-  else
-    FFieldOffset := Dataset.FieldDefs.Count + Dataset.FCalcFieldList.IndexOf(Field);
-  FActiveItem := PPDataRecord(Dataset.ActiveBuffer)^;
-  FFieldRow := FActiveItem^.Row[FFieldOffset];
+  FFieldOffset := FieldOffset;
+  FWriteMode := WriteMode;
+  FEditItem := EditItem;
+  FFieldRow := FEditItem^.Row[FFieldOffset];
   if FFieldRow <> nil then
   if FFieldRow <> nil then
     FRowSize := StrLen(FFieldRow);
     FRowSize := StrLen(FFieldRow);
   //else
   //else
   //  FRowSize := 0;  
   //  FRowSize := 0;  
-end;  
+end;
+
+destructor TDSStream.Destroy;
+begin
+  if FWriteMode and not (FDataset.State in [dsCalcFields, dsFilter, dsNewValue]) then
+    FDataset.DataEvent(deFieldChange, PtrInt(FField));
+  inherited Destroy;
+end;
 
 
 function TDSStream.Seek(Offset: LongInt; Origin: Word): LongInt;
 function TDSStream.Seek(Offset: LongInt; Origin: Word): LongInt;
 begin
 begin
@@ -362,30 +373,29 @@ var
   NewRow: PChar;
   NewRow: PChar;
 begin
 begin
   Result := Count;
   Result := Count;
-  if Count = 0 then
-    Exit;
-  //FRowSize is always 0 when FPosition = 0,
-  //so there's no need to check FPosition
-  NewRow := StrAlloc(FRowSize + Count + 1);
-  (NewRow + Count + FRowSize)^ := #0;
-  if FRowSize > 0 then
-    Move(FFieldRow^, NewRow^, FRowSize);
-  Move(Buffer, (NewRow + FRowSize)^, Count);
-  FActiveItem^.Row[FFieldOffset] := NewRow;
-  StrDispose(FFieldRow);
-  {$ifdef DEBUG_SQLITEDS}
-  WriteLn('##TDSStream.Write##');
-  WriteLn('  FPosition(Before): ', FPosition);
-  WriteLn('  FRowSize(Before): ', FRowSize);
-  WriteLn('  FPosition(After): ', FPosition+Count);
-  WriteLn('  FRowSize(After): ', StrLen(NewRow));
-  //WriteLn('  Stream Value: ',NewRow);
-  {$endif}
-  FFieldRow := NewRow;
-  FRowSize := StrLen(NewRow);
-  Inc(FPosition, Count);
-  if not (FDataset.State in [dsCalcFields, dsFilter, dsNewValue]) then
-    FDataset.DataEvent(deFieldChange, PtrInt(FField));
+  if Count > 0 then
+  begin
+    //FRowSize is always 0 when FPosition = 0,
+    //so there's no need to check FPosition
+    NewRow := StrAlloc(FRowSize + Count + 1);
+    (NewRow + Count + FRowSize)^ := #0;
+    if FRowSize > 0 then
+      Move(FFieldRow^, NewRow^, FRowSize);
+    Move(Buffer, (NewRow + FRowSize)^, Count);
+    FEditItem^.Row[FFieldOffset] := NewRow;
+    StrDispose(FFieldRow);
+    {$ifdef DEBUG_SQLITEDS}
+    WriteLn('##TDSStream.Write##');
+    WriteLn('  FPosition(Before): ', FPosition);
+    WriteLn('  FRowSize(Before): ', FRowSize);
+    WriteLn('  FPosition(After): ', FPosition+Count);
+    WriteLn('  FRowSize(After): ', StrLen(NewRow));
+    //WriteLn('  Stream Value: ',NewRow);
+    {$endif}
+    FFieldRow := NewRow;
+    FRowSize := StrLen(NewRow);
+    Inc(FPosition, Count);
+  end;
 end; 
 end; 
  
  
 function TDSStream.Read(var Buffer; Count: Longint): LongInt;
 function TDSStream.Read(var Buffer; Count: Longint): LongInt;
@@ -456,18 +466,31 @@ begin
 end;
 end;
 
 
 function TCustomSqliteDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
 function TCustomSqliteDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
+var
+  FieldOffset: Integer;
+  EditItem: PDataRecord;
 begin
 begin
+  if Field.FieldNo >= 0 then
+  begin
+    if Mode = bmWrite then
+      EditItem := FCacheItem
+    else
+      EditItem := PPDataRecord(ActiveBuffer)^;
+    FieldOffset := Field.FieldNo - 1;
+  end
+  else
+  begin
+    EditItem := PPDataRecord(CalcBuffer)^;
+    FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field);
+  end;
   if Mode = bmWrite then
   if Mode = bmWrite then
   begin
   begin
-    if not (State in [dsEdit, dsInsert]) then
-    begin
-      DatabaseErrorFmt(SNotEditing,[Name],Self);
-      Exit;
-    end;
-    StrDispose(FCacheItem^.Row[Field.FieldNo - 1]);
-    FCacheItem^.Row[Field.FieldNo - 1] := nil;
+    if not (State in [dsEdit, dsInsert, dsCalcFields]) then
+      DatabaseErrorFmt(SNotEditing, [Name], Self);
+    StrDispose(EditItem^.Row[FieldOffset]);
+    EditItem^.Row[FieldOffset] := nil;
   end;
   end;
-  Result := TDSStream.Create(Self, Field);
+  Result := TDSStream.Create(Self, Field, FieldOffset, EditItem, Mode = bmWrite);
 end;
 end;
 
 
 procedure TCustomSqliteDataset.DoBeforeClose;
 procedure TCustomSqliteDataset.DoBeforeClose;

+ 1 - 1
packages/fcl-db/tests/testdbbasics.pas

@@ -139,7 +139,7 @@ begin
     begin
     begin
     open;
     open;
     delete;
     delete;
-    refresh;
+    Resync([]);
     applyupdates;
     applyupdates;
     AssertTrue(IsEmpty);
     AssertTrue(IsEmpty);
 
 

+ 38 - 0
packages/fcl-db/tests/testfieldtypes.pas

@@ -57,6 +57,7 @@ type
     procedure TestInsertReturningQuery;
     procedure TestInsertReturningQuery;
 
 
     procedure TestTemporaryTable;
     procedure TestTemporaryTable;
+    procedure TestRefresh;
 
 
     procedure TestParametersAndDates;
     procedure TestParametersAndDates;
     procedure TestExceptOnsecClose;
     procedure TestExceptOnsecClose;
@@ -925,6 +926,43 @@ begin
     inherited RunTest;
     inherited RunTest;
 end;
 end;
 
 
+procedure TTestFieldTypes.TestRefresh;
+var ADataset: TDataset;
+    i: integer;
+    AFldID, AFldName: TField;
+begin
+  ADataset := TSQLDBConnector(DBConnector).GetNDataset(true,5);
+
+  Adataset.Open;
+  AFldId:=Adataset.Fields[0];
+  AFldName:=Adataset.Fields[1];
+  for i := 1 to 5 do
+    begin
+    AssertEquals(i,AFldID.asinteger);
+    AssertEquals('TestName'+inttostr(i),AFldName.asstring);
+    ADataset.Next;
+    end;
+
+  ADataset.Next;
+  AssertTrue(ADataset.EOF);
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set NAME=''test'' where ID=2');
+
+  ADataset.Refresh;
+
+  ADataset.First;
+  for i := 1 to 5 do
+    begin
+    AssertEquals(i,AFldID.AsInteger);
+    if i = 2 then
+      AssertEquals('test',AFldName.AsString)
+    else
+      AssertEquals('TestName'+inttostr(i),AFldName.AsString);
+    ADataset.Next;
+    end;
+  ADataset.Next;
+  AssertTrue(ADataset.EOF);
+end;
+
 procedure TTestFieldTypes.TestEmptyUpdateQuery;
 procedure TTestFieldTypes.TestEmptyUpdateQuery;
 begin
 begin
   TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set name=''nothing'' where (1=0)');
   TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set name=''nothing'' where (1=0)');

+ 6 - 0
packages/fcl-web/src/fphttp.pp

@@ -37,6 +37,7 @@ Type
     Procedure DoGetContent(ARequest : TRequest; Content : TStream; Var Handled : Boolean); virtual;
     Procedure DoGetContent(ARequest : TRequest; Content : TStream; Var Handled : Boolean); virtual;
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse; Var Handled : Boolean);
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse; Var Handled : Boolean);
     Function ProduceContent : String; virtual;
     Function ProduceContent : String; virtual;
+    Procedure SetRequest(ARequest: TRequest);
   Protected
   Protected
     Property BeforeRequest : TRequestEvent Read FBeforeRequest Write FBeforeRequest;
     Property BeforeRequest : TRequestEvent Read FBeforeRequest Write FBeforeRequest;
     Property AfterResponse : TResponseEvent Read FAfterResponse Write FAfterResponse;
     Property AfterResponse : TResponseEvent Read FAfterResponse Write FAfterResponse;
@@ -258,6 +259,11 @@ begin
   Result:='';
   Result:='';
 end;
 end;
 
 
+procedure THTTPContentProducer.SetRequest(ARequest: TRequest);
+begin
+  FRequest := ARequest;
+end;
+
 function THTTPContentProducer.HaveContent: Boolean;
 function THTTPContentProducer.HaveContent: Boolean;
 begin
 begin
   Result:=(ProduceContent<>'');
   Result:=(ProduceContent<>'');

+ 1 - 1
packages/fcl-web/src/httpdefs.pp

@@ -1170,7 +1170,7 @@ begin
       ProcessMultiPart(M,CT, ContentFields)
       ProcessMultiPart(M,CT, ContentFields)
     else if Pos('APPLICATION/X-WWW-FORM-URLENCODED',Uppercase(CT))<>0 then
     else if Pos('APPLICATION/X-WWW-FORM-URLENCODED',Uppercase(CT))<>0 then
       ProcessUrlEncoded(M, ContentFields)
       ProcessUrlEncoded(M, ContentFields)
-    else
+    else if CL<>0 then
       begin
       begin
 {$ifdef CGIDEBUG}
 {$ifdef CGIDEBUG}
       SendDebug('InitPostVars: unsupported content type:'+CT);
       SendDebug('InitPostVars: unsupported content type:'+CT);

+ 1 - 1
packages/fcl-web/src/websession.pp

@@ -261,11 +261,11 @@ begin
     FIniFile:=TMemIniFile.Create(IncludeTrailingPathDelimiter(SessionDir)+SessionID);
     FIniFile:=TMemIniFile.Create(IncludeTrailingPathDelimiter(SessionDir)+SessionID);
     FIniFile.WriteDateTime(SSession,KeyStart,Now);
     FIniFile.WriteDateTime(SSession,KeyStart,Now);
     FIniFile.WriteInteger(SSession,KeyTimeOut,Self.TimeOutMinutes);
     FIniFile.WriteInteger(SSession,KeyTimeOut,Self.TimeOutMinutes);
+    FSessionStarted:=True;
     end;
     end;
   FIniFile.WriteDateTime(SSession,KeyLast,Now);
   FIniFile.WriteDateTime(SSession,KeyLast,Now);
   If not FCached then
   If not FCached then
     FIniFile.UpdateFile;
     FIniFile.UpdateFile;
-  FSessionStarted:=True;
 {$ifdef cgidebug}SendMethodExit('TIniWebSession.InitSession');{$endif}
 {$ifdef cgidebug}SendMethodExit('TIniWebSession.InitSession');{$endif}
 end;
 end;
 
 

+ 1 - 24
packages/libxml/src/xml2.pas

@@ -32,9 +32,6 @@ const
 
 
 {$i xml2.inc}
 {$i xml2.inc}
 
 
-operator := (const S: String): xmlCharPtr; inline;
-//operator := (const C: AnsiChar): xmlCharPtr; inline;
-
 implementation
 implementation
 
 
 procedure fpcxmlFree(mem: pointer); EXTDECL;
 procedure fpcxmlFree(mem: pointer); EXTDECL;
@@ -73,26 +70,6 @@ end;
  * macros from xmlversion.inc
  * macros from xmlversion.inc
  *)
  *)
 
 
-function BAD_CAST(str: pchar): xmlCharPtr;
-begin
-  result := xmlCharPtr(str);
-end;
-
-function BAD_CAST(str: string): xmlCharPtr;
-begin
-  result := xmlCharPtr(PChar(str));
-end;
-
-operator := (const S: String): xmlCharPtr; inline;
-begin
-  Result := xmlCharPtr(PChar(S));
-end;
-
-{operator := (const C: AnsiChar): xmlCharPtr; inline;
-begin
-  Result := xmlCharPtr(PChar(String(C)));
-end;}
-
 
 
 (*
 (*
  * macros from chvalid.inc
  * macros from chvalid.inc
@@ -218,7 +195,7 @@ end;
 
 
 function htmlElementAllowedHereDesc(parent: htmlElemDescPtr; elt: htmlElemDescPtr): cint;
 function htmlElementAllowedHereDesc(parent: htmlElemDescPtr; elt: htmlElemDescPtr): cint;
 begin
 begin
-  Result := htmlElementAllowedHere(parent, BAD_CAST(elt^.name));
+  Result := htmlElementAllowedHere(parent, xmlCharPtr(elt^.name));
 end;
 end;
 
 
 function htmlRequiredAttrs(elt: htmlElemDescPtr): ppchar;
 function htmlRequiredAttrs(elt: htmlElemDescPtr): ppchar;

+ 4 - 5
packages/libxml/src/xmlstring.inc

@@ -9,8 +9,8 @@
  *)
  *)
 
 
 {$IFDEF POINTER}
 {$IFDEF POINTER}
-  xmlCharPtr = ^xmlChar;
-  xmlCharPtrPtr = ^xmlCharPtr;
+  xmlCharPtr = PChar;
+  xmlCharPtrPtr = PPChar;
 {$ENDIF}
 {$ENDIF}
 
 
 {$IFDEF TYPE}
 {$IFDEF TYPE}
@@ -21,7 +21,7 @@
  * It's unsigned allowing to pinpoint case where char * are assigned
  * It's unsigned allowing to pinpoint case where char * are assigned
  * to xmlChar * (possibly making serialization back impossible).
  * to xmlChar * (possibly making serialization back impossible).
  *)
  *)
-  xmlChar = cchar;
+  xmlChar = Char;
 {$ENDIF}
 {$ENDIF}
 
 
 {$IFDEF FUNCTION}
 {$IFDEF FUNCTION}
@@ -30,8 +30,7 @@
  *
  *
  * Macro to cast a string to an xmlChar * when one know its safe.
  * Macro to cast a string to an xmlChar * when one know its safe.
  *)
  *)
-function BAD_CAST(str: pchar): xmlCharPtr; inline;
-function BAD_CAST(str: string): xmlCharPtr; inline;
+//function BAD_CAST(str: string): xmlCharPtr; inline;
 
 
 (*
 (*
  * xmlChar handling
  * xmlChar handling

File diff suppressed because it is too large
+ 446 - 194
packages/libxml/src/xmlxsd.pas


+ 2 - 0
rtl/objpas/classes/classesh.inc

@@ -737,10 +737,12 @@ type
     function ReadByte : Byte;
     function ReadByte : Byte;
     function ReadWord : Word;
     function ReadWord : Word;
     function ReadDWord : Cardinal;
     function ReadDWord : Cardinal;
+    function ReadQWord : QWord;
     function ReadAnsiString : String;
     function ReadAnsiString : String;
     procedure WriteByte(b : Byte);
     procedure WriteByte(b : Byte);
     procedure WriteWord(w : Word);
     procedure WriteWord(w : Word);
     procedure WriteDWord(d : Cardinal);
     procedure WriteDWord(d : Cardinal);
+    procedure WriteQWord(q : QWord);
     Procedure WriteAnsiString (const S : String);
     Procedure WriteAnsiString (const S : String);
     property Position: Int64 read GetPosition write SetPosition;
     property Position: Int64 read GetPosition write SetPosition;
     property Size: Int64 read GetSize write SetSize64;
     property Size: Int64 read GetSize write SetSize64;

+ 14 - 0
rtl/objpas/classes/streams.inc

@@ -345,6 +345,15 @@ end;
        ReadDWord:=d;
        ReadDWord:=d;
     end;
     end;
 
 
+  function TStream.ReadQWord: QWord;
+    var
+       q: QWord;
+    begin
+      ReadBuffer(q,8);
+      ReadQWord:=q;
+
+    end;
+
   Function TStream.ReadAnsiString : String;
   Function TStream.ReadAnsiString : String;
 
 
   Var
   Var
@@ -390,6 +399,11 @@ end;
        WriteBuffer(d,4);
        WriteBuffer(d,4);
     end;
     end;
 
 
+  procedure TStream.WriteQWord(q: QWord);
+    begin
+      WriteBuffer(q,8);
+    end;
+
 
 
 {****************************************************************************}
 {****************************************************************************}
 {*                             THandleStream                                *}
 {*                             THandleStream                                *}

+ 3 - 1
rtl/win/wininc/ascdef.inc

@@ -473,7 +473,9 @@ function DdeQueryString(_para1:DWORD; _para2:HSZ; _para3:pchar;_para4:DWORD; _pa
 function LogonUser(_para1:LPSTR; _para2:LPSTR; _para3:LPSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserA';
 function LogonUser(_para1:LPSTR; _para2:LPSTR; _para3:LPSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserA';
 function CreateProcessAsUser(_para1:HANDLE; _para2:LPCTSTR; _para3:LPTSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCTSTR;
 function CreateProcessAsUser(_para1:HANDLE; _para2:LPCTSTR; _para3:LPTSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCTSTR;
   _para10:LPSTARTUPINFO; _para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserA';
   _para10:LPSTARTUPINFO; _para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserA';
-
+function FindFirstFileEx(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external name 'FindFirstFileExA';
+// winver>$0600
+function FindFirstFileTransacted(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external name 'FindFirstFileTransactedA';
 {$endif read_interface}
 {$endif read_interface}
 
 
 
 

+ 3 - 0
rtl/win/wininc/ascfun.inc

@@ -477,6 +477,9 @@ function CreateProcessAsUserA(_para1:HANDLE; _para2:LPCTSTR; _para3:LPTSTR; _par
   _para10:LPSTARTUPINFO; _para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserA';
   _para10:LPSTARTUPINFO; _para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserA';
 function CreateWaitableTimerA(lpTimerAttributes :LPSECURITY_ATTRIBUTES; bManualReset:BOOl;lpTimerName:LPCTSTR):THandle;external 'kernel32' name 'CreateWaitableTimerA'; 
 function CreateWaitableTimerA(lpTimerAttributes :LPSECURITY_ATTRIBUTES; bManualReset:BOOl;lpTimerName:LPCTSTR):THandle;external 'kernel32' name 'CreateWaitableTimerA'; 
 function OpenWaitableTimerA(dwDesiredAccess:DWORD;bInheritHandle:BOOL;lpTimerName:LPCTSTR):THandle;external 'kernel32' name 'OpenWaitableTimerA'; 
 function OpenWaitableTimerA(dwDesiredAccess:DWORD;bInheritHandle:BOOL;lpTimerName:LPCTSTR):THandle;external 'kernel32' name 'OpenWaitableTimerA'; 
+function FindFirstFileExA(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external name 'FindFirstFileExA';
+// winver>$0600
+function FindFirstFileTransactedA(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external name 'FindFirstFileTransactedA';
 
 
 {$endif read_interface}
 {$endif read_interface}
 
 

+ 11 - 0
rtl/win/wininc/base.inc

@@ -345,6 +345,17 @@
 
 
      tagTOKEN_TYPE = TOKEN_TYPE;
      tagTOKEN_TYPE = TOKEN_TYPE;
 
 
+    _FINDEX_INFO_LEVELS = (FindExInfoStandard,FindExInfoBasic,FindExInfoMaxInfoLevel);
+    _FINDEX_SEARCH_OPS  = (FindExSearchNameMatch, FindExSearchLimitToDirectories,
+ 			   FindExSearchLimitToDevices, FindExSearchMaxSearchOp);
+    TFINDEX_INFO_LEVELS = _FINDEX_INFO_LEVELS;
+    FINDEX_INFO_LEVELS  = _FINDEX_INFO_LEVELS;
+    PFINDEX_INFO_LEVELS = ^TFINDEX_INFO_LEVELS;
+    TFINDEX_SEARCH_OPS  = _FINDEX_SEARCH_OPS;
+    FINDEX_SEARCH_OPS   = _FINDEX_SEARCH_OPS;
+    PFINDEX_SEARCH_OPS  = ^TFINDEX_SEARCH_OPS;
+
+
  {
  {
    Macros
    Macros
  }
  }

+ 6 - 3
rtl/win/wininc/defines.inc

@@ -1681,9 +1681,9 @@
      SIF_RANGE = 1;
      SIF_RANGE = 1;
      SIF_DISABLENOSCROLL = 8;
      SIF_DISABLENOSCROLL = 8;
   { GetStdHandle  }
   { GetStdHandle  }
-     STD_INPUT_HANDLE = HANDLE(-10);
-     STD_OUTPUT_HANDLE = HANDLE(-11);
-     STD_ERROR_HANDLE = HANDLE(-12);
+     STD_INPUT_HANDLE = DWORD(-10);
+     STD_OUTPUT_HANDLE = DWORD(-11);
+     STD_ERROR_HANDLE = DWORD(-12);
 
 
      INVALID_HANDLE_VALUE = HANDLE(-1);
      INVALID_HANDLE_VALUE = HANDLE(-1);
 
 
@@ -5644,6 +5644,9 @@ const
   DMDO_180        = 2;
   DMDO_180        = 2;
   DMDO_270        = 3;
   DMDO_270        = 3;
 
 
+  FIND_FIRST_EX_CASE_SENSITIVE   = $00000001;
+  FIND_FIRST_EX_LARGE_FETCH      = $00000002;
+
 {$endif read_interface}
 {$endif read_interface}
 
 
 {$ifdef read_implementation}
 {$ifdef read_implementation}

+ 5 - 0
rtl/win/wininc/unidef.inc

@@ -467,6 +467,11 @@ function DdeQueryString(_para1:DWORD; _para2:HSZ; _para3:LPCWSTR; _para4:DWORD;
 function LogonUser(_para1:LPWSTR; _para2:LPWSTR; _para3:LPWSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserW';
 function LogonUser(_para1:LPWSTR; _para2:LPWSTR; _para3:LPWSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserW';
 function CreateProcessAsUser(_para1:HANDLE; _para2:LPCWSTR; _para3:LPWSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCWSTR;
 function CreateProcessAsUser(_para1:HANDLE; _para2:LPCWSTR; _para3:LPWSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCWSTR;
   _para10:LPSTARTUPINFO;_para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserW';
   _para10:LPSTARTUPINFO;_para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserW';
+
+function FindFirstFileEx(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external name 'FindFirstFileExW';
+// winver>$0600 
+function FindFirstFileTransacted(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external name 'FindFirstFileTransactedW';
+
 {$endif read_interface}
 {$endif read_interface}
 
 
 
 

+ 5 - 0
rtl/win/wininc/unifun.inc

@@ -476,6 +476,11 @@ function CreateProcessAsUserW(_para1:HANDLE; _para2:LPCWSTR; _para3:LPWSTR; _par
   _para10:LPSTARTUPINFO;_para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserW';
   _para10:LPSTARTUPINFO;_para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserW';
 function CreateWaitableTimerW(lpTimerAttributes :LPSECURITY_ATTRIBUTES; bManualReset:BOOl;lpTimerName:LPWSTR):THandle;external 'kernel32' name 'CreateWaitableTimerW'; 
 function CreateWaitableTimerW(lpTimerAttributes :LPSECURITY_ATTRIBUTES; bManualReset:BOOl;lpTimerName:LPWSTR):THandle;external 'kernel32' name 'CreateWaitableTimerW'; 
 function OpenWaitableTimerW(dwDesiredAccess:DWORD;bInheritHandle:BOOL;lpTimerName:LPWSTR):THandle;external 'kernel32' name 'OpenWaitableTimerW'; 
 function OpenWaitableTimerW(dwDesiredAccess:DWORD;bInheritHandle:BOOL;lpTimerName:LPWSTR):THandle;external 'kernel32' name 'OpenWaitableTimerW'; 
+
+function FindFirstFileExW(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external name 'FindFirstFileExW';
+// winver>$0600 
+function FindFirstFileTransactedW(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external name 'FindFirstFileTransactedW';
+
 {$endif read_interface}
 {$endif read_interface}
 
 
 
 

+ 6 - 3
rtl/win64/system.pp

@@ -93,6 +93,7 @@ var
   argv : ppchar;
   argv : ppchar;
 { Win32 Info }
 { Win32 Info }
   startupinfo : tstartupinfo;
   startupinfo : tstartupinfo;
+  StartupConsoleMode : dword;
   hprevinst,
   hprevinst,
   MainInstance : qword;
   MainInstance : qword;
   cmdshow     : longint;
   cmdshow     : longint;
@@ -106,13 +107,13 @@ const
   Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
-  
+
 Const
 Const
-  { it can be discussed whether fmShareDenyNone means read and write or read, write and delete, see 
+  { it can be discussed whether fmShareDenyNone means read and write or read, write and delete, see
     also http://bugs.freepascal.org/view.php?id=8898, this allows users to configure the used
     also http://bugs.freepascal.org/view.php?id=8898, this allows users to configure the used
 	value
 	value
   }
   }
-  fmShareDenyNoneFlags : DWord = 3;  
+  fmShareDenyNoneFlags : DWord = 3;
 
 
 implementation
 implementation
 
 
@@ -425,12 +426,14 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
      system_exit;
      system_exit;
   end;
   end;
 
 
+function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): Boolean; stdcall; external 'kernel32' name 'GetConsoleMode';
 
 
 function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntryInformation){$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} : longbool;forward;
 function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntryInformation){$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} : longbool;forward;
 
 
 procedure _FPC_mainCRTStartup;stdcall;public name '_mainCRTStartup';
 procedure _FPC_mainCRTStartup;stdcall;public name '_mainCRTStartup';
 begin
 begin
   IsConsole:=true;
   IsConsole:=true;
+  GetConsoleMode(GetStdHandle((Std_Input_Handle)),StartupConsoleMode);
   Exe_entry;
   Exe_entry;
 end;
 end;
 
 

+ 9 - 3
utils/fpcm/fpcmwr.pp

@@ -522,6 +522,7 @@ implementation
         procedure AddPackage(const pack,prefix:string);
         procedure AddPackage(const pack,prefix:string);
         var
         var
           packdirvar,unitdirvar : string;
           packdirvar,unitdirvar : string;
+          fpcmadedirvar : string;
         begin
         begin
           FOutput.Add('ifdef '+Prefix+VarName(pack));
           FOutput.Add('ifdef '+Prefix+VarName(pack));
           { create needed variables }
           { create needed variables }
@@ -537,9 +538,14 @@ implementation
           FOutput.Add(unitdirvar+'=$('+packdirvar+')');
           FOutput.Add(unitdirvar+'=$('+packdirvar+')');
           FOutput.Add('endif');
           FOutput.Add('endif');
           FOutput.Add('ifdef CHECKDEPEND');
           FOutput.Add('ifdef CHECKDEPEND');
-          FOutput.Add('$('+packdirvar+')/$(FPCMADE):');
-          FOutput.Add(#9'$(MAKE) -C $('+packdirvar+') $(FPCMADE)');
-          FOutput.Add('override ALLDEPENDENCIES+=$('+packdirvar+')/$(FPCMADE)');
+          { rtl needs special handling for FPCMADE }
+          if pack='rtl' then
+            fpcmadedirvar:='/$(OS_TARGET)'
+          else
+            fpcmadedirvar:='';
+          FOutput.Add('$('+packdirvar+')'+fpcmadedirvar+'/$(FPCMADE):');
+          FOutput.Add(#9'$(MAKE) -C $('+packdirvar+')'+fpcmadedirvar+' $(FPCMADE)');
+          FOutput.Add('override ALLDEPENDENCIES+=$('+packdirvar+')'+fpcmadedirvar+'/$(FPCMADE)');
           FOutput.Add('endif');
           FOutput.Add('endif');
           { Package dir doesn't exists, check unit dir }
           { Package dir doesn't exists, check unit dir }
           FOutput.Add('else');
           FOutput.Add('else');

Some files were not shown because too many files changed in this diff