Browse Source

* don't check array ranges for being constant in generic declarations, resolves #20028

git-svn-id: trunk@19500 -
florian 14 years ago
parent
commit
80b5100bf6
3 changed files with 57 additions and 28 deletions
  1. 1 0
      .gitattributes
  2. 32 28
      compiler/ptype.pas
  3. 24 0
      tests/webtbs/tw20028.pp

+ 1 - 0
.gitattributes

@@ -11895,6 +11895,7 @@ tests/webtbs/tw20003.pp svneol=native#text/pascal
 tests/webtbs/tw20005.pp svneol=native#text/pascal
 tests/webtbs/tw20005.pp svneol=native#text/pascal
 tests/webtbs/tw2001.pp svneol=native#text/plain
 tests/webtbs/tw2001.pp svneol=native#text/plain
 tests/webtbs/tw2002.pp svneol=native#text/plain
 tests/webtbs/tw2002.pp svneol=native#text/plain
+tests/webtbs/tw20028.pp svneol=native#text/pascal
 tests/webtbs/tw20035a.pp svneol=native#text/pascal
 tests/webtbs/tw20035a.pp svneol=native#text/pascal
 tests/webtbs/tw20035b.pp svneol=native#text/pascal
 tests/webtbs/tw20035b.pp svneol=native#text/pascal
 tests/webtbs/tw20035c.pp svneol=native#text/pascal
 tests/webtbs/tw20035c.pp svneol=native#text/pascal

+ 32 - 28
compiler/ptype.pas

@@ -1241,38 +1241,42 @@ implementation
                        setdefdecl(pt.resultdef)
                        setdefdecl(pt.resultdef)
                      else
                      else
                        begin
                        begin
-                         if (pt.nodetype=rangen) then
+                         if pt.nodetype=rangen then
                            begin
                            begin
-                             if (trangenode(pt).left.nodetype=ordconstn) and
-                                (trangenode(pt).right.nodetype=ordconstn) then
+                             { check the expression only if we are not in a generic declaration }
+                             if not(parse_generic) then
                                begin
                                begin
-                                 { make both the same type or give an error. This is not
-                                   done when both are integer values, because typecasting
-                                   between -3200..3200 will result in a signed-unsigned
-                                   conflict and give a range check error (PFV) }
-                                 if not(is_integer(trangenode(pt).left.resultdef) and is_integer(trangenode(pt).left.resultdef)) then
-                                   inserttypeconv(trangenode(pt).left,trangenode(pt).right.resultdef);
-                                 lowval:=tordconstnode(trangenode(pt).left).value;
-                                 highval:=tordconstnode(trangenode(pt).right).value;
-                                 if highval<lowval then
-                                  begin
-                                    Message(parser_e_array_lower_less_than_upper_bound);
-                                    highval:=lowval;
-                                  end
-                                 else if (lowval<int64(low(asizeint))) or
-                                         (highval>high(asizeint)) then
+                                 if (trangenode(pt).left.nodetype=ordconstn) and
+                                    (trangenode(pt).right.nodetype=ordconstn) then
                                    begin
                                    begin
-                                     Message(parser_e_array_range_out_of_bounds);
-                                     lowval :=0;
-                                     highval:=0;
-                                   end;
-                                 if is_integer(trangenode(pt).left.resultdef) then
-                                   range_to_type(lowval,highval,indexdef)
+                                     { make both the same type or give an error. This is not
+                                       done when both are integer values, because typecasting
+                                       between -3200..3200 will result in a signed-unsigned
+                                       conflict and give a range check error (PFV) }
+                                     if not(is_integer(trangenode(pt).left.resultdef) and is_integer(trangenode(pt).left.resultdef)) then
+                                       inserttypeconv(trangenode(pt).left,trangenode(pt).right.resultdef);
+                                     lowval:=tordconstnode(trangenode(pt).left).value;
+                                     highval:=tordconstnode(trangenode(pt).right).value;
+                                     if highval<lowval then
+                                      begin
+                                        Message(parser_e_array_lower_less_than_upper_bound);
+                                        highval:=lowval;
+                                      end
+                                     else if (lowval<int64(low(asizeint))) or
+                                             (highval>high(asizeint)) then
+                                       begin
+                                         Message(parser_e_array_range_out_of_bounds);
+                                         lowval :=0;
+                                         highval:=0;
+                                       end;
+                                     if is_integer(trangenode(pt).left.resultdef) then
+                                       range_to_type(lowval,highval,indexdef)
+                                     else
+                                       indexdef:=trangenode(pt).left.resultdef;
+                                   end
                                  else
                                  else
-                                   indexdef:=trangenode(pt).left.resultdef;
-                               end
-                             else
-                               Message(type_e_cant_eval_constant_expr);
+                                   Message(type_e_cant_eval_constant_expr);
+                               end;
                            end
                            end
                          else
                          else
                            Message(sym_e_error_in_type_def)
                            Message(sym_e_error_in_type_def)

+ 24 - 0
tests/webtbs/tw20028.pp

@@ -0,0 +1,24 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+type
+  TConstHolder = class
+  public
+    const
+      C = 10;
+  end;
+
+  TSimple = class
+    Arr: array [0..TConstHolder.C] of Integer; //this works
+  end;
+
+
+  generic TGeneric <T> = class
+    Arr: array [0..T.C] of Integer; //but here is error
+// Can't evaluate constant expression
+
+  end;
+
+begin
+end.