Merged revisions 7347,7352-7353,7358-7360 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r7347 | jonas | 2007-05-15 16:28:31 +0200 (Tue, 15 May 2007) | 2 lines

  + added tests for already solved bug (crashed with IE in 2.0.4)

........
r7352 | jonas | 2007-05-15 22:25:30 +0200 (Tue, 15 May 2007) | 3 lines

  * upper bound of for-loop cannot be a regvar, because the regvar may
    be modified inside the loop (mantis #8883)

........
r7353 | jonas | 2007-05-15 22:26:27 +0200 (Tue, 15 May 2007) | 2 lines

  + test for previous commit

........
r7358 | jonas | 2007-05-16 14:13:28 +0200 (Wed, 16 May 2007) | 4 lines

  * no need to synchronise the upper bound of a for-loop after the loop
    anymore if it is a regvar, because it cannot be a regvar anymore
    after the fix for tw8883

........
r7359 | jonas | 2007-05-16 15:59:35 +0200 (Wed, 16 May 2007) | 5 lines

  * do not search variant operators when looking for an overloaded
    operator for a non-variant type (was already intended that way,
    but checks didn't work) (mantis #7070) + tests
  * some tab->spaces in defcmp.pas

........
r7360 | jonas | 2007-05-16 16:44:38 +0200 (Wed, 16 May 2007) | 2 lines

  + test which already works

........

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

.gitattributes

@@ -7173,6 +7173,7 @@ tests/webtbf/tw6686.pp svneol=native#text/plain
 tests/webtbf/tw6796.pp svneol=native#text/plain
 tests/webtbf/tw6922.pp svneol=native#text/plain
 tests/webtbf/tw6970.pp svneol=native#text/plain
+tests/webtbf/tw7070.pp svneol=native#text/plain
 tests/webtbf/tw7322.pp svneol=native#text/plain
 tests/webtbf/tw7438.pp svneol=native#text/plain
 tests/webtbf/tw7438a.pp svneol=native#text/plain
@@ -7195,6 +7196,7 @@ tests/webtbf/tw8398.pp svneol=native#text/plain
 tests/webtbf/tw8528.pp svneol=native#text/plain
 tests/webtbf/tw8583.pp svneol=native#text/plain
 tests/webtbf/tw8588.pp svneol=native#text/plain
+tests/webtbf/tw8738.pas svneol=native#text/plain
 tests/webtbf/tw8777a.pp svneol=native#text/plain
 tests/webtbf/tw8777b.pp svneol=native#text/plain
 tests/webtbf/tw8777c.pp svneol=native#text/plain
@@ -7211,6 +7213,8 @@ tests/webtbf/uw3450.pp svneol=native#text/plain
 tests/webtbf/uw3969.pp svneol=native#text/plain
 tests/webtbf/uw4103.pp svneol=native#text/plain
 tests/webtbf/uw6922.pp svneol=native#text/plain
+tests/webtbf/uw8738a.pas svneol=native#text/plain
+tests/webtbf/uw8738b.pas svneol=native#text/plain
 tests/webtbs/tu2002.pp svneol=native#text/plain
 tests/webtbs/tw0555.pp svneol=native#text/plain
 tests/webtbs/tw0630.pp svneol=native#text/plain
@@ -7978,6 +7982,7 @@ tests/webtbs/tw6203.pp svneol=native#text/plain
 tests/webtbs/tw6435.pp svneol=native#text/plain
 tests/webtbs/tw6491.pp svneol=native#text/plain
 tests/webtbs/tw6493.pp svneol=native#text/plain
+tests/webtbs/tw6543.pp svneol=native#text/plain
 tests/webtbs/tw6624.pp svneol=native#text/plain
 tests/webtbs/tw6641.pp svneol=native#text/plain
 tests/webtbs/tw6684.pp svneol=native#text/plain
@@ -7995,6 +8000,8 @@ tests/webtbs/tw6977.pp svneol=native#text/plain
 tests/webtbs/tw6980.pp svneol=native#text/plain
 tests/webtbs/tw6989.pp svneol=native#text/plain
 tests/webtbs/tw7006.pp svneol=native#text/plain
+tests/webtbs/tw7070a.pp svneol=native#text/plain
+tests/webtbs/tw7070b.pp svneol=native#text/plain
 tests/webtbs/tw7071.pp svneol=native#text/plain
 tests/webtbs/tw7100.pp svneol=native#text/plain
 tests/webtbs/tw7104.pp svneol=native#text/plain
@@ -8094,6 +8101,7 @@ tests/webtbs/tw8810.pp svneol=native#text/plain
 tests/webtbs/tw8838.pp svneol=native#text/plain
 tests/webtbs/tw8861.pp svneol=native#text/plain
 tests/webtbs/tw8870.pp svneol=native#text/plain
+tests/webtbs/tw8883.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

compiler/defcmp.pas

@@ -657,7 +657,8 @@ implementation
                                 begin
                                   subeq:=compare_defs_ext(tarraydef(def_from).elementdef,
                                                        tarraydef(def_to).elementdef,
-                                                       arrayconstructorn,hct,hpd,[cdo_check_operator]);
+                                                       { reason for cdo_allow_variant: see webtbs/tw7070a and webtbs/tw7070b }
+                                                       arrayconstructorn,hct,hpd,[cdo_check_operator,cdo_allow_variant]);
                                   if (subeq>=te_equal) then
                                     begin
                                       doconv:=tc_equal;
@@ -892,28 +893,46 @@ implementation
                           end;
                       end;
                      { allow explicit typecasts from ordinals to pointer.
-		       Support for delphi compatibility
-		       Support constructs like pointer(cardinal-cardinal) or pointer(longint+cardinal) where
-		        the result of the ordinal operation is int64 also on 32 bit platforms.
+                       Support for delphi compatibility
+                       Support constructs like pointer(cardinal-cardinal) or pointer(longint+cardinal) where
+                        the result of the ordinal operation is int64 also on 32 bit platforms.
                        It is also used by the compiler internally for inc(pointer,ordinal) }
                      if (eq=te_incompatible) and
                         not is_void(def_from) and
-			(
+                        (
                          (
-			  (cdo_explicit in cdoptions) and
-			  (
-			   (m_delphi in current_settings.modeswitches) or
-			   { Don't allow pchar(char) in fpc modes }
-			   is_integer(def_from)
-			  )
-			 ) or
-			 (cdo_internal in cdoptions)
-			) then
+                          (cdo_explicit in cdoptions) and
+                          (
+                           (m_delphi in current_settings.modeswitches) or
+                           { Don't allow pchar(char) in fpc modes }
+                           is_integer(def_from)
+                          )
+                         ) or
+                         (cdo_internal in cdoptions)
+                        ) then
                        begin
                          doconv:=tc_int_2_int;
                          eq:=te_convert_l1;
                        end;
                    end;
+{
+                 enumdef :
+                   begin
+                     { allow explicit typecasts from enums to pointer.
+                       Support for delphi compatibility
+                     }
+                     if (eq=te_incompatible) and
+                        (((cdo_explicit in cdoptions) and
+                          (m_delphi in current_settings.modeswitches)
+                          ) or
+                         (cdo_internal in cdoptions)
+                        ) then
+                       begin
+                         doconv:=tc_int_2_int;
+                         eq:=te_convert_l1;
+                       end;
+                   end;
+}
                  arraydef :
                    begin
                      { string constant (which can be part of array constructor)
@@ -1314,6 +1333,13 @@ implementation
         { if we didn't find an appropriate type conversion yet
           then we search also the := operator }
         if (eq=te_incompatible) and
+           { make sure there is not a single variant if variants   }
+           { are not allowed (otherwise if only cdo_check_operator }
+           { and e.g. fromdef=stringdef and todef=variantdef, then }
+           { the test will still succeed                           }
+           ((cdo_allow_variant in cdoptions) or
+            ((def_from.typ<>variantdef) and (def_to.typ<>variantdef))
+           ) and
            (
             { Check for variants? }
             (
@@ -1323,8 +1349,8 @@ implementation
             { Check for operators? }
             (
              (cdo_check_operator in cdoptions) and
-             ((def_from.typ in [objectdef,recorddef,arraydef,stringdef,variantdef]) or
-              (def_to.typ in [objectdef,recorddef,arraydef,stringdef,variantdef]))
+             ((def_from.typ in [objectdef,recorddef,arraydef,stringdef]) or
+              (def_to.typ in [objectdef,recorddef,arraydef,stringdef]))
             )
            ) then
           begin

compiler/ncgflw.pas

@@ -390,9 +390,8 @@ implementation
                  get_used_regvars(right,usedregvars);
                  { loop body }
                  get_used_regvars(t2,usedregvars);
-                 { end value if necessary }
-                 if (t1.location.loc = LOC_CREGISTER) then
-                   get_used_regvars(t1,usedregvars);
+                 { end value (t1) is not necessary (it cannot be a regvar, }
+                 { see webtbs/tw8883)                                      }
 
                  gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars);
                end
@@ -447,7 +446,7 @@ implementation
          if t1.nodetype<>ordconstn then
            begin
               do_loopvar_at_end:=false;
-              location_force_reg(current_asmdata.CurrAsmList,t1.location,t1.location.size,true);
+              location_force_reg(current_asmdata.CurrAsmList,t1.location,t1.location.size,false);
               temptovalue:=true;
            end
          else

tests/webtbf/tw7070.pp

@@ -0,0 +1,18 @@
+{ %fail }
+
+program varistr;
+
+{$ifdef fpc}
+{$mode delphi}
+{$h+}
+{$endif}
+
+var
+  str: string;
+begin
+  str := 'something';
+
+  if not str = 'hello' then
+    writeln('test')
+end.
+

tests/webtbf/tw8738.pas

@@ -0,0 +1,8 @@
+{ %fail }
+
+program test;
+
+uses uw8738b;
+
+begin
+end.

tests/webtbf/uw8738a.pas

@@ -0,0 +1,12 @@
+unit uw8738a;
+
+interface
+
+implementation
+
+initialization
+
+finalization
+
+end.
+

tests/webtbf/uw8738b.pas

@@ -0,0 +1,14 @@
+unit uw8738b;
+
+interface
+
+uses uw8738a, uw8738a;
+
+implementation
+
+initialization
+
+finalization
+
+end.
+

tests/webtbs/tw6543.pp

@@ -0,0 +1,20 @@
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+
+program p;
+
+type
+  c = class
+    a: array[boolean] of byte;
+    property f: byte read a[false] write a[false];
+  end;
+
+var
+  o: c;
+begin
+  o := c.Create;
+  o.f := 1;
+  if (o.a[false] <> 1) then
+    halt(1);
+end.

tests/webtbs/tw7070a.pp

@@ -0,0 +1,21 @@
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$h+}
+{$endif}
+
+uses
+  Variants;
+
+procedure test(const a: array of string);
+begin
+end;
+
+var
+  a,b: variant;
+begin
+  a:=1;
+  b:=2;
+  test([a,b]);
+end.

tests/webtbs/tw7070b.pp

@@ -0,0 +1,21 @@
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$h+}
+{$endif}
+
+uses
+  Variants;
+
+procedure test(const a: array of variant);
+begin
+end;
+
+var
+  a,b: longint;
+begin
+  a:=1;
+  b:=2;
+  test([a,b]);
+end.

tests/webtbs/tw8883.pp

@@ -0,0 +1,24 @@
+procedure DoTest;
+var
+  i, j, cnt: longint;
+begin
+  cnt:=0;
+  j:=1;
+  for i:=0 to j do
+  begin
+    Inc(cnt);
+    Dec(j);
+  end;
+
+  writeln(cnt);
+  if cnt <> 2 then
+  begin
+    writeln('Test failed!');
+    Halt(1);
+  end;
+  writeln('Test OK.');
+end;
+
+begin
+  dotest;
+end.