paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 10:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added n8086cal.pas, based on n386cal.pas; this pulls in nx86cal.pas as well and fixes compilation of the system unit on i8086 after the merge of the i8086 branch to trunk

Browse Source 
git-svn-id: trunk@24335 -
This commit is contained in:
nickysn 2013-04-26 20:19:57 +00:00
parent a07af824ea
commit 3853d06ac0
12 changed files with 428 additions and 325 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
.gitattributes vendored
View File

@ -244,6 +244,7 @@ compiler/i8086/i8086op.inc svneol=native#text/plain
compiler/i8086/i8086prop.inc svneol=native#text/plain compiler/i8086/i8086prop.inc svneol=native#text/plain
compiler/i8086/i8086tab.inc svneol=native#text/plain compiler/i8086/i8086tab.inc svneol=native#text/plain
compiler/i8086/n8086add.pas svneol=native#text/plain compiler/i8086/n8086add.pas svneol=native#text/plain
compiler/i8086/n8086cal.pas svneol=native#text/plain
compiler/i8086/n8086inl.pas svneol=native#text/plain compiler/i8086/n8086inl.pas svneol=native#text/plain
compiler/i8086/n8086mat.pas svneol=native#text/plain compiler/i8086/n8086mat.pas svneol=native#text/plain
compiler/i8086/r8086ari.inc svneol=native#text/plain compiler/i8086/r8086ari.inc svneol=native#text/plain
@ -10597,7 +10598,7 @@ tests/test/jvm/trange3.pp svneol=native#text/plain
tests/test/jvm/tset1.pp svneol=native#text/plain tests/test/jvm/tset1.pp svneol=native#text/plain
tests/test/jvm/tset3.pp svneol=native#text/plain tests/test/jvm/tset3.pp svneol=native#text/plain
tests/test/jvm/tset7.pp svneol=native#text/plain tests/test/jvm/tset7.pp svneol=native#text/plain
tests/test/jvm/tsetansistr.pp -text svneol=native#text/plain tests/test/jvm/tsetansistr.pp svneol=native#text/plain
tests/test/jvm/tstr.pp svneol=native#text/plain tests/test/jvm/tstr.pp svneol=native#text/plain
tests/test/jvm/tstring1.pp svneol=native#text/plain tests/test/jvm/tstring1.pp svneol=native#text/plain
tests/test/jvm/tstring9.pp svneol=native#text/plain tests/test/jvm/tstring9.pp svneol=native#text/plain
@ -13156,7 +13157,7 @@ tests/webtbs/tw19548.pp svneol=native#text/pascal
tests/webtbs/tw19555.pp svneol=native#text/pascal tests/webtbs/tw19555.pp svneol=native#text/pascal
tests/webtbs/tw19581.pp svneol=native#text/plain tests/webtbs/tw19581.pp svneol=native#text/plain
tests/webtbs/tw19610.pp svneol=native#text/plain tests/webtbs/tw19610.pp svneol=native#text/plain
tests/webtbs/tw19622.pp -text svneol=native#text/plain tests/webtbs/tw19622.pp svneol=native#text/plain
tests/webtbs/tw1964.pp svneol=native#text/plain tests/webtbs/tw1964.pp svneol=native#text/plain
tests/webtbs/tw19651.pp svneol=native#text/plain tests/webtbs/tw19651.pp svneol=native#text/plain
tests/webtbs/tw19700.pp svneol=native#text/plain tests/webtbs/tw19700.pp svneol=native#text/plain
@ -13224,7 +13225,7 @@ tests/webtbs/tw20872c.pp svneol=native#text/pascal
tests/webtbs/tw20873.pp svneol=native#text/plain tests/webtbs/tw20873.pp svneol=native#text/plain
tests/webtbs/tw20874a.pp svneol=native#text/pascal tests/webtbs/tw20874a.pp svneol=native#text/pascal
tests/webtbs/tw20874b.pp svneol=native#text/pascal tests/webtbs/tw20874b.pp svneol=native#text/pascal
tests/webtbs/tw20880.pp -text svneol=native#text/plain tests/webtbs/tw20880.pp svneol=native#text/plain
tests/webtbs/tw20889.pp svneol=native#text/pascal tests/webtbs/tw20889.pp svneol=native#text/pascal
tests/webtbs/tw20909.pp svneol=native#text/pascal tests/webtbs/tw20909.pp svneol=native#text/pascal
tests/webtbs/tw20940.pp svneol=native#text/pascal tests/webtbs/tw20940.pp svneol=native#text/pascal
@ -13357,7 +13358,7 @@ tests/webtbs/tw2317.pp svneol=native#text/plain
tests/webtbs/tw2318.pp svneol=native#text/plain tests/webtbs/tw2318.pp svneol=native#text/plain
tests/webtbs/tw23185.pp svneol=native#text/pascal tests/webtbs/tw23185.pp svneol=native#text/pascal
tests/webtbs/tw2318b.pp svneol=native#text/plain tests/webtbs/tw2318b.pp svneol=native#text/plain
tests/webtbs/tw23204.pp -text svneol=native#text/plain tests/webtbs/tw23204.pp svneol=native#text/plain
tests/webtbs/tw23212.pp svneol=native#text/plain tests/webtbs/tw23212.pp svneol=native#text/plain
tests/webtbs/tw2323.pp svneol=native#text/plain tests/webtbs/tw2323.pp svneol=native#text/plain
tests/webtbs/tw23270.pp svneol=native#text/pascal tests/webtbs/tw23270.pp svneol=native#text/pascal
@ -13370,17 +13371,17 @@ tests/webtbs/tw23447.pp svneol=native#text/pascal
tests/webtbs/tw23486.pp svneol=native#text/pascal tests/webtbs/tw23486.pp svneol=native#text/pascal
tests/webtbs/tw23503.pp svneol=native#text/pascal tests/webtbs/tw23503.pp svneol=native#text/pascal
tests/webtbs/tw2351.pp svneol=native#text/plain tests/webtbs/tw2351.pp svneol=native#text/plain
tests/webtbs/tw23568.pp -text svneol=native#text/plain tests/webtbs/tw23568.pp svneol=native#text/plain
tests/webtbs/tw2363.pp svneol=native#text/plain tests/webtbs/tw2363.pp svneol=native#text/plain
tests/webtbs/tw23667.pp svneol=native#text/plain tests/webtbs/tw23667.pp svneol=native#text/plain
tests/webtbs/tw23725.pp svneol=native#text/pascal tests/webtbs/tw23725.pp svneol=native#text/pascal
tests/webtbs/tw23744.pp svneol=native#text/plain tests/webtbs/tw23744.pp svneol=native#text/plain
tests/webtbs/tw2377.pp svneol=native#text/plain tests/webtbs/tw2377.pp svneol=native#text/plain
tests/webtbs/tw2378.pp svneol=native#text/plain tests/webtbs/tw2378.pp svneol=native#text/plain
tests/webtbs/tw23819.pp -text svneol=native#text/plain tests/webtbs/tw23819.pp svneol=native#text/plain
tests/webtbs/tw2382.pp svneol=native#text/plain tests/webtbs/tw2382.pp svneol=native#text/plain
tests/webtbs/tw2388.pp svneol=native#text/plain tests/webtbs/tw2388.pp svneol=native#text/plain
tests/webtbs/tw23912.pp -text svneol=native#text/plain tests/webtbs/tw23912.pp svneol=native#text/plain
tests/webtbs/tw23962.pp svneol=native#text/plain tests/webtbs/tw23962.pp svneol=native#text/plain
tests/webtbs/tw2397.pp svneol=native#text/plain tests/webtbs/tw2397.pp svneol=native#text/plain
tests/webtbs/tw24007.pp svneol=native#text/plain tests/webtbs/tw24007.pp svneol=native#text/plain
@ -14168,7 +14169,7 @@ tests/webtbs/uw2266b.pas svneol=native#text/plain
tests/webtbs/uw2269.inc svneol=native#text/plain tests/webtbs/uw2269.inc svneol=native#text/plain
tests/webtbs/uw22741a.pp svneol=native#text/plain tests/webtbs/uw22741a.pp svneol=native#text/plain
tests/webtbs/uw22741b.pp svneol=native#text/plain tests/webtbs/uw22741b.pp svneol=native#text/plain
tests/webtbs/uw23204.pp -text svneol=native#text/plain tests/webtbs/uw23204.pp svneol=native#text/plain
tests/webtbs/uw2364.pp svneol=native#text/plain tests/webtbs/uw2364.pp svneol=native#text/plain
tests/webtbs/uw2706a.pp svneol=native#text/plain tests/webtbs/uw2706a.pp svneol=native#text/plain
tests/webtbs/uw2706b.pp svneol=native#text/plain tests/webtbs/uw2706b.pp svneol=native#text/plain

4
compiler/i8086/cpunode.pas
View File

@ -49,8 +49,8 @@ unit cpunode;
nx86con, nx86con,
nx86cnv, nx86cnv,
n8086add{, n8086add,
n386cal, n8086cal{,
n386mem, n386mem,
n386set}, n386set},
n8086inl, n8086inl,

97
compiler/i8086/n8086cal.pas Normal file
View File

@ -0,0 +1,97 @@
{
Copyright (c) 1998-2002 by Florian Klaempfl
Generate i8086 assembler for in call nodes
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit n8086cal;
{$i fpcdefs.inc}
interface
{ $define AnsiStrRef}
uses
nx86cal;
type
ti8086callnode = class(tx86callnode)
protected
procedure pop_parasize(pop_size:longint);override;
procedure extra_interrupt_code;override;
end;
implementation
uses
globtype,systems,
cutils,verbose,globals,
cgbase,cgutils,
cpubase,paramgr,
aasmtai,aasmdata,aasmcpu,
ncal,nbas,nmem,nld,ncnv,
cga,cgobj,cpuinfo;
{*****************************************************************************
TI8086CALLNODE
*****************************************************************************}
procedure ti8086callnode.extra_interrupt_code;
begin
emit_none(A_PUSHF,S_W);
emit_reg(A_PUSH,S_W,NR_CS);
end;
procedure ti8086callnode.pop_parasize(pop_size:longint);
var
hreg : tregister;
begin
if (paramanager.use_fixed_stack) then
begin
{ very weird: in this case the callee does a "ret $4" and the }
{ caller immediately a "subl $4,%esp". Possibly this is for }
{ use_fixed_stack code to be able to transparently call }
{ old-style code (JM) }
dec(pop_size,pushedparasize);
if (pop_size < 0) then
current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_SUB,S_W,-pop_size,NR_SP));
exit;
end;
{ better than an add on all processors }
if pop_size=2 then
begin
hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_POP,S_W,hreg));
end
{ the pentium has two pipes and pop reg is pairable }
{ but the registers must be different! }
else
if pop_size<>0 then
current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_ADD,S_W,pop_size,NR_SP));
end;
begin
ccallnode:=ti8086callnode;
end.

7
compiler/ppc8086.lpi
View File

@ -28,7 +28,7 @@
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<Units Count="15"> <Units Count="16">
<Unit0> <Unit0>
<Filename Value="pp.pas"/> <Filename Value="pp.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -103,6 +103,11 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="n8086inl"/> <UnitName Value="n8086inl"/>
</Unit14> </Unit14>
<Unit15>
<Filename Value="i8086\n8086cal.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="n8086cal"/>
</Unit15>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

62
tests/test/jvm/tsetansistr.pp
View File

@ -1,31 +1,31 @@
program tsetansistr; program tsetansistr;
{$mode delphi} {$mode delphi}
{$modeswitch unicodestrings} {$modeswitch unicodestrings}
type type
ByteArray = array of byte; ByteArray = array of byte;
const const
AnsiStrOffset = 1; AnsiStrOffset = 1;
function AnsiStringOfBytes(const Src : ByteArray) : AnsiString; function AnsiStringOfBytes(const Src : ByteArray) : AnsiString;
var var
i : integer; i : integer;
begin begin
SetLength(Result, Length(Src)); SetLength(Result, Length(Src));
for i := 0 to Length(Src) - 1 do for i := 0 to Length(Src) - 1 do
Result[i + AnsiStrOffset] := Chr(Src[i]); Result[i + AnsiStrOffset] := Chr(Src[i]);
end; end;
var var
A : ByteArray; A : ByteArray;
B : AnsiString; B : AnsiString;
begin begin
DefaultSystemCodePage:=20127; // ASCII DefaultSystemCodePage:=20127; // ASCII
SetLength(A, 1); A[0] := $98; SetLength(A, 1); A[0] := $98;
B := AnsiStringOfBytes(A); B := AnsiStringOfBytes(A);
if ord(B[1]) <> $98 then if ord(B[1]) <> $98 then
halt(1); halt(1);
end. end.

66
tests/webtbs/tw19622.pp
View File

@ -1,33 +1,33 @@
Var a,b:qword; Var a,b:qword;
c:boolean; c:boolean;
aa,bb:longword; aa,bb:longword;
Begin Begin
a:=qword($FFFFFFFFFFFFFFFF); a:=qword($FFFFFFFFFFFFFFFF);
b:=9223372036854775807; b:=9223372036854775807;
c:=a>b; c:=a>b;
if not c then if not c then
halt(1); halt(1);
if not(qword($FFFFFFFFFFFFFFFF)>9223372036854775807) then if not(qword($FFFFFFFFFFFFFFFF)>9223372036854775807) then
halt(2); halt(2);
c:=qword($FFFFFFFFFFFFFFFF)>b; c:=qword($FFFFFFFFFFFFFFFF)>b;
if not c then if not c then
halt(3); halt(3);
c:=18446744073709551615>=9223372036854775807; c:=18446744073709551615>=9223372036854775807;
if not c then if not c then
halt(4); halt(4);
aa:=$FFFFFFFF; aa:=$FFFFFFFF;
bb:=2147483647; bb:=2147483647;
c:=aa>bb; c:=aa>bb;
if not c then if not c then
halt(5); halt(5);
if not ($FFFFFFFF>2147483647) then if not ($FFFFFFFF>2147483647) then
halt(6); halt(6);
c:=$FFFFFFFF>bb; c:=$FFFFFFFF>bb;
if not c then if not c then
halt(7); halt(7);
c:=4294967295>=2147483647; c:=4294967295>=2147483647;
if not c then if not c then
halt(8); halt(8);
End. End.

42
tests/webtbs/tw20880.pp
View File

@ -1,21 +1,21 @@
{ %interactive } { %interactive }
program CrtBug; program CrtBug;
uses Crt; uses Crt;
begin begin
ClrScr; ClrScr;
Window(windmaxx - 25, 5, windmaxx, 20); Window(windmaxx - 25, 5, windmaxx, 20);
TextColor(LightRed); TextColor(LightRed);
TextBackground(Cyan); TextBackground(Cyan);
ClrScr; ClrScr;
while not KeyPressed do while not KeyPressed do
begin begin
Write('R=', Random(256), ' '); Write('R=', Random(256), ' ');
Delay(100); Delay(100);
end; end;
ReadKey; ReadKey;
end. end.

42
tests/webtbs/tw23204.pp
View File

@ -1,21 +1,21 @@
program tw23204; program tw23204;
{$mode Delphi}{$H+} {$mode Delphi}{$H+}
uses uses
uw23204; uw23204;
var var
cur_p: TP; cur_p: TP;
function DropP:TPs; function DropP:TPs;
begin begin
result := [cur_p.AType]; result := [cur_p.AType];
end; end;
begin begin
cur_p.AType:=pt_1; cur_p.AType:=pt_1;
if DropP<>[pt_1] then if DropP<>[pt_1] then
halt(1); halt(1);
end. end.

118
tests/webtbs/tw23568.pp
View File

@ -1,59 +1,59 @@
program tw23568; program tw23568;
{$MODE DELPHI} {$MODE DELPHI}
type type
TInteger32Boolean = record TInteger32Boolean = record
public public
Value: Integer; Value: Integer;
class operator Implicit(const Operand: TInteger32Boolean): Boolean; class operator Implicit(const Operand: TInteger32Boolean): Boolean;
end; end;
{ TInteger32Boolean } { TInteger32Boolean }
class operator TInteger32Boolean.Implicit(const Operand: TInteger32Boolean): Boolean; class operator TInteger32Boolean.Implicit(const Operand: TInteger32Boolean): Boolean;
begin begin
Result := Operand.Value <> 0; Result := Operand.Value <> 0;
WriteLn('In TInteger32Boolean.Implicit()'); WriteLn('In TInteger32Boolean.Implicit()');
end; end;
var var
Value: TInteger32Boolean; Value: TInteger32Boolean;
Intermediate: Boolean; Intermediate: Boolean;
begin begin
// Assign True to TInteger32Boolean // Assign True to TInteger32Boolean
Value.Value := 1; Value.Value := 1;
// If statement using intermediate assignment through Intermediate // If statement using intermediate assignment through Intermediate
Intermediate := Value; Intermediate := Value;
if Intermediate then if Intermediate then
WriteLn('True') WriteLn('True')
else else
halt(1); halt(1);
// If statement should perform implicit type conversion from TInteger32Boolean to Boolean // If statement should perform implicit type conversion from TInteger32Boolean to Boolean
if Value then if Value then
WriteLn('True') WriteLn('True')
else else
halt(2); halt(2);
// While statement should perform implicit type conversion as well // While statement should perform implicit type conversion as well
while Value do while Value do
begin begin
if Value.Value=0 then if Value.Value=0 then
halt(3); halt(3);
Value.Value := 0; Value.Value := 0;
WriteLn('While'); WriteLn('While');
end; end;
// Repeat until statement should perform implicit type conversion as well // Repeat until statement should perform implicit type conversion as well
repeat repeat
if Value.Value=1 then if Value.Value=1 then
halt(4); halt(4);
Value.Value := 1; Value.Value := 1;
WriteLn('Repeat until'); WriteLn('Repeat until');
until Value; until Value;
end. end.

76
tests/webtbs/tw23819.pp
View File

@ -1,38 +1,38 @@
{ %norun } { %norun }
program tw23819; program tw23819;
type type
fixstring = string [ 255 ] ; fixstring = string [ 255 ] ;
t9496 = ( t94, t96 ) ; t9496 = ( t94, t96 ) ;
tSD = ( sdSingle94, sdSingle96, sdDOuble94, sdDouble96 ) ; tSD = ( sdSingle94, sdSingle96, sdDOuble94, sdDouble96 ) ;
tg = ( G0, G1, G2, G3 ) ; tg = ( G0, G1, G2, G3 ) ;
tG13 = G1..G3 ; tG13 = G1..G3 ;
tl = #$40..#$7f ; tl = #$40..#$7f ;
ESCstring = string [ 7 ] ; ESCstring = string [ 7 ] ;
tgl9496 = {packed} object tgl9496 = {packed} object
sd : tSD ; sd : tSD ;
g : tg ; g : tg ;
l : tl ; l : tl ;
n : t9496 ; n : t9496 ;
procedure Put ( const pESCseq : ESCstring ) ; procedure Put ( const pESCseq : ESCstring ) ;
end ; end ;
procedure tgl9496.Put ( const pESCseq : ESCstring ) ; procedure tgl9496.Put ( const pESCseq : ESCstring ) ;
var var
yp : tgl9496 ; yp : tgl9496 ;
locals : record locals : record
Lst : FixString ; Lst : FixString ;
gc : Char ; gc : Char ;
gp, gp,
letp : LongInt ; letp : LongInt ;
xp : tgl9496 ; xp : tgl9496 ;
end ; end ;
begin begin
end ; end ;
begin begin
end. end.

186
tests/webtbs/tw23912.pp
View File

@ -1,93 +1,93 @@
program crash_2_7_1; program crash_2_7_1;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
//uses //uses
type type
TSynCommentType = (sctAnsi, sctBor, sctSlash); TSynCommentType = (sctAnsi, sctBor, sctSlash);
TSynCommentIndentFlag = ( TSynCommentIndentFlag = (
// * For Matching lines (FCommentMode) // * For Matching lines (FCommentMode)
// By default indent is the same as for none comment lines (none overrides sciAlignOpen) // By default indent is the same as for none comment lines (none overrides sciAlignOpen)
sciNone, // Does not Indent comment lines (Prefix may contain a fixed indent) sciNone, // Does not Indent comment lines (Prefix may contain a fixed indent)
sciAlignOpen, // Indent to real opening pos on first line, if comment does not start at BOL "Foo(); (*" sciAlignOpen, // Indent to real opening pos on first line, if comment does not start at BOL "Foo(); (*"
sciAddTokenLen, // add 1 or 2 spaces to indent (for the length of the token) sciAddTokenLen, // add 1 or 2 spaces to indent (for the length of the token)
sciAddPastTokenIndent, // Adds any indent found past the opening token "(*", "{" or "//". sciAddPastTokenIndent, // Adds any indent found past the opening token "(*", "{" or "//".
sciMatchOnlyTokenLen, // Apply the Above only if first line matches. (Only if sciAddTokenLen is specified) sciMatchOnlyTokenLen, // Apply the Above only if first line matches. (Only if sciAddTokenLen is specified)
sciMatchOnlyPastTokenIndent, sciMatchOnlyPastTokenIndent,
sciAlignOnlyTokenLen, // Apply the Above only if sciAlignOpen was used (include via max) sciAlignOnlyTokenLen, // Apply the Above only if sciAlignOpen was used (include via max)
sciAlignOnlyPastTokenIndent, sciAlignOnlyPastTokenIndent,
sciApplyIndentForNoMatch // Apply above rules For NONE Matching lines (FCommentMode), sciApplyIndentForNoMatch // Apply above rules For NONE Matching lines (FCommentMode),
// includes FIndentFirstLineExtra // includes FIndentFirstLineExtra
); );
TSynCommentIndentFlags = set of TSynCommentIndentFlag; TSynCommentIndentFlags = set of TSynCommentIndentFlag;
TSynCommentContineMode = ( TSynCommentContineMode = (
sccNoPrefix, // May still do indent, if matched sccNoPrefix, // May still do indent, if matched
sccPrefixAlways, // If the pattern did not match all will be done, except the indent AFTER the prefix (can not be detected) sccPrefixAlways, // If the pattern did not match all will be done, except the indent AFTER the prefix (can not be detected)
sccPrefixMatch sccPrefixMatch
); );
TSynCommentMatchMode = ( TSynCommentMatchMode = (
scmMatchAfterOpening, // will not include (*,{,//. The ^ will match the first char after scmMatchAfterOpening, // will not include (*,{,//. The ^ will match the first char after
scmMatchOpening, // will include (*,{,//. The ^ will match the ({/ scmMatchOpening, // will include (*,{,//. The ^ will match the ({/
scmMatchWholeLine, // Match the entire line scmMatchWholeLine, // Match the entire line
scmMatchAtAsterisk // AnsiComment only, will match the * of (*, but not the ( scmMatchAtAsterisk // AnsiComment only, will match the * of (*, but not the (
); );
TSynCommentMatchLine = ( TSynCommentMatchLine = (
sclMatchFirst, // Match the first line of the comment to get substitutes for Prefix ($1) sclMatchFirst, // Match the first line of the comment to get substitutes for Prefix ($1)
sclMatchPrev // Match the previous line of the comment to get substitutes for Prefix ($1) sclMatchPrev // Match the previous line of the comment to get substitutes for Prefix ($1)
); );
TSynBeautifierIndentType = (sbitSpace, sbitCopySpaceTab, sbitPositionCaret); TSynBeautifierIndentType = (sbitSpace, sbitCopySpaceTab, sbitPositionCaret);
TSynCommentExtendMode = ( TSynCommentExtendMode = (
sceNever, // Never Extend sceNever, // Never Extend
sceAlways, // Always sceAlways, // Always
sceSplitLine, // If the line was split (caret was not at EOL, when enter was pressed sceSplitLine, // If the line was split (caret was not at EOL, when enter was pressed
sceMatching, // If the line matched (even if sccPrefixAlways or sccNoPrefix sceMatching, // If the line matched (even if sccPrefixAlways or sccNoPrefix
sceMatchingSplitLine sceMatchingSplitLine
); );
function dbgs(AIndentFlag: TSynCommentIndentFlag): String; function dbgs(AIndentFlag: TSynCommentIndentFlag): String;
begin begin
Result := ''; WriteStr(Result, AIndentFlag); Result := ''; WriteStr(Result, AIndentFlag);
end; end;
function dbgs(AIndentFlags: TSynCommentIndentFlags): String; function dbgs(AIndentFlags: TSynCommentIndentFlags): String;
var var
i: TSynCommentIndentFlag; i: TSynCommentIndentFlag;
begin begin
Result := ''; Result := '';
for i := low(TSynCommentIndentFlag) to high(TSynCommentIndentFlag) do for i := low(TSynCommentIndentFlag) to high(TSynCommentIndentFlag) do
if i in AIndentFlags then if i in AIndentFlags then
if Result = '' if Result = ''
then Result := dbgs(i) then Result := dbgs(i)
else Result := Result + ',' + dbgs(i); else Result := Result + ',' + dbgs(i);
if Result <> '' then if Result <> '' then
Result := '[' + Result + ']'; Result := '[' + Result + ']';
end; end;
procedure Foo(Atype: TSynCommentType; procedure Foo(Atype: TSynCommentType;
AIndentMode: TSynCommentIndentFlags; AIndentMode: TSynCommentIndentFlags;
AIndentFirstLineMax: Integer; AIndentFirstLineExtra: String; AIndentFirstLineMax: Integer; AIndentFirstLineExtra: String;
ACommentMode: TSynCommentContineMode; AMatchMode: TSynCommentMatchMode; ACommentMode: TSynCommentContineMode; AMatchMode: TSynCommentMatchMode;
AMatchLine: TSynCommentMatchLine; ACommentIndent: TSynBeautifierIndentType; AMatchLine: TSynCommentMatchLine; ACommentIndent: TSynBeautifierIndentType;
AMatch: String; APrefix: String; AMatch: String; APrefix: String;
AExtenbSlash: TSynCommentExtendMode = sceNever); AExtenbSlash: TSynCommentExtendMode = sceNever);
var var
s: String; s: String;
begin begin
writestr(s, AType,':', writestr(s, AType,':',
' IMode=', dbgs(AIndentMode), ' IMax=', AIndentFirstLineMax, ' IExtra=', AIndentFirstLineExtra, ' IMode=', dbgs(AIndentMode), ' IMax=', AIndentFirstLineMax, ' IExtra=', AIndentFirstLineExtra,
' CMode=', ACommentMode, ' CMatch=', AMatchMode, ' CLine=', AMatchLine, ' CMode=', ACommentMode, ' CMatch=', AMatchMode, ' CLine=', AMatchLine,
' M=''', AMatch, ''' R=''', APrefix, ''' CIndent=', ACommentIndent ' M=''', AMatch, ''' R=''', APrefix, ''' CIndent=', ACommentIndent
); );
if s<>'sctAnsi: IMode=[sciAddTokenLen] IMax=5 IExtra= CMode=sccPrefixMatch CMatch=scmMatchOpening CLine=sclMatchPrev M=''.'' R=''+'' CIndent=sbitCopySpaceTab' then if s<>'sctAnsi: IMode=[sciAddTokenLen] IMax=5 IExtra= CMode=sccPrefixMatch CMatch=scmMatchOpening CLine=sclMatchPrev M=''.'' R=''+'' CIndent=sbitCopySpaceTab' then
halt(1); halt(1);
end; end;
begin begin
Foo(sctAnsi, [sciAddTokenLen], 5, ' ', sccPrefixMatch, scmMatchOpening, Foo(sctAnsi, [sciAddTokenLen], 5, ' ', sccPrefixMatch, scmMatchOpening,
sclMatchPrev, sbitCopySpaceTab, '.', '+'); sclMatchPrev, sbitCopySpaceTab, '.', '+');
end. end.

36
tests/webtbs/uw23204.pp
View File

@ -1,18 +1,18 @@
unit uw23204; unit uw23204;
//{$mode Delphi}{$H+} // error disappears! //{$mode Delphi}{$H+} // error disappears!
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
type type
// TPColor = (pc1, pc2); // TPColor = (pc1, pc2);
TPType = (pt_0, pt_1); TPType = (pt_0, pt_1);
TP = record TP = record
// AColor: TPColor; // AColor: TPColor;
AType: TPType; AType: TPType;
end; end;
TPs = set of TPType; TPs = set of TPType;
implementation implementation
end. end.