mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-10 03:28:40 +02:00
+ support for <text>^ in iso mode
git-svn-id: trunk@22512 -
This commit is contained in:
parent
01fcc389be
commit
420cd9bd27
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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}
|
||||
|
@ -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
20
tests/test/tisobuf1.pp
Normal 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.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user