paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 18:49:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* allowed open "packed" arrays (same as regular open arrays, for

Browse Source 
compatibility with some other Pascal compilers) (mantis #14812)

git-svn-id: trunk@13918 -
This commit is contained in:
Jonas Maebe 2009-10-22 19:48:35 +00:00
parent 2bfe336917
commit 7e0a5aec4c
3 changed files with 40 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9333,6 +9333,7 @@ tests/webtbs/tw14740.pp svneol=native#text/plain
tests/webtbs/tw14743.pp svneol=native#text/pascal tests/webtbs/tw14743.pp svneol=native#text/pascal
tests/webtbs/tw1477.pp svneol=native#text/plain tests/webtbs/tw1477.pp svneol=native#text/plain
tests/webtbs/tw1479.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/tw1485.pp svneol=native#text/plain
tests/webtbs/tw1489.pp svneol=native#text/plain tests/webtbs/tw1489.pp svneol=native#text/plain
tests/webtbs/tw1501.pp svneol=native#text/plain tests/webtbs/tw1501.pp svneol=native#text/plain

14
compiler/pdecsub.pas
View File

@ -395,10 +395,11 @@ implementation
old_block_type : tblock_type; old_block_type : tblock_type;
currparast : tparasymtable; currparast : tparasymtable;
parseprocvar : tppv; parseprocvar : tppv;
explicit_paraloc : boolean;
locationstr : string; locationstr : string;
paranr : integer; paranr : integer;
dummytype : ttypesym; dummytype : ttypesym;
explicit_paraloc,
need_array: boolean;
begin begin
old_block_type:=block_type; old_block_type:=block_type;
explicit_paraloc:=false; explicit_paraloc:=false;
@ -497,7 +498,16 @@ implementation
begin begin
consume(_COLON); consume(_COLON);
{ check for an open array } { 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 begin
consume(_ARRAY); consume(_ARRAY);
consume(_OF); consume(_OF);

27
tests/webtbs/tw14812.pp Normal file
View File

@ -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.