Procházet zdrojové kódy

* fixed web bug #4913 (don't allow indexing of strings/variants/pointers
with enums/chars/booleans)

git-svn-id: trunk@2952 -

Jonas Maebe před 19 roky
rodič
revize
f59d552ecb
3 změnil soubory, kde provedl 27 přidání a 3 odebrání
  1. 1 0
      .gitattributes
  2. 4 3
      compiler/nmem.pas
  3. 22 0
      tests/webtbf/tw4913.pp

+ 1 - 0
.gitattributes

@@ -6017,6 +6017,7 @@ tests/webtbf/tw4777.pp svneol=native#text/plain
 tests/webtbf/tw4778a.pp svneol=native#text/plain
 tests/webtbf/tw4781a.pp svneol=native#text/plain
 tests/webtbf/tw4781b.pp svneol=native#text/plain
+tests/webtbf/tw4913.pp -text
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
 tests/webtbf/uw0840b.pp svneol=native#text/plain

+ 4 - 3
compiler/nmem.pas

@@ -676,9 +676,10 @@ implementation
 
          { maybe type conversion for the index value, but
            do not convert enums,booleans,char }
-         if (right.resulttype.def.deftype<>enumdef) and
-            not(is_char(right.resulttype.def) or is_widechar(right.resulttype.def)) and
-            not(is_boolean(right.resulttype.def)) then
+         if ((right.resulttype.def.deftype<>enumdef) and
+             not(is_char(right.resulttype.def) or is_widechar(right.resulttype.def)) and
+             not(is_boolean(right.resulttype.def))) or
+            (left.resulttype.def.deftype <> arraydef) then
            begin
              inserttypeconv(right,sinttype);
            end;

+ 22 - 0
tests/webtbf/tw4913.pp

@@ -0,0 +1,22 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 4913 }
+{ Submitted by "Vinzent Hoefler" on  2006-03-17 }
+{ e-mail: [email protected] }
+const
+   Some_String : String = '0123456789';
+
+type
+   Some_Enum = (Zero, One, Two, Three);
+
+var
+   i : Some_Enum;
+
+begin
+   WriteLn (Some_String[2]);   // Should fail if "Some_String = '...'";
+   WriteLn (Some_String[Two]); // Should fail with type error.
+
+   i := Three;
+   WriteLn (Some_String[i]);
+end.
+