+ support for <text>^ in iso mode

git-svn-id: trunk@22512 -
This commit is contained in:
florian 2012-10-01 17:18:51 +00:00
parent 01fcc389be
commit 420cd9bd27
5 changed files with 43 additions and 2 deletions

1
.gitattributes vendored
View File

@ -10906,6 +10906,7 @@ tests/test/tintfcdecl1.pp svneol=native#text/plain
tests/test/tintfcdecl2.pp svneol=native#text/plain
tests/test/tintfdef.pp svneol=native#text/plain
tests/test/tintuint.pp svneol=native#text/plain
tests/test/tisobuf1.pp svneol=native#text/pascal
tests/test/tisogoto1.pp svneol=native#text/pascal
tests/test/tisogoto2.pp svneol=native#text/pascal
tests/test/tisogoto3.pp svneol=native#text/pascal

View File

@ -1653,7 +1653,15 @@ implementation
typecheckpass(p1);
end;
if (p1.resultdef.typ<>pointerdef) then
{ iso file buf access? }
if (m_iso in current_settings.modeswitches) and
(p1.resultdef.typ=filedef) and
(tfiledef(p1.resultdef).filetyp=ft_text) then
begin
p1:=cderefnode.create(ccallnode.createintern('fpc_getbuf',ccallparanode.create(p1,nil)));
typecheckpass(p1);
end
else if (p1.resultdef.typ<>pointerdef) then
begin
{ ^ as binary operator is a problem!!!! (FK) }
again:=false;

View File

@ -471,6 +471,7 @@ procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); compilerproc;
Procedure fpc_Read_Text_QWord(var f : text; out q : qword); compilerproc;
Procedure fpc_Read_Text_Int64(var f : text; out i : int64); compilerproc;
{$endif CPU64}
function fpc_GetBuf(var f : Text) : pchar; compilerproc;
{$endif FPC_HAS_FEATURE_TEXTIO}
{$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}

View File

@ -1388,7 +1388,7 @@ Begin
End;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
procedure fpc_Read_Text_Char(var f : Text; out c: char); [public, alias: 'FPC_READ_TEXT_CHAR']; iocheck;compilerproc;
procedure fpc_Read_Text_Char(var f : Text; out c: char); [public, alias: 'FPC_READ_TEXT_CHAR']; iocheck; compilerproc;
Begin
c:=#0;
If not CheckRead(f) then
@ -1405,6 +1405,17 @@ end;
procedure fpc_Read_Text_Char_intern(var f : Text; out c: char); iocheck; [external name 'FPC_READ_TEXT_CHAR'];
function fpc_GetBuf(var f : Text) : pchar; iocheck; compilerproc;
Begin
Result:=@TextRec(f).Bufptr^[TextRec(f).BufEnd];
If not CheckRead(f) then
exit;
If TextRec(f).BufPos>=TextRec(f).BufEnd Then
exit;
Result:=@TextRec(f).Bufptr^[TextRec(f).BufPos];
end;
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
procedure fpc_Read_Text_WideChar(var f : Text; out wc: widechar); iocheck;compilerproc;
var

20
tests/test/tisobuf1.pp Normal file
View File

@ -0,0 +1,20 @@
{$mode iso}
program test(input, output);
var
t : text;
begin
assign(t,'tisobuf1.tmp');
rewrite(t);
writeln(t,'{Test}');
close(t);
reset(t);
if t^<>'{' then
halt(1);
close(t);
erase(t);
writeln('ok');
end.