* rebase to trunk@17295avr

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/avr@17296 3ad0048d-3df7-0310-abae-a5850022a9f2

6 files changed, 72 insertions, 41 deletions

diff --git a/packages/fcl-db/src/base/fields.inc b/packages/fcl-db/src/base/fields.inc
index 5b0e8b1b8b..66f5bc7d15 100644
--- a/packages/fcl-db/src/base/fields.inc
+++ b/packages/fcl-db/src/base/fields.inc
@@ -819,7 +819,13 @@ procedure TField.SetData(Buffer: Pointer; NativeFormat : Boolean);
 
 begin
   If Not Assigned(FDataset) then
-    EDatabaseError.CreateFmt(SNoDataset,[FieldName]);
+    DatabaseErrorFmt(SNoDataset,[FieldName]);
+  if (FieldNo>0) and not (FDataSet.State in [dsSetKey, dsFilter]) then
+    begin
+    if ReadOnly then 
+      DatabaseErrorFmt(SReadOnlyField, [DisplayName], Self); 
+    Validate(Buffer);
+    end;
   FDataSet.SetFieldData(Self,Buffer, NativeFormat);
 end;
 
@@ -1070,7 +1076,7 @@ function TStringField.GetDataSize: Integer;
 
 begin
   if DataType=ftFixedChar then
-    Result:=Size
+    Result:=Size+1
   else
     Result:=Size+1;
 end;
@@ -2475,28 +2481,23 @@ end;
 procedure TFMTBCDField.GetText(var TheText: string; ADisplayText: Boolean);
 var
   bcd: TBCD;
-  E: double; //remove when formatBCD,BCDToStrF in fmtbcd.pp will be implemented
   fmt: String;
 begin
   if GetData(@bcd) then begin
-    E:=BCDToDouble(bcd);
     if aDisplayText or (FEditFormat='') then
       fmt := FDisplayFormat
     else
       fmt := FEditFormat;
     if fmt<>'' then
-      TheText := FormatFloat(fmt,E)
-      //TheText := FormatBCD(fmt,bcd)
+      TheText := BCDToStr(bcd)
+      //TheText := FormatBCD(fmt,bcd) //uncomment when formatBCD in fmtbcd.pp will be implemented
     else if fCurrency then begin
       if aDisplayText then
-        TheText := FloatToStrF(E, ffCurrency, FPrecision, 2{digits?})
-        //TheText := BcdToStrF(bcd, ffCurrency, FPrecision, 2{digits?})
+        TheText := BcdToStrF(bcd, ffCurrency, FPrecision, 2)
       else
-        TheText := FloatToStrF(E, ffFixed, FPrecision, 2{digits?});
-        //TheText := BcdToStrF(bcd, ffFixed, FPrecision, 2{digits?});
+        TheText := BcdToStrF(bcd, ffFixed, FPrecision, 2);
     end else
-      TheText := BcdToStr(bcd);
-      //TheText := BcdToStrF(bcd, ffGeneral, FPrecision, FSize);
+      TheText := BcdToStrF(bcd, ffGeneral, FPrecision, FSize);
   end else
     TheText := '';
 end;
diff --git a/packages/fcl-db/src/memds/memds.pp b/packages/fcl-db/src/memds/memds.pp
index d109fd4547..f7807f68d0 100644
--- a/packages/fcl-db/src/memds/memds.pp
+++ b/packages/fcl-db/src/memds/memds.pp
@@ -11,8 +11,10 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$IFDEF FPC}
 {$mode objfpc}
 {$H+}
+{$ENDIF}
 {
   TMemDataset : In-memory dataset.
   - Has possibility to copy Structure/Data from other dataset.
@@ -37,6 +39,10 @@ const
   smData      = 2;
 
 type
+  {$IFNDEF FPC}
+  ptrint = Integer;
+  {$ENDIF}
+
   MDSError=class(Exception);
 
   PRecInfo=^TMTRecInfo;
@@ -63,6 +69,9 @@ type
     FFilterBuffer: PChar;
     ffieldoffsets: PInteger;
     ffieldsizes: PInteger;
+    function GetCharPointer(p:PChar; Pos:Integer):PChar;
+    function GetIntegerPointer(p:PInteger; Pos:Integer):PInteger;
+
     procedure calcrecordlayout;
     function  MDSGetRecordOffset(ARecNo: integer): longint;
     function  MDSGetFieldOffset(FieldNo: integer): integer;
@@ -123,16 +132,16 @@ type
 
     Function  DataSize : Integer;
 
-    procedure Clear(ClearDefs : Boolean);
-    procedure Clear;
-    Procedure SaveToFile(AFileName : String);
-    Procedure SaveToFile(AFileName : String; SaveData : Boolean);
-    Procedure SaveToStream(F : TStream);
-    Procedure SaveToStream(F : TStream; SaveData : Boolean);
+    procedure Clear(ClearDefs : Boolean);{$IFNDEF FPC} overload; {$ENDIF}
+    procedure Clear;{$IFNDEF FPC} overload; {$ENDIF}
+    Procedure SaveToFile(AFileName : String);{$IFNDEF FPC} overload; {$ENDIF}
+    Procedure SaveToFile(AFileName : String; SaveData : Boolean);{$IFNDEF FPC} overload; {$ENDIF}
+    Procedure SaveToStream(F : TStream); {$IFNDEF FPC} overload; {$ENDIF}
+    Procedure SaveToStream(F : TStream; SaveData : Boolean);{$IFNDEF FPC} overload; {$ENDIF}
     Procedure LoadFromStream(F : TStream);
     Procedure LoadFromFile(AFileName : String);
-    Procedure CopyFromDataset(DataSet : TDataSet);
-    Procedure CopyFromDataset(DataSet : TDataSet; CopyData : Boolean);
+    Procedure CopyFromDataset(DataSet : TDataSet); {$IFNDEF FPC} overload; {$ENDIF}
+    Procedure CopyFromDataset(DataSet : TDataSet; CopyData : Boolean); {$IFNDEF FPC} overload; {$ENDIF}
 
     Property FileModified : Boolean Read FFileModified;
 
@@ -284,7 +293,7 @@ end;
 
 function TMemDataset.MDSGetFieldOffset(FieldNo: integer): integer;
 begin
- result:= ffieldoffsets[fieldno-1];
+ result:= getIntegerpointer(ffieldoffsets, fieldno-1)^;
 end;
 
 Procedure TMemDataset.RaiseError(Fmt : String; Args : Array of const);
@@ -300,6 +309,7 @@ begin
  dt1:= FieldDefs.Items[FieldNo-1].Datatype;
  case dt1 of
   ftString:   result:=FieldDefs.Items[FieldNo-1].Size+1;
+  ftFixedChar:result:=FieldDefs.Items[FieldNo-1].Size+1;
   ftBoolean:  result:=SizeOf(Wordbool);
   ftFloat:    result:=SizeOf(Double);
   ftLargeInt: result:=SizeOf(int64);
@@ -705,7 +715,7 @@ begin
           not getfieldisnull(pointer(srcbuffer),I);
  if result and (buffer <> nil) then 
    begin
-   Move((SrcBuffer+ffieldoffsets[I])^, Buffer^,FFieldSizes[I]);
+   Move(getcharpointer(SrcBuffer,getintegerpointer(ffieldoffsets,I)^)^, Buffer^,GetIntegerPointer(FFieldSizes, I)^);
    end;
 end;
 
@@ -723,10 +733,10 @@ begin
    else 
      begin 
      unsetfieldisnull(pointer(destbuffer),I);
-     J:=FFieldSizes[I];
+     J:=GetIntegerPointer(FFieldSizes, I)^;
      if Field.DataType=ftString then
        Dec(J); // Do not move terminating 0, which is in the size.
-     Move(Buffer^,(DestBuffer+FFieldOffsets[I])^,J);
+     Move(Buffer^,GetCharPointer(DestBuffer, getIntegerPointer(FFieldOffsets, I)^)^,J);
      dataevent(defieldchange,ptrint(field));
      end;
    end;
@@ -842,18 +852,22 @@ begin
  // Avoid mem-leak if CreateTable is called twice
  FreeMem(ffieldoffsets);
  Freemem(ffieldsizes);
-
+ {$IFDEF FPC}
  FFieldOffsets:=getmem(Count*sizeof(integer));
  FFieldSizes:=getmem(Count*sizeof(integer));
+ {$ELSE}
+ getmem(FFieldOffsets, Count*sizeof(integer));
+ getmem(FFieldSizes, Count*sizeof(integer));
+ {$ENDIF}
  FRecSize:= (Count+7) div 8; //null mask
 {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  FRecSize:=Align(FRecSize,4);
 {$ENDIF}
  for i:= 0 to Count-1 do
    begin
-   ffieldoffsets[i] := frecsize;
-   ffieldsizes[i] := MDSGetbufferSize(i+1);
-   FRecSize:= FRecSize+FFieldSizes[i];
+   GetIntegerPointer(ffieldoffsets, i)^ := frecsize;
+   GetIntegerPointer(ffieldsizes,   i)^ := MDSGetbufferSize(i+1);
+   FRecSize:= FRecSize+GetIntegerPointeR(FFieldSizes, i)^;
    end;
 end;
 
@@ -964,6 +978,7 @@ begin
                 ftInteger  : F1.AsInteger:=F2.AsInteger;
                 ftDate     : F1.AsDateTime:=F2.AsDateTime;
                 ftTime     : F1.AsDateTime:=F2.AsDateTime;
+                ftDateTime : F1.AsDateTime:=F2.AsDateTime;
               end;
               end;
             Try
@@ -986,4 +1001,16 @@ begin
     end;
 end;
 
+function TMemDataset.GetCharPointer(p:PChar; Pos:Integer):PChar;
+begin
+  Result:=p;
+  inc(Result, Pos);
+end;
+
+function TMemDataset.GetIntegerPointer(p:PInteger; Pos:Integer):PInteger;
+begin
+  Result:=p;
+  inc(Result, Pos);
+end;
+
 end.
diff --git a/packages/fcl-db/src/sqldb/mysql/mysql50conn.pas b/packages/fcl-db/src/sqldb/mysql/mysql50conn.pas
index a3695ad929..80e3994d91 100644
--- a/packages/fcl-db/src/sqldb/mysql/mysql50conn.pas
+++ b/packages/fcl-db/src/sqldb/mysql/mysql50conn.pas
@@ -4,6 +4,7 @@
 
 unit mysql50conn;
 
+{$DEFINE MYSQL50_up}
 {$DEFINE MYSQL50}
 
 {$i mysqlconn.inc}
diff --git a/packages/fcl-db/src/sqldb/mysql/mysql51conn.pas b/packages/fcl-db/src/sqldb/mysql/mysql51conn.pas
index 9088bc80f4..41bbc113b0 100644
--- a/packages/fcl-db/src/sqldb/mysql/mysql51conn.pas
+++ b/packages/fcl-db/src/sqldb/mysql/mysql51conn.pas
@@ -4,6 +4,8 @@
 
 unit mysql51conn;
 
+{$DEFINE MYSQL50_UP}
+{$DEFINE MYSQL51_UP}
 {$DEFINE MYSQL51}
 
 {$i mysqlconn.inc}
diff --git a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
index 0ed85ff45c..8f6f7a61e2 100644
--- a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
+++ b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
@@ -188,12 +188,8 @@ const
      'MYSQL_OPT_USE_REMOTE_CONNECTION','MYSQL_OPT_USE_EMBEDDED_CONNECTION',
      'MYSQL_OPT_GUESS_CONNECTION','MYSQL_SET_CLIENT_IP',
      'MYSQL_SECURE_AUTH'
-{$IFDEF MYSQL50}
+{$IFDEF MYSQL50_UP}
      ,'MYSQL_REPORT_DATA_TRUNCATION', 'MYSQL_OPT_RECONNECT'
-{$ELSE}     
-  {$IFDEF MYSQL51}
-     ,'MYSQL_REPORT_DATA_TRUNCATION', 'MYSQL_OPT_RECONNECT'
-  {$ENDIF}     
 {$ENDIF}
      );
 
@@ -559,7 +555,7 @@ begin
       NewType := ftInteger;
       NewSize := 0;
       end;
-{$ifdef mysql50}
+{$ifdef mysql50_up}
     FIELD_TYPE_NEWDECIMAL,
 {$endif}
     FIELD_TYPE_DECIMAL: if ADecimals < 5 then
@@ -867,7 +863,7 @@ begin
         VL := 0;
       Move(VL, Dest^, SizeOf(LargeInt));
       end;
-{$ifdef mysql50}
+{$ifdef mysql50_up}
     FIELD_TYPE_NEWDECIMAL,
 {$endif}      
     FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
diff --git a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp b/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
index 664b8a2bd9..d40e9a9398 100644
--- a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
+++ b/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
@@ -546,7 +546,7 @@ begin
       FPrepared := True;
       end
     else
-      statement := buf;
+      statement := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psPostgreSQL);
     end;
 end;
 
@@ -561,10 +561,11 @@ begin
       res := pqexec(tr.PGConn,pchar('deallocate prepst'+nr));
       if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
         begin
+          pqclear(res);
+          DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
+        end
+      else
         pqclear(res);
-        DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
-        end;
-      pqclear(res);
       end;
     FPrepared := False;
     end;
@@ -641,9 +642,12 @@ begin
         s := Statement;
       res := pqexec(tr.PGConn,pchar(s));
       if (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
-        pqclear(res);
+        begin
+          pqclear(res); 
+          res:=nil;
+        end;
       end;
-    if not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
+    if assigned(res) and not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
       begin
       s := PQerrorMessage(tr.PGConn);
       pqclear(res);