Selaa lähdekoodia

* allowed open "packed" arrays (same as regular open arrays, for
compatibility with some other Pascal compilers) (mantis #14812)

git-svn-id: trunk@13918 -

Jonas Maebe 16 vuotta sitten
vanhempi
commit
7e0a5aec4c
3 muutettua tiedostoa jossa 40 lisäystä ja 2 poistoa
  1. 1 0
      .gitattributes
  2. 12 2
      compiler/pdecsub.pas
  3. 27 0
      tests/webtbs/tw14812.pp

+ 1 - 0
.gitattributes

@@ -9333,6 +9333,7 @@ tests/webtbs/tw14740.pp svneol=native#text/plain
 tests/webtbs/tw14743.pp svneol=native#text/pascal
 tests/webtbs/tw1477.pp svneol=native#text/plain
 tests/webtbs/tw1479.pp svneol=native#text/plain
+tests/webtbs/tw14812.pp svneol=native#text/plain
 tests/webtbs/tw1485.pp svneol=native#text/plain
 tests/webtbs/tw1489.pp svneol=native#text/plain
 tests/webtbs/tw1501.pp svneol=native#text/plain

+ 12 - 2
compiler/pdecsub.pas

@@ -395,10 +395,11 @@ implementation
         old_block_type : tblock_type;
         currparast : tparasymtable;
         parseprocvar : tppv;
-        explicit_paraloc : boolean;
         locationstr : string;
         paranr : integer;
         dummytype : ttypesym;
+        explicit_paraloc,
+        need_array: boolean;
       begin
         old_block_type:=block_type;
         explicit_paraloc:=false;
@@ -497,7 +498,16 @@ implementation
            begin
              consume(_COLON);
              { check for an open array }
-             if token=_ARRAY then
+             need_array:=false;
+             { bitpacked open array are not yet supported }
+             if (token=_PACKED) and
+                not(cs_bitpacking in current_settings.localswitches) then
+               begin
+                 consume(_PACKED);
+                 need_array:=true;
+               end;
+             if (token=_ARRAY) or
+                need_array then
               begin
                 consume(_ARRAY);
                 consume(_OF);

+ 27 - 0
tests/webtbs/tw14812.pp

@@ -0,0 +1,27 @@
+type
+  stdstrlong = string;
+
+procedure PackStr // Convert string to packed array
+   ( InStr: StdStrLong;
+    var OutArr: packed array of char);
+var
+  i: longint;
+begin
+  if (low(outarr)<>0) or
+     (high(outarr)<>5) then
+    halt(1);
+  if (instr<>'abc') then
+    halt(2);
+  for i:=1 to length(instr) do
+    outarr[i-1]:=instr[i];
+end;
+
+var
+  a: packed array[5..10] of char;
+begin
+  packstr('abc',a);
+  if (a[5]<>'a') or
+     (a[6]<>'b') or
+     (a[7]<>'c') then
+    halt(1);
+end.