Merged revisions 1481,1533,1535-1536,1542,1544,1556,1590,1597,1608 via svnmerge from

http://[email protected]/svn/fpc/trunk

........
r1481 | peter | 2005-10-18 22:25:09 +0200 (Tue, 18 Oct 2005) | 2 lines

  * protected overload test

........
r1533 | florian | 2005-10-19 16:31:59 +0200 (Wed, 19 Oct 2005) | 2 lines

* OP_DIV shouldn't be used directly, not all cpu CGs support it

........
r1535 | florian | 2005-10-19 21:06:45 +0200 (Wed, 19 Oct 2005) | 3 lines

* cleaning up sets for exports behaviour
+ allow exports from units

........
r1536 | florian | 2005-10-19 21:17:33 +0200 (Wed, 19 Oct 2005) | 2 lines

* memory leak in RegisterInitComponentHandler fixed, thx to Martin Schreiber

........
r1542 | peter | 2005-10-20 08:51:40 +0200 (Thu, 20 Oct 2005) | 3 lines

  * remove check for expectloc<>location.loc, it doesn't work anymore for
    temprefn,blockn causing too much warnings in extdebug

........
r1544 | peter | 2005-10-20 13:13:49 +0200 (Thu, 20 Oct 2005) | 4 lines

  * more flexibel support for typecasting to different sizes
    fixes tw4450
      

........
r1556 | peter | 2005-10-21 09:46:14 +0200 (Fri, 21 Oct 2005) | 2 lines

  * generate implicit 0+<x> for +<x> expressions

........
r1590 | florian | 2005-10-23 21:41:16 +0200 (Sun, 23 Oct 2005) | 2 lines

* rtti parameter for dyn. array to variant conversion fixed

........
r1597 | tom_at_work | 2005-10-26 21:42:12 +0200 (Wed, 26 Oct 2005) | 1 line

* fixed code generation for calling threadvar relocation function
........
r1608 | florian | 2005-10-31 00:12:08 +0100 (Mon, 31 Oct 2005) | 4 lines

+ (ole)variant<->error type conversion
+ DynArraySetLength
+ DynArrayFromVariant

........

git-svn-id: branches/fixes_2_0@1612 -

.gitattributes

@@ -4315,6 +4315,7 @@ tests/tbf/tb0174b.pp svneol=native#text/plain
 tests/tbf/tb0174c.pp svneol=native#text/plain
 tests/tbf/tb0174d.pp svneol=native#text/plain
 tests/tbf/tb0175.pp svneol=native#text/plain
+tests/tbf/tb0176.pp svneol=native#text/plain
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -6027,6 +6028,7 @@ tests/webtbs/tw4015.pp svneol=native#text/plain
 tests/webtbs/tw4038.pp svneol=native#text/plain
 tests/webtbs/tw4043.pp svneol=native#text/plain
 tests/webtbs/tw4055.pp svneol=native#text/plain
+tests/webtbs/tw4056.pp svneol=native#text/plain
 tests/webtbs/tw4058.pp svneol=native#text/plain
 tests/webtbs/tw4068.pp svneol=native#text/plain
 tests/webtbs/tw4078.pp svneol=native#text/plain
@@ -6052,6 +6054,7 @@ tests/webtbs/tw4209.pp svneol=native#text/plain
 tests/webtbs/tw4215.pp svneol=native#text/plain
 tests/webtbs/tw4219.pp svneol=native#text/plain
 tests/webtbs/tw4223.pp svneol=native#text/plain
+tests/webtbs/tw4229.pp -text svneol=unset#text/plain
 tests/webtbs/tw4233.pp svneol=native#text/plain
 tests/webtbs/tw4234.pp svneol=native#text/plain
 tests/webtbs/tw4234a.pp svneol=native#text/plain
@@ -6078,6 +6081,7 @@ tests/webtbs/tw4390.pp svneol=native#text/plain
 tests/webtbs/tw4398.pp svneol=native#text/plain
 tests/webtbs/tw4427.pp svneol=native#text/plain
 tests/webtbs/tw4428.pp svneol=native#text/plain
+tests/webtbs/tw4450.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain
@@ -6093,6 +6097,7 @@ tests/webtbs/uw2040.pp svneol=native#text/plain
 tests/webtbs/uw2266a.inc svneol=native#text/plain
 tests/webtbs/uw2266b.pas svneol=native#text/plain
 tests/webtbs/uw2269.inc svneol=native#text/plain
+tests/webtbs/uw2364.pp svneol=native#text/plain
 tests/webtbs/uw2706a.pp svneol=native#text/plain
 tests/webtbs/uw2706b.pp svneol=native#text/plain
 tests/webtbs/uw2731.pp svneol=native#text/plain
@@ -6114,6 +6119,7 @@ tests/webtbs/uw3429.pp svneol=native#text/plain
 tests/webtbs/uw3474a.pp svneol=native#text/plain
 tests/webtbs/uw3474b.pp svneol=native#text/plain
 tests/webtbs/uw3968.pp svneol=native#text/plain
+tests/webtbs/uw4056.pp svneol=native#text/plain
 tests/webtbs/uw4140.pp svneol=native#text/plain
 tests/webtbs/uw4352a.pp svneol=native#text/plain
 tests/webtbs/uw4352b.pp svneol=native#text/plain

compiler/i386/ra386int.pas

@@ -66,7 +66,7 @@ Unit Ra386int;
          function BuildConstExpression:aint;
          function BuildRefConstExpression:aint;
          procedure BuildReference(oper : tx86operand);
-         procedure BuildOperand(oper: tx86operand);
+         procedure BuildOperand(oper: tx86operand;istypecast:boolean);
          procedure BuildConstantOperand(oper: tx86operand);
          procedure BuildOpCode(instr : tx86instruction);
          procedure BuildConstant(constsize: byte);
@@ -751,6 +751,9 @@ Unit Ra386int;
         inexpression:=TRUE;
         parenlevel:=0;
         Repeat
+          { Support ugly delphi constructs like: [ECX].1+2[EDX] }
+          if isref and (actasmtoken=AS_LBRACKET) then
+            break;
           Case actasmtoken of
             AS_LPAREN:
               Begin
@@ -801,12 +804,6 @@ Unit Ra386int;
                  break;
                 expr:=expr + '+';
               end;
-            AS_LBRACKET:
-              begin
-                { Support ugly delphi constructs like: [ECX].1+2[EDX] }
-                if isref then
-                  break;
-              end;
             AS_MINUS:
               Begin
                 Consume(AS_MINUS);
@@ -890,6 +887,11 @@ Unit Ra386int;
                 if hasparen then
                   Consume(AS_RPAREN);
               end;
+            AS_PTR :
+              begin
+                { Support ugly delphi constructs like <constant> PTR [ref] }
+                break;
+              end;
             AS_STRING:
               begin
                 l:=0;
@@ -1091,10 +1093,10 @@ Unit Ra386int;
 
     procedure ti386intreader.BuildReference(oper : tx86operand);
       var
-        k,l,scale : aint;
+        scale : byte;
+        k,l : aint;
         tempstr,hs : string;
         tempsymtyp : tasmsymtype;
-        typesize : longint;
         code : integer;
         hreg : tregister;
         GotStar,GotOffset,HadVar,
@@ -1162,14 +1164,13 @@ Unit Ra386int;
                    Consume(AS_ID);
                    { typecasting? }
                    if (actasmtoken=AS_LPAREN) and
-                      SearchType(tempstr,typesize) then
+                      SearchType(tempstr,l) then
                     begin
                       oper.hastype:=true;
+                      oper.typesize:=l;
                       Consume(AS_LPAREN);
-                      BuildOperand(oper);
+                      BuildOperand(oper,true);
                       Consume(AS_RPAREN);
-                      if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                        oper.SetSize(typesize,true);
                     end
                    else
                     if is_locallabel(tempstr) then
@@ -1467,7 +1468,7 @@ Unit Ra386int;
       end;
 
 
-    Procedure ti386intreader.BuildOperand(oper: tx86operand);
+    Procedure ti386intreader.BuildOperand(oper: tx86operand;istypecast:boolean);
 
         procedure AddLabelOperand(hl:tasmlabel);
         begin
@@ -1487,12 +1488,10 @@ Unit Ra386int;
       var
         expr    : string;
         tempreg : tregister;
-        typesize,
-        l,k     : aint;
+        l       : aint;
         hl      : tasmlabel;
         toffset,
         tsize   : aint;
-        tempstr : string;
       begin
         expr:='';
         repeat
@@ -1535,15 +1534,6 @@ Unit Ra386int;
                 end;
            end;
 
-          { Word,Dword,etc shall now be seen as normal (pascal) typename identifiers }
-          case actasmtoken of
-            AS_DWORD,
-            AS_BYTE,
-            AS_WORD,
-            AS_QWORD :
-              actasmtoken:=AS_ID;
-          end;
-
           case actasmtoken of
             AS_OFFSET,
             AS_SIZEOF,
@@ -1568,6 +1558,25 @@ Unit Ra386int;
                 end;
               end;
 
+            AS_PTR :
+              begin
+                if not oper.hastype then
+                  begin
+                    if (oper.opr.typ=OPR_CONSTANT) then
+                      begin
+                        oper.typesize:=oper.opr.val;
+                        { reset constant value of operand }
+                        oper.opr.typ:=OPR_NONE;
+                        oper.opr.val:=0;
+                      end
+                    else
+                      Message(asmr_e_syn_operand);
+                  end;
+                Consume(AS_PTR);
+                oper.InitRef;
+                BuildOperand(oper,false);
+              end;
+
             AS_ID : { A constant expression, or a Variable ref. }
               Begin
                 { Label or Special symbol reference? }
@@ -1631,18 +1640,17 @@ Unit Ra386int;
                        expr:=actasmpattern;
                        Consume(AS_ID);
                        { typecasting? }
-                       if SearchType(expr,typesize) then
+                       if SearchType(expr,l) then
                         begin
                           oper.hastype:=true;
+                          oper.typesize:=l;
                           case actasmtoken of
                             AS_LPAREN :
                               begin
                                 { Support Type([Reference]) }
                                 Consume(AS_LPAREN);
-                                BuildOperand(oper);
+                                BuildOperand(oper,true);
                                 Consume(AS_RPAREN);
-                                if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                                  oper.SetSize(typesize,true);
                               end;
                             AS_LBRACKET :
                               begin
@@ -1650,11 +1658,7 @@ Unit Ra386int;
                                 { Convert @label.Byte[1] to reference }
                                 if oper.opr.typ=OPR_SYMBOL then
                                   oper.initref;
-                                if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                                  oper.SetSize(typesize,true);
                               end;
-                            else
-                              oper.SetSize(typesize,true);
                           end;
                         end
                        else
@@ -1707,29 +1711,71 @@ Unit Ra386int;
                 Consume(actasmtoken);
               end;
 
+            AS_DWORD,
+            AS_BYTE,
+            AS_WORD,
+            AS_TBYTE,
+            AS_DQWORD,
+            AS_QWORD :
+              begin
+                { Type specifier }
+                oper.hastype:=true;
+                oper.typesize:=0;
+                case actasmtoken of
+                  AS_DWORD : oper.typesize:=4;
+                  AS_WORD  : oper.typesize:=2;
+                  AS_BYTE  : oper.typesize:=1;
+                  AS_QWORD : oper.typesize:=8;
+                  AS_DQWORD : oper.typesize:=16;
+                  AS_TBYTE : oper.typesize:=10;
+                end;
+                Consume(actasmtoken);
+                if (actasmtoken=AS_LPAREN) then
+                  begin
+                    { Support Type([Reference]) }
+                    Consume(AS_LPAREN);
+                    BuildOperand(oper,true);
+                    Consume(AS_RPAREN);
+                  end;
+              end;
+
             AS_SEPARATOR,
             AS_END,
             AS_COMMA,
             AS_COLON:
-              break;
+              begin
+                break;
+              end;
+
+            AS_RPAREN:
+              begin
+                if not istypecast then
+                  begin
+                    Message(asmr_e_syn_operand);
+                    Consume(AS_RPAREN);
+                  end
+                else
+                  break;
+              end;
 
             else
-              Message(asmr_e_syn_operand);
+              begin
+                Message(asmr_e_syn_operand);
+                RecoverConsume(true);
+                break;
+              end;
           end;
-        until not(actasmtoken in [AS_DOT,AS_PLUS,AS_LBRACKET]);
-        if not((actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA,AS_COLON]) or
-               (oper.hastype and (actasmtoken=AS_RPAREN))) then
-         begin
-           Message(asmr_e_syntax_error);
-           RecoverConsume(true);
-         end;
+        until false;
+        { End of operand, update size if a typecast is forced }
+        if (oper.typesize<>0) and
+           (oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL]) then
+          oper.SetSize(oper.typesize,true);
       end;
 
 
     Procedure ti386intreader.BuildOpCode(instr : tx86instruction);
       var
         PrefixOp,OverrideOp: tasmop;
-        size,
         operandnum : longint;
         is_far_const:boolean;
         i:byte;
@@ -1816,6 +1862,7 @@ Unit Ra386int;
                   Inc(operandnum);
                 Consume(AS_COMMA);
               end;
+
             {Far constant, i.e. jmp $0000:$11111111.}
             AS_COLON:
               begin
@@ -1827,47 +1874,6 @@ Unit Ra386int;
                 consume(AS_COLON);
               end;
 
-            { Typecast, Constant Expression, Type Specifier }
-            AS_DWORD,
-            AS_BYTE,
-            AS_WORD,
-            AS_TBYTE,
-            AS_DQWORD,
-            AS_QWORD :
-              begin
-                { load the size in a temp variable, so it can be set when the
-                  operand is read }
-                size:=0;
-                case actasmtoken of
-                  AS_DWORD : size:=4;
-                  AS_WORD  : size:=2;
-                  AS_BYTE  : size:=1;
-                  AS_QWORD : size:=8;
-                  AS_DQWORD : size:=16;
-                  AS_TBYTE : size:=10;
-                end;
-                Consume(actasmtoken);
-                case actasmtoken of
-                  AS_LPAREN :
-                    begin
-                      instr.Operands[operandnum].hastype:=true;
-                      Consume(AS_LPAREN);
-                      BuildOperand(instr.Operands[operandnum] as tx86operand);
-                      Consume(AS_RPAREN);
-                    end;
-                  AS_PTR :
-                    begin
-                      Consume(AS_PTR);
-                      instr.Operands[operandnum].InitRef;
-                      BuildOperand(instr.Operands[operandnum] as tx86operand);
-                    end;
-                  else
-                    BuildOperand(instr.Operands[operandnum] as tx86operand);
-                end;
-                { now set the size which was specified by the override }
-                instr.Operands[operandnum].setsize(size,true);
-              end;
-
             { Type specifier }
             AS_NEAR,
             AS_FAR :
@@ -1888,17 +1894,23 @@ Unit Ra386int;
                    Consume(AS_PTR);
                    instr.Operands[operandnum].InitRef;
                  end;
-                BuildOperand(instr.Operands[operandnum] as tx86operand);
+                BuildOperand(instr.Operands[operandnum] as tx86operand,false);
               end;
             else
-              BuildOperand(instr.Operands[operandnum] as tx86operand);
+              BuildOperand(instr.Operands[operandnum] as tx86operand,false);
           end; { end case }
         until false;
         instr.ops:=operandnum;
-        if is_far_const then
-          for i:=1 to operandnum do
-            if instr.operands[i].opr.typ<>OPR_CONSTANT then
-              message(asmr_e_expr_illegal);
+        { Check operands }
+        for i:=1 to operandnum do
+          begin
+            if is_far_const and
+               (instr.operands[i].opr.typ<>OPR_CONSTANT) then
+              message(asmr_e_expr_illegal)
+            else
+              if instr.operands[i].opr.typ=OPR_NONE then
+                Message(asmr_e_syntax_error);
+          end;
       end;
 
 

compiler/ncginl.pas

@@ -351,7 +351,7 @@ implementation
            hregister:=cg.makeregsize(exprasmlist,left.location.register,OS_INT);
            cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,href,hregister);
            if is_widestring(left.resulttype.def) then
-             cg.a_op_const_reg(exprasmlist,OP_IDIV,OS_INT,cwidechartype.def.size,hregister);
+             cg.a_op_const_reg(exprasmlist,OP_SHR,OS_INT,1,hregister);
            cg.a_label(exprasmlist,lengthlab);
            location_reset(location,LOC_REGISTER,OS_INT);
            location.register:=hregister;

compiler/ncgld.pas

@@ -166,7 +166,7 @@ implementation
                        { don't save the allocated register else the result will be destroyed later }
                        reference_reset_symbol(href,objectlibrary.newasmsymbol(tglobalvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA),0);
                        paramanager.allocparaloc(exprasmlist,paraloc1);
-                       cg.a_param_ref(exprasmlist,OS_ADDR,href,paraloc1);
+                       cg.a_param_ref(exprasmlist,OS_32,href,paraloc1);
                        paramanager.freeparaloc(exprasmlist,paraloc1);
                        paraloc1.done;
                        cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));

compiler/ncnv.pas

@@ -1162,7 +1162,7 @@ implementation
       begin
         result := ccallnode.createinternres(
           'fpc_dynarray_to_variant',
-          ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(resulttype.def),initrtti)),
+          ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(left.resulttype.def),initrtti)),
             ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil)
           ),resulttype);
         resulttypepass(result);

compiler/pass_2.pas

@@ -179,9 +179,7 @@ implementation
             if (not codegenerror) then
              begin
                if (p.location.loc=LOC_INVALID) then
-                 Comment(V_Warning,'Location not set in secondpass: '+nodetype2str[p.nodetype])
-               else if (p.location.loc<>p.expectloc) then
-                 Comment(V_Warning,'Location is different in secondpass: '+nodetype2str[p.nodetype]);
+                 Comment(V_Warning,'Location not set in secondpass: '+nodetype2str[p.nodetype]);
              end;
 {$endif EXTDEBUG}
             if codegenerror then

compiler/pexpr.pas

@@ -2346,6 +2346,9 @@ implementation
              begin
                consume(_PLUS);
                p1:=factor(false);
+               { we must generate a new node to do 0+<p1> otherwise the + will
+                 not be checked }
+               p1:=caddnode.create(addn,genintconstnode(0),p1);
              end;
 
            _MINUS :

compiler/pmodules.pas

@@ -1031,6 +1031,9 @@ implementation
              dispose(s1);
           end;
 
+         if (target_info.system in system_unit_program_exports) then
+           exportlib.preparelib(current_module.realmodulename^);
+
          consume(_ID);
          consume(_SEMICOLON);
          consume(_INTERFACE);
@@ -1437,7 +1440,7 @@ implementation
               stringdispose(current_module.realmodulename);
               current_module.modulename:=stringdup(pattern);
               current_module.realmodulename:=stringdup(orgpattern);
-              if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then
+              if (target_info.system in system_unit_program_exports) then
                 exportlib.preparelib(orgpattern);
               consume(_ID);
               if token=_LKLAMMER then
@@ -1450,7 +1453,7 @@ implementation
                 end;
               consume(_SEMICOLON);
             end
-         else if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then
+         else if (target_info.system in system_unit_program_exports) then
            exportlib.preparelib(current_module.realmodulename^);
 
          { global switches are read, so further changes aren't allowed }

compiler/psub.pas

@@ -1378,18 +1378,13 @@ implementation
               _EXPORTS:
                 begin
                    if not(assigned(current_procinfo.procdef.localst)) or
-                      (current_procinfo.procdef.localst.symtablelevel>main_program_level) or
-                      (current_module.is_unit) then
+                      (current_procinfo.procdef.localst.symtablelevel>main_program_level) then
                      begin
                         Message(parser_e_syntax_error);
                         consume_all_until(_SEMICOLON);
                      end
                    else if islibrary or
-                     (target_info.system in [
-                     system_i386_win32,
-                     system_i386_wdosx,
-                     system_i386_Netware,
-                     system_i386_netwlibc]+system_linux) then
+                     (target_info.system in system_unit_program_exports) then
                      read_exports
                    else
                      begin

compiler/rautils.pas

@@ -88,6 +88,7 @@ type
   end;
 
   TOperand = class
+    typesize : aint;
     hastype,          { if the operand has typecasted variable }
     hasvar : boolean; { if the operand is loaded with a variable }
     size   : TCGSize;

compiler/systems.pas

@@ -50,7 +50,8 @@ interface
              cpu_iA64,                     { 7 }
              cpu_x86_64,                   { 8 }
              cpu_mips,                     { 9 }
-             cpu_arm                       { 10 }
+             cpu_arm,                      { 10 }
+             cpu_powerpc64                 { 11 }
        );
 
        tasmmode= (asmmode_none
@@ -117,7 +118,10 @@ interface
              system_arm_wince,          { 38 }
              system_ia64_win64,         { 39 }
              system_i386_wince,         { 40 }
-             system_x86_6432_linux      { 41 }
+             system_x86_6432_linux,     { 41 }
+             system_arm_gba,            { 42 }
+             system_powerpc64_linux,    { 43 }
+             system_i386_darwin         { 44 }
        );
 
        tasm = (as_none
@@ -139,6 +143,10 @@ interface
              ,as_m68k_mit
              ,as_powerpc_mpw
              ,as_darwin
+             ,as_x86_64_masm
+             ,as_x86_64_pecoff
+             ,as_i386_pecoffwince
+             ,as_arm_pecoffwince
        );
 
        tar = (ar_none
@@ -205,7 +213,7 @@ interface
        pasminfo = ^tasminfo;
        tasminfo = record
           id          : tasm;
-          idtxt       : string[9];
+          idtxt       : string[12];
           asmbin      : string[8];
           asmcmd      : string[50];
           supported_target : tsystem;
@@ -236,7 +244,8 @@ interface
             tf_needs_dwarf_cfi,
             tf_use_8_3,
             tf_pic_uses_got,
-            tf_library_needs_pic
+            tf_library_needs_pic,
+            tf_needs_symbol_type
        );
 
        psysteminfo = ^tsysteminfo;
@@ -248,7 +257,7 @@ interface
           flags        : set of tsystemflags;
           cpu          : tsystemcpu;
           unit_env     : string[16];
-          extradefines : string[40]; 
+          extradefines : string[40];
           exeext,
           defext,
           scriptext,
@@ -298,12 +307,28 @@ interface
        { alias for supported_target field in tasminfo }
        system_any = system_none;
 
-       system_linux : set of tsystem = [system_i386_linux,system_x86_64_linux,system_powerpc_linux,
-                                        system_arm_linux,system_sparc_linux,system_alpha_linux,system_m68k_linux];
+       system_wince : set of tsystem = [system_arm_wince,system_i386_wince];
+       system_linux = [system_i386_linux,system_x86_64_linux,system_powerpc_linux,
+                       system_arm_linux,system_sparc_linux,system_alpha_linux,system_m68k_linux,
+                       system_x86_6432_linux];
+       { all real windows systems, no cripple ones like wince, wdosx et. al. }
+       system_windows : set of tsystem = [system_i386_win32,system_x86_64_win64,system_ia64_win64];
+       { all windows systems }
+       system_all_windows : set of tsystem = [system_i386_win32,system_x86_64_win64,system_ia64_win64,
+                                              system_arm_wince,system_i386_wince];
+
+       { all systems supporting exports from programs or units }
+       system_unit_program_exports : set of tsystem = [system_i386_win32,
+                                         system_i386_wdosx,
+                                         system_i386_Netware,
+                                         system_i386_netwlibc,
+                                         system_arm_wince,
+                                         system_x86_64_win64,
+                                         system_ia64_win64]+system_linux;
 
        cpu2str : array[TSystemCpu] of string =
             ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
-             'mips','arm');
+             'mips','arm', 'powerpc64');
 
     var
        targetinfos   : array[tsystem] of psysteminfo;

rtl/inc/dynarr.inc

@@ -140,6 +140,7 @@ procedure fpc_dynarray_incr_ref(p : pointer);[Public,Alias:'FPC_DYNARRAY_INCR_RE
 { provide local access to dynarr_decr_ref for dynarr_setlength }
 procedure fpc_dynarray_incr_ref(p : pointer); [external name 'FPC_DYNARRAY_INCR_REF'];
 
+
 { provide local access to dynarr_setlength }
 procedure int_dynarray_setlength(var p : pointer;pti : pointer;
   dimcount : dword;dims : pdynarrayindex);[external name 'FPC_DYNARR_SETLENGTH'];
@@ -337,3 +338,8 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
   end;
 
 
+procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: SizeInt; lengthVec: PSizeInt);
+  begin
+    int_dynarray_setlength(a,typeInfo,dimCnt,lengthVec);
+  end;
+

rtl/inc/dynarrh.inc

@@ -28,3 +28,5 @@ type
     eletype : pdynarraytypeinfo;
     vartype : longint;
   end;
+  
+procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: SizeInt; lengthVec: PSizeInt);

rtl/inc/variant.inc

@@ -150,21 +150,18 @@ function fpc_interface_to_variant(const i : iinterface) : variant;compilerproc;
 { Integer }
 
 operator :=(const source : byte) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
-
 begin
   Variantmanager.varfromInt(Dest,Source,1);
 end;
 
 
 operator :=(const source : shortint) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
-
 begin
   Variantmanager.varfromInt(Dest,Source,-1);
 end;
 
 
 operator :=(const source : word) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
-
 begin
   Variantmanager.varfromInt(Dest,Source,2);
 end;
@@ -304,6 +301,12 @@ operator :=(const source : tdatetime) dest : variant;{$ifdef SYSTEMINLINE}inline
     VariantManager.VarFromTDateTime(Dest,Source);
   end;
 
+
+operator :=(const source : error) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    Variantmanager.varfromInt(Dest,Source,-sizeof(error));
+  end;
+  
 {**********************************************************************
                        from Variant assignments
  **********************************************************************}
@@ -318,38 +321,33 @@ end;
 
 
 operator :=(const source : variant) dest : shortint;{$ifdef SYSTEMINLINE}inline;{$endif}
-
-begin
-  dest:=variantmanager.vartoint(source);
-end;
+  begin
+    dest:=variantmanager.vartoint(source);
+  end;
 
 
 operator :=(const source : variant) dest : word;{$ifdef SYSTEMINLINE}inline;{$endif}
-
-begin
-  dest:=variantmanager.vartoint(source);
-end;
+  begin
+    dest:=variantmanager.vartoint(source);
+  end;
 
 
 operator :=(const source : variant) dest : smallint;{$ifdef SYSTEMINLINE}inline;{$endif}
-
-begin
-  dest:=variantmanager.vartoint(source);
-end;
+  begin
+    dest:=variantmanager.vartoint(source);
+  end;
 
 
 operator :=(const source : variant) dest : dword;{$ifdef SYSTEMINLINE}inline;{$endif}
-
-begin
-  dest:=variantmanager.vartoint(source);
-end;
+  begin
+    dest:=variantmanager.vartoint(source);
+  end;
 
 
 operator :=(const source : variant) dest : longint;{$ifdef SYSTEMINLINE}inline;{$endif}
-
-begin
-  dest:=variantmanager.vartoint(source);
-end;
+  begin
+    dest:=variantmanager.vartoint(source);
+  end;
 
 
 operator :=(const source : variant) dest : qword;{$ifdef SYSTEMINLINE}inline;{$endif}
@@ -471,15 +469,15 @@ end;
 
 { Misc. }
 operator :=(const source : variant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
-begin
-  dest:=variantmanager.vartocurr(source);
-end;
+  begin
+    dest:=variantmanager.vartocurr(source);
+  end;
 
 
 operator :=(const source : variant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
-begin
-  dest:=variantmanager.vartotdatetime(source);
-end;
+  begin
+    dest:=variantmanager.vartotdatetime(source);
+  end;
 
 
 operator :=(const source : olevariant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
@@ -493,6 +491,11 @@ operator :=(const source : variant) dest : olevariant;{$ifdef SYSTEMINLINE}inlin
     variantmanager.olevarfromvar(dest,source);
   end;
 
+
+operator :=(const source : variant) dest : error;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    dest:=variantmanager.vartoint(source);
+  end;
 {**********************************************************************
                                Operators
  **********************************************************************}
@@ -781,6 +784,11 @@ operator :=(const source : olevariant) dest : tdatetime;{$ifdef SYSTEMINLINE}inl
   end;
 
 
+operator :=(const source : olevariant) dest : error;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    dest:=variantmanager.vartoint(variant(tvardata(source)));
+  end;
+
 {**********************************************************************
                           to OLEVariant assignments
  **********************************************************************}
@@ -793,43 +801,43 @@ operator :=(const source : byte) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{
 
 operator :=(const source : shortint) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    variantmanager.olevarfromint(dest,source,1);
+    variantmanager.olevarfromint(dest,source,-1);
   end;
 
 
 operator :=(const source : word) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    variantmanager.olevarfromint(dest,source,1);
+    variantmanager.olevarfromint(dest,source,2);
   end;
 
 
 operator :=(const source : smallint) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    variantmanager.olevarfromint(dest,source,1);
+    variantmanager.olevarfromint(dest,source,-2);
   end;
 
 
 operator :=(const source : dword) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    variantmanager.olevarfromint(dest,source,1);
+    variantmanager.olevarfromint(dest,source,4);
   end;
 
 
 operator :=(const source : longint) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    variantmanager.olevarfromint(dest,source,1);
+    variantmanager.olevarfromint(dest,source,-4);
   end;
 
 
 operator :=(const source : qword) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    variantmanager.olevarfromint(dest,source,1);
+    variantmanager.olevarfromint(dest,source,8);
   end;
 
 
 operator :=(const source : int64) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
-    variantmanager.olevarfromint(dest,source,1);
+    variantmanager.olevarfromint(dest,source,-8);
   end;
 
 { Boolean }
@@ -928,6 +936,11 @@ operator :=(const source : tdatetime) dest : olevariant;{$ifdef SYSTEMINLINE}inl
     variantmanager.varfromtdatetime(variant(tvardata(dest)),source);
   end;
 
+
+operator :=(const source : error) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+    variantmanager.olevarfromint(dest,source,-sizeof(error));
+  end;
 {**********************************************************************
                       Variant manager functions
  **********************************************************************}

rtl/inc/varianth.inc

@@ -247,6 +247,7 @@ operator :=(const source : comp) dest : variant;{$ifdef SYSTEMINLINE}inline;{$en
 { Misc. }
 operator :=(const source : currency) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : tdatetime) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
+operator :=(const source : error) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
 
 {**********************************************************************
                        from Variant assignments
@@ -296,6 +297,7 @@ operator :=(const source : variant) dest : olevariant;{$ifdef SYSTEMINLINE}inlin
 { Misc. }
 operator :=(const source : variant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : variant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
+operator :=(const source : variant) dest : error;{$ifdef SYSTEMINLINE}inline;{$endif}
 
 {**********************************************************************
                          Operators
@@ -370,6 +372,7 @@ operator :=(const source : olevariant) dest : comp;{$ifdef SYSTEMINLINE}inline;{
 { Misc. }
 operator :=(const source : olevariant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : olevariant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
+operator :=(const source : olevariant) dest : error;{$ifdef SYSTEMINLINE}inline;{$endif}
 
 {**********************************************************************
                          to OLEVariant assignments
@@ -416,6 +419,7 @@ operator :=(const source : comp) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{
 { Misc. }
 operator :=(const source : currency) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
 operator :=(const source : tdatetime) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
+operator :=(const source : error) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
 
 {**********************************************************************
                              OLEVariant Operators

tests/tbf/tb0176.pp

@@ -0,0 +1,9 @@
+{ %fail }
+
+{$mode objfpc} {$H+}
+begin
+   + ParamStr(0);
+   + ParamCount;
+   + Exit;
+   + WriteLN;
+end.

tests/webtbs/tw4056.pp

@@ -0,0 +1,29 @@
+{$ifdef fpc}{$Mode delphi}{$endif}
+uses
+  uw4056;
+
+type
+  TestC = class(TestB)
+  public
+    procedure TestProc; override;
+    procedure TestProc(const C: Integer); override;
+  end;
+
+var
+  X : TestC;
+
+procedure TestC.TestProc;
+begin
+  inherited TestProc;
+end;
+
+procedure TestC.TestProc(const C: Integer);
+begin
+  inherited TestProc(C);
+end;
+
+begin
+  X := TestC.Create;
+  X.TestProc(10);
+  X.Free;
+end.

tests/webtbs/tw4229.pp

@@ -0,0 +1,30 @@
+{ Source provided for Free Pascal Bug Report 4229 }
+{ Submitted by "Gerhard" on  2005-07-28 }
+{ e-mail: [email protected] }
+unit tw4229 ;
+
+interface
+
+  type
+    strobj = object
+               bs : string ;
+               ba : ansistring ;
+              end ;
+
+  operator := ( const a : ansistring ) z : strobj ;
+
+implementation
+
+  operator := ( const s : string ) z : strobj ;
+
+    begin
+      z.bs := s ;
+     end ;
+
+  operator := ( const a : ansistring ) z : strobj ;
+
+    begin
+      z.ba := a ;
+     end ;
+
+end.

tests/webtbs/tw4450.pp

@@ -0,0 +1,21 @@
+{ %cpu=i386 }
+
+{$ifdef fpc}{$asmmode intel}{$endif}
+
+Type
+float=single;
+var
+  f : float;
+begin
+  f:=4.0;
+asm
+  lea eax,f
+fld SizeOf(float) ptr [eax]
+fsqrt
+fstp SizeOf(float) ptr [eax]
+end;
+  writeln(f);
+  if trunc(f)<>2 then
+    halt(1);
+end.
+

tests/webtbs/uw2364.pp

@@ -0,0 +1,25 @@
+{ %TARGET=win64,wince,win32,linux }
+
+{ Source provided for Free Pascal Bug Report 2364 }
+{ Submitted by "Maarten Bekers" on  2003-02-08 }
+{ e-mail: [email protected] }
+unit tw2364;
+
+interface
+
+type blah = function: integer;
+function iee: integer;
+
+
+var blah2: blah;
+
+implementation
+
+function iee: integer;
+begin
+end;
+
+exports
+  iee;
+
+end.

tests/webtbs/uw4056.pp

@@ -0,0 +1,32 @@
+{$ifdef fpc}{$Mode delphi}{$endif}
+unit uw4056;
+
+interface
+
+type
+  TestA = class
+  protected
+    procedure TestProc; overload; virtual;
+    procedure TestProc(const C: Integer); overload; virtual;
+  end;
+  TestB = class(TestA)
+  public
+    procedure TestProc; override;
+  end;
+
+implementation
+
+procedure TestA.TestProc;
+begin
+end;
+
+procedure TestA.TestProc(const C: Integer);
+begin
+  writeln(C);
+end;
+
+procedure TestB.TestProc;
+begin
+end;
+
+end.