Merged revisions 6816,6824,6842-6843,6864-6866,6868-6869,6872,6882-6883,6889,6891,6893-6894,6896,6898,6901-6903,6908,6916,6921-6922,6924-6925,6927-6928,6930,6943-6946,6952,6954,6956,6974,6976,6996-6997,7002,7007,7016,7020-7021,7033,7037,7040,7042,7045,7068-7069,7075-7079,7087,7094,7098-7099,7101,7103,7109,7115-7119,7128,7136-7137,7139,7150,7160-7162,7175,7179,7190-7195,7198,7202,7205-7206,7208-7217,7220-7222,7225-7228,7230,7233,7239-7241,7244,7246,7263,7275,7277,7279-7281,7285,7288-7289,7291-7293,7296,7300,7303,7310,7318,7340-7341,7343,7345,7372-7373,7375-7376,7379,7381,7383-7388,7391-7392,7400,7404-7406,7411,7422,7425,7436,7441-7442,7444-7445,7450,7456,7463,7467,7475,7479,7486,7504,7506-7509,7522,7527,7534-7536,7558-7559,7563-7565,7567,7570-7571,7573-7576,7586,7589,7592-7594,7607,7612,7615,7619-7620,7622-7623,7626,7628,7631,7633,7646,7663,7677,7681-7684,7689,7697,7704-7712,7725,7736,7738,7740,7744-7746,7751,7753,7764,7767,7769-7770,7776-7777,7786,7788,7794,7802-7803,7812,7830,7836-7839,7846,7849,7862,7864-7865,7869,7872,7877,7882,7927-7929,7953,7961,7967,7971,7986-7987,7990-7994,7998-8000,8004-8006,8008-8012,8016,8027,8034,8036-8037,8039,8044,8046,8048,8051,8060,8071,8075-8076,8080,8082-8083,8087-8089,8095-8096,8099-8101,8121,8136,8187,8190,8203,8206-8207,8212-8213,8215,8225,8227,8233-8239,8262,8302,8307,8309,8316,8318-8319,8336,8338-8340,8366,8404,8410-8411,8415 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
  r6816 | jonas | 2007-03-13 09:35:08 +0100 (Tue, 13 Mar 2007) | 2 lines
  
    * fixed 64 bit compilation
........
  r7684 | florian | 2007-06-16 18:56:27 +0200 (Sat, 16 Jun 2007) | 2 lines
  
  + start of D7 compatible tlist.assign
........
  r7786 | tom_at_work | 2007-06-23 21:01:57 +0200 (Sat, 23 Jun 2007) | 1 line
  
  * fix compilation on non-windows platforms
........
  r7794 | florian | 2007-06-24 17:15:53 +0200 (Sun, 24 Jun 2007) | 2 lines
  
  + ReplaceDate
........
  r7802 | florian | 2007-06-24 22:30:22 +0200 (Sun, 24 Jun 2007) | 2 lines
  
  * made CheckSynchronize a function returning info about a method being executed
........
  r7803 | florian | 2007-06-24 22:30:55 +0200 (Sun, 24 Jun 2007) | 2 lines
  
  + StrNextChar implemented
........
  r7812 | florian | 2007-06-25 22:18:00 +0200 (Mon, 25 Jun 2007) | 2 lines
  
  * made TShiftState a packed set to be more compatible
........
  r8080 | Almindor | 2007-07-16 23:47:31 +0200 (Mon, 16 Jul 2007) | 2 lines
  
  * fix AssignFile to use "out" if the PARAMOUT define is defined (fixes 9275)
........
  r8101 | michael | 2007-07-19 10:03:53 +0200 (Thu, 19 Jul 2007) | 1 line
  
  * Added ssExtra1,ssExtra2 to TShiftStateEnum at the request of Marc Weustinc
........
  r8121 | florian | 2007-07-21 22:19:29 +0200 (Sat, 21 Jul 2007) | 2 lines
  
  + added some constants missed for compatibility, resolves #9182
........
  r8366 | marco | 2007-09-03 15:24:26 +0200 (Mon, 03 Sep 2007) | 2 lines
  
   * fix for 9588
........
  r8415 | jonas | 2007-09-09 14:54:04 +0200 (Sun, 09 Sep 2007) | 3 lines
  
    * fixed TReader.ReadWideChar
    * removed some unwanted widechar->char translations
........

git-svn-id: branches/fixes_2_2@8481 -

rtl/objpas/classes/bits.inc

@@ -45,7 +45,10 @@ end;
 
 procedure TBits.setSize(value : longint);
 begin
-   grow(value - 1);
+   if value=0 then
+    grow(0) // truncate
+   else
+    grow(value - 1);
 end;
 
 procedure TBits.SetBit(bit : longint; value : Boolean);

rtl/objpas/objpas.pp

@@ -50,22 +50,22 @@ Var
 
     { Untyped file support }
 
-     Procedure AssignFile(Var f:File;const Name:string);
-     Procedure AssignFile(Var f:File;p:pchar);
-     Procedure AssignFile(Var f:File;c:char);
-     Procedure CloseFile(Var f:File);
+     Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;const Name:string);
+     Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;p:pchar);
+     Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;c:char);
+     Procedure CloseFile(var f:File);
 
      { Text file support }
-     Procedure AssignFile(Var t:Text;const s:string);
-     Procedure AssignFile(Var t:Text;p:pchar);
-     Procedure AssignFile(Var t:Text;c:char);
+     Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;const s:string);
+     Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;p:pchar);
+     Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;c:char);
      Procedure CloseFile(Var t:Text);
 
      { Typed file supoort }
 
-     Procedure AssignFile(Var f:TypedFile;const Name:string);
-     Procedure AssignFile(Var f:TypedFile;p:pchar);
-     Procedure AssignFile(Var f:TypedFile;c:char);
+     Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;const Name:string);
+     Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;p:pchar);
+     Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;c:char);
 
      { ParamStr should return also an ansistring }
      Function ParamStr(Param : Integer) : Ansistring;
@@ -106,19 +106,19 @@ Var
 
 { Untyped file support }
 
-Procedure AssignFile(Var f:File;const Name:string);
+Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;const Name:string);
 
 begin
   System.Assign (F,Name);
 end;
 
-Procedure AssignFile(Var f:File;p:pchar);
+Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;p:pchar);
 
 begin
   System.Assign (F,P);
 end;
 
-Procedure AssignFile(Var f:File;c:char);
+Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:File;c:char);
 
 begin
   System.Assign (F,C);
@@ -133,19 +133,19 @@ end;
 
 { Text file support }
 
-Procedure AssignFile(Var t:Text;const s:string);
+Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;const s:string);
 
 begin
   System.Assign (T,S);
 end;
 
-Procedure AssignFile(Var t:Text;p:pchar);
+Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;p:pchar);
 
 begin
   System.Assign (T,P);
 end;
 
-Procedure AssignFile(Var t:Text;c:char);
+Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} t:Text;c:char);
 
 begin
   System.Assign (T,C);
@@ -160,19 +160,19 @@ end;
 
 { Typed file support }
 
-Procedure AssignFile(Var f:TypedFile;const Name:string);
+Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;const Name:string);
 
 begin
   system.Assign(F,Name);
 end;
 
-Procedure AssignFile(Var f:TypedFile;p:pchar);
+Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;p:pchar);
 
 begin
   system.Assign (F,p);
 end;
 
-Procedure AssignFile(Var f:TypedFile;c:char);
+Procedure AssignFile({$ifdef PARAOUTFILE}out{$else}var{$endif} f:TypedFile;c:char);
 
 begin
   system.Assign (F,C);

rtl/objpas/sysutils/dati.inc

@@ -490,14 +490,14 @@ If (i<5) and (TimeValues[I]=-1) then
   TimeValues[I]:=0;
 if PM then
   begin
-  if (TimeValues[0] <> 12) then 
+  if (TimeValues[0] <> 12) then
     Inc(TimeValues[0], 12);
   end
 else
   begin
   if (TimeValues[0]=12) then
     TimeValues[0]:=0;
-  end;   
+  end;
 result := EncodeTime(TimeValues[0], TimeValues[1], TimeValues[2], TimeValues[3]);
 end ;
 
@@ -854,7 +854,16 @@ begin
 end;
 
 procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime);inline;
-
 begin
   dati:=trunc(dati)+frac(newtime);
 end;
+
+procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); inline;
+var
+  tmp : TDateTime;
+begin
+  tmp:=NewDate;
+  ReplaceTime(tmp,DateTime);
+  DateTime:=tmp;
+end;
+

rtl/objpas/sysutils/datih.inc

@@ -140,4 +140,5 @@ function CurrentYear:Word;
 { FPC Extra }
 Procedure GetLocalTime(var SystemTime: TSystemTime);
 
-procedure  ReplaceTime(var dati:TDateTime; NewTime : TDateTime); inline;
+procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime); inline;
+procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); inline;

rtl/objpas/sysutils/sysstr.inc

@@ -942,7 +942,7 @@ begin
   Result:=StrFmt(Buffer,Fmt,Args,DefaultFormatSettings);
 end;
 
-Function StrFmt(Buffer,Fmt : PChar; Const Args: Array of const; Const FormatSettings: TFormatSettings): PChar; 
+Function StrFmt(Buffer,Fmt : PChar; Const Args: Array of const; Const FormatSettings: TFormatSettings): PChar;
 
 begin
   Buffer[FormatBuf(Buffer^,Maxint,Fmt^,strlen(fmt),args,FormatSettings)]:=#0;
@@ -1108,7 +1108,7 @@ Var
   P: Integer;
   Negative, TooSmall, TooLarge: Boolean;
   DS: Char;
-  
+
 Begin
   DS:=FormatSettings.DecimalSeparator;
   Case format Of
@@ -1612,7 +1612,7 @@ begin
   Result:=FloatToStrF(Value,ffGeneral,-1,0);
 end;
 
-function AnsiDequotedStr(const S: string; AQuote: Char): string; 
+function AnsiDequotedStr(const S: string; AQuote: Char): string;
 
 var p : pchar;
 
@@ -1670,7 +1670,7 @@ begin
   begin
     CheckStrs;
     if B then
-      Result:=TrueBoolStrs[0] 
+      Result:=TrueBoolStrs[0]
     else
       Result:=FalseBoolStrs[0];
   end
@@ -1686,7 +1686,7 @@ begin
   if not(TryStrToBool(S,Result)) then
     Result:=Default;
 end;
-  
+
 function TryStrToBool(const S: string; out Value: Boolean): Boolean;
 Var
   Temp : String;
@@ -1906,7 +1906,7 @@ Var
           End; { Case }
           End  { Begin }
         Else
-          Inc(Fmt); 
+          Inc(Fmt);
       End; { Case }
       End; { While .. Begin }
   End;
@@ -2211,7 +2211,7 @@ begin
     fvComp:
       Str(Currency(Value):23, Buffer);
   end;
-    
+
   N := 1;
   L := Byte(Buffer[0]);
   while Buffer[N]=' ' do
@@ -2466,8 +2466,8 @@ begin
   Result:=mbSingleByte;
 end;
 
-Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
 
+Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
 begin
   Result:=mbSingleByte;
 end;
@@ -2479,6 +2479,12 @@ begin
 end;
 
 
+function StrNextChar(const Str: PChar): PChar;
+begin
+  result:=Str+StrCharLength(Str);
+end;
+
+
 Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;IgnoreCase: Boolean): Boolean;
 
 Var

rtl/objpas/sysutils/sysstrh.inc

@@ -69,7 +69,7 @@ procedure AppendStr(var Dest: String; const S: string);
 function UpperCase(const s: string): string;
 function LowerCase(const s: string): string; overload;
 { the compiler can't decide else if it should use the char or the ansistring
-  version for a variant } 
+  version for a variant }
 function LowerCase(const V: variant): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function CompareStr(const S1, S2: string): Integer;
 function CompareMemRange(P1, P2: Pointer; Length: cardinal): integer;
@@ -97,7 +97,7 @@ function TrimLeft(const S: string): string;
 function TrimRight(const S: string): string;
 function QuotedStr(const S: string): string;
 function AnsiQuotedStr(const S: string; Quote: char): string;
-function AnsiDequotedStr(const S: string; AQuote: Char): string; 
+function AnsiDequotedStr(const S: string; AQuote: Char): string;
 function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string;
 function AdjustLineBreaks(const S: string): string;
 function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
@@ -124,7 +124,7 @@ Function Format (Const Fmt: string; const Args: array of const; const FormatSett
 Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const) : Cardinal;
 Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const; Const FormatSettings: TFormatSettings) : Cardinal;
 Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar;
-Function StrFmt(Buffer,Fmt : PChar; Const Args: Array of const; Const FormatSettings: TFormatSettings): PChar; 
+Function StrFmt(Buffer,Fmt : PChar; Const Args: Array of const; Const FormatSettings: TFormatSettings): PChar;
 Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar;
 Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const; Const FormatSettings: TFormatSettings) : Pchar;
 Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
@@ -219,6 +219,7 @@ Function ByteToCharLen(const S: string; MaxLen: Integer): Integer;
 Function CharToByteLen(const S: string; MaxLen: Integer): Integer;
 Function ByteToCharIndex(const S: string; Index: Integer): Integer;
 Function StrCharLength(const Str: PChar): Integer;
+function StrNextChar(const Str: PChar): PChar;
 
 
 const

rtl/objpas/sysutils/sysutilh.inc

@@ -182,7 +182,7 @@ Var
 
 type
   TTerminateProc = Function: Boolean;
-  
+
   procedure AddTerminateProc(TermProc: TTerminateProc);
   function CallTerminateProcs: Boolean;
 
@@ -237,3 +237,29 @@ Type
 
   function SafeLoadLibrary(const FileName: AnsiString;
     ErrorMode: DWord = {$ifdef windows}SEM_NOOPENFILEERRORBOX{$else windows}0{$endif windows}): HMODULE;
+
+{ some packages and unit related constants for compatibility }
+
+const
+  pfExeModule = $00000000;
+  pfNeverBuild = $00000001;
+  pfDesignOnly = $00000002;
+  pfRunOnly = $00000004;
+  pfIgnoreDupUnits = $00000008;
+  pfPackageModule = $40000000;
+  pfModuleTypeMask = $C0000000;
+  pfV3Produced =  $00000000;
+  pfProducerUndefined = $04000000;
+  pfBCB4Produced = $08000000;
+  pfDelphi4Produced = $0C000000;
+  pfLibraryModule = $80000000;
+  pfProducerMask = $0C000000;
+
+const
+  ufMainUnit     = $01;
+  ufPackageUnit  = $02;
+  ufWeakUnit     = $04;
+  ufOrgWeakUnit  = $08;
+  ufImplicitUnit = $10;
+
+  ufWeakPackageUnit = ufPackageUnit or ufWeakUnit;