paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +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/i8086tab.inc 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/n8086mat.pas 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/tset3.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/tstring1.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/tw19581.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/tw19651.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/tw20874a.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/tw20909.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/tw23185.pp svneol=native#text/pascal
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/tw2323.pp svneol=native#text/plain
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/tw23503.pp svneol=native#text/pascal
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/tw23667.pp svneol=native#text/plain
tests/webtbs/tw23725.pp svneol=native#text/pascal
tests/webtbs/tw23744.pp svneol=native#text/plain
tests/webtbs/tw2377.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/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/tw2397.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/uw22741a.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/uw2706a.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,
nx86cnv,
n8086add{,
n386cal,
n8086add,
n8086cal{,
n386mem,
n386set},
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)"/>
</local>
</RunParams>
<Units Count="15">
<Units Count="16">
<Unit0>
<Filename Value="pp.pas"/>
<IsPartOfProject Value="True"/>
@ -103,6 +103,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="n8086inl"/>
</Unit14>
<Unit15>
<Filename Value="i8086\n8086cal.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="n8086cal"/>
</Unit15>
</Units>
</ProjectOptions>
<CompilerOptions>

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

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

66
tests/webtbs/tw19622.pp
View File

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

42
tests/webtbs/tw20880.pp
View File

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

42
tests/webtbs/tw23204.pp
View File

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

118
tests/webtbs/tw23568.pp
View File

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

76
tests/webtbs/tw23819.pp
View File

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

186
tests/webtbs/tw23912.pp
View File

@ -1,93 +1,93 @@
program crash_2_7_1;
{$mode objfpc}{$H+}
//uses
type
TSynCommentType = (sctAnsi, sctBor, sctSlash);
TSynCommentIndentFlag = (
// * For Matching lines (FCommentMode)
// 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)
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)
sciAddPastTokenIndent, // Adds any indent found past the opening token "(*", "{" or "//".
sciMatchOnlyTokenLen, // Apply the Above only if first line matches. (Only if sciAddTokenLen is specified)
sciMatchOnlyPastTokenIndent,
sciAlignOnlyTokenLen, // Apply the Above only if sciAlignOpen was used (include via max)
sciAlignOnlyPastTokenIndent,
sciApplyIndentForNoMatch // Apply above rules For NONE Matching lines (FCommentMode),
// includes FIndentFirstLineExtra
);
TSynCommentIndentFlags = set of TSynCommentIndentFlag;
TSynCommentContineMode = (
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)
sccPrefixMatch
);
TSynCommentMatchMode = (
scmMatchAfterOpening, // will not include (*,{,//. The ^ will match the first char after
scmMatchOpening, // will include (*,{,//. The ^ will match the ({/
scmMatchWholeLine, // Match the entire line
scmMatchAtAsterisk // AnsiComment only, will match the * of (*, but not the (
);
TSynCommentMatchLine = (
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)
);
TSynBeautifierIndentType = (sbitSpace, sbitCopySpaceTab, sbitPositionCaret);
TSynCommentExtendMode = (
sceNever, // Never Extend
sceAlways, // Always
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
sceMatchingSplitLine
);
function dbgs(AIndentFlag: TSynCommentIndentFlag): String;
begin
Result := ''; WriteStr(Result, AIndentFlag);
end;
function dbgs(AIndentFlags: TSynCommentIndentFlags): String;
var
i: TSynCommentIndentFlag;
begin
Result := '';
for i := low(TSynCommentIndentFlag) to high(TSynCommentIndentFlag) do
if i in AIndentFlags then
if Result = ''
then Result := dbgs(i)
else Result := Result + ',' + dbgs(i);
if Result <> '' then
Result := '[' + Result + ']';
end;
procedure Foo(Atype: TSynCommentType;
AIndentMode: TSynCommentIndentFlags;
AIndentFirstLineMax: Integer; AIndentFirstLineExtra: String;
ACommentMode: TSynCommentContineMode; AMatchMode: TSynCommentMatchMode;
AMatchLine: TSynCommentMatchLine; ACommentIndent: TSynBeautifierIndentType;
AMatch: String; APrefix: String;
AExtenbSlash: TSynCommentExtendMode = sceNever);
var
s: String;
begin
writestr(s, AType,':',
' IMode=', dbgs(AIndentMode), ' IMax=', AIndentFirstLineMax, ' IExtra=', AIndentFirstLineExtra,
' CMode=', ACommentMode, ' CMatch=', AMatchMode, ' CLine=', AMatchLine,
' 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
halt(1);
end;
begin
Foo(sctAnsi, [sciAddTokenLen], 5, ' ', sccPrefixMatch, scmMatchOpening,
sclMatchPrev, sbitCopySpaceTab, '.', '+');
end.
program crash_2_7_1;
{$mode objfpc}{$H+}
//uses
type
TSynCommentType = (sctAnsi, sctBor, sctSlash);
TSynCommentIndentFlag = (
// * For Matching lines (FCommentMode)
// 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)
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)
sciAddPastTokenIndent, // Adds any indent found past the opening token "(*", "{" or "//".
sciMatchOnlyTokenLen, // Apply the Above only if first line matches. (Only if sciAddTokenLen is specified)
sciMatchOnlyPastTokenIndent,
sciAlignOnlyTokenLen, // Apply the Above only if sciAlignOpen was used (include via max)
sciAlignOnlyPastTokenIndent,
sciApplyIndentForNoMatch // Apply above rules For NONE Matching lines (FCommentMode),
// includes FIndentFirstLineExtra
);
TSynCommentIndentFlags = set of TSynCommentIndentFlag;
TSynCommentContineMode = (
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)
sccPrefixMatch
);
TSynCommentMatchMode = (
scmMatchAfterOpening, // will not include (*,{,//. The ^ will match the first char after
scmMatchOpening, // will include (*,{,//. The ^ will match the ({/
scmMatchWholeLine, // Match the entire line
scmMatchAtAsterisk // AnsiComment only, will match the * of (*, but not the (
);
TSynCommentMatchLine = (
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)
);
TSynBeautifierIndentType = (sbitSpace, sbitCopySpaceTab, sbitPositionCaret);
TSynCommentExtendMode = (
sceNever, // Never Extend
sceAlways, // Always
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
sceMatchingSplitLine
);
function dbgs(AIndentFlag: TSynCommentIndentFlag): String;
begin
Result := ''; WriteStr(Result, AIndentFlag);
end;
function dbgs(AIndentFlags: TSynCommentIndentFlags): String;
var
i: TSynCommentIndentFlag;
begin
Result := '';
for i := low(TSynCommentIndentFlag) to high(TSynCommentIndentFlag) do
if i in AIndentFlags then
if Result = ''
then Result := dbgs(i)
else Result := Result + ',' + dbgs(i);
if Result <> '' then
Result := '[' + Result + ']';
end;
procedure Foo(Atype: TSynCommentType;
AIndentMode: TSynCommentIndentFlags;
AIndentFirstLineMax: Integer; AIndentFirstLineExtra: String;
ACommentMode: TSynCommentContineMode; AMatchMode: TSynCommentMatchMode;
AMatchLine: TSynCommentMatchLine; ACommentIndent: TSynBeautifierIndentType;
AMatch: String; APrefix: String;
AExtenbSlash: TSynCommentExtendMode = sceNever);
var
s: String;
begin
writestr(s, AType,':',
' IMode=', dbgs(AIndentMode), ' IMax=', AIndentFirstLineMax, ' IExtra=', AIndentFirstLineExtra,
' CMode=', ACommentMode, ' CMatch=', AMatchMode, ' CLine=', AMatchLine,
' 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
halt(1);
end;
begin
Foo(sctAnsi, [sciAddTokenLen], 5, ' ', sccPrefixMatch, scmMatchOpening,
sclMatchPrev, sbitCopySpaceTab, '.', '+');
end.

36
tests/webtbs/uw23204.pp
View File

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