Merged revisions 8588,8590,8593-8594,8596,8600-8601,8603,8605,8607,8609,8617,8625,8628,8630-8638,8640-8641,8656,8658-8659,8665,8667,8681-8682,8686-8687,8702,8705-8706,8710-8714,8716,8719,8721-8725,8727,8730-8731,8734-8735,8743,8747-8751,8766-8769,8779,8784,8797,8799,8822,8831,8848-8849,8851,8879,8885-8889,8891-8893,8895,8897,8900,8907,8912,8917,8942,8950,8974 via svnmerge from

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

........
  r8588 | florian | 2007-09-21 00:28:54 +0200 (Fri, 21 Sep 2007) | 2 lines
  
  * fixed some crashes
........
  r8601 | jonas | 2007-09-22 12:02:36 +0200 (Sat, 22 Sep 2007) | 2 lines
  
    + callparan support in node_complexity()
........
  r8603 | jonas | 2007-09-22 19:22:17 +0200 (Sat, 22 Sep 2007) | 7 lines
  
    * Also take into account the node complexity of parameters to determine
      the order in which they are evaluated (except for LOC_REFERENCE
      parameters on i386, because the code generator expects them in their
      original order). This saves quite a lot of spilling and uses of
      non-volatile registers when the parameters themselves also contain
      calls
........
  r8609 | jonas | 2007-09-22 22:46:45 +0200 (Sat, 22 Sep 2007) | 2 lines
  
    * fixed typo that broke non-i386 compilation after r8603
........
  r8617 | florian | 2007-09-23 16:23:31 +0200 (Sun, 23 Sep 2007) | 2 lines
  
  * take care of the used fpu instruction set when saving/restoring function results on x86
........
  r8628 | jonas | 2007-09-23 23:21:17 +0200 (Sun, 23 Sep 2007) | 2 lines
  
    * fixed compilation on non-x86 after r8617
........
  r8656 | peter | 2007-09-26 23:13:32 +0200 (Wed, 26 Sep 2007) | 2 lines
  
    * remove firstpasscount
........
  r8658 | jonas | 2007-09-27 00:00:29 +0200 (Thu, 27 Sep 2007) | 2 lines
  
    * added maxfpuregs constant to fix compilation after r8655
........
  r8706 | hajny | 2007-09-30 23:11:10 +0200 (Sun, 30 Sep 2007) | 1 line
  
    * workaround for yet another #%$#@#^ EMX LD.EXE bug (link.res path must not be quoted)
........
  r8716 | peter | 2007-10-01 21:23:49 +0200 (Mon, 01 Oct 2007) | 2 lines
  
    * there can be a tai_stab between lock/rep and the next opcode
........
  r8724 | peter | 2007-10-02 20:41:07 +0200 (Tue, 02 Oct 2007) | 2 lines
  
    * don't reuse emptyint
........
  r8725 | peter | 2007-10-02 20:41:47 +0200 (Tue, 02 Oct 2007) | 3 lines
  
    * idata must be aligned on 4 bytes to prevent a corrupt
      idata2 section where the entries are always 20 bytes
........
  r8734 | florian | 2007-10-06 16:33:57 +0200 (Sat, 06 Oct 2007) | 2 lines
  
  * hack around the -intconst hack in pexpr when recording tokens, resolves #9471
........
  r8735 | florian | 2007-10-06 16:35:42 +0200 (Sat, 06 Oct 2007) | 2 lines
  
  * fixed wrong test number
........
  r8779 | florian | 2007-10-13 21:39:25 +0200 (Sat, 13 Oct 2007) | 2 lines
  
  * fixed calculation of fpu resources
........
  r8784 | jonas | 2007-10-14 10:50:24 +0200 (Sun, 14 Oct 2007) | 2 lines
  
    * fixed compilation
........
  r8799 | florian | 2007-10-14 19:54:00 +0200 (Sun, 14 Oct 2007) | 2 lines
  
  * allow the usage of fields of parent classes for property readers/writers, resolves #9095
........
  r8900 | florian | 2007-10-21 21:05:06 +0200 (Sun, 21 Oct 2007) | 2 lines
  
  * don't range pointers converted to arrays, resolves #8191
........
  r8907 | jonas | 2007-10-22 00:39:49 +0200 (Mon, 22 Oct 2007) | 3 lines
  
    * only allow using array elements as for-loop counter variables
      in TP mode
........
  r8974 | florian | 2007-10-28 18:06:02 +0100 (Sun, 28 Oct 2007) | 2 lines
  
  * handle case ranges properly for unsigned types with a non-zero base, resolves #10009
........

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

.gitattributes

@@ -7476,6 +7476,8 @@ tests/webtbf/tw9039b.pp svneol=native#text/plain
 tests/webtbf/tw9039c.pp svneol=native#text/plain
 tests/webtbf/tw9039d.pp svneol=native#text/plain
 tests/webtbf/tw9053.pp svneol=native#text/plain
+tests/webtbf/tw9072a.pp svneol=native#text/plain
+tests/webtbf/tw9072b.pp svneol=native#text/plain
 tests/webtbf/tw9225.pp svneol=native#text/plain
 tests/webtbf/tw9306c.pp svneol=native#text/plain
 tests/webtbf/tw9499.pp svneol=native#text/plain
@@ -7576,6 +7578,7 @@ tests/webtbs/tw0961.pp svneol=native#text/plain
 tests/webtbs/tw0965.pp svneol=native#text/plain
 tests/webtbs/tw0966.pp svneol=native#text/plain
 tests/webtbs/tw0976.pp svneol=native#text/plain
+tests/webtbs/tw10009.pp svneol=native#text/plain
 tests/webtbs/tw10013.pp svneol=native#text/plain
 tests/webtbs/tw10072.pp svneol=native#text/plain
 tests/webtbs/tw1021.pp svneol=native#text/plain
@@ -8368,6 +8371,7 @@ tests/webtbs/tw8177a.pp -text
 tests/webtbs/tw8180.pp svneol=native#text/plain
 tests/webtbs/tw8183.pp svneol=native#text/plain
 tests/webtbs/tw8187.pp svneol=native#text/plain
+tests/webtbs/tw8191.pp svneol=native#text/plain
 tests/webtbs/tw8195a.pp svneol=native#text/plain
 tests/webtbs/tw8195b.pp svneol=native#text/plain
 tests/webtbs/tw8199.pp svneol=native#text/plain
@@ -8421,6 +8425,7 @@ tests/webtbs/tw9073.pp svneol=native#text/plain
 tests/webtbs/tw9076.pp svneol=native#text/plain
 tests/webtbs/tw9076a.pp svneol=native#text/plain
 tests/webtbs/tw9085.pp svneol=native#text/plain
+tests/webtbs/tw9095.pp svneol=native#text/plain
 tests/webtbs/tw9096.pp svneol=native#text/plain
 tests/webtbs/tw9098.pp svneol=native#text/plain
 tests/webtbs/tw9107.pp svneol=native#text/plain
@@ -8460,8 +8465,10 @@ tests/webtbs/tw9667.pp svneol=native#text/plain
 tests/webtbs/tw9672.pp svneol=native#text/plain
 tests/webtbs/tw9695.pp svneol=native#text/plain
 tests/webtbs/tw9704.pp svneol=native#text/plain
+tests/webtbs/tw9827.pp svneol=native#text/plain
 tests/webtbs/tw9897.pp svneol=native#text/plain
 tests/webtbs/tw9918.pp svneol=native#text/plain
+tests/webtbs/tw9919.pp -text
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

compiler/arm/narmset.pas

@@ -153,7 +153,7 @@ implementation
                   if first then
                     begin
                        { have we to ajust the first value ? }
-                       if (t^._low>get_min_value(left.resultdef)) then
+                       if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then
                          begin
                            tcgarm(cg).cgsetflags:=true;
                            cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, aint(t^._low), hregister);

compiler/i386/n386set.pas

@@ -174,7 +174,7 @@ implementation
                   if first then
                     begin
                        { have we to ajust the first value ? }
-                       if (t^._low>get_min_value(left.resultdef)) then
+                       if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then
                          cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, aint(t^._low), hregister);
                     end
                   else

compiler/ncal.pas

@@ -2328,11 +2328,27 @@ implementation
             hpnext:=tcallparanode(hpcurr.right);
             { pull in at the correct place.
               Used order:
-                1. LOC_REFERENCE with smallest offset (x86 only)
-                2. LOC_REFERENCE with most registers
-                3. LOC_REGISTER with most registers
+                1. LOC_REFERENCE with smallest offset (i386 only)
+                2. LOC_REFERENCE with most registers and least complexity (non-i386 only)
+                3. LOC_REFERENCE with least registers and most complexity (non-i386 only)
+                4. LOC_REGISTER with most registers and most complexity
+                5. LOC_REGISTER with least registers and least complexity
               For the moment we only look at the first parameter field. Combining it
-              with multiple parameter fields will make things a lot complexer (PFV) }
+              with multiple parameter fields will make things a lot complexer (PFV)
+
+              The reason for the difference regarding complexity ordering
+              between LOC_REFERENCE and LOC_REGISTER is mainly for calls:
+              we first want to treat the LOC_REFERENCE destinations whose
+              calculation does not require a call, because their location
+              may contain registers which might otherwise have to be saved
+              if a call has to be evaluated first. The calculated value is
+              stored on the stack and will thus no longer occupy any
+              register.
+
+              Similarly, for the register parameters we first want to
+              evaluate the calls, because otherwise the already loaded
+              register parameters will have to be saved so the intermediate
+              call can be evaluated (JM) }
             if not assigned(hpcurr.parasym.paraloc[callerside].location) then
               internalerror(200412152);
             currloc:=hpcurr.parasym.paraloc[callerside].location^.loc;
@@ -2355,23 +2371,29 @@ implementation
                               That means the for pushes the para with the
                               highest offset (see para3) needs to be pushed first
                             }
-                            if (hpcurr.registersint>hp.registersint)
-{$ifdef x86}
-                               or (hpcurr.parasym.paraloc[callerside].location^.reference.offset>hp.parasym.paraloc[callerside].location^.reference.offset)
-{$endif x86}
-                               then
+{$ifdef i386}
+                            { the i386 code generator expects all reference }
+                            { parameter to be in this order so it can use   }
+                            { pushes                                        }
+                            if (hpcurr.parasym.paraloc[callerside].location^.reference.offset>hp.parasym.paraloc[callerside].location^.reference.offset) then
+{$else i386}
+                            if (hpcurr.registersint>hp.registersint) or
+                               (node_complexity(hpcurr)<node_complexity(hp)) then
+{$endif i386}
                               break;
                           end;
+                        LOC_MMREGISTER,
                         LOC_REGISTER,
                         LOC_FPUREGISTER :
                           break;
                       end;
                     end;
+                  LOC_MMREGISTER,
                   LOC_FPUREGISTER,
                   LOC_REGISTER :
                     begin
-                      if (hp.parasym.paraloc[callerside].location^.loc=currloc) and
-                         (hpcurr.registersint>hp.registersint) then
+                      if (hp.parasym.paraloc[callerside].location^.loc<>LOC_REFERENCE) and
+                         (node_complexity(hpcurr)>node_complexity(hp)) then
                         break;
                     end;
                 end;

compiler/ncgadd.pas

@@ -136,14 +136,26 @@ interface
           end;
         if pushedfpu then
           begin
-            tmpreg := cg.getfpuregister(current_asmdata.CurrAsmList,left.location.size);
-            cg.a_loadfpu_loc_reg(current_asmdata.CurrAsmList,left.location.size,left.location,tmpreg);
-            location_reset(left.location,LOC_FPUREGISTER,left.location.size);
-            left.location.register := tmpreg;
 {$ifdef x86}
-            { left operand is now on top of the stack, instead of the right one! }
-            toggleflag(nf_swapped);
+            if use_sse(left.resultdef) then
+              begin
+                tmpreg := cg.getmmregister(current_asmdata.CurrAsmList,left.location.size);
+                cg.a_loadmm_loc_reg(current_asmdata.CurrAsmList,left.location.size,left.location,tmpreg,mms_movescalar);
+                location_reset(left.location,LOC_MMREGISTER,left.location.size);
+                left.location.register := tmpreg;
+              end
+            else
 {$endif x86}
+              begin
+                tmpreg := cg.getfpuregister(current_asmdata.CurrAsmList,left.location.size);
+                cg.a_loadfpu_loc_reg(current_asmdata.CurrAsmList,left.location.size,left.location,tmpreg);
+                location_reset(left.location,LOC_FPUREGISTER,left.location.size);
+                left.location.register := tmpreg;
+{$ifdef x86}
+                { left operand is now on top of the stack, instead of the right one! }
+                toggleflag(nf_swapped);
+{$endif x86}
+              end;
           end;
       end;
 
@@ -248,7 +260,7 @@ interface
         tmpreg : tregister;
         mask,
         setbase : aint;
-        
+
         cgop    : TOpCg;
         opdone  : boolean;
       begin

compiler/ncgmem.pas

@@ -722,7 +722,8 @@ implementation
                   begin
                      if not(is_open_array(left.resultdef)) and
                         not(is_array_of_const(left.resultdef)) and
-                        not(is_dynamic_array(left.resultdef)) then
+                        not(is_dynamic_array(left.resultdef)) and
+                        not(ado_isconvertedpointer in tarraydef(left.resultdef).arrayoptions) then
                        begin
                           if (tordconstnode(right).value>tarraydef(left.resultdef).highrange) or
                              (tordconstnode(right).value<tarraydef(left.resultdef).lowrange) then

compiler/ncgset.pas

@@ -531,7 +531,7 @@ implementation
                 if first then
                   begin
                      { have we to ajust the first value ? }
-                     if (t^._low>get_min_value(left.resultdef)) then
+                     if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then
                        gensub(aint(t^._low));
                   end
                 else

compiler/node.pas

@@ -291,10 +291,6 @@ interface
          fileinfo      : tfileposinfo;
          localswitches : tlocalswitches;
          optinfo : poptinfo;
-{$ifdef extdebug}
-         maxfirstpasscount,
-         firstpasscount : longint;
-{$endif extdebug}
          constructor create(t:tnodetype);
          { this constructor is only for creating copies of class }
          { the fields are copied by getcopy                      }
@@ -688,10 +684,6 @@ implementation
 {$ifdef SUPPORT_MMX}
          registersmmx:=0;
 {$endif SUPPORT_MMX}
-{$ifdef EXTDEBUG}
-         maxfirstpasscount:=0;
-         firstpasscount:=0;
-{$endif EXTDEBUG}
          flags:=[];
          ppuidx:=-1;
       end;
@@ -720,10 +712,6 @@ implementation
 {$ifdef SUPPORT_MMX}
         registersmmx:=0;
 {$endif SUPPORT_MMX}
-{$ifdef EXTDEBUG}
-        maxfirstpasscount:=0;
-        firstpasscount:=0;
-{$endif EXTDEBUG}
         ppuidx:=-1;
       end;
 
@@ -772,10 +760,6 @@ implementation
 
     destructor tnode.destroy;
       begin
-{$ifdef EXTDEBUG}
-         if firstpasscount>maxfirstpasscount then
-            maxfirstpasscount:=firstpasscount;
-{$endif EXTDEBUG}
       end;
 
 
@@ -893,9 +877,6 @@ implementation
          p.resultdef:=resultdef;
          p.fileinfo:=fileinfo;
          p.localswitches:=localswitches;
-{$ifdef extdebug}
-         p.firstpasscount:=firstpasscount;
-{$endif extdebug}
 {         p.list:=list; }
          result:=p;
       end;

compiler/nutils.pas

@@ -618,7 +618,8 @@ implementation
                   exit;
                 end;
               subscriptn,
-              blockn:
+              blockn,
+              callparan:
                 p := tunarynode(p).left;
               derefn :
                 begin

compiler/ogbase.pas

@@ -881,6 +881,12 @@ implementation
           sec_bss,
           sec_data:
             result:=16;
+          { For idata (at least idata2) it must be 4 bytes, because
+            an entry is always (also in win64) 20 bytes and aligning
+            on 8 bytes will insert 4 bytes between the entries resulting
+            in a corrupt idata section }
+          sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7:
+            result:=4;
           else
             result:=sizeof(aint);
         end;

compiler/ogcoff.pas

@@ -2372,6 +2372,7 @@ const pemagic : array[0..3] of byte = (
           idata4label,
           idata5label,
           idata6label : TObjSymbol;
+          ordint,
           emptyint : longint;
           secname,
           num : string;
@@ -2380,7 +2381,12 @@ const pemagic : array[0..3] of byte = (
           result:=nil;
           emptyint:=0;
           if assigned(exemap) then
-            exemap.Add(' Importing Function '+afuncname);
+            begin
+              if AOrdNr <= 0 then
+                exemap.Add(' Importing Function '+afuncname)
+              else
+                exemap.Add(' Importing Function '+afuncname+' (OrdNr='+tostr(AOrdNr)+')');
+            end;
 
           with internalobjdata do
             begin
@@ -2413,19 +2419,18 @@ const pemagic : array[0..3] of byte = (
             end
           else
             begin
-              emptyint:=AOrdNr;
+              ordint:=AOrdNr;
               if target_info.system=system_x86_64_win64 then
                 begin
-                  internalobjdata.writebytes(emptyint,sizeof(emptyint));
-                  emptyint:=longint($80000000);
-                  internalobjdata.writebytes(emptyint,sizeof(emptyint));
+                  internalobjdata.writebytes(ordint,sizeof(ordint));
+                  ordint:=longint($80000000);
+                  internalobjdata.writebytes(ordint,sizeof(ordint));
                 end
               else
                 begin
-                  emptyint:=emptyint or longint($80000000);
-                  internalobjdata.writebytes(emptyint,sizeof(emptyint));
+                  ordint:=ordint or longint($80000000);
+                  internalobjdata.writebytes(ordint,sizeof(ordint));
                 end;
-              emptyint:=0;
             end;
           { idata5, import address table }
           internalobjdata.SetSection(idata5objsection);

compiler/optcse.pas

@@ -24,6 +24,7 @@ unit optcse;
 {$i fpcdefs.inc}
 
 { $define csedebug}
+{$define csestats}
 
   interface
 
@@ -37,6 +38,7 @@ unit optcse;
     uses
       globtype,
       cclasses,
+      verbose,
       nutils,
       nbas,nld,
       pass_1,
@@ -70,7 +72,9 @@ unit optcse;
     function collectnodes(var n:tnode; arg: pointer) : foreachnoderesult;
       begin
         { node worth to add? }
-        if (node_complexity(n)>1) and (tstoreddef(n.resultdef).is_intregable or tstoreddef(n.resultdef).is_fpuregable) then
+        if (node_complexity(n)>1) and (tstoreddef(n.resultdef).is_intregable or tstoreddef(n.resultdef).is_fpuregable) and
+          { adding tempref nodes is worthless but there complexity is probably <= 1 anyways }
+          not(n.nodetype in [temprefn]) then
           begin
             plists(arg)^.nodelist.Add(n);
             plists(arg)^.locationlist.Add(@n);
@@ -119,53 +123,59 @@ unit optcse;
                 for i:=0 to lists.nodelist.count-1 do
                   for j:=i+1 to lists.nodelist.count-1 do
                     begin
-                      if tnode(lists.nodelist[i]).isequal(tnode(lists.nodelist[j])) then
+                      if not(tnode(lists.nodelist[i]).nodetype in [tempcreaten,temprefn]) and
+                        tnode(lists.nodelist[i]).isequal(tnode(lists.nodelist[j])) then
                         begin
                           if not(assigned(statements)) then
                             begin
                               nodes:=internalstatements(statements);
                               addstatement(statements,internalstatements(creates));
                             end;
-{$ifdef csedebug}
+{$if defined(csedebug) or defined(csestats)}
                           writeln('    ====     ');
                           printnode(output,tnode(lists.nodelist[i]));
                           writeln('    equals   ');
                           printnode(output,tnode(lists.nodelist[j]));
                           writeln('    ====     ');
-{$endif csedebug}
+{$endif defined(csedebug) or defined(csestats)}
 
                           def:=tstoreddef(tnode(lists.nodelist[i]).resultdef);
-                          if assigned(templist[i])  then
+                          if assigned(def) then
                             begin
-                              templist[j]:=templist[i];
-                              pnode(lists.locationlist[j])^.free;
-                              pnode(lists.locationlist[j])^:=ctemprefnode.create(ttempcreatenode(templist[j]));
-                              do_firstpass(pnode(lists.locationlist[j])^);
-                            end
-                          else
-                            begin
-                              templist[i]:=ctempcreatenode.create(def,def.size,tt_persistent,
-                                def.is_intregable or def.is_fpuregable);
-                              addstatement(creates,tnode(templist[i]));
-
-                              { properties can't be passed by var }
-                              hp:=ttempcreatenode(templist[i]);
-                              do_firstpass(tnode(hp));
-
-                              addstatement(statements,cassignmentnode.create(ctemprefnode.create(ttempcreatenode(templist[i])),
-                                tnode(lists.nodelist[i])));
-                              pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[i]));
-                              do_firstpass(pnode(lists.locationlist[i])^);
-
-                              templist[j]:=templist[i];
-
-                              pnode(lists.locationlist[j])^.free;
-                              pnode(lists.locationlist[j])^:=ctemprefnode.create(ttempcreatenode(templist[j]));
-                              do_firstpass(pnode(lists.locationlist[j])^);
+                              if assigned(templist[i])  then
+                                begin
+                                  templist[j]:=templist[i];
+                                  pnode(lists.locationlist[j])^.free;
+                                  pnode(lists.locationlist[j])^:=ctemprefnode.create(ttempcreatenode(templist[j]));
+                                  do_firstpass(pnode(lists.locationlist[j])^);
+                                end
+                              else
+                                begin
+                                  templist[i]:=ctempcreatenode.create(def,def.size,tt_persistent,
+                                    def.is_intregable or def.is_fpuregable);
+                                  addstatement(creates,tnode(templist[i]));
+
+                                  { properties can't be passed by var }
+                                  hp:=ttempcreatenode(templist[i]);
+                                  do_firstpass(tnode(hp));
+
+                                  addstatement(statements,cassignmentnode.create(ctemprefnode.create(ttempcreatenode(templist[i])),
+                                    tnode(lists.nodelist[i])));
+                                  pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[i]));
+                                  do_firstpass(pnode(lists.locationlist[i])^);
+
+                                  templist[j]:=templist[i];
+
+                                  pnode(lists.locationlist[j])^.free;
+                                  pnode(lists.locationlist[j])^:=ctemprefnode.create(ttempcreatenode(templist[j]));
+                                  do_firstpass(pnode(lists.locationlist[j])^);
 {$ifdef csedebug}
-                              printnode(output,statements);
+                                  printnode(output,statements);
 {$endif csedebug}
-                            end;
+                                end;
+                              end
+                            else
+                              internalerror(2007091701);
                         end;
                     end;
                 if assigned(statements) then

compiler/pdecvar.pas

@@ -133,6 +133,8 @@ implementation
                           if assigned(st) then
                            begin
                              sym:=tsym(st.Find(pattern));
+                             if not(assigned(sym)) and is_object(def) then
+                               sym:=search_class_member(tobjectdef(def),pattern);
                              if assigned(sym) then
                               begin
                                 pl.addsym(sl_subscript,sym);

compiler/powerpc/cpubase.pas

@@ -378,6 +378,8 @@ uses
 
       NR_RTOC = NR_R2;
 
+      maxfpuregs = 8;
+
 {*****************************************************************************
                                   Helpers
 *****************************************************************************}

compiler/powerpc64/cpubase.pas

@@ -382,6 +382,8 @@ const
   { minimum size of the stack frame if one exists }
   MINIMUM_STACKFRAME_SIZE = 112;
 
+  maxfpuregs = 8;
+
   {*****************************************************************************
                                     Helpers
   *****************************************************************************}

compiler/ppcgen/ngppcset.pas

@@ -199,7 +199,7 @@ implementation
                 if first then
                   begin
                      { have we to ajust the first value ? }
-                     if (t^._low>get_min_value(left.resultdef)) then
+                     if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then
                        gensub(longint(t^._low));
                   end
                 else

compiler/pstatmnt.pas

@@ -325,17 +325,21 @@ implementation
          hp:=hloopvar;
          while assigned(hp) and
                (
-                { record/object fields are allowed in tp7 mode only }
+                { record/object fields and array elements are allowed }
+                { in tp7 mode only                                    }
                 (
                  (m_tp7 in current_settings.modeswitches) and
-                 (hp.nodetype=subscriptn) and
-                 ((tsubscriptnode(hp).left.resultdef.typ=recorddef) or
-                  is_object(tsubscriptnode(hp).left.resultdef))
-                ) or
-                { constant array index }
-                (
-                 (hp.nodetype=vecn) and
-                 is_constintnode(tvecnode(hp).right)
+                 (
+                  ((hp.nodetype=subscriptn) and
+                   ((tsubscriptnode(hp).left.resultdef.typ=recorddef) or
+                    is_object(tsubscriptnode(hp).left.resultdef))
+                  ) or
+                  { constant array index }
+                  (
+                   (hp.nodetype=vecn) and
+                   is_constintnode(tvecnode(hp).right)
+                  )
+                 )
                 ) or
                 { equal typeconversions }
                 (

compiler/scanner.pas

@@ -1902,6 +1902,12 @@ In case not, the value returned can be arbitrary.
           _INTCONST,
           _REALNUMBER :
             begin
+              { pexpr.pas messes with pattern in case of negative integer consts,
+                see around line 2562 the comment of JM; remove the - before recording it
+                                                     (FK)
+              }
+              if (token=_INTCONST) and (pattern[1]='-') then
+                delete(pattern,1,1);
               recordtokenbuf.write(pattern[0],1);
               recordtokenbuf.write(pattern[1],length(pattern));
             end;

compiler/systems/t_os2.pas

@@ -517,7 +517,15 @@ begin
         Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+1023) shr 10));
         Replace(cmdstr,'$STRIP',StripStr);
         Replace(cmdstr,'$APPTYPE',AppTypeStr);
+(*
+   Arrgh!!! The ancient EMX LD.EXE simply dies without saying anything
+   if the full pathname to link.res is quoted!!!!! @#$@@^%@#$^@#$^@^#$
+   This means that name of the output directory cannot contain spaces,
+   but at least it works otherwise...
+
         Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
+*)
+        Replace(cmdstr,'$RES',outputexedir+Info.ResName);
         Replace(cmdstr,'$OPT',Info.ExtraOptions);
         Replace(cmdstr,'$RSRC',RsrcStr);
         Replace(cmdstr,'$OUT',maybequoted(OutName));

compiler/x86/agx86int.pas

@@ -703,8 +703,12 @@ implementation
                    (taicpu(hp).opcode = A_REPNE)) then
                 Begin
                   prefix:=std_op2str[taicpu(hp).opcode]+#9;
-                  hp:=tai(hp.next);
-                { this is theorically impossible... }
+                  { there can be a stab inbetween when the opcode was on
+                    a different line in the source code }
+                  repeat
+                    hp:=tai(hp.next);
+                  until (hp=nil) or (hp.typ=ait_instruction);
+                  { this is theorically impossible... }
                   if hp=nil then
                    begin
                      AsmWriteLn(#9#9+prefix);

tests/utils/testu.pp

@@ -34,6 +34,7 @@ type
     NoRun         : boolean;
     UsesGraph     : boolean;
     ShouldFail    : boolean;
+    Timeout       : longint;
     Category      : string;
     Note          : string;
   end;
@@ -253,6 +254,9 @@ begin
                   R.Note:='Note: '+res;
                   Verbose(V_Normal,r.Note);
                 end
+              else
+               if GetEntry('TIMEOUT') then
+                Val(res,r.Timeout,code)
               else
                Verbose(V_Error,'Unknown entry: '+s);
             end;

tests/webtbf/tw9072a.pp

@@ -0,0 +1,11 @@
+{ %fail }
+
+{$mode tp}
+
+var
+  a: array[1..10] of byte;
+  b:  byte;
+begin
+  b:=1;
+  for a[b] := 1 to 10 do ;
+end.

tests/webtbf/tw9072b.pp

@@ -0,0 +1,12 @@
+{ %fail }
+
+var
+  a: array[1..2] of longint;
+  l: longint;
+begin
+  l:=0;
+  for a[1]:=1 to 10 do
+    inc(l);
+  if (l<>10) then
+    halt(1);
+end.

tests/webtbs/tw10009.pp

@@ -0,0 +1,13 @@
+var
+  test : 2..14;
+
+begin
+  test:=14;
+  case test of
+    2..9: halt(1);
+    14: ;
+  else
+    halt(1);
+  end;
+  writeln('ok');
+end.

tests/webtbs/tw1407.pp

@@ -3,6 +3,8 @@
 { e-mail: [email protected] }
 { compiled with 1.04 on win32 }
 { options : -B -CX -XXs -OG2p3 -So }
+{$mode tp}
+
 var
         a : array[1..10] of integer;
         i : byte;

tests/webtbs/tw8191.pp

@@ -0,0 +1,37 @@
+program PCharRangeChecking;
+
+{$APPTYPE CONSOLE}
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+{$R+}
+
+function Test: Boolean;
+var
+  s: shortstring;
+  p: PChar;
+begin
+  s := '1234567890';
+  p := PChar(@s[1]);
+  Inc(p,4);
+
+  Result :=
+   (p[-4] = '1') and
+   (p[-3] = '2') and
+   (p[-2] = '3') and
+   (p[-1] = '4') and
+   (p[ 0] = '5') and
+   (p[ 1] = '6') and
+   (p[ 2] = '7') and
+   (p[ 3] = '8') and
+   (p[ 4] = '9') and
+   (p[ 5] = '0');
+end;
+
+begin
+  if not Test then
+    halt(1);
+  WriteLn('ok');
+end.

tests/webtbs/tw9095.pp

@@ -0,0 +1,51 @@
+{$mode objfpc}
+
+type
+    ta = byte;
+    pa = ^byte;
+    panother = pa;
+
+type
+    tRec = record
+        a : ta;
+        p : panother;
+    end;
+
+    tNestedObj = object
+        arec : tRec;
+        p : panother;
+    end;
+
+    tChildObj = object(tNestedObj)
+        dummy : byte;
+    end;
+
+type
+
+    tObj = object
+        arec : tRec;
+        aobj : tNestedObj;
+        achild : tChildObj;
+
+        property a_rec : byte read arec.a;
+        property a_obj : byte read aobj.arec.a;
+        property p_obj : pa read aobj.p;
+        property dummy_child : byte read achild.dummy;
+        property a_child : byte read achild.arec.a;
+{ Error: Unknown record field identifier "arec" ^
+            Error: Unknown record field identifier "a" ^
+}
+        property p_child : pa read achild.p;
+{ Error: Unknown record field identifier "p" ^
+}
+    end;
+
+var
+  Obj : tObj;
+
+begin
+  Obj.achild.p:=panother($deadbeef);
+  if Obj.p_child<>panother($deadbeef) then
+    halt(1);
+  writeln('ok');
+end.

tests/webtbs/tw9827.pp

@@ -0,0 +1,27 @@
+{$mode objfpc}
+
+type
+  generic GList<_T> = class
+    var private
+      i : integer;
+    function some_func(): integer;
+  end;
+
+function GList.some_func(): integer;
+begin
+  i := -1;
+  Result := -1;
+end { some_func };
+
+
+type
+  TA = specialize GList<integer>;
+var
+  A : TA;
+
+begin
+  A:=TA.Create;
+  if A.some_func<>-1 then
+    halt(1);
+  writeln('ok');
+end.

tests/webtbs/tw9919.pp

@@ -0,0 +1,23 @@
+{$mode objfpc}
+
+type
+  TForm1 = class
+    function crash(n:integer):real;
+  end;
+
+function TForm1.crash(n:integer):real;
+begin
+  case n of
+  0: Result:=0;
+  1..100: Result:=crash(n-1)+crash(n-1);
+  end;
+end;
+
+var
+  f : TForm1;
+
+begin
+  f:=TForm1.create;
+  writeln(f.crash(15));
+  f.Free;
+end.