Merged revisions 9605-9606,9620-9621,9624,9626,9632-9637,9646,9652,9655-9656,9658,9692,9694-9695,9697-9714,9716,9720,9722-9723,9726-9729,9732-9734,9740,9745,9749-9750,9753-9757,9760-9770,9772-9774,9814,9817 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r9605 | florian | 2008-01-01 12:03:55 +0100 (Tue, 01 Jan 2008) | 1 line
  
  * updates from Karl-Michael Schindler
........
  r9606 | florian | 2008-01-01 12:07:42 +0100 (Tue, 01 Jan 2008) | 2 lines
  
  * regenerated
........
  r9620 | jonas | 2008-01-03 13:45:13 +0100 (Thu, 03 Jan 2008) | 2 lines
  
    * fixed ppc compiler compilation with -dextdebug
........
  r9621 | jonas | 2008-01-03 13:47:31 +0100 (Thu, 03 Jan 2008) | 4 lines
  
    * only use ".set" directive when creating dwarf relsyms on darwin and
      not for other relsyms, as older versions of the darwin assembler
      don't understand the ".set" directive (mantis #10541)
........
  r9624 | jonas | 2008-01-04 13:54:47 +0100 (Fri, 04 Jan 2008) | 2 lines
  
    * perform real "exactness" checking for open array parameters
........
  r9626 | jonas | 2008-01-04 21:51:09 +0100 (Fri, 04 Jan 2008) | 5 lines
  
    * don't change the temp location of types which needs to be
      initialised/finalised, because the init/final generation code
      happens after pass 2 using plain nodes and therefore needs the
      original locations intact
........
  r9646 | jonas | 2008-01-05 22:35:42 +0100 (Sat, 05 Jan 2008) | 2 lines
  
    * fixed sign of location.size for divmodn, 64 shlshrn and for muln
........
  r9652 | jonas | 2008-01-06 16:30:04 +0100 (Sun, 06 Jan 2008) | 3 lines
  
    * typecheckpass before calling do_simplify, as the siplify methods
      assume that the resultdefs are available
........
  r9716 | jonas | 2008-01-11 22:18:49 +0100 (Fri, 11 Jan 2008) | 4 lines
  
    * perform floating point type conversions directly in assignment nodes
      when possible, as this can save a lot of useless memory traffic
      (and fpu<->sse conversions on x86)
........
  r9723 | jonas | 2008-01-12 17:47:46 +0100 (Sat, 12 Jan 2008) | 3 lines
  
    * enable {$push}/{$pop} in all syntax modes instead of ony in macpas
      (mantis #10351)
........
  r9726 | jonas | 2008-01-12 20:01:49 +0100 (Sat, 12 Jan 2008) | 4 lines
  
    * simply discard overloaded routines which cannot accept a variant
      when determining the optimal candidate for a single variant
      parameter, rather than giving an internal error (mantis #10623)
........
  r9727 | florian | 2008-01-12 23:25:33 +0100 (Sat, 12 Jan 2008) | 2 lines
  
  + accept system.string, resolves #10489
........
  r9728 | florian | 2008-01-13 10:59:13 +0100 (Sun, 13 Jan 2008) | 2 lines
  
  * use the current cgsizes instead of the def to determine if loadfpu can be used, else softfloats are broken
........
  r9734 | florian | 2008-01-13 14:23:19 +0100 (Sun, 13 Jan 2008) | 2 lines
  
  * reverted 9727 and made a better fix for it
........
  r9767 | florian | 2008-01-15 22:36:58 +0100 (Tue, 15 Jan 2008) | 3 lines
  
  * better detection of source file change while writing debug info
  * set module index before replaying tokens of a generic
........
  r9817 | florian | 2008-01-20 16:13:42 +0100 (Sun, 20 Jan 2008) | 2 lines
  
  * win64 -glw build fix
........

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

.gitattributes

@@ -6095,6 +6095,7 @@ tests/tbf/tb0201.pp svneol=native#text/plain
 tests/tbf/tb0202.pp svneol=native#text/plain
 tests/tbf/tb0204.pp svneol=native#text/plain
 tests/tbf/tb0204a.pp svneol=native#text/plain
+tests/tbf/tb0205.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
@@ -7820,10 +7821,12 @@ tests/webtbs/tw10425.pp svneol=native#text/plain
 tests/webtbs/tw1044.pp svneol=native#text/plain
 tests/webtbs/tw10454.pp svneol=native#text/plain
 tests/webtbs/tw1046.pp svneol=native#text/plain
+tests/webtbs/tw10489.pp svneol=native#text/plain
 tests/webtbs/tw1050.pp svneol=native#text/plain
 tests/webtbs/tw10519.pp svneol=native#text/plain
 tests/webtbs/tw10540.pp svneol=native#text/plain
 tests/webtbs/tw1061.pp svneol=native#text/plain
+tests/webtbs/tw10623.pp svneol=native#text/plain
 tests/webtbs/tw1066a.pp svneol=native#text/plain
 tests/webtbs/tw1066b.pp svneol=native#text/plain
 tests/webtbs/tw1068.pp svneol=native#text/plain

compiler/aasmtai.pas

@@ -96,7 +96,22 @@ interface
           aitconst_rva_symbol,
           aitconst_secrel32_symbol,
           { darwin only }
-          aitconst_indirect_symbol
+          aitconst_indirect_symbol,
+          { From gcc/config/darwin.c (darwin_asm_output_dwarf_delta):
+            ***
+            Output a difference of two labels that will be an assembly time
+            constant if the two labels are local.  (.long lab1-lab2 will be
+            very different if lab1 is at the boundary between two sections; it
+            will be relocated according to the second section, not the first,
+            so one ends up with a difference between labels in different
+            sections, which is bad in the dwarf2 eh context for instance.)
+            ***
+            We cannot use this everywhere, because older versions of the
+            darwin assembler don't support the construct used for these
+            relsyms (nor do they support dwarf, for that matter)
+          }
+          aitconst_darwin_dwarf_delta64,
+          aitconst_darwin_dwarf_delta32
         );
 
     const

compiler/aggas.pas

@@ -205,10 +205,10 @@ implementation
 
 
     const
-      ait_const2str : array[aitconst_128bit..aitconst_indirect_symbol] of string[20]=(
+      ait_const2str : array[aitconst_128bit..aitconst_darwin_dwarf_delta32] of string[20]=(
         #9'.fixme128'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9,
         #9'.sleb128'#9,#9'.uleb128'#9,
-        #9'.rva'#9,#9'.secrel32'#9,#9'.indirect_symbol'#9
+        #9'.rva'#9,#9'.secrel32'#9,#9'.indirect_symbol'#9,#9'.quad'#9,#9'.long'#9
       );
 
 {****************************************************************************}
@@ -690,10 +690,12 @@ implementation
                  aitconst_8bit,
                  aitconst_rva_symbol,
                  aitconst_secrel32_symbol,
-                 aitconst_indirect_symbol :
+                 aitconst_indirect_symbol,
+                 aitconst_darwin_dwarf_delta32,
+                 aitconst_darwin_dwarf_delta64:
                    begin
                      if (target_info.system in systems_darwin) and
-                        (tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) then
+                        (constdef in [aitconst_uleb128bit,aitconst_sleb128bit]) then
                        begin
                          AsmWrite(ait_const2str[aitconst_8bit]);
                          case tai_const(hp).consttype of
@@ -705,7 +707,7 @@ implementation
                        end
                      else
                        begin
-                         AsmWrite(ait_const2str[tai_const(hp).consttype]);
+                         AsmWrite(ait_const2str[constdef]);
                          l:=0;
                          t := '';
                          repeat
@@ -713,7 +715,7 @@ implementation
                              begin
                                if assigned(tai_const(hp).endsym) then
                                  begin
-                                   if (target_info.system in systems_darwin) then
+                                   if (constdef in [aitconst_darwin_dwarf_delta32,aitconst_darwin_dwarf_delta64]) then
                                      begin
                                        s := NextSetLabel;
                                        t := #9'.set '+s+','+tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name;

compiler/cgobj.pas

@@ -259,6 +259,7 @@ unit cgobj;
           procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize:tcgsize; reg1, reg2: tregister); virtual; abstract;
           procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); virtual; abstract;
           procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); virtual; abstract;
+          procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tcgsize; const ref1,ref2: treference);
           procedure a_loadfpu_loc_reg(list: TAsmList; tosize: tcgsize; const loc: tlocation; const reg: tregister);
           procedure a_loadfpu_reg_loc(list: TAsmList; fromsize: tcgsize; const reg: tregister; const loc: tlocation);
           procedure a_paramfpu_reg(list : TAsmList;size : tcgsize;const r : tregister;const cgpara : TCGPara);virtual;
@@ -2466,6 +2467,21 @@ implementation
       end;
 
 
+    procedure tcg.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tcgsize; const ref1,ref2: treference);
+      var
+        reg: tregister;
+        regsize: tcgsize;
+      begin
+        if (fromsize>=tosize) then
+          regsize:=fromsize
+        else
+          regsize:=tosize;
+        reg:=getfpuregister(list,regsize);
+        a_loadfpu_ref_reg(list,fromsize,regsize,ref1,reg);
+        a_loadfpu_reg_ref(list,regsize,tosize,reg,ref2);
+      end;
+
+
     procedure tcg.a_paramfpu_reg(list : TAsmList;size : tcgsize;const r : tregister;const cgpara : TCGPara);
       var
          ref : treference;

compiler/dbgdwarf.pas

@@ -643,11 +643,17 @@ implementation
                offsetabstype:=aitconst_secrel32_symbol
              else
                offsetabstype:=aitconst_32bit;
-             offsetreltype:=aitconst_32bit;
+             if (target_info.system in systems_darwin) then
+                offsetreltype:=aitconst_darwin_dwarf_delta32
+              else
+                offsetreltype:=aitconst_32bit;
            end
          else
            begin
-             offsetreltype:=aitconst_64bit;
+             if (target_info.system in systems_darwin) then
+                offsetreltype:=aitconst_darwin_dwarf_delta64
+             else
+               offsetreltype:=aitconst_64bit;
              offsetabstype:=aitconst_64bit;
            end;
       end;
@@ -1548,7 +1554,7 @@ implementation
               files for debugging and also that gdb only loads in the
               debug info of a particular object file once you step into
               or over a procedure in it.
-              
+
               To solve this, there is a tool called dsymutil which can
               extract all the dwarf info from a program's object files.
               This utility however performs "smart linking" on the dwarf
@@ -1556,7 +1562,7 @@ implementation
               variables' types always point to the dwarfino for a tdef
               and never to that for a typesym, this means all debug
               entries generated for typesyms are thrown away.
-              
+
               The problem with that is that we translate typesyms into
               DW_TAG_typedef, and gdb's dwarf-2 reader only makes types
               globally visibly if they are defined using a DW_TAG_typedef.
@@ -1567,7 +1573,7 @@ implementation
               tdef dwarf info is still available, but you cannot typecast
               anything outside the declaring units because the type names
               are not known there).
-              
+
               The solution: if a tdef has an associated typesym, let the
               debug label for the tdef point to a DW_TAG_typedef instead
               of directly to the tdef itself. And don't write anything
@@ -2340,7 +2346,7 @@ implementation
             if ditem.Name = '.' then
               Continue;
             { Write without trailing path delimiter and also don't prefix with ./ for current dir (already done while adding to dirlist }
-            
+
             linelist.concat(tai_string.create(ditem.Name+#0));
           end;
         linelist.concat(tai_const.create_8bit(0));
@@ -2370,7 +2376,7 @@ implementation
 
         { end of debug line table }
         linelist.concat(tai_symbol.createname(target_asm.labelprefix+'edebug_line0',AT_DATA,0));
-        
+
         flist.free;
       end;
 
@@ -2604,9 +2610,10 @@ implementation
                 currfileinfo:=tailineinfo(hp).fileinfo;
                 { file changed ? (must be before line info) }
                 if (currfileinfo.fileindex<>0) and
-                   (lastfileinfo.fileindex<>currfileinfo.fileindex) then
+                   ((lastfileinfo.fileindex<>currfileinfo.fileindex) or
+                    (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then
                   begin
-                    infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
+                    infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex);
                     if assigned(infile) then
                       begin
                         currfileidx := get_file_index(infile);

compiler/dbgstabs.pas

@@ -1573,9 +1573,10 @@ implementation
                 currfileinfo:=tailineinfo(hp).fileinfo;
                 { file changed ? (must be before line info) }
                 if (currfileinfo.fileindex<>0) and
-                   (lastfileinfo.fileindex<>currfileinfo.fileindex) then
+                   ((lastfileinfo.fileindex<>currfileinfo.fileindex) or
+                    (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then
                   begin
-                    infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
+                    infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex);
                     if assigned(infile) then
                       begin
                         current_asmdata.getlabel(hlabel,alt_dbgfile);

compiler/defcmp.pas

@@ -697,7 +697,10 @@ implementation
                              { open array -> open array }
                              if is_open_array(def_from) and
                                 equal_defs(tarraydef(def_from).elementdef,tarraydef(def_to).elementdef) then
-                               eq:=te_equal
+                               if tarraydef(def_from).elementdef=tarraydef(def_to).elementdef then
+                                 eq:=te_exact
+                               else
+                                 eq:=te_equal
                             else
                              { array -> open array }
                              if not(cdo_parameter in cdoptions) and
@@ -1558,12 +1561,13 @@ implementation
               { check type }
               if eq=te_incompatible then
                 exit;
-              { open arrays can never match exactly, since you cannot define }
-              { a separate "open array" type -> we have to be able to        }
-              { consider those as exact when resolving forward definitions.  }
-              { The same goes for openstrings and array of const             }
-              if (is_open_array(currpara1.vardef) or
-                  is_array_of_const(currpara1.vardef) or
+              { open strings can never match exactly, since you cannot define }
+              { a separate "open string" type -> we have to be able to        }
+              { consider those as exact when resolving forward definitions.   }
+              { The same goes for array of const. Open arrays are handled     }
+              { already (if their element types match exactly, they are       }
+              { considered to be an exact match)                              }
+              if (is_array_of_const(currpara1.vardef) or
                   is_open_string(currpara1.vardef)) and
                  (eq=te_equal) and
                  (cpo_openequalisexact in cpoptions) then

compiler/htypechk.pas

@@ -2236,7 +2236,6 @@ implementation
         variantstringdef_cl: array[tstringtype] of tvariantequaltype =
           (tve_sstring,tve_astring,tve_astring,tve_wstring);
       begin
-        result:=tve_incompatible;
         case def.typ of
           orddef:
             begin
@@ -2255,7 +2254,9 @@ implementation
               result:=tve_boolformal;
             end;
           else
-            internalerror(2006122804);
+            begin
+              result:=tve_incompatible;
+            end;
         end
       end;
 
@@ -2420,6 +2421,11 @@ implementation
         { if both are the same, there is a conflict }
         if (currvcl=bestvcl) then
           result:=0
+        { if one of the two cannot be used as variant, the other is better }
+        else if (bestvcl=tve_incompatible) then
+          result:=1
+        else if (currvcl=tve_incompatible) then
+          result:=-1
         { boolean and formal are better than chari64str, but conflict with }
         { everything else                                                  }
         else if (currvcl=tve_boolformal) or
@@ -2450,7 +2456,7 @@ implementation
           result:=calculate_relation(currvcl,bestvcl,tve_smallint,[tve_cardinal])
         { cardinal conflicts with each longint and is better than everything }
         { which has not yet been tested                                      }
-        else if (currvcl = tve_cardinal) or
+        else if (currvcl=tve_cardinal) or
                 (bestvcl=tve_cardinal) then
           result:=calculate_relation(currvcl,bestvcl,tve_cardinal,[tve_longint])
         { longint is better than everything which has not yet been tested }

compiler/i386/n386add.pas

@@ -40,7 +40,7 @@ interface
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,paramgr,
+      symconst,symdef,paramgr,defutil,
       aasmbase,aasmtai,aasmdata,aasmcpu,
       cgbase,procinfo,
       ncon,nset,cgutils,tgobj,
@@ -108,7 +108,7 @@ interface
               hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
               hregister2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
               cg64.a_load64_loc_reg(current_asmdata.CurrAsmList,left.location,joinreg64(hregister,hregister2));
-              location_reset(left.location,LOC_REGISTER,OS_64);
+              location_reset(left.location,LOC_REGISTER,left.location.size);
               left.location.register64.reglo:=hregister;
               left.location.register64.reghi:=hregister2;
             end
@@ -279,7 +279,7 @@ interface
                  hregister2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
                  cg64.a_load64_loc_reg(current_asmdata.CurrAsmList,left.location,joinreg64(hregister,hregister2));
                  location_freetemp(current_asmdata.CurrAsmList,left.location);
-                 location_reset(left.location,LOC_REGISTER,OS_64);
+                 location_reset(left.location,LOC_REGISTER,left.location.size);
                  left.location.register64.reglo:=hregister;
                  left.location.register64.reghi:=hregister2;
                end;
@@ -354,7 +354,7 @@ interface
       pass_left_right;
 
       {The location.register will be filled in later (JM)}
-      location_reset(location,LOC_REGISTER,OS_INT);
+      location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
       { Mul supports registers and references, so if not register/reference,
         load the location into a register}
       use_ref:=false;

compiler/i386/n386mat.pas

@@ -93,8 +93,8 @@ implementation
           { should be handled in pass_1 (JM) }
           internalerror(200109052);
         { put numerator in register }
-        location_reset(location,LOC_REGISTER,OS_INT);
-        location_force_reg(current_asmdata.CurrAsmList,left.location,OS_INT,false);
+        location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+        location_force_reg(current_asmdata.CurrAsmList,left.location,location.size,false);
         hreg1:=left.location.register;
 
         if (nodetype=divn) and (right.nodetype=ordconstn) then
@@ -368,10 +368,10 @@ implementation
         v : TConstExprInt;
         l1,l2,l3:Tasmlabel;
       begin
-        location_reset(location,LOC_REGISTER,OS_64);
+        location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
 
         { load left operator in a register }
-        location_force_reg(current_asmdata.CurrAsmList,left.location,OS_64,false);
+        location_force_reg(current_asmdata.CurrAsmList,left.location,location.size,false);
         hreg64hi:=left.location.register64.reghi;
         hreg64lo:=left.location.register64.reglo;
 

compiler/msg/errord.msg

@@ -3,7 +3,7 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at physik.uni-halle.de>
 #
-#   Based on errore.msg of SVN revision 9149 + one
+#   Based on errore.msg of SVN revision 9207 + one
 #
 #   This file is part of the Free Pascal Compiler
 #   Copyright (c) 1998-2000 by the Free Pascal Development team
@@ -186,7 +186,7 @@ scan_e_illegal_pack_records=02015_E_Ung
 scan_e_illegal_pack_enum=02016_E_Ung�ltige minimale Gr”sse der Aufz„hlung "$1"
 % You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for
 % \var{n}. Only 1,2 or 4 NORMAL or DEFAULT are valid in this case.
-scan_e_endif_expected=02017_E_$1 erwartet f�r $1 $2 definiert in $3 Zeile $4
+scan_e_endif_expected=02017_E_$ENDIF erwartet f�r $1 $2 definiert in $3 Zeile $4
 % Your conditional compilation statements are unbalanced.
 scan_e_preproc_syntax_error=02018_E_Syntaxfehler im Argument einer $if Direktive
 % There is an error in the expression following the \var{\{\$if ..\}} compiler
@@ -1142,7 +1142,7 @@ parser_w_register_list_ignored=03237_W_Registerliste wird in reinen Assemblerrou
 #
 # Type Checking
 #
-# 04082 is the last used one
+# 04083 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1417,6 +1417,9 @@ type_w_pointer_to_signed=04082_W_Die Konvertierung von Pointern in einen Integer
 % allocate memory above \$80000000, for example both Windows and Linux allow pointers in the range \$0000000 to \$bfffffff.
 % If you convert pointers to signed types, this can cause overflow and range check errors, but also \$80000000 < \$7fffffff.
 % This can cause random errors in code like "if p>q".
+type_interface_has_no_guid=04083_E_Interface Typ $1 hat keine g�ltige GUID
+% When applying the as-operator to an interface or class, the desired interface, i.e. the right operand of the
+% as-operator must have a valid GUID
 % \end{description}
 #
 # Symtable
@@ -1719,7 +1722,7 @@ cg_e_goto_label_not_found=06049_E_Goto Label "$1": Das Label ist nicht definiert
 #
 # Assembler reader
 #
-# 07106 is the last used one
+# 07107 is the last used one
 #
 asmr_d_start_reading=07000_DL_Starte $1 Stil Assembler Parsen
 % This informs you that an assembler block is being parsed
@@ -1960,7 +1963,11 @@ asmr_w_direct_esp_neg_offset=07105_W_Verwendung von -offset(%esp); Zugriff kann
 % Using -8(%esp) to access a local stack is not recommended, as
 % this stack portion can be overwritten by any function calls or interrupts.
 asmr_e_no_vmtoffset_possible=07106_E_VMTOffset muss in Kombination mit einer virtuellen Methode verwendet werden; "$1" ist aber nicht virtuell
-%
+% Only virtual methods have VMT offsets
+asmr_e_need_pic_ref=07107_E_Erzeuge eigentlich PIC, aber die Referenz ist nicht PIC-sicher
+% The compiler has been configured to generate position-independent code
+% (PIC), but there are position-dependent references in the current
+% handwritten assembler instruction.
 #
 # Assembler/binary writers
 #

compiler/msg/errordu.msg

@@ -3,7 +3,7 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at physik.uni-halle.de>
 #
-#   Based on errore.msg of SVN revision 9149 + one
+#   Based on errore.msg of SVN revision 9207 + one
 #
 #   This file is part of the Free Pascal Compiler
 #   Copyright (c) 1998-2000 by the Free Pascal Development team
@@ -186,7 +186,7 @@ scan_e_illegal_pack_records=02015_E_Ungültige Record Ausrichtung "$1"
 scan_e_illegal_pack_enum=02016_E_Ungültige minimale Grösse der Aufzählung "$1"
 % You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for
 % \var{n}. Only 1,2 or 4 NORMAL or DEFAULT are valid in this case.
-scan_e_endif_expected=02017_E_$1 erwartet für $1 $2 definiert in $3 Zeile $4
+scan_e_endif_expected=02017_E_$ENDIF erwartet für $1 $2 definiert in $3 Zeile $4
 % Your conditional compilation statements are unbalanced.
 scan_e_preproc_syntax_error=02018_E_Syntaxfehler im Argument einer $if Direktive
 % There is an error in the expression following the \var{\{\$if ..\}} compiler
@@ -1142,7 +1142,7 @@ parser_w_register_list_ignored=03237_W_Registerliste wird in reinen Assemblerrou
 #
 # Type Checking
 #
-# 04082 is the last used one
+# 04083 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1417,6 +1417,9 @@ type_w_pointer_to_signed=04082_W_Die Konvertierung von Pointern in einen Integer
 % allocate memory above \$80000000, for example both Windows and Linux allow pointers in the range \$0000000 to \$bfffffff.
 % If you convert pointers to signed types, this can cause overflow and range check errors, but also \$80000000 < \$7fffffff.
 % This can cause random errors in code like "if p>q".
+type_interface_has_no_guid=04083_E_Interface Typ $1 hat keine gültige GUID
+% When applying the as-operator to an interface or class, the desired interface, i.e. the right operand of the
+% as-operator must have a valid GUID
 % \end{description}
 #
 # Symtable
@@ -1719,7 +1722,7 @@ cg_e_goto_label_not_found=06049_E_Goto Label "$1": Das Label ist nicht definiert
 #
 # Assembler reader
 #
-# 07106 is the last used one
+# 07107 is the last used one
 #
 asmr_d_start_reading=07000_DL_Starte $1 Stil Assembler Parsen
 % This informs you that an assembler block is being parsed
@@ -1960,7 +1963,11 @@ asmr_w_direct_esp_neg_offset=07105_W_Verwendung von -offset(%esp); Zugriff kann
 % Using -8(%esp) to access a local stack is not recommended, as
 % this stack portion can be overwritten by any function calls or interrupts.
 asmr_e_no_vmtoffset_possible=07106_E_VMTOffset muss in Kombination mit einer virtuellen Methode verwendet werden; "$1" ist aber nicht virtuell
-%
+% Only virtual methods have VMT offsets
+asmr_e_need_pic_ref=07107_E_Erzeuge eigentlich PIC, aber die Referenz ist nicht PIC-sicher
+% The compiler has been configured to generate position-independent code
+% (PIC), but there are position-dependent references in the current
+% handwritten assembler instruction.
 #
 # Assembler/binary writers
 #

compiler/msg/errore.msg

@@ -1138,7 +1138,7 @@ parser_w_register_list_ignored=03237_W_Register list is ignored for pure assembl
 #
 # Type Checking
 #
-# 04082 is the last used one
+# 04083 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1412,7 +1412,7 @@ type_w_pointer_to_signed=04082_W_Converting pointers to signed integers may resu
 % allocate memory above \$80000000, for example both Windows and Linux allow pointers in the range \$0000000 to \$bfffffff.
 % If you convert pointers to signed types, this can cause overflow and range check errors, but also \$80000000 < \$7fffffff.
 % This can cause random errors in code like "if p>q".
-type_interface_has_no_guid=04084_E_Interface type $1 has no valid GUID
+type_interface_has_no_guid=04083_E_Interface type $1 has no valid GUID
 % When applying the as-operator to an interface or class, the desired interface, i.e. the right operand of the
 % as-operator must have a valid GUID
 % \end{description}
@@ -1958,7 +1958,7 @@ asmr_w_direct_esp_neg_offset=07105_W_Use of -offset(%esp), access may cause a cr
 % Using -8(%esp) to access a local stack is not recommended, as
 % this stack portion can be overwritten by any function calls or interrupts.
 asmr_e_no_vmtoffset_possible=07106_E_VMTOffset must be used in combination with a virtual method, and "$1" is not virtual
-% Only virtul methods have a VMT offset
+% Only virtual methods have VMT offsets
 asmr_e_need_pic_ref=07107_E_Generating PIC, but reference is not PIC-safe
 % The compiler has been configured to generate position-independent code
 % (PIC), but there are position-dependent references in the current

compiler/msgidx.inc

@@ -397,7 +397,7 @@ const
   type_h_convert_sub_operands_to_prevent_overflow=04080;
   type_h_convert_mul_operands_to_prevent_overflow=04081;
   type_w_pointer_to_signed=04082;
-  type_interface_has_no_guid=04084;
+  type_interface_has_no_guid=04083;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -737,6 +737,6 @@ const
   MsgTxtSize = 45480;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,86,238,85,63,50,108,22,135,60,
+    24,86,238,84,63,50,108,22,135,60,
     42,1,1,1,1,1,1,1,1,1
   );

compiler/msgtxt.inc

@@ -456,7 +456,7 @@ const msgtxt : array[0..000189,1..240] of char=(
   'd prevent overflow errors.'#000+
   '04082_W_Converting pointers to signed integers may result in wrong com'+
   'p','arison results and range errors, use an unsigned type instead.'#000+
-  '04084_E_Interface type $1 has no valid GUID'#000+
+  '04083_E_Interface type $1 has no valid GUID'#000+
   '05000_E_Identifier not found "$1"'#000+
   '05001_F_Internal Error in SymTableStack()'#000+
   '05002_E_Duplicate identifier "$1"'#000+

compiler/ncal.pas

@@ -2874,6 +2874,7 @@ implementation
           again inside the args or itself }
         exclude(procdefinition.procoptions,po_inline);
 
+        typecheckpass(createblock);
         dosimplify(createblock);
         firstpass(createblock);
         include(procdefinition.procoptions,po_inline);

compiler/ncgld.pas

@@ -572,27 +572,57 @@ implementation
                     LOC_REFERENCE,
                     LOC_CREFERENCE :
                       begin
-{$warning HACK: unaligned test, maybe remove all unaligned locations (array of char) from the compiler}
-                        { Use unaligned copy when the offset is not aligned }
-                        len:=left.resultdef.size;
-                        if (right.location.reference.offset mod sizeof(aint)<>0) or
-                          (left.location.reference.offset mod sizeof(aint)<>0) or
-                          (right.resultdef.alignment<sizeof(aint)) or
-                          ((right.location.reference.alignment<>0) and
-                           (right.location.reference.alignment<sizeof(aint))) or
-                          ((left.location.reference.alignment<>0) and
-                           (left.location.reference.alignment<sizeof(aint))) then
-                          cg.g_concatcopy_unaligned(current_asmdata.CurrAsmList,right.location.reference,left.location.reference,len)
+                        if (left.resultdef.typ=floatdef) and
+                           (right.resultdef.typ=floatdef) and
+                           (left.location.size<>right.location.size) then
+                          begin
+                            cg.a_loadfpu_ref_ref(current_asmdata.CurrAsmList,
+                              right.location.size,left.location.size,
+                              right.location.reference,left.location.reference)
+                          end
                         else
-                          cg.g_concatcopy(current_asmdata.CurrAsmList,right.location.reference,left.location.reference,len);
+                          begin
+{$warning HACK: unaligned test, maybe remove all unaligned locations (array of char) from the compiler}
+                            { Use unaligned copy when the offset is not aligned }
+                            len:=left.resultdef.size;
+                            if (right.location.reference.offset mod sizeof(aint)<>0) or
+                              (left.location.reference.offset mod sizeof(aint)<>0) or
+                              (right.resultdef.alignment<sizeof(aint)) or
+                              ((right.location.reference.alignment<>0) and
+                               (right.location.reference.alignment<sizeof(aint))) or
+                              ((left.location.reference.alignment<>0) and
+                               (left.location.reference.alignment<sizeof(aint))) then
+                              cg.g_concatcopy_unaligned(current_asmdata.CurrAsmList,right.location.reference,left.location.reference,len)
+                            else
+                              cg.g_concatcopy(current_asmdata.CurrAsmList,right.location.reference,left.location.reference,len);
+                          end;
                       end;
                     LOC_MMREGISTER,
                     LOC_CMMREGISTER:
-                      cg.a_loadmm_ref_reg(current_asmdata.CurrAsmList,
-                        right.location.size,
-                        left.location.size,
-                        right.location.reference,
-                        left.location.register,mms_movescalar);
+                      begin
+{$ifdef x86}
+                        if not use_sse(right.resultdef) then
+                          begin
+                            { perform size conversion if needed (the mm-code cannot }
+                            { convert an extended into a double/single, since sse   }
+                            { doesn't support extended)                             }
+                            r:=cg.getfpuregister(current_asmdata.CurrAsmList,right.location.size);
+                            tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,tt_normal,href);
+                            cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,right.location.size,right.location.size,right.location.reference,r);
+                            cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,r,href);
+                            if releaseright then
+                              location_freetemp(current_asmdata.CurrAsmList,right.location);
+                            releaseright:=true;
+                            location_reset(right.location,LOC_REFERENCE,left.location.size);
+                            right.location.reference:=href;
+                          end;
+{$endif}
+                        cg.a_loadmm_ref_reg(current_asmdata.CurrAsmList,
+                          right.location.size,
+                          left.location.size,
+                          right.location.reference,
+                          left.location.register,mms_movescalar);
+                      end;
                     LOC_SUBSETREG,
                     LOC_CSUBSETREG:
                       cg.a_load_ref_subsetreg(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.sreg);
@@ -649,6 +679,17 @@ implementation
                   { we can't do direct moves between fpu and mm registers }
                   if left.location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER] then
                     begin
+{$ifdef x86}
+                      if not use_sse(right.resultdef) then
+                        begin
+                          { perform size conversion if needed (the mm-code cannot convert an   }
+                          { extended into a double/single, since sse doesn't support extended) }
+                          tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,tt_normal,href);
+                          cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.register,href);
+                          location_reset(right.location,LOC_REFERENCE,left.location.size);
+                          right.location.reference:=href;
+                        end;
+{$endif}
                       location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,false);
                       cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,
                           right.location.size,left.location.size,

compiler/nld.pas

@@ -70,6 +70,7 @@ interface
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
+          function simplify : tnode;override;
        {$ifdef state_tracking}
           function track_state_pass(exec_known:boolean):boolean;override;
        {$endif state_tracking}
@@ -147,6 +148,7 @@ implementation
       symnot,
       defutil,defcmp,
       htypechk,pass_1,procinfo,paramgr,
+      cpuinfo,
       ncon,ninl,ncnv,nmem,ncal,nutils,nbas,
       cgobj,cgbase
       ;
@@ -485,6 +487,22 @@ implementation
       end;
 
 
+    function tassignmentnode.simplify : tnode;
+      begin
+        result:=nil;
+        { assignment nodes can perform several floating point }
+        { type conversions directly, so no typeconversions    }
+        { are inserted in those cases. When inlining, a       }
+        { variable may be replaced by a constant which can be }
+        { converted at compile time, so check for this case   }
+        if is_real(left.resultdef) and
+           is_real(right.resultdef) and
+           is_constrealnode(right) and
+           not equal_defs(right.resultdef,left.resultdef) then
+          inserttypeconv(right,left.resultdef);
+      end;
+
+
     function tassignmentnode.pass_typecheck:tnode;
       var
         hp : tnode;
@@ -563,6 +581,25 @@ implementation
                exit;
             end
          end
+        { floating point assignments can also perform the conversion directly }
+        else if is_real(left.resultdef) and is_real(right.resultdef) and
+                not is_constrealnode(right)
+{$ifdef cpufpemu}
+                { the emulator can't do this obviously }
+                and not(current_settings.fputype in [fpu_libgcc,fpu_soft])
+{$endif cpufpemu}
+
+{$ifdef x86}
+                { the assignment node code can't convert a double in an }
+                { sse register to an extended value in memory more      }
+                { efficiently than a type conversion node, so don't     }
+                { bother implementing support for that                  }
+                and (use_sse(left.resultdef) or not(use_sse(right.resultdef)))
+{$endif}
+        then
+          begin
+            check_ranges(fileinfo,right,left.resultdef);
+          end
         else
           begin
             { check if the assignment may cause a range check error }

compiler/ogcoff.pas

@@ -1546,6 +1546,8 @@ const pemagic : array[0..3] of byte = (
                rel_type:=RELOC_RELATIVE_4;
              IMAGE_REL_AMD64_REL32_5:
                rel_type:=RELOC_RELATIVE_5;
+             IMAGE_REL_AMD64_SECREL:
+               rel_type:=RELOC_SECREL32;
 {$endif x86_64}
            else
              begin

compiler/pbase.pas

@@ -88,7 +88,7 @@ interface
     function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean;
     function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean;
 
-    function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable):boolean;
+    function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume : ttoken):boolean;
 
     function try_consume_hintdirective(var symopt:tsymoptions):boolean;
 
@@ -100,7 +100,7 @@ interface
 implementation
 
     uses
-       globtype,htypechk,scanner,systems,verbose;
+       globtype,htypechk,scanner,systems,verbose,fmodule;
 
 {****************************************************************************
                                Token Parsing
@@ -177,6 +177,8 @@ implementation
       must be changed as well (FK)
     }
     function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean;
+      var
+        t : ttoken;
       begin
         { first check for identifier }
         if token<>_ID then
@@ -189,7 +191,7 @@ implementation
           end;
         searchsym(pattern,srsym,srsymtable);
         { handle unit specification like System.Writeln }
-        try_consume_unitsym(srsym,srsymtable);
+        try_consume_unitsym(srsym,srsymtable,t);
         { if nothing found give error and return errorsym }
         if assigned(srsym) then
           check_hints(srsym,srsym.symoptions)
@@ -199,7 +201,7 @@ implementation
             srsym:=generrorsym;
             srsymtable:=nil;
           end;
-        consume(_ID);
+        consume(t);
         result:=assigned(srsym);
       end;
 
@@ -208,6 +210,8 @@ implementation
       if required and returns the id with it's original casing
     }
     function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean;
+      var
+        t : ttoken;
       begin
         { first check for identifier }
         if token<>_ID then
@@ -220,7 +224,7 @@ implementation
           end;
         searchsym(pattern,srsym,srsymtable);
         { handle unit specification like System.Writeln }
-        try_consume_unitsym(srsym,srsymtable);
+        try_consume_unitsym(srsym,srsymtable,t);
         { if nothing found give error and return errorsym }
         if assigned(srsym) then
           check_hints(srsym,srsym.symoptions)
@@ -231,13 +235,15 @@ implementation
             srsymtable:=nil;
           end;
         s:=orgpattern;
-        consume(_ID);
+        consume(t);
         result:=assigned(srsym);
       end;
 
-    function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable):boolean;
+
+    function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume : ttoken):boolean;
       begin
         result:=false;
+        tokentoconsume:=_ID;
         if assigned(srsym) and
            (srsym.typ=unitsym) then
           begin
@@ -249,7 +255,22 @@ implementation
               begin
                 consume(_ID);
                 consume(_POINT);
-                searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
+                case token of
+                  _ID:
+                     searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
+                  _STRING:
+                    begin
+                      { system.string? }
+                      if tmodule(tunitsym(srsym).module).globalsymtable=systemunit then
+                        begin
+                          if cs_ansistrings in current_settings.localswitches then
+                            searchsym_in_module(tunitsym(srsym).module,'ANSISTRING',srsym,srsymtable)
+                          else
+                            searchsym_in_module(tunitsym(srsym).module,'SHORTSTRING',srsym,srsymtable);
+                          tokentoconsume:=_STRING;
+                        end;
+                    end
+                  end;
               end
             else
               begin

compiler/pexpr.pas

@@ -1367,6 +1367,7 @@ implementation
            orgstoredpattern,
            storedpattern : string;
            len   : longint;
+           t : ttoken;
          begin
            { allow post fix operators }
            again:=true;
@@ -1383,10 +1384,10 @@ implementation
                searchsym(pattern,srsym,srsymtable);
 
                { handle unit specification like System.Writeln }
-               unit_found:=try_consume_unitsym(srsym,srsymtable);
+               unit_found:=try_consume_unitsym(srsym,srsymtable,t);
                storedpattern:=pattern;
                orgstoredpattern:=orgpattern;
-               consume(_ID);
+               consume(t);
 
                { named parameter support }
                found_arg_name:=false;

compiler/powerpc64/cgcpu.pas

@@ -154,34 +154,6 @@ uses
   symconst, fmodule,
   rgobj, tgobj, cpupi, procinfo, paramgr, cpupara;
 
-function ref2string(const ref : treference) : string;
-begin
-  result := 'base : ' + inttostr(ord(ref.base)) + ' index : ' + inttostr(ord(ref.index)) + ' refaddr : ' + inttostr(ord(ref.refaddr)) + ' offset : ' + inttostr(ref.offset) + ' symbol : ';
-  if (assigned(ref.symbol)) then
-    result := result + ref.symbol.name;
-end;
-
-function cgsize2string(const size : TCgSize) : string;
-const
-  cgsize_strings : array[TCgSize] of string[8] = (
-    'OS_NO', 'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128', 'OS_S8', 'OS_S16', 'OS_S32',
-    'OS_S64', 'OS_S128', 'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128',
-    'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_MS8', 'OS_MS16', 'OS_MS32',
-    'OS_MS64', 'OS_MS128');
-begin
-  result := cgsize_strings[size];
-end;
-
-function cgop2string(const op : TOpCg) : String;
-const
-  opcg_strings : array[TOpCg] of string[6] = (
-    'None', 'Move', 'Add', 'And', 'Div', 'IDiv', 'IMul', 'Mul',
-    'Neg', 'Not', 'Or', 'Sar', 'Shl', 'Shr', 'Sub', 'Xor'
-  );
-begin
-  result := opcg_strings[op];
-end;
-
 function is_signed_cgsize(const size : TCgSize) : Boolean;
 begin
   case size of

compiler/ppcgen/cgppc.pas

@@ -96,13 +96,50 @@ unit cgppc;
                          C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT);
 
 
+{$ifdef extdebug}
+     function ref2string(const ref : treference) : string;
+     function cgsize2string(const size : TCgSize) : string;
+     function cgop2string(const op : TOpCg) : String;
+{$endif extdebug}
+
   implementation
 
     uses
+       {$ifdef extdebug}sysutils,{$endif}
        globals,verbose,systems,cutils,
        symconst,symsym,fmodule,
        rgobj,tgobj,cpupi,procinfo,paramgr;
 
+{$ifdef extdebug}
+     function ref2string(const ref : treference) : string;
+       begin
+         result := 'base : ' + inttostr(ord(ref.base)) + ' index : ' + inttostr(ord(ref.index)) + ' refaddr : ' + inttostr(ord(ref.refaddr)) + ' offset : ' + inttostr(ref.offset) + ' symbol : ';
+         if (assigned(ref.symbol)) then
+           result := result + ref.symbol.name;
+       end;
+     
+     function cgsize2string(const size : TCgSize) : string;
+       const
+         cgsize_strings : array[TCgSize] of string[8] = (
+           'OS_NO', 'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128', 'OS_S8', 'OS_S16', 'OS_S32',
+           'OS_S64', 'OS_S128', 'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128',
+           'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_MS8', 'OS_MS16', 'OS_MS32',
+           'OS_MS64', 'OS_MS128');
+       begin
+         result := cgsize_strings[size];
+       end;
+     
+     function cgop2string(const op : TOpCg) : String;
+       const
+         opcg_strings : array[TOpCg] of string[6] = (
+           'None', 'Move', 'Add', 'And', 'Div', 'IDiv', 'IMul', 'Mul',
+           'Neg', 'Not', 'Or', 'Sar', 'Shl', 'Shr', 'Sub', 'Xor'
+         );
+       begin
+         result := opcg_strings[op];
+       end;
+{$endif extdebug}
+    
 
     function tcgppcgen.hasLargeOffset(const ref : TReference) : Boolean;
       begin

compiler/psub.pas

@@ -1780,6 +1780,8 @@ implementation
                  begin
                    oldcurrent_filepos:=current_filepos;
                    current_filepos:=tprocdef(tprocdef(hp).genericdef).fileinfo;
+                   { use the index the module got from the current compilation process }
+                   current_filepos.moduleindex:=hmodule.unit_index;
                    current_tokenpos:=current_filepos;
                    current_scanner.startreplaytokens(tprocdef(tprocdef(hp).genericdef).generictokenbuf);
                    read_proc_body(nil,tprocdef(hp));

compiler/ptype.pas

@@ -277,6 +277,7 @@ implementation
         srsym : tsym;
         srsymtable : TSymtable;
         s,sorg : TIDString;
+        t : ttoken;
       begin
          s:=pattern;
          sorg:=orgpattern;
@@ -299,8 +300,8 @@ implementation
            parameters }
          searchsym_type(s,srsym,srsymtable);
          { handle unit specification like System.Writeln }
-         is_unit_specific:=try_consume_unitsym(srsym,srsymtable);
-         consume(_ID);
+         is_unit_specific:=try_consume_unitsym(srsym,srsymtable,t);
+         consume(t);
          { Types are first defined with an error def before assigning
            the real type so check if it's an errordef. if so then
            give an error. Only check for typesyms in the current symbol

compiler/scandir.pas

@@ -1346,9 +1346,9 @@ implementation
         AddDirective('PACKRECORDS',directive_all, @dir_packrecords);
         AddDirective('PACKSET',directive_all, @dir_packset);
         AddDirective('PIC',directive_all, @dir_pic);
-        AddDirective('POP',directive_mac, @dir_pop);
+        AddDirective('POP',directive_all, @dir_pop);
         AddDirective('PROFILE',directive_all, @dir_profile);
-        AddDirective('PUSH',directive_mac, @dir_push);
+        AddDirective('PUSH',directive_all, @dir_push);
         AddDirective('R',directive_all, @dir_resource);
         AddDirective('RANGECHECKS',directive_all, @dir_rangechecks);
         AddDirective('REFERENCEINFO',directive_all, @dir_referenceinfo);

tests/tbf/tb0205.pp

@@ -0,0 +1,14 @@
+{ %fail }
+
+procedure test(a: array of longint); forward;
+
+type
+  tl = type longint;
+
+procedure test(a: array of tl);
+begin
+end;
+
+begin
+end.
+

tests/webtbs/tw10489.pp

@@ -0,0 +1,20 @@
+{$mode objfpc}
+program test;
+
+uses
+  TypInfo;
+
+function GetTypeInfo(const i: Integer): PTypeInfo;
+begin
+  case i of
+    0: Result := TypeInfo(System.Integer);
+    1: Result := TypeInfo(System.Int64);
+    2: Result := TypeInfo(System.String); //syntax error
+    3: Result := TypeInfo(System.WideString);
+  else
+    Result := nil;
+  end;
+end;
+
+begin
+end.

tests/webtbs/tw10623.pp

@@ -0,0 +1,60 @@
+{$mode delphi}
+
+uses
+  Variants
+  ;
+
+type
+
+
+  // TMockMethod
+  //
+  TMockMethod = class
+  private 
+    FReturnValue: variant; 
+    
+  public
+
+    //: Set return value
+    procedure Returns(AValue: Variant); overload;
+    procedure Returns(AValue: Pointer); overload; // if i change this from type Pointer to Double it works
+    procedure Returns(AValue: Integer); overload;
+  end;
+
+
+function Failure: TMockMethod;
+begin
+  Result := TMockMethod.Create;
+
+  { TODO: Free Pascal Compiler version 2.2.0 [2007/08/30] for i386 crash with Internal error 2006122804 on this line
+	using fpc -Sd PascalMockBug.pas or fpc -S2 PascalMockBug.pas
+  }
+  Result.Returns(Result.FReturnValue);
+end;
+
+
+{ TMockMethod }
+
+
+procedure TMockMethod.Returns(AValue: Integer);
+begin
+  halt(1);
+end;
+
+procedure TMockMethod.Returns(AValue: Pointer);
+begin
+  halt(1);
+end;
+
+procedure TMockMethod.Returns(AValue: Variant);
+begin
+  writeln('ok');
+end;
+
+var
+  c: tmockmethod;
+begin
+  c:=Failure;
+  c.free;
+end.
+