mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 06:51:46 +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/tintfcdecl2.pp svneol=native#text/plain
|
||||||
tests/test/tintfdef.pp svneol=native#text/plain
|
tests/test/tintfdef.pp svneol=native#text/plain
|
||||||
tests/test/tintuint.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/tisogoto1.pp svneol=native#text/pascal
|
||||||
tests/test/tisogoto2.pp svneol=native#text/pascal
|
tests/test/tisogoto2.pp svneol=native#text/pascal
|
||||||
tests/test/tisogoto3.pp svneol=native#text/pascal
|
tests/test/tisogoto3.pp svneol=native#text/pascal
|
||||||
|
@ -1653,7 +1653,15 @@ implementation
|
|||||||
typecheckpass(p1);
|
typecheckpass(p1);
|
||||||
end;
|
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
|
begin
|
||||||
{ ^ as binary operator is a problem!!!! (FK) }
|
{ ^ as binary operator is a problem!!!! (FK) }
|
||||||
again:=false;
|
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_QWord(var f : text; out q : qword); compilerproc;
|
||||||
Procedure fpc_Read_Text_Int64(var f : text; out i : int64); compilerproc;
|
Procedure fpc_Read_Text_Int64(var f : text; out i : int64); compilerproc;
|
||||||
{$endif CPU64}
|
{$endif CPU64}
|
||||||
|
function fpc_GetBuf(var f : Text) : pchar; compilerproc;
|
||||||
{$endif FPC_HAS_FEATURE_TEXTIO}
|
{$endif FPC_HAS_FEATURE_TEXTIO}
|
||||||
|
|
||||||
{$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}
|
{$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}
|
||||||
|
@ -1405,6 +1405,17 @@ end;
|
|||||||
procedure fpc_Read_Text_Char_intern(var f : Text; out c: char); iocheck; [external name 'FPC_READ_TEXT_CHAR'];
|
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}
|
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
|
||||||
procedure fpc_Read_Text_WideChar(var f : Text; out wc: widechar); iocheck;compilerproc;
|
procedure fpc_Read_Text_WideChar(var f : Text; out wc: widechar); iocheck;compilerproc;
|
||||||
var
|
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