--- Merging r19612 into '.':

U    rtl/bsd/ostypes.inc
Skipped 'tests/webtbf/tw20661.pp'
--- Merging r19651 into '.':
U    compiler/ncal.pas
--- Merging r19687 into '.':
U    compiler/pmodules.pas
--- Merging r19689 into '.':
U    compiler/symdef.pas
--- Merging r19691 into '.':
G    compiler/pmodules.pas
Skipped 'tests/webtbs/tw18706.pp'
--- Merging r19736 into '.':
U    compiler/symsym.pas
--- Merging r19738 into '.':
U    rtl/objpas/sysutils/sysstr.inc
U    tests/test/units/sysutils/tfloattostr.pp
Skipped 'tests/test/packages/cocoaint/tw20876.pp'
--- Merging r19861 into '.':
U    compiler/ncgrtti.pas
Skipped 'tests/test/packages/cocoaint/uw20875a.pp'
Skipped 'tests/test/packages/cocoaint/uw20875b.pp'
Skipped 'tests/test/packages/cocoaint/tw20875.pp'
--- Merging r19865 into '.':
U    compiler/objcgutl.pas
Skipped 'tests/test/packages/cocoaint/tw20876.pp'
Skipped 'tests/test/packages/cocoaint/tw20875.pp'
--- Merging r19920 into '.':
U    compiler/powerpc/nppcmat.pas
--- Merging r19921 into '.':
U    compiler/powerpc/cgcpu.pas
--- Merging r19922 into '.':
U    compiler/aggas.pas
--- Merging r20003 into '.':
U    tests/test/tmt1.pp
Skipped 'tests/webtbs/tw21029.pp'
--- Merging r20046 into '.':
U    compiler/nmat.pas
--- Merging r20060 into '.':
U    compiler/pdecvar.pas
Skipped 'tests/webtbs/tw21073.pp'
--- Merging r20062 into '.':
U    compiler/pexpr.pas
--- Merging r20096 into '.':
U    packages/univint/src/Finder.pas
--- Merging r20107 into '.':
G    compiler/symdef.pas
Skipped 'tests/webtbs/tw20873.pp'
--- Merging r20108 into '.':
U    compiler/nmem.pas
--- Merging r20132 into '.':
G    compiler/nmem.pas
--- Merging r20137 into '.':
U    compiler/ogbase.pas
Skipped 'tests/test/tobjc38.pp'
--- Merging r20187 into '.':
G    compiler/pdecvar.pas
Skipped 'tests/webtbs/tw21177.pp'
--- Merging r20192 into '.':
G    compiler/ncal.pas
Skipped 'tests/test/tobjc38.pp'
--- Merging r20211 into '.':
U    compiler/systems/t_bsd.pas
--- Merging r20235 into '.':
U    packages/univint/src/MacOSAll.pas
--- Merging r20311 into '.':
U    packages/cocoaint/src/IvarSize.pas
--- Merging r20312 into '.':
U    packages/univint/src/Files.pas
--- Merging r20331 into '.':
U    packages/univint/src/MacTypes.pas
Skipped 'tests/webtbf/tw20907a.pp'
Skipped 'tests/webtbf/tw20907.pp'
--- Merging r20373 into '.':
G    compiler/symsym.pas
--- Merging r20374 into '.':
U    rtl/unix/cthreads.pp
Summary of conflicts:
  Skipped paths: 16

git-svn-id: branches/fixes_2_6@20427 -

compiler/aggas.pas

@@ -782,7 +782,6 @@ implementation
                          sepChar := '@'
                        else
                          sepChar := '%';
-                       if (tf_needs_symbol_type in target_info.flags) then
                          asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object');
                        if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
                          asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));

compiler/ncal.pas

@@ -2334,6 +2334,12 @@ implementation
                        para.left:=gen_procvar_context_tree
                      else
                        para.left:=gen_self_tree;
+                     { make sure that e.g. the self pointer of an advanced
+                       record does not become a regvar, because it's a vs_var
+                       parameter }
+                     if paramanager.push_addr_param(para.parasym.varspez,para.parasym.vardef,
+                         procdefinition.proccalloption) then
+                       make_not_regable(para.left,[ra_addr_regable]);
                    end
                 else
                  if vo_is_vmt in para.parasym.varoptions then
@@ -2967,6 +2973,14 @@ implementation
                   CGMessage(cg_e_cant_call_abstract_method);
               end;
 
+            { directly calling an interface/protocol/category/class helper
+              method via its type is not possible (always must be called via
+              the actual instance) }
+            if (methodpointer.nodetype=typen) and
+               (is_interface(methodpointer.resultdef) or
+                is_objc_protocol_or_category(methodpointer.resultdef)) then
+              CGMessage1(type_e_class_type_expected,methodpointer.resultdef.typename);
+
             { if an inherited con- or destructor should be  }
             { called in a con- or destructor then a warning }
             { will be made                                  }

compiler/ncgrtti.pas

@@ -171,7 +171,8 @@ implementation
                (
                 (rt=fullrtti) or
                 tfieldvarsym(sym).vardef.needs_inittable
-               ) then
+               ) and
+               not is_objc_class_or_protocol(tfieldvarsym(sym).vardef) then
               begin
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tfieldvarsym(sym).vardef,rt)));
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tfieldvarsym(sym).fieldoffset));

compiler/nmat.pas

@@ -928,10 +928,21 @@ implementation
                else
                  CGMessage(type_e_mismatch);
              end;
-             if not forinline then
+             { not-nodes are not range checked by the code generator -> also
+               don't range check while inlining; the resultdef is a bit tricky
+               though: the node's resultdef gets changed in most cases compared
+               to left, but the not-operation itself is caried out in the code
+               generator using the size of left
+               }
+             if not(forinline) then
                t:=cordconstnode.create(v,def,false)
              else
-               t:=create_simplified_ord_const(v,resultdef,true);
+               begin
+                 { cut off the value if necessary }
+                 t:=cordconstnode.create(v,left.resultdef,false);
+                 { now convert to node's resultdef }
+                 inserttypeconv_explicit(t,def);
+               end;
              result:=t;
              exit;
           end;

compiler/nmem.pas

@@ -770,6 +770,7 @@ implementation
       var
          hightree: tnode;
          htype,elementdef : tdef;
+         newordtyp: tordtype;
          valid : boolean;
       begin
          result:=nil;
@@ -808,30 +809,67 @@ implementation
           exit;
 
          { maybe type conversion for the index value, but
-           do not convert enums, char (why not? (JM))
-           and do not convert range nodes }
-         if (right.nodetype<>rangen) and (is_integer(right.resultdef) or is_boolean(right.resultdef) or (left.resultdef.typ<>arraydef)) then
+           do not convert range nodes }
+         if (right.nodetype<>rangen) then
            case left.resultdef.typ of
              arraydef:
-               if ado_isvariant in Tarraydef(left.resultdef).arrayoptions then
-                 {Variant arrays are a special array, can have negative indexes and would therefore
-                  need s32bit. However, they should not appear in a vecn, as they are handled in
-                  handle_variantarray in pexpr.pas. Therefore, encountering a variant array is an
-                  internal error... }
-                 internalerror(200707031)
-               else if is_special_array(left.resultdef) then
-                 {Arrays without a high bound (dynamic arrays, open arrays) are zero based,
-                  convert indexes into these arrays to aword.}
-                 inserttypeconv(right,uinttype)
-               { convert between pasbool and cbool if necessary }
-               else if is_boolean(right.resultdef) then
-                 inserttypeconv(right,tarraydef(left.resultdef).rangedef)
-               else
-                 {Convert array indexes to low_bound..high_bound.}
-                 inserttypeconv(right,Torddef.create(Torddef(sinttype).ordtype,
-                                                     int64(Tarraydef(left.resultdef).lowrange),
-                                                     int64(Tarraydef(left.resultdef).highrange)
-                                                    ));
+               begin
+                 htype:=Tarraydef(left.resultdef).rangedef;
+                 if ado_isvariant in Tarraydef(left.resultdef).arrayoptions then
+                   {Variant arrays are a special array, can have negative indexes and would therefore
+                    need s32bit. However, they should not appear in a vecn, as they are handled in
+                    handle_variantarray in pexpr.pas. Therefore, encountering a variant array is an
+                    internal error... }
+                   internalerror(200707031)
+                 else if is_special_array(left.resultdef) then
+                   {Arrays without a high bound (dynamic arrays, open arrays) are zero based,
+                    convert indexes into these arrays to aword.}
+                   inserttypeconv(right,uinttype)
+                 { note: <> rather than </>, because indexing e.g. an array 0..0
+                     must not result in truncating the indexing value from 2/4/8
+                     bytes to 1 byte (with range checking off, the full index
+                     value must be used) }
+                 else if (htype.typ=enumdef) and
+                         (right.resultdef.typ=enumdef) and
+                         (tenumdef(htype).basedef=tenumdef(right.resultdef).basedef) and
+                    ((tarraydef(left.resultdef).lowrange<>tenumdef(htype).min) or
+                     (tarraydef(left.resultdef).highrange<>tenumdef(htype).max)) then
+                   {Convert array indexes to low_bound..high_bound.}
+                   inserttypeconv(right,tenumdef.create_subrange(tenumdef(right.resultdef),
+                                                      asizeint(Tarraydef(left.resultdef).lowrange),
+                                                      asizeint(Tarraydef(left.resultdef).highrange)
+                                                     ))
+                 else if (htype.typ=orddef) and
+                    { don't try to create boolean types with custom ranges }
+                    not is_boolean(right.resultdef) and
+                    { ordtype determines the size of the loaded value -> make
+                      sure we don't truncate }
+                    ((Torddef(right.resultdef).ordtype<>torddef(htype).ordtype) or
+                     (tarraydef(left.resultdef).lowrange<>torddef(htype).low) or
+                     (tarraydef(left.resultdef).highrange<>torddef(htype).high)) then
+                    {Convert array indexes to low_bound..high_bound.}
+                   begin
+                     if (right.resultdef.typ=orddef)
+{$ifndef cpu64bitaddr}
+                        { do truncate 64 bit values on 32 bit cpus, since
+                           a) the arrays cannot be > 32 bit anyway
+                           b) their code generators can't directly handle 64 bit
+                              loads
+                        }
+                        and not is_64bit(right.resultdef)
+{$endif not cpu64bitaddr}
+                        then
+                       newordtyp:=Torddef(right.resultdef).ordtype
+                     else
+                       newordtyp:=torddef(ptrsinttype).ordtype;
+                     inserttypeconv(right,Torddef.create(newordtyp,
+                                                         int64(Tarraydef(left.resultdef).lowrange),
+                                                         int64(Tarraydef(left.resultdef).highrange)
+                                                        ))
+                   end
+                 else
+                   inserttypeconv(right,htype)
+               end;
              stringdef:
                if is_open_string(left.resultdef) then
                  inserttypeconv(right,u8inttype)

compiler/objcgutl.pas

@@ -1128,6 +1128,7 @@ procedure tobjcrttiwriter_nonfragile.gen_objc_protocol(list: tasmlist; protocol:
     }
     lbl:=current_asmdata.DefineAsmSymbol(protocol.rtti_mangledname(objcclassrtti),AB_PRIVATE_EXTERN,AT_DATA);
     list.Concat(tai_symbol.Create_Global(lbl,0));
+    list.Concat(tai_directive.Create(asd_weak_definition,lbl.name));
     protocollabel:=lbl;
 
     { protocol's isa - always nil }

compiler/ogbase.pas

@@ -1616,7 +1616,7 @@ implementation
         objsym : TObjSymbol;
         exesym : TExeSymbol;
       begin
-        val(avalue,ImageBase,code);
+        val(avalue,FImageBase,code);
         if code<>0 then
           Comment(V_Error,'Invalid number '+avalue);
         { Create __image_base__ symbol, create the symbol

compiler/pdecvar.pas

@@ -1493,7 +1493,6 @@ implementation
          srsymtable : TSymtable;
          visibility : tvisibility;
          recst : tabstractrecordsymtable;
-         recstlist : tfpobjectlist;
          unionsymtable : trecordsymtable;
          offset : longint;
          uniondef : trecorddef;
@@ -1519,7 +1518,6 @@ implementation
            consume(_ID);
          { read vars }
          sc:=TFPObjectList.create(false);
-         recstlist:=TFPObjectList.create(false);
          removeclassoption:=false;
          while (token=_ID) and
             not(((vd_object in options) or
@@ -1545,16 +1543,6 @@ implementation
                block_type:=old_block_type;
              consume(_COLON);
 
-             { Don't search for types where they can't be:
-               types can be only in objects, classes and records.
-               This just speedup the search a bit. }
-             recstlist.count:=0;
-             if not is_class_or_object(tdef(recst.defowner)) and
-                not is_record(tdef(recst.defowner)) then
-               begin
-                 recstlist.add(recst);
-                 symtablestack.pop(recst);
-               end;
              read_anon_type(hdef,false);
              block_type:=bt_var;
              { allow only static fields reference to struct where they are declared }
@@ -1566,12 +1554,6 @@ implementation
                  { for error recovery or compiler will crash later }
                  hdef:=generrordef;
                end;
-             { restore stack }
-             for i:=recstlist.count-1 downto 0 do
-               begin
-                 recst:=tabstractrecordsymtable(recstlist[i]);
-                 symtablestack.push(recst);
-               end;
 
              { Process procvar directives }
              if maybe_parse_proc_directives(hdef) then
@@ -1686,7 +1668,7 @@ implementation
              if (visibility=vis_published) and
                 not(is_class(hdef)) then
                begin
-                 Message(parser_e_cant_publish_that);
+                 MessagePos(tfieldvarsym(sc[0]).fileinfo,parser_e_cant_publish_that);
                  visibility:=vis_public;
                end;
 
@@ -1694,7 +1676,7 @@ implementation
                 not(oo_can_have_published in tobjectdef(hdef).objectoptions) and
                 not(m_delphi in current_settings.modeswitches) then
                begin
-                 Message(parser_e_only_publishable_classes_can_be_published);
+                 MessagePos(tfieldvarsym(sc[0]).fileinfo,parser_e_only_publishable_classes_can_be_published);
                  visibility:=vis_public;
                end;
 
@@ -1707,7 +1689,6 @@ implementation
                    recst.addfield(fieldvs,visibility);
                end;
            end;
-          recstlist.free;
 
          if m_delphi in current_settings.modeswitches then
            block_type:=bt_var_type

compiler/pexpr.pas

@@ -891,8 +891,9 @@ implementation
                getaddr:=true;
              end
             else
-             if (m_tp_procvar in current_settings.modeswitches) or
-                (m_mac_procvar in current_settings.modeswitches) then
+             if ((m_tp_procvar in current_settings.modeswitches) or
+                 (m_mac_procvar in current_settings.modeswitches)) and
+                not(token in [_CARET,_POINT,_LKLAMMER]) then
               begin
                 aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
                 if assigned(aprocdef) then

compiler/pmodules.pas

@@ -332,7 +332,7 @@ implementation
           ResourceInfo.concat(Tai_const.Createname('FPC_RESSYMBOL',0))
         else
           { Nil pointer to resource information }
-          {$IFDEF CPU32}
+          {$IFNDEF cpu64bitaddr}
           ResourceInfo.Concat(Tai_const.Create_32bit(0));
           {$ELSE}
           ResourceInfo.Concat(Tai_const.Create_64bit(0));

compiler/powerpc/cgcpu.pas

@@ -1695,7 +1695,20 @@ const
 
     procedure tcg64fppc.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);
       begin
-        a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst);
+        case op of
+          OP_NOT:
+            begin
+              cg.a_op_reg_reg(list,OP_NOT,OS_32,regsrc.reglo,regdst.reglo);
+              cg.a_op_reg_reg(list,OP_NOT,OS_32,regsrc.reghi,regdst.reghi);
+            end;
+          OP_NEG:
+            begin
+              list.concat(taicpu.op_reg_reg_const(a_subfic,regdst.reglo,regsrc.reglo,0));
+              list.concat(taicpu.op_reg_reg(a_subfze,regdst.reghi,regsrc.reghi));
+            end;
+          else
+            a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst);
+        end;
       end;
 
 

compiler/powerpc/nppcmat.pas

@@ -648,7 +648,7 @@ end;
 
       var
          hl : tasmlabel;
-
+         tmpreg: tregister;
       begin
          if is_boolean(resultdef) then
           begin
@@ -682,7 +682,18 @@ end;
                   LOC_SUBSETREF, LOC_CSUBSETREF:
                     begin
                       location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true);
-                      current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMPWI,left.location.register,0));
+                      tmpreg:=left.location.register;
+{$ifndef cpu64bitalu}
+                      { 64 bit pascal booleans have their truth value stored in
+                        the lower 32 bits; with cbools, it can be anywhere }
+                      if (left.location.size in [OS_64,OS_S64]) and
+                         not is_pasbool(left.resultdef) then
+                        begin
+                          tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                          cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reglo,left.location.register64.reghi,tmpreg);
+                        end;
+{$endif not cpu64bitalu}
+                      current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMPWI,tmpreg,0));
                       location_reset(location,LOC_FLAGS,OS_NO);
                       location.resflags.cr:=RS_CR0;
                       location.resflags.flag:=F_EQ;

compiler/symdef.pas

@@ -1955,6 +1955,7 @@ implementation
       begin
         if (target_info.system in [system_i386_darwin,system_i386_iphonesim,system_arm_darwin]) then
           case floattype of
+            sc80real,
             s80real: result:=16;
             s64real,
             s64currency,
@@ -2563,7 +2564,7 @@ implementation
     constructor tarraydef.create_from_pointer(def:tdef);
       begin
          { use -1 so that the elecount will not overflow }
-         self.create(0,high(aint)-1,s32inttype);
+         self.create(0,high(aint)-1,ptrsinttype);
          arrayoptions:=[ado_IsConvertedPointer];
          setelementdef(def);
       end;

compiler/symsym.pas

@@ -703,6 +703,8 @@ implementation
         bestpd,
         pd : tprocdef;
         eq,besteq : tequaltype;
+        sym: tsym;
+        ps: tprocsym;
       begin
         { This function will return the pprocdef of pprocsym that
           is the best match for procvardef. When there are multiple
@@ -710,23 +712,47 @@ implementation
         result:=nil;
         bestpd:=nil;
         besteq:=te_incompatible;
-        for i:=0 to ProcdefList.Count-1 do
-          begin
-            pd:=tprocdef(ProcdefList[i]);
-            eq:=proc_to_procvar_equal(pd,d,false);
-            if eq>=te_convert_l1 then
-              begin
-                { multiple procvars with the same equal level }
-                if assigned(bestpd) and
-                   (besteq=eq) then
-                  exit;
-                if eq>besteq then
-                  begin
-                    besteq:=eq;
-                    bestpd:=pd;
-                  end;
-              end;
-          end;
+        ps:=self;
+        repeat
+          for i:=0 to ps.ProcdefList.Count-1 do
+            begin
+              pd:=tprocdef(ps.ProcdefList[i]);
+              eq:=proc_to_procvar_equal(pd,d,false);
+              if eq>=te_convert_l1 then
+                begin
+                  { multiple procvars with the same equal level }
+                  if assigned(bestpd) and
+                     (besteq=eq) then
+                    exit;
+                  if eq>besteq then
+                    begin
+                      besteq:=eq;
+                      bestpd:=pd;
+                    end;
+                end;
+            end;
+          { maybe TODO: also search class helpers? -- this code is similar to
+            what happens in htypechk in
+            tcallcandidates.collect_overloads_in_struct: keep searching in
+            parent types in case the currently found procdef is marked as
+            "overload" and we haven't found a proper match yet }
+          if assigned(ps.owner.defowner) and
+             (ps.owner.defowner.typ=objectdef) and
+             assigned(tobjectdef(ps.owner.defowner).childof) and
+             (not assigned(bestpd) or
+              (po_overload in bestpd.procoptions)) then
+            begin
+              sym:=tsym(tobjectdef(ps.owner.defowner).childof.symtable.find(ps.name));
+              if assigned(sym) and
+                 (sym.typ=procsym) then
+                ps:=tprocsym(sym)
+              else
+                ps:=nil;
+            end
+          else
+            ps:=nil;
+        until (besteq>=te_equal) or
+              not assigned(ps);
         result:=bestpd;
       end;
 
@@ -1419,7 +1445,8 @@ implementation
     constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
       begin
          inherited create(paravarsym,n,vsp,def,vopts);
-         if (vsp in [vs_var,vs_value,vs_const,vs_constref]) then
+         if (vsp in [vs_var,vs_value,vs_const,vs_constref]) and
+            not(vo_is_funcret in vopts) then
            varstate := vs_initialised;
          paranr:=nr;
          paraloc[calleeside].init;

compiler/systems/t_bsd.pas

@@ -339,29 +339,25 @@ begin
       LinkRes.Add(sysrootpath);
     end;
 
-  if (not isdll) or
-     (apptype=app_bundle) then
+  if (target_info.system in systems_darwin) then
     begin
-      if (target_info.system in systems_darwin) then
-        begin
-          LinkRes.Add('-arch');
-          case target_info.system of
-            system_powerpc_darwin:
-              LinkRes.Add('ppc');
-            system_i386_darwin,
-            system_i386_iphonesim:
-              LinkRes.Add('i386');
-            system_powerpc64_darwin:
-              LinkRes.Add('ppc64');
-            system_x86_64_darwin:
-              LinkRes.Add('x86_64');
-            system_arm_darwin:
-              { current versions of the linker require the sub-architecture type
-                to be specified }
-              LinkRes.Add(lower(cputypestr[current_settings.cputype]));
-          end;
+      LinkRes.Add('-arch');
+      case target_info.system of
+        system_powerpc_darwin:
+          LinkRes.Add('ppc');
+        system_i386_darwin,
+        system_i386_iphonesim:
+          LinkRes.Add('i386');
+        system_powerpc64_darwin:
+          LinkRes.Add('ppc64');
+        system_x86_64_darwin:
+          LinkRes.Add('x86_64');
+        system_arm_darwin:
+          { current versions of the linker require the sub-architecture type
+            to be specified }
+          LinkRes.Add(lower(cputypestr[current_settings.cputype]));
       end;
-  end;
+    end;
   { Write path to search libraries }
   HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First);
   while assigned(HPath) do

packages/cocoaint/src/IvarSize.pas

@@ -1295,7 +1295,10 @@ type
 ;end;
 
 procedure PrintGlue1;
-begin 
+var
+  pool: NSAutoReleasePool;
+begin
+ pool:=NSAutoReleasePool.alloc.init;
  if class_getInstanceSize(TDerivedNSAffineTransform) <> (class_getInstanceSize(NSAffineTransform)+sizeof(pointer)) then
  writeln('size of NSAffineTransform is wrong: ',class_getInstanceSize(TDerivedNSAffineTransform),' <> ',class_getInstanceSize(NSAffineTransform)+sizeof(pointer));
  if class_getInstanceSize(TDerivedNSAppleEventDescriptor) <> (class_getInstanceSize(NSAppleEventDescriptor)+sizeof(pointer)) then
@@ -1945,6 +1948,7 @@ begin
  writeln('size of NSWindowController is wrong: ',class_getInstanceSize(TDerivedNSWindowController),' <> ',class_getInstanceSize(NSWindowController)+sizeof(pointer));
  if class_getInstanceSize(TDerivedNSWorkspace) <> (class_getInstanceSize(NSWorkspace)+sizeof(pointer)) then
  writeln('size of NSWorkspace is wrong: ',class_getInstanceSize(TDerivedNSWorkspace),' <> ',class_getInstanceSize(NSWorkspace)+sizeof(pointer));
+ pool.release;
 end;
 begin
  PrintGlue1;

packages/univint/src/Files.pas

@@ -197,8 +197,8 @@ type
 	ConstHFSUniStr255Param = ^HFSUniStr255;
 
 type
-	DirIDTypePtr = UInt32Ptr;
-	DirIDType = UInt32;
+	DirIDTypePtr = ^DirIDType;
+	DirIDType = SInt32;
 
 {
     File Permissions
@@ -3543,7 +3543,7 @@ procedure PBIterateForksAsync( var paramBlock: FSForkIOParam ); external name '_
  *    CarbonLib:        in CarbonLib 1.0 and later
  *    Non-Carbon CFM:   in InterfaceLib 9.0 and later
  }
-function FSOpenFork( const (*var*) ref: FSRef; forkNameLength: UniCharCount; forkName: UniCharPtr; permissions: SInt8; var forkRefNum: SInt16 ): OSErr; external name '_FSOpenFork';
+function FSOpenFork( const (*var*) ref: FSRef; forkNameLength: UniCharCount; forkName: UniCharPtr; permissions: SInt8; var forkRefNum: FSIORefNum ): OSErr; external name '_FSOpenFork';
 (* AVAILABLE_MAC_OS_X_VERSION_10_0_AND_LATER *)
 
 

packages/univint/src/Finder.pas

@@ -447,6 +447,7 @@ type
 type
 	FXInfoPtr = ^FXInfo;
 	FXInfo = record
+		fdIconID: SInt16;              { Reserved (set to 0) }
 		fdReserved: array [0..2] of SInt16;          { Reserved (set to 0) }
 		fdScript: SInt8;               { Extended flags. Script code if high-bit is set }
 		fdXFlags: SInt8;               { Extended flags }

packages/univint/src/MacOSAll.pas

@@ -11,7 +11,7 @@
 unit MacOSAll;
 interface
 
-{$ifc defined CPUPOWERPC32 or defined CPUI386}
+{$ifc (defined CPUPOWERPC32 or defined CPUI386) and not defined(iphonesim)}
 {$linkframework Carbon}
 {$elsec}
 {$linkframework CoreFoundation}

packages/univint/src/MacTypes.pas

@@ -398,7 +398,7 @@ type
 	PtrPtr = ^Ptr;       
 	Handle = ^Ptr;
 	Handle_fix = Handle; { used as field type when a record declaration contains a Handle field identifier }
-	Size = SInt32;
+	Size = SIGNEDLONG;
 	Size_fix = Size; { used as field type when a record declaration contains a Size field identifier }
 	SizePtr = ^Size;
 	UnivPtr = Pointer;
@@ -437,16 +437,16 @@ type
 	ConstLogicalAddress = UnivPtr;
 	PhysicalAddress = UnivPtr;
 	BytePtr = UInt8Ptr;
-	ByteCount = UInt32;
+	ByteCount = UNSIGNEDLONG;
  	ByteCountPtr = ^ByteCount;
-	ByteOffset = UInt32;
+	ByteOffset = UNSIGNEDLONG;
  	ByteOffsetPtr = ^ByteOffset;
 	Duration = SInt32;
 	AbsoluteTime = UnsignedWide;
 	AbsoluteTimePtr = ^AbsoluteTime;
 	OptionBits = UInt32;
 	OptionBitsPtr = ^OptionBits;
-	ItemCount = UInt32;
+	ItemCount = UNSIGNEDLONG;
  	ItemCountPtr = ^ItemCount;
 	PBVersion = UInt32;
 	ScriptCode = SInt16;
@@ -623,7 +623,7 @@ type
 	UTF8Char = UInt8;
 	UniCharPtr = ^UniChar;
 	ConstUniCharPtr = UniCharPtr;
-	UniCharCount = UInt32;
+	UniCharCount = UNSIGNEDLONG;
 	UniCharCountPtr = ^UniCharCount;
 	Str15 = STRING[15];
 	Str27 = STRING[27];

rtl/bsd/ostypes.inc

@@ -137,7 +137,7 @@ TYPE
    TDirent = dirent;
    pDirent = ^dirent;
 
-   dir     = packed record
+   dir     = record
         dd_fd     : cint;         // file descriptor associated with directory
         dd_loc    : clong;        // offset in current buffer
         dd_size   : clong;        // amount of data returned by getdirentries
@@ -176,7 +176,7 @@ TYPE
    TFlock   = flock;
    pFlock   = ^flock;
 
- tms = packed record
+ tms = record
          tms_utime  : clock_t;  { User CPU time }
          tms_stime  : clock_t;  { System CPU time }
          tms_cutime : clock_t;  { User CPU time of terminated child procs }
@@ -310,14 +310,14 @@ CONST
 
 
 type
-  timezone = packed record
+  timezone = record
     tz_minuteswest,
     tz_dsttime  : cint;
   end;
   ptimezone =^timezone;
   TTimeZone = timezone;
 
-  rusage = packed record
+  rusage = record
         ru_utime    : timeval;          { user time used }
         ru_stime    : timeval;          { system time used }
         ru_maxrss   : clong;            { max resident set size }

rtl/objpas/sysutils/sysstr.inc

@@ -1161,8 +1161,8 @@ const
 
 Function FloatToStrFIntl(const Value; format: TFloatFormat; Precision, Digits: Integer; ValueType: TFloatValue; Const FormatSettings: TFormatSettings): String;
 Var
-  P: Integer;
-  Negative, TooSmall, TooLarge: Boolean;
+  P, PE, Q, Exponent: Integer;
+  Negative: Boolean;
   DS: Char;
 
   function RemoveLeadingNegativeSign(var AValue: String): Boolean;
@@ -1197,82 +1197,102 @@ Begin
       Begin
         case ValueType of
           fvCurrency:
-            begin
               If (Precision = -1) Or (Precision > 19) Then Precision := 19;
-              TooSmall:=False;
-            end;
           else
-            begin
               If (Precision = -1) Or (Precision > maxdigits) Then Precision := maxdigits;
-              TooSmall := (Abs(Extended(Value)) < 0.00001) and (Extended(Value)<>0.0);
-            end;
         end;
-        If Not TooSmall Then
-        Begin
-          case ValueType of
-            fvDouble:
-              Str(Double(Extended(Value)):0:precision, Result);
-            fvSingle:
-              Str(Single(Extended(Value)):0:precision, Result);
-            fvCurrency:
+        { First convert to scientific format, with correct precision }
+        case ValueType of
+          fvDouble:
+            Str(Double(Extended(Value)):precision+7, Result);
+          fvSingle:
+            Str(Single(Extended(Value)):precision+6, Result);
+          fvCurrency:
 {$ifdef FPC_HAS_STR_CURRENCY}
-              Str(Currency(Value):0:precision, Result);
+            Str(Currency(Value):precision+6, Result);
 {$else}
-              Str(Extended(Currency(Value)):0:precision, Result);
+            Str(Extended(Currency(Value)):precision+8, Result);
 {$endif FPC_HAS_STR_CURRENCY}
-            else
-              Str(Extended(Value):0:precision, Result);
+          else
+            Str(Extended(Value):precision+8, Result);
+        end;
+        { Delete leading spaces }
+        while Result[1] = ' ' do
+          System.Delete(Result, 1, 1);
+        P := Pos('.', Result);
+        if P<>0 then
+          Result[P] := DS
+        else
+          Exit; { NAN or other special case }
+        { Consider removing exponent }
+        PE:=Pos('E',Result);
+        if PE > 0 then begin
+          { Read exponent }
+          Q := PE+2;
+          Exponent := 0;
+          while (Q <= Length(Result)) do begin
+            Exponent := Exponent*10 + Ord(Result[Q])-Ord('0');
+            Inc(Q);
           end;
-          Negative := Result[1] = '-';
-          P := Pos('.', Result);
-          if P<>0 then
-            Result[P] := DS;
-          TooLarge :=(P > Precision + ord(Negative) + 1) or (Pos('E', Result)<>0);
-        End;
-
-        If TooSmall Or TooLarge Then
-          begin
-            Result := FloatToStrFIntl(Value, ffExponent, Precision, Digits, ValueType,FormatSettings);
-            // Strip unneeded zeroes.
-            P:=Pos('E',result)-1;
-            If P<>-1 then
-              begin
-                { delete superfluous +? }
-                if result[p+2]='+' then
-                  system.Delete(Result,P+2,1);
-                While (P>1) and (Result[P]='0') do
-                  begin
-                    system.Delete(Result,P,1);
-                    Dec(P);
-                  end;
-                If (P>0) and (Result[P]=DS) Then
-                  begin
-                    system.Delete(Result,P,1);
-                    Dec(P);
-                  end;
+          if Result[PE+1] = '-' then
+            Exponent := -Exponent;
+          if (P+Exponent < PE) and (Exponent > -6) then begin
+            { OK to remove exponent }
+            SetLength(Result,PE-1); { Trim exponent }
+            if Exponent >= 0 then begin
+              { Shift point to right }
+              for Q := 0 to Exponent-1 do begin
+                Result[P] := Result[P+1];
+                Inc(P);
               end;
-            end
-        else if (P<>0) then // we have a decimalseparator
-          begin
-            { it seems that in this unit "precision" must mean "number of }
-            { significant digits" rather than "number of digits after the }
-            { decimal point" (as it does in the system unit) -> adjust    }
-            { (precision+1 to count the decimal point character)          }
-            { don't just cut off the string, as rounding must be taken    }
-            { into account based on the final digit                       }
-            
-            if (Length(Result) > Precision + ord(Negative) + 1) and
-               (Precision + ord(Negative) + 1 >= P) then
-              Result := FloatToStrFIntl(Value, ffFixed,
-                0, Precision - (P - Ord(Negative) - 1),
-                ValueType, FormatSettings);
-            P := Length(Result);
-            While (P>0) and (Result[P] = '0') Do
-              Dec(P);
-            If (P>0) and (Result[P]=DS) Then
-              Dec(P);
-            SetLength(Result, P);
+              Result[P] := DS;
+              P := 1;
+              if Result[P] = '-' then
+                Inc(P);
+              while (Result[P] = '0') and (P < Length(Result)) and (Result[P+1] <> DS) do
+                { Trim leading zeros; conversion above should not give any, but occasionally does
+                  because of rounding }
+                System.Delete(Result,P,1);
+            end else begin
+              { Add zeros at start }
+              Insert(Copy('00000',1,-Exponent),Result,P-1);
+              Result[P-Exponent] := Result[P-Exponent-1]; { Copy leading digit }
+              Result[P] := DS;
+              if Exponent <> -1 then
+                Result[P-Exponent-1] := '0';
+            end;
+            { Remove trailing zeros }
+            Q := Length(Result);
+            while (Q > 0) and (Result[Q] = '0') do
+              Dec(Q);
+            if Result[Q] = DS then
+              Dec(Q); { Remove trailing decimal point }
+            if (Q = 0) or ((Q=1) and (Result[1] = '-')) then
+              Result := '0'
+            else
+              SetLength(Result,Q);
+          end else begin
+            { Need exponent, but remove superfluous characters }
+            { Delete trailing zeros }
+            while Result[PE-1] = '0' do begin
+              System.Delete(Result,PE-1,1);
+              Dec(PE);
+            end;
+            { If number ends in decimal point, remove it }
+            if Result[PE-1] = DS then begin
+              System.Delete(Result,PE-1,1);
+              Dec(PE);
+            end;
+            { delete superfluous + in exponent }
+            if Result[PE+1]='+' then
+              System.Delete(Result,PE+1,1)
+            else
+              Inc(PE);
+            while Result[PE+1] = '0' do
+              { Delete leading zeros in exponent }
+              System.Delete(Result,PE+1,1)
           end;
+        end;
       End;
 
     ffExponent:

rtl/unix/cthreads.pp

@@ -34,11 +34,11 @@
 
 { Darwin doesn't support nameless semaphores in at least }
 { Mac OS X 10.4.8/Darwin 8.8                             }
-{$ifndef darwin}
+{$if not defined(darwin) and not defined(iphonesim)}
 {$define has_sem_init}
 {$define has_sem_getvalue}
 {$else }
-{$ifdef darwin}
+{$if defined(darwin) or defined(iphonesim)}
 {$define has_sem_open}
 {$endif}
 {$endif}
@@ -53,7 +53,7 @@ interface
 
 {$ifndef dynpthreads}   // If you have problems compiling this on FreeBSD 5.x
  {$linklib c}           // try adding -Xf
- {$ifndef Darwin}
+ {$if not defined(Darwin) and not defined(iphonesim)}
    {$ifndef haiku}
      {$linklib pthread}
    {$endif haiku}

tests/test/tmt1.pp

@@ -45,13 +45,16 @@ function f(p : pointer) : ptrint;
 
 var
    i : ptrint;
+   started: longint;
 begin
    finished:=0;
+   started:=0;
 
    for i:=1 to threadcount do
-     BeginThread({$ifdef fpc}@{$endif}f,pointer(i));
+     if BeginThread({$ifdef fpc}@{$endif}f,pointer(i)) <> tthreadid(0) then
+       inc(started);
 
-   while finished<threadcount do
+   while finished<started do
      {$ifdef wince}sleep(10){$endif};
    writeln(finished);
 end.

tests/test/units/sysutils/tfloattostr.pp

@@ -9,6 +9,49 @@ const
 var
   ErrCount: longint;
 
+procedure CheckVal(f: Extended);
+var
+  s: string;
+  f1: Extended;
+begin
+  s := FloatToStr(f);
+  f1 := StrToFloat(s);
+  if (f<>f1) and (Abs(f-f1)/Abs(f) > 6e-15) then begin
+    WriteLn('Error (Double):',Abs(f-f1)/Abs(f), ' Input:', f, ' Output:', s);
+    Inc(ErrCount);
+  end;
+  f := Single(f);
+  s := FloatToStr(Single(f));
+  f1 := StrToFloat(s);
+  if (f<>f1) and (Abs(f-f1)/Abs(f) > 6e-10) then begin
+    WriteLn('Error (Single):',Abs(f-f1)/Abs(f), ' Input:', f, ' Output:', s);
+    Inc(ErrCount);
+  end;
+end;
+
+procedure Cycle(f: Extended);
+var
+  i: Integer;
+begin
+  for i := 1 to 50 do begin
+    CheckVal(f);
+    CheckVal(-f);
+    f := f/10;
+  end;
+end;
+
+procedure CycleInc(f, increment: Extended);
+var
+  i: Integer;
+begin
+  Cycle(f);
+  for i := 0 to 30 do begin
+    Cycle(f+increment);
+    Cycle(f-increment);
+    increment := increment/10;
+  end;
+end;
+
 procedure CheckResult(const s, ref: string);
 begin
   if s <> ref then
@@ -24,6 +67,8 @@ var
   d: double;
   s: single;
   c: currency;
+  i: Integer;
+  tests: array [0..4] of Double = (123456789123456789., 1e20, 1.6e20, 5e20, 9e20);
 begin
   e:=1234567890123.4;
   d:=12345.12345;
@@ -46,6 +91,14 @@ begin
   NegCurrFormat:=8;
   CheckResult(FloatToStrF(-12345.1234,ffCurrency,19,4), '-12' + ThousandSeparator + '345'+DecimalSeparator+'1234 ' + CurrencyString);
   CheckResult(FloatToStrF(MinCurrency,ffCurrency,19,4), '-922' + ThousandSeparator + '337' + ThousandSeparator + '203' + ThousandSeparator + '685' + ThousandSeparator + '477'+DecimalSeparator+'5807 ' + CurrencyString);
+  for i := 0 to High(tests) do begin
+    e := tests[i];
+    CycleInc(e,1e20);
+    CycleInc(e,9e20);
+    CycleInc(e,e);
+    CycleInc(e,e/2);
+    CycleInc(e,e/3);
+  end;
   if ErrCount > 0 then
     begin
       writeln('Test failed. Errors: ', ErrCount);