Merged revisions 6846-6847,6850-6852,6857-6858 via svnmerge from

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

........
r6846 | jonas | 2007-03-14 17:04:50 +0100 (Wed, 14 Mar 2007) | 2 lines

  * fixed range errors when reading zero-length strings from streams

........
r6847 | jonas | 2007-03-14 18:04:15 +0100 (Wed, 14 Mar 2007) | 2 lines

  * fixed real:=variant for non-x86

........
r6850 | jonas | 2007-03-14 18:32:16 +0100 (Wed, 14 Mar 2007) | 3 lines

  * fixed overflow when calculating the byte offset of a field in case
    of very large records (e.g. a record of 1GB on a 32 bit system)

........
r6851 | jonas | 2007-03-14 19:27:01 +0100 (Wed, 14 Mar 2007) | 3 lines

  * fixed test according to Kylix behaviour (which means current
    FPC behaviour is wrong)

........
r6852 | jonas | 2007-03-14 20:42:01 +0100 (Wed, 14 Mar 2007) | 3 lines

  * fixed overflow for constant in-expressions involving values >
    high(uinttype) on the left side

........
r6857 | jonas | 2007-03-14 20:47:53 +0100 (Wed, 14 Mar 2007) | 2 lines

  * fixed several range errors

........
r6858 | jonas | 2007-03-14 20:48:08 +0100 (Wed, 14 Mar 2007) | 2 lines

  * fixed range error in incmonth()

........

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

.gitattributes

@@ -7125,6 +7125,7 @@ tests/webtbf/tw3716.pp svneol=native#text/plain
 tests/webtbf/tw3738.pp svneol=native#text/plain
 tests/webtbf/tw3740.pp svneol=native#text/plain
 tests/webtbf/tw3790.pp svneol=native#text/plain
+tests/webtbf/tw3930a.pp svneol=native#text/plain
 tests/webtbf/tw3931b.pp svneol=native#text/plain
 tests/webtbf/tw3969.pp svneol=native#text/plain
 tests/webtbf/tw4103.pp svneol=native#text/plain

compiler/dbgstabs.pas

@@ -353,7 +353,7 @@ implementation
               varsize:=$fffffff;
             newrec:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)),
                                      spec+def_stab_number(tfieldvarsym(p).vardef),
-                                     tostr(tfieldvarsym(p).fieldoffset*8),tostr(varsize*8)]);
+                                     tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)*8),tostr(varsize*8)]);
             if state^.stabsize+strlen(newrec)>=state^.staballoc-256 then
               begin
                 inc(state^.staballoc,strlen(newrec)+64);

compiler/nset.pas

@@ -286,8 +286,17 @@ implementation
            begin
              if (right.nodetype=setconstn) then
                begin
-                 t:=cordconstnode.create(byte(tordconstnode(left).value in Tsetconstnode(right).value_set^),
-                   booltype,true);
+                 { tordconstnode.value is int64 -> signed -> the expression }
+                 { below will be converted to longint on 32 bit systems due }
+                 { to the rule above -> will give range check error if      }
+                 { value > high(longint) if we don't take the signedness    }
+                 { into account                                             }
+                 if is_signed(left.resultdef) then
+                   t:=cordconstnode.create(byte(tordconstnode(left).value in Tsetconstnode(right).value_set^),
+                     booltype,true)
+                 else
+                   t:=cordconstnode.create(byte(TConstExprUInt(tordconstnode(left).value) in Tsetconstnode(right).value_set^),
+                     booltype,true);                   
                  typecheckpass(t);
                  result:=t;
                  exit;

rtl/inc/variant.inc

@@ -462,7 +462,7 @@ end;
 {$ifndef VER2_0}
 operator :=(const source : variant) dest : real;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
-  dest:=comp(variantmanager.vartoreal(source));
+  dest:=variantmanager.vartoreal(source);
 end;
 {$endif VER2_0}
 

rtl/objpas/sysutils/dati.inc

@@ -264,8 +264,8 @@ end;
 
 function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
 var
+  TempMonth, S: Integer;
   Year, Month, Day : word;
-  S : Integer;
 begin
   If NumberOfMonths>=0 then
     s:=1
@@ -273,13 +273,14 @@ begin
     s:=-1;
   DecodeDate(DateTime, Year, Month, Day);
   inc(Year,(NumberOfMonths div 12));
-  inc(Month,(NumberOfMonths mod 12)-1); // Mod result always positive
-  if Month>11 then
+  TempMonth:=Month+(NumberOfMonths mod 12)-1;
+  if (TempMonth>11) or
+     (TempMonth<0) then
    begin
-     Dec(Month, S*12);
+     Dec(TempMonth, S*12);
      Inc(Year, S);
    end;
-  Inc(Month);                            {   Months from 1 to 12   }
+  Month:=TempMonth+1;          {   Months from 1 to 12   }
   If (Day>MonthDays[IsLeapYear(Year)][Month]) then
     Day:=MonthDays[IsLeapYear(Year)][Month];
   result := Frac(DateTime) + DoEncodeDate(Year, Month, Day);

rtl/objpas/sysutils/sysstr.inc

@@ -2641,7 +2641,7 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
   function GetInt(unsigned : boolean=false) : Integer;
     begin
       s1 := '';
-      while (s[n] = ' ')  and (Length(s) > n) do
+      while (Length(s) > n) and (s[n] = ' ') do
         inc(n);
       { read sign }
       if (Length(s)>= n) and (s[n] in ['+', '-']) then
@@ -2659,8 +2659,8 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
             end;
         end;
       { read numbers }
-      while (s[n] in ['0'..'9'])
-        and (Length(s) >= n) do
+      while (Length(s) >= n) and
+            (s[n] in ['0'..'9']) do
         begin
           s1 := s1+s[n];
           inc(n);
@@ -2672,10 +2672,10 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
   function GetFloat : Integer;
     begin
       s1 := '';
-      while (s[n] = ' ')  and (Length(s) > n) do
+      while (Length(s) > n) and (s[n] = ' ')  do
         inc(n);
-      while (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E'])
-        and (Length(s) >= n) do
+      while (Length(s) >= n) and
+            (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
         begin
           s1 := s1+s[n];
           inc(n);
@@ -2687,9 +2687,9 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
   function GetString : Integer;
     begin
       s1 := '';
-      while (s[n] = ' ')  and (Length(s) > n) do
+      while (Length(s) > n) and (s[n] = ' ') do
         inc(n);
-      while (s[n] <> ' ') and (Length(s) >= n) do
+      while (Length(s) >= n) and (s[n] <> ' ')do
         begin
           s1 := s1+s[n];
           inc(n);
@@ -2700,7 +2700,7 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
 
   function ScanStr(c : Char) : Boolean;
     begin
-      while (s[n] <> c) and (Length(s) > n) do
+      while (Length(s) > n) and (s[n] <> c) do
         inc(n);
       inc(n);
       If (n <= Length(s)) then
@@ -2716,7 +2716,7 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
       while true do
         begin
 
-          while (fmt[m] = ' ') and (Length(fmt) > m) do
+          while (Length(fmt) > m) and (fmt[m] = ' ') do
             inc(m);
 
           if (m >= Length(fmt)) then

tests/webtbf/tw3930a.pp

@@ -0,0 +1,25 @@
+{ %fail }
+
+{ Gives under Kylix:
+
+tw3930a.pp(22) Error: Incompatible types: 'TMyStringList' and 'TStringList'
+
+}
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+uses
+  Classes;
+  
+type
+  TMyStringList = type TStringlist;
+  
+var
+  list : TMyStringList;
+
+begin
+  list:=TMyStringList.Create;
+end.
+
+    

tests/webtbs/tw3930.pp

@@ -1,19 +1,20 @@
-{$mode objfpc}
-uses
-  classes;
-  
-type
-  TMyStringList = type TStringlist;
-  
-var
-  list : TMyStringList;
-
-begin
-  list:=TMyStringList.Create;
-  list.Free;
-  if pointer(TMyStringList)=pointer(TStringList) then
-    halt(1);
-  writeln('ok');
-end.
-
-    
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+uses
+  Classes;
+  
+type
+  TMyStringList = type TStringlist;
+  
+var
+  list : TMyStringList;
+
+begin
+  TMyStringList.Create.Free;
+  if pointer(TMyStringList)<>pointer(TStringList) then
+    halt(1);
+  writeln('ok');
+end.
+
+