Browse Source

* fixed calculation of high parameter for arrays with non-integer bounds
(mantis #32645)

git-svn-id: trunk@37928 -

Jonas Maebe 7 years ago
parent
commit
53bef8d202
4 changed files with 39 additions and 5 deletions
  1. 2 0
      .gitattributes
  2. 5 5
      compiler/ncal.pas
  3. 16 0
      tests/webtbs/tw32645.pp
  4. 16 0
      tests/webtbs/tw32645a.pp

+ 2 - 0
.gitattributes

@@ -15930,6 +15930,8 @@ tests/webtbs/tw3257.pp svneol=native#text/plain
 tests/webtbs/tw3259.pp svneol=native#text/plain
 tests/webtbs/tw3259.pp svneol=native#text/plain
 tests/webtbs/tw3261.pp svneol=native#text/plain
 tests/webtbs/tw3261.pp svneol=native#text/plain
 tests/webtbs/tw3263.pp svneol=native#text/plain
 tests/webtbs/tw3263.pp svneol=native#text/plain
+tests/webtbs/tw32645.pp -text svneol=native#text/plain
+tests/webtbs/tw32645a.pp -text svneol=native#text/plain
 tests/webtbs/tw3265.pp svneol=native#text/plain
 tests/webtbs/tw3265.pp svneol=native#text/plain
 tests/webtbs/tw3272.pp svneol=native#text/plain
 tests/webtbs/tw3272.pp svneol=native#text/plain
 tests/webtbs/tw3272b.pp svneol=native#text/pascal
 tests/webtbs/tw3272b.pp svneol=native#text/pascal

+ 5 - 5
compiler/ncal.pas

@@ -2104,7 +2104,7 @@ implementation
                       begin
                       begin
                         {Array slice using slice builtin function.}
                         {Array slice using slice builtin function.}
                         l:=Tcallparanode(right).left;
                         l:=Tcallparanode(right).left;
-                        hightree:=caddnode.create(subn,l,genintconstnode(1));
+                        hightree:=caddnode.create(subn,geninlinenode(in_ord_x,false,l),genintconstnode(1));
                         Tcallparanode(right).left:=nil;
                         Tcallparanode(right).left:=nil;
 
 
                         {Remove the inline node.}
                         {Remove the inline node.}
@@ -2120,8 +2120,8 @@ implementation
                       {Array slice using .. operator.}
                       {Array slice using .. operator.}
                       with Trangenode(Tvecnode(p).right) do
                       with Trangenode(Tvecnode(p).right) do
                         begin
                         begin
-                          l:=left;  {Get lower bound.}
-                          r:=right; {Get upper bound.}
+                          l:=geninlinenode(in_ord_x,false,left);  {Get lower bound.}
+                          r:=geninlinenode(in_ord_x,false,right); {Get upper bound.}
                         end;
                         end;
                       {In the procedure the array range is 0..(upper_bound-lower_bound).}
                       {In the procedure the array range is 0..(upper_bound-lower_bound).}
                       hightree:=caddnode.create(subn,r,l);
                       hightree:=caddnode.create(subn,r,l);
@@ -2149,10 +2149,10 @@ implementation
                   else
                   else
                     begin
                     begin
                       maybe_load_in_temp(p);
                       maybe_load_in_temp(p);
-                      hightree:=geninlinenode(in_high_x,false,p.getcopy);
+                      hightree:=geninlinenode(in_ord_x,false,geninlinenode(in_high_x,false,p.getcopy));
                       typecheckpass(hightree);
                       typecheckpass(hightree);
                       { only substract low(array) if it's <> 0 }
                       { only substract low(array) if it's <> 0 }
-                      temp:=geninlinenode(in_low_x,false,p.getcopy);
+                      temp:=geninlinenode(in_ord_x,false,geninlinenode(in_low_x,false,p.getcopy));
                       typecheckpass(temp);
                       typecheckpass(temp);
                       if (temp.nodetype <> ordconstn) or
                       if (temp.nodetype <> ordconstn) or
                          (tordconstnode(temp).value <> 0) then
                          (tordconstnode(temp).value <> 0) then

+ 16 - 0
tests/webtbs/tw32645.pp

@@ -0,0 +1,16 @@
+{$mode objfpc}
+
+var myarray : array ['a'..'z'] of integer; //operator is not overloaded 'char' - 'char'
+//var myarray : array ['a'..'zz'] of integer; //signal 291
+//var myarray : array ['a'..'z'*5] of integer; //signal 291
+
+
+procedure myproc (myarray: array of integer);
+begin
+  if high(myarray)<>25 then
+    halt(1);
+end;
+
+begin
+  myproc(myarray);
+end.

+ 16 - 0
tests/webtbs/tw32645a.pp

@@ -0,0 +1,16 @@
+{ %fail }
+
+{$mode objfpc}
+
+var myarray : array ['a'..'zz'] of integer; //signal 291
+
+
+procedure myproc (myarray: array of integer);
+begin
+  if high(myarray)<>25 then
+    halt(1);
+end;
+
+begin
+  myproc(myarray);
+end.