--- Merging r14716 into '.':

U    tests/test/units/system/tres.pp
U    tests/test/units/system/tres3.pp
U    tests/test/units/system/tres2.pp
U    compiler/systems/i_haiku.pas
--- Merging r14754 into '.':
U    rtl/objpas/typinfo.pp
--- Merging r14811 into '.':
U    compiler/systems/t_sunos.pas
--- Merging r14813 into '.':
U    packages/gdbint/Makefile.fpc
U    packages/gdbint/Makefile
--- Merging r14833 into '.':
U    rtl/inc/ctypes.pp
--- Merging r14840 into '.':
U    rtl/inc/fexpand.inc
--- Merging r14841 into '.':
U    tests/test/units/dos/tfexpand.pp
--- Merging r14849 into '.':
G    rtl/inc/ctypes.pp
--- Merging r14873 into '.':
U    rtl/objpas/math.pp
A    tests/test/units/math/tpower.pp

# revisions: 14716,14754,14811,14813,14833,14840,14841,14849,14873
------------------------------------------------------------------------
r14716 | florian | 2010-01-17 16:10:47 +0100 (Sun, 17 Jan 2010) | 1 line
Changed paths:
   M /trunk/compiler/systems/i_haiku.pas
   M /trunk/tests/test/units/system/tres.pp
   M /trunk/tests/test/units/system/tres2.pp
   M /trunk/tests/test/units/system/tres3.pp

* patch by Olivier Coursiere to enable winlike resources on haiku, resolves #15539
------------------------------------------------------------------------
------------------------------------------------------------------------
r14754 | paul | 2010-01-20 16:17:06 +0100 (Wed, 20 Jan 2010) | 1 line
Changed paths:
   M /trunk/rtl/objpas/typinfo.pp

rtl: add TVmtFieldTable, TVmtFieldEntry to typinfo unit since delphi has that declarations too
------------------------------------------------------------------------
------------------------------------------------------------------------
r14811 | pierre | 2010-01-27 13:19:46 +0100 (Wed, 27 Jan 2010) | 1 line
Changed paths:
   M /trunk/compiler/systems/t_sunos.pas

 * correct problem for -init -fini for scripts
------------------------------------------------------------------------
------------------------------------------------------------------------
r14813 | pierre | 2010-01-27 13:30:35 +0100 (Wed, 27 Jan 2010) | 1 line
Changed paths:
   M /trunk/packages/gdbint/Makefile
   M /trunk/packages/gdbint/Makefile.fpc

 + add NO_GDBLIBINC variable to be able to disable use of -dUSE_GDBLIBINC
------------------------------------------------------------------------
------------------------------------------------------------------------
r14833 | pierre | 2010-01-30 23:19:14 +0100 (Sat, 30 Jan 2010) | 1 line
Changed paths:
   M /trunk/rtl/inc/ctypes.pp

 * Fix alignment problem for sparc arch.
------------------------------------------------------------------------
------------------------------------------------------------------------
r14840 | pierre | 2010-02-01 16:47:22 +0100 (Mon, 01 Feb 2010) | 1 line
Changed paths:
   M /trunk/rtl/inc/fexpand.inc

 * avoid problems for windows if case of drive letter is different
------------------------------------------------------------------------
------------------------------------------------------------------------
r14841 | pierre | 2010-02-01 17:52:19 +0100 (Mon, 01 Feb 2010) | 1 line
Changed paths:
   M /trunk/tests/test/units/dos/tfexpand.pp

 * ignore case of drive letter
------------------------------------------------------------------------
------------------------------------------------------------------------
r14849 | pierre | 2010-02-03 00:36:46 +0100 (Wed, 03 Feb 2010) | 1 line
Changed paths:
   M /trunk/rtl/inc/ctypes.pp

 * fix double to clongdouble conversions for 128 bits C long double
------------------------------------------------------------------------
------------------------------------------------------------------------
r14873 | florian | 2010-02-07 00:10:03 +0100 (Sun, 07 Feb 2010) | 3 lines
Changed paths:
   M /trunk/rtl/objpas/math.pp
   A /trunk/tests/test/units/math/tpower.pp

* math.power/intpower(0,0) return 1, this is as recommended in IEEE 754 
  as well as compatible with other programming languages and delphi

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

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

.gitattributes

@@ -8653,6 +8653,7 @@ tests/test/units/math/tmask.inc svneol=native#text/plain
 tests/test/units/math/tmask.pp svneol=native#text/plain
 tests/test/units/math/tmask2.pp svneol=native#text/plain
 tests/test/units/math/tnaninf.pp svneol=native#text/plain
+tests/test/units/math/tpower.pp svneol=native#text/pascal
 tests/test/units/math/ttrig1.pp svneol=native#text/plain
 tests/test/units/objects/testobj.pp svneol=native#text/plain
 tests/test/units/objects/testobj1.pp svneol=native#text/plain

compiler/systems/i_haiku.pas

@@ -36,7 +36,7 @@ unit i_haiku;
             name         : 'Haiku for i386';
             shortname    : 'Haiku';
             flags        : [tf_under_development,tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses,
-                            tf_smartlink_sections, tf_smartlink_library];
+                            tf_smartlink_sections, tf_smartlink_library, tf_has_winlike_resources];
             cpu          : cpu_i386;
             unit_env     : 'HAIKUUNITS';
             extradefines : 'BEOS;UNIX;HASUNIX';
@@ -68,7 +68,7 @@ unit i_haiku;
             link         : nil;
             linkextern   : nil;
             ar           : ar_gnu_ar;
-            res          : res_none;
+            res          : res_elf;
             dbg          : dbg_stabs;
             script       : script_unix;
             endian       : endian_little;

compiler/systems/t_sunos.pas

@@ -556,17 +556,38 @@ begin
   WriteResponseFile(true);
 
 { Create some replacements }
+{ initname and fininame may contain $, which can be wrongly interpreted
+  in a link script, thus we surround them with single quotes 
+  in cs_link_nolink is in globalswitches }
   if use_gnu_ld then
     begin
-      InitFiniStr:='-init '+exportlib.initname;
+      InitFiniStr:='-init ';
+      if cs_link_nolink in current_settings.globalswitches then
+        InitFiniStr:=InitFiniStr+''''+exportlib.initname+''''
+      else
+        InitFiniStr:=InitFiniStr+exportlib.initname;
       if (exportlib.fininame<>'') then
-        InitFiniStr:=InitFiniStr+' -fini '+exportlib.fininame;
+        begin
+          if cs_link_nolink in current_settings.globalswitches then
+            InitFiniStr:=InitFiniStr+' -fini '''+exportlib.initname+''''
+          else
+            InitFiniStr:=InitFiniStr+' -fini '+exportlib.fininame;
+        end;
     end
   else
     begin
-      InitFiniStr:='-z initarray='+exportlib.initname;
+      InitFiniStr:='-z initarray=';
+      if cs_link_nolink in current_settings.globalswitches then
+        InitFiniStr:=InitFiniStr+''''+exportlib.initname+''''
+      else
+        InitFiniStr:=InitFiniStr+exportlib.initname;
       if (exportlib.fininame<>'') then
-        InitFiniStr:=InitFiniStr+' -z finiarray='+exportlib.fininame;
+        begin
+          if cs_link_nolink in current_settings.globalswitches then
+            InitFiniStr:=InitFiniStr+' -z finiarray='''+exportlib.initname+''''
+          else
+            InitFiniStr:=InitFiniStr+' -z finiarray='+exportlib.fininame;
+        end;
     end;
 
 { Call linker }

packages/gdbint/Makefile

@@ -293,6 +293,10 @@ else
 GDBLIBINCFOUND=1
 GDBLIBINCCOND=-dUSE_GDBLIBINC
 endif
+ifdef NO_GDBLIBINC
+GDBLIBINCFOUND=0
+GDBLIBINCCOND=
+endif
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_UNITS+=gdbint gdbcon

packages/gdbint/Makefile.fpc

@@ -65,7 +65,10 @@ else
 GDBLIBINCFOUND=1
 GDBLIBINCCOND=-dUSE_GDBLIBINC
 endif
-
+ifdef NO_GDBLIBINC
+GDBLIBINCFOUND=0
+GDBLIBINCCOND=
+endif
 endif
 
 

rtl/inc/ctypes.pp

@@ -18,6 +18,7 @@
 unit ctypes;
 
 {$inline on}
+{$define dummy}
 
 interface
 
@@ -279,21 +280,48 @@ const r128_mantissa_ofs=0;
 {$else}
 const r128_mantissa_ofs=2;
       r128_exponent_ofs=0;
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+  {$define USE_UNALIGNED}
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 {$endif}
 
 operator := (const v:clongdouble) r:double;
-
-begin
-  qword(r):=(qword(Pword(@v[r128_exponent_ofs])^) shl 52) or
-            (Pqword(@v[r128_mantissa_ofs])^ shr 12);
+var
+  exp : word;
+  mant : qword;
+  is_neg : boolean;
+begin
+  is_neg:=(pword(@v[r128_exponent_ofs])^and $8000)<>0;
+  exp:=((Pword(@v[r128_exponent_ofs])^and $7fff)-$4000)+$400;
+  if is_neg then
+    exp:=exp+$800;
+{$ifdef USE_UNALIGNED}
+  mant:=unaligned(Pqword(@v[r128_mantissa_ofs])^);
+{$else not USE_UNALIGNED}
+  mant:=Pqword(@v[r128_mantissa_ofs])^;
+{$endif not USE_UNALIGNED}
+  qword(r):=(qword(exp) shl 52) or
+            (mant shr 12);
 end;
 
 operator := (const v:double) r:clongdouble;
-
-begin
-  Pword(@r[r128_exponent_ofs])^:=qword(v) shr 52;
+var
+  is_neg : boolean;
+   exp : word;
+begin
+  is_neg:=(qword(v) shr 63) <> 0;
+  exp:=$4000 + ((qword(v) shr 52) and $7ff) -$400;
+  if is_neg then
+    exp:=exp+$8000;
+  Pword(@r[r128_exponent_ofs])^:=exp;
+{$ifdef USE_UNALIGNED}
+  unaligned(Pqword(@r[r128_mantissa_ofs])^):=qword(v) shl 12;
+  Pword(@r[r128_mantissa_ofs+8])^:=0;
+  Pword(@r[r128_mantissa_ofs+10])^:=0;
+{$else not USE_UNALIGNED}
   Pqword(@r[r128_mantissa_ofs])^:=qword(v) shl 12;
   Pcardinal(@r[r128_mantissa_ofs+8])^:=0;
+{$endif not USE_UNALIGNED}
   Pword(@r[r128_mantissa_ofs+12])^:=0;
 end;
 
@@ -303,92 +331,92 @@ end;
 
 operator +(const e:Double;const c:clongdouble) r:Double;inline;
 begin
-  r:=e+c.value;
+  r:=e+double(c);
 end;
 
 operator +(const c:clongdouble;const e:Double) r:Double;inline;
 begin
-  r:=c.value+e;
+  r:=double(c)+e;
 end;
 
 operator -(const e:Double;const c:clongdouble) r:Double;inline;
 begin
-  r:=e-c.value;
+  r:=e-double(c);
 end;
 
 operator -(const c:clongdouble;const e:Double) r:Double;inline;
 begin
-  r:=c.value-e;
+  r:=double(c)-e;
 end;
 
 operator *(const e:Double;const c:clongdouble) r:Double;inline;
 begin
-  r:=e*c.value;
+  r:=e*double(c);
 end;
 
 operator *(const c:clongdouble;const e:Double) r:Double;inline;
 begin
-  r:=c.value*e;
+  r:=double(c)*e;
 end;
 
 operator /(const e:Double;const c:clongdouble) r:Double;inline;
 begin
-  r:=e/c.value;
+  r:=e/double(c);
 end;
 
 operator /(const c:clongdouble;const e:Double) r:Double;inline;
 begin
-  r:=c.value/e;
+  r:=double(c)/e;
 end;
 
 operator =(const e:Double;const c:clongdouble) r:boolean;inline;
 begin
-  r:=e=c.value;
+  r:=e=double(c);
 end;
 
 operator =(const c:clongdouble;const e:Double) r:boolean;inline;
 begin
-  r:=c.value=e;
+  r:=double(c)=e;
 end;
 
 operator <(const e:Double;const c:clongdouble) r:boolean;inline;
 begin
-  r:=e<c.value;
+  r:=e<double(c);
 end;
 
 operator <(const c:clongdouble;const e:Double) r:boolean;inline;
 begin
-  r:=c.value<e;
+  r:=double(c)<e;
 end;
 
 operator >(const e:Double;const c:clongdouble) r:boolean;inline;
 begin
-  r:=e>c.value;
+  r:=e>double(c);
 end;
 
 operator >(const c:clongdouble;const e:Double) r:boolean;inline;
 begin
-  r:=c.value>e;
+  r:=double(c)>e;
 end;
 
 operator >=(const e:Double;const c:clongdouble) r:boolean;inline;
 begin
-  r:=e>=c.value;
+  r:=e>=double(c);
 end;
 
 operator >=(const c:clongdouble;const e:Double) r:boolean;inline;
 begin
-  r:=c.value>=e;
+  r:=double(c)>=e;
 end;
 
 operator <=(const e:Double;const c:clongdouble) r:boolean;inline;
 begin
-  r:=e<=c.value;
+  r:=e<=double(c);
 end;
 
 operator <=(const c:clongdouble;const e:Double) r:boolean;inline;
 begin
-  r:=c.value<=e;
+  r:=double(c)<=e;
 end;
 {$endif}
 {$endif}

rtl/inc/fexpand.inc

@@ -207,7 +207,7 @@ begin
                     if Copy (Pa, 1, PathStart - 2) = Copy (S, 1, PathStart - 2)
                                                                            then
   {$ELSE FPC_FEXPAND_VOLUMES}
-                    if Pa [1] = S [1] then
+                    if UpCase(Pa [1]) = UpCase(S [1]) then
   {$ENDIF FPC_FEXPAND_VOLUMES}
                         begin
                             { remove ending slash if it already exists }

rtl/objpas/math.pp

@@ -102,7 +102,7 @@ interface
 
        tpaymenttime = (ptendofperiod,ptstartofperiod);
 
-       einvalidargument = class(ematherror);
+       EInvalidArgument = class(ematherror);
 
        TValueRelationship = -1..1;
 
@@ -875,10 +875,7 @@ function power(base,exponent : float) : float;
 
   begin
     if Exponent=0.0 then
-      if base <> 0.0 then
-        result:=1.0
-      else
-        InvalidArgument
+      result:=1.0
     else if (base=0.0) and (exponent>0.0) then
       result:=0.0
     else if (abs(exponent)<=maxint) and (frac(exponent)=0.0) then
@@ -896,21 +893,24 @@ function intpower(base : float;const exponent : Integer) : float;
 
   begin
      if (base = 0.0) and (exponent = 0) then
-       InvalidArgument;
-     i:=abs(exponent);
-     intpower:=1.0;
-     while i>0 do
+       result:=1
+     else
        begin
-          while (i and 1)=0 do
-            begin
-               i:=i shr 1;
-               base:=sqr(base);
-            end;
-          i:=i-1;
-          intpower:=intpower*base;
+         i:=abs(exponent);
+         intpower:=1.0;
+         while i>0 do
+           begin
+              while (i and 1)=0 do
+                begin
+                   i:=i shr 1;
+                   base:=sqr(base);
+                end;
+              i:=i-1;
+              intpower:=intpower*base;
+           end;
+         if exponent<0 then
+           intpower:=1.0/intpower;
        end;
-     if exponent<0 then
-       intpower:=1.0/intpower;
   end;
 
 

rtl/objpas/typinfo.pp

@@ -71,6 +71,30 @@ unit typinfo;
       TTypeKinds = set of TTypeKind;
       ShortStringBase = string[255];
 
+      PVmtFieldEntry = ^TVmtFieldEntry;
+      TVmtFieldEntry =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        FieldOffset: PtrUInt;
+        TypeIndex: Word;
+        Name: ShortString;
+      end;
+
+      PVmtFieldTable = ^TVmtFieldTable;
+      TVmtFieldTable =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        Count: Word;
+        ClassTab: Pointer;
+        { should be array[Word] of TFieldInfo;  but
+          Elements have variant size! force at least proper alignment }
+        Fields: array[0..0] of TVmtFieldEntry
+      end;
+
 {$PACKRECORDS 1}
       TTypeInfo = record
          Kind : TTypeKind;

tests/test/units/dos/tfexpand.pp

@@ -185,7 +185,8 @@ begin
  if (Length (S) > 1) and (S [2] = ':') then Delete (S, 1, 2);
 {$ELSE UNIX}
  for I := 1 to Length (S) do if S [I] = '/' then S [I] := DirSep;
- if (Length (S) > 0) and (S [1] in ['a'..'z']) then S [1] := UpCase (S [1]);
+ if (Length (S) > 1) and (S [1] in ['a'..'z']) and (S[2]=DriveSep) then
+   S [1] := UpCase (S [1]);
 {$ENDIF UNIX}
  if not (FileNameCaseSensitive) then
                            for I := 1 to Length (S) do S [I] := UpCase (S [I]);
@@ -201,6 +202,10 @@ begin
 {$ENDIF DEBUG}
  Rslt := Translate (Rslt);
  Rslt2 := FExpand (Src);
+{$IFNDEF UNIX}
+ if (Length (Rslt2) > 1) and (Rslt2 [1] in ['a'..'z']) and (Rslt2[2]=DriveSep) then
+   Rslt2 [1] := UpCase (Rslt2 [1]);
+{$ENDIF NDEF UNIX}
  if Rslt <> Rslt2 then
  begin
   WriteLn ('Error: FExpand (', Src, ') should be "', Rslt, '", not "',
@@ -389,13 +394,14 @@ if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
  Check (TestDrive + '.' + DirSep + '.', CurDir);
  Check (TestDrive + '.' + DirSep + '..', TestDir + TestDir1Name);
 {$I-}
-{ $ ifndef unix
- { avoid a and b drives for
+(*
+{ $ ifndef unix }
+{   avoid a and b drives for
    no unix systems to reduce the
    probablility of getting an alert message box }
- (* This should not be needed - unit popuperr should solve this?! TH *)
+ { This should not be needed - unit popuperr should solve this?! TH }
  I := 3;
-$else unix}
+{$else unix} *)
  I := 1;
 { $ endif unix}
  repeat

tests/test/units/math/tpower.pp

@@ -0,0 +1,10 @@
+uses
+  math;
+
+begin
+  if power(0,0)<>1 then
+    halt(1);
+  if intpower(0,0)<>1 then
+    halt(1);
+  writeln('ok');
+end.

tests/test/units/system/tres.pp

@@ -1,6 +1,6 @@
 { Test for resources support. }
 
-{%TARGET=win32,win64,wince,linux,freebsd,darwin,netbsd,openbsd,solaris}
+{%TARGET=win32,win64,wince,linux,freebsd,darwin,netbsd,openbsd,solaris,haiku}
 
 {$mode objfpc}
 

tests/test/units/system/tres2.pp

@@ -1,6 +1,6 @@
 { Test for FindResourceEx function. }
 
-{%TARGET=win32,win64,linux,freebsd,darwin,netbsd,openbsd,solaris}
+{%TARGET=win32,win64,linux,freebsd,darwin,netbsd,openbsd,solaris,haiku}
 
 {$mode objfpc}
 

tests/test/units/system/tres3.pp

@@ -1,6 +1,6 @@
 { Test for resource enumeration functions. }
 
-{%TARGET=win32,win64,wince,linux,freebsd,darwin,netbsd,openbsd,solaris}
+{%TARGET=win32,win64,wince,linux,freebsd,darwin,netbsd,openbsd,solaris,haiku}
 
 {$mode objfpc}