|
@@ -13,8 +13,11 @@
|
|
|
*)
|
|
|
unit TCResolver;
|
|
|
|
|
|
-{$mode objfpc}{$H+}
|
|
|
+{$mode objfpc}
|
|
|
+{$H+}
|
|
|
+{$codepage Utf8}
|
|
|
|
|
|
+{$DEFINE NOCONSOLE}
|
|
|
interface
|
|
|
|
|
|
uses
|
|
@@ -39,7 +42,7 @@ type
|
|
|
end;
|
|
|
|
|
|
const
|
|
|
- SrcMarker: array[TSrcMarkerKind] of char = (
|
|
|
+ SrcMarker: array[TSrcMarkerKind] of AnsiChar = (
|
|
|
'#', // mkLabel
|
|
|
'@', // mkResolverReference
|
|
|
'=' // mkDirectReference
|
|
@@ -129,7 +132,7 @@ type
|
|
|
procedure OnCheckElementParent(El: TPasElement; arg: pointer);
|
|
|
procedure FreeSrcMarkers;
|
|
|
procedure OnPasResolverLog(Sender: TObject; const Msg: String);
|
|
|
- procedure OnScannerDirective(Sender: TObject; Directive, Param: String;
|
|
|
+ procedure OnScannerDirective(Sender: TObject; Directive, Param: TPasScannerString;
|
|
|
var Handled: boolean);
|
|
|
procedure OnScannerLog(Sender: TObject; const Msg: String);
|
|
|
Protected
|
|
@@ -1206,11 +1209,13 @@ begin
|
|
|
aFilename:=E.Filename;
|
|
|
aRow:=E.Row;
|
|
|
aCol:=E.Column;
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
WriteSources(aFilename,aRow,aCol);
|
|
|
writeln('ERROR: TTestResolver.ParseMain ',ExpectedModuleClass.ClassName,' Parser: '+E.ClassName+':'+E.Message,
|
|
|
' Scanner at'
|
|
|
+' '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')'
|
|
|
+' Line="'+Scanner.CurLine+'"');
|
|
|
+{$ENDIF}
|
|
|
Fail(E.Message);
|
|
|
end;
|
|
|
on E: EPasResolve do
|
|
@@ -1223,14 +1228,18 @@ begin
|
|
|
aFilename:=E.PasElement.SourceFilename;
|
|
|
ResolverEngine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,aRow,aCol);
|
|
|
end;
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
WriteSources(aFilename,aRow,aCol);
|
|
|
writeln('ERROR: TTestResolver.ParseMain ',ExpectedModuleClass.ClassName,' PasResolver: '+E.ClassName+':'+E.Message
|
|
|
+' at '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')');
|
|
|
+{$ENDIF}
|
|
|
Fail(E.Message);
|
|
|
end;
|
|
|
on E: Exception do
|
|
|
begin
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
writeln('ERROR: TTestResolver.ParseMain ',ExpectedModuleClass.ClassName,' Exception: '+E.ClassName+':'+E.Message);
|
|
|
+{$ENDIF}
|
|
|
Fail(E.Message);
|
|
|
end;
|
|
|
end;
|
|
@@ -1329,7 +1338,7 @@ var
|
|
|
while p^ in ['a'..'z','A'..'Z','_','0'..'9'] do inc(p);
|
|
|
Result:='';
|
|
|
SetLength(Result,p-StartP);
|
|
|
- Move(StartP^,Result[1],length(Result));
|
|
|
+ Move(StartP^,Result[1],length(Result)*SizeOf(Char));
|
|
|
end;
|
|
|
|
|
|
procedure AddLabel;
|
|
@@ -1369,7 +1378,7 @@ var
|
|
|
|
|
|
procedure ParseCode(SrcLines: TStringList; aFilename: string);
|
|
|
var
|
|
|
- p: PChar;
|
|
|
+ p,pstart,pend: PChar;
|
|
|
IsDirective: Boolean;
|
|
|
begin
|
|
|
//writeln('TTestResolver.CheckReferenceDirectives.ParseCode File=',aFilename);
|
|
@@ -1382,10 +1391,14 @@ var
|
|
|
SrcLine:=SrcLines[LineNumber-1];
|
|
|
if SrcLine='' then continue;
|
|
|
//writeln('TTestResolver.CheckReferenceDirectives Line=',SrcLine);
|
|
|
- p:=PChar(SrcLine);
|
|
|
+
|
|
|
+ pstart:=PChar(SrcLine);
|
|
|
+ pend:=pstart;
|
|
|
+ inc(PEnd,length(SrcLine));
|
|
|
+ p:=pstart;
|
|
|
repeat
|
|
|
case p^ of
|
|
|
- #0: if (p-PChar(SrcLine)=length(SrcLine)) then break;
|
|
|
+ #0: if (p>=pend) then break;
|
|
|
'{':
|
|
|
begin
|
|
|
CommentStartP:=p;
|
|
@@ -1396,7 +1409,7 @@ var
|
|
|
repeat
|
|
|
case p^ of
|
|
|
#0:
|
|
|
- if (p-PChar(SrcLine)=length(SrcLine)) then
|
|
|
+ if (p>=pend) then
|
|
|
begin
|
|
|
// multi line comment
|
|
|
if IsDirective then
|
|
@@ -1407,7 +1420,10 @@ var
|
|
|
SrcLine:=SrcLines[LineNumber-1];
|
|
|
//writeln('TTestResolver.CheckReferenceDirectives Comment Line=',SrcLine);
|
|
|
until SrcLine<>'';
|
|
|
- p:=PChar(SrcLine);
|
|
|
+ pstart:=PChar(SrcLine);
|
|
|
+ pend:=pstart;
|
|
|
+ inc(PEnd,length(SrcLine));
|
|
|
+ p:=pstart;
|
|
|
continue;
|
|
|
end;
|
|
|
'}':
|
|
@@ -1480,12 +1496,14 @@ var
|
|
|
for i:=0 to ReferenceElements.Count-1 do
|
|
|
begin
|
|
|
El:=TPasElement(ReferenceElements[i]);
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
write('Reference candidate for "',aMarker^.Identifier,'" at reference ',aMarker^.Filename,'(',aMarker^.Row,',',aMarker^.StartCol,'-',aMarker^.EndCol,')');
|
|
|
write(' El=',GetObjName(El));
|
|
|
if EL is TPrimitiveExpr then
|
|
|
begin
|
|
|
writeln('CheckResolverReference ',TPrimitiveExpr(El).Value);
|
|
|
end;
|
|
|
+{$ENDIF}
|
|
|
Ref:=nil;
|
|
|
if El.CustomData is TResolvedReference then
|
|
|
Ref:=TResolvedReference(El.CustomData).Declaration
|
|
@@ -1493,6 +1511,7 @@ var
|
|
|
Ref:=TPasPropertyScope(El.CustomData).AncestorProp
|
|
|
else if El.CustomData is TPasSpecializeTypeData then
|
|
|
Ref:=TPasSpecializeTypeData(El.CustomData).SpecializedType;
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
if Ref<>nil then
|
|
|
begin
|
|
|
write(' Decl=',GetObjName(Ref));
|
|
@@ -1502,7 +1521,9 @@ var
|
|
|
else
|
|
|
write(' has no TResolvedReference. El.CustomData=',GetObjName(El.CustomData));
|
|
|
writeln;
|
|
|
+{$ENDIF}
|
|
|
end;
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
for i:=0 to LabelElements.Count-1 do
|
|
|
begin
|
|
|
El:=TPasElement(LabelElements[i]);
|
|
@@ -1510,6 +1531,7 @@ var
|
|
|
write(' El=',GetObjName(El));
|
|
|
writeln;
|
|
|
end;
|
|
|
+{$ENDIF}
|
|
|
|
|
|
RaiseErrorAtSrcMarker('wrong resolved reference "'+aMarker^.Identifier+'"',aMarker);
|
|
|
finally
|
|
@@ -1581,6 +1603,7 @@ var
|
|
|
end;
|
|
|
end;
|
|
|
// failed -> show candidates
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
writeln('CheckDirectReference failed: Labels:');
|
|
|
for j:=0 to LabelElements.Count-1 do
|
|
|
begin
|
|
@@ -1595,6 +1618,7 @@ var
|
|
|
//if EL is TPasVariable then
|
|
|
// writeln('CheckDirectReference ',GetObjPath(TPasVariable(El).VarType),' ',ResolverEngine.GetElementSourcePosStr(TPasVariable(EL).VarType));
|
|
|
end;
|
|
|
+{$ENDIF}
|
|
|
RaiseErrorAtSrcMarker('wrong direct reference "'+aMarker^.Identifier+'"',aMarker);
|
|
|
finally
|
|
|
LabelElements.Free;
|
|
@@ -1658,6 +1682,7 @@ begin
|
|
|
end;
|
|
|
|
|
|
// needed message missing -> show emitted messages
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
WriteSources('',0,0);
|
|
|
for i:=0 to MsgCount-1 do
|
|
|
begin
|
|
@@ -1668,6 +1693,7 @@ begin
|
|
|
write(' '+ExtractFileName(Item.SourcePos.FileName),'(',Item.SourcePos.Row,',',Item.SourcePos.Column,')');
|
|
|
writeln(' {',Item.Msg,'}');
|
|
|
end;
|
|
|
+{$ENDIF}
|
|
|
str(MsgType,Expected);
|
|
|
Actual:='Missing '+Expected+' ('+IntToStr(MsgNumber)+')';
|
|
|
if Marker<>nil then
|
|
@@ -2077,6 +2103,7 @@ var
|
|
|
i, j: Integer;
|
|
|
SrcLines: TStringList;
|
|
|
SrcFilename, Line: string;
|
|
|
+
|
|
|
begin
|
|
|
for i:=0 to Resolver.Streams.Count-1 do
|
|
|
begin
|
|
@@ -2099,12 +2126,16 @@ end;
|
|
|
|
|
|
procedure TCustomTestResolver.RaiseErrorAtSrc(Msg: string; const aFilename: string;
|
|
|
aRow, aCol: integer);
|
|
|
+
|
|
|
var
|
|
|
s: String;
|
|
|
+
|
|
|
begin
|
|
|
- WriteSources(aFilename,aRow,aCol);
|
|
|
s:='[TTestResolver.RaiseErrorAtSrc] '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+') Error: '+Msg;
|
|
|
+ {$IFNDEF NOCONSOLE}
|
|
|
+ WriteSources(aFilename,aRow,aCol);
|
|
|
writeln('ERROR: ',s);
|
|
|
+ {$ENDIF}
|
|
|
Fail(s);
|
|
|
end;
|
|
|
|
|
@@ -2122,6 +2153,7 @@ begin
|
|
|
ErrFilename:=CurEngine.Scanner.CurFilename;
|
|
|
ErrRow:=CurEngine.Scanner.CurRow;
|
|
|
ErrCol:=CurEngine.Scanner.CurColumn;
|
|
|
+ {$IFNDEF NOCONSOLE}
|
|
|
writeln('ERROR: TCustomTestResolver.HandleError during parsing: '+E.ClassName+':'+E.Message
|
|
|
+' File='+ErrFilename
|
|
|
+' LineNo='+IntToStr(ErrRow)
|
|
@@ -2129,6 +2161,7 @@ begin
|
|
|
+' Line="'+CurEngine.Scanner.CurLine+'"'
|
|
|
);
|
|
|
WriteSources(ErrFilename,ErrRow,ErrCol);
|
|
|
+ {$ENDIF}
|
|
|
Fail(E.Message);
|
|
|
end;
|
|
|
|
|
@@ -2220,8 +2253,8 @@ begin
|
|
|
//' LineEnding = #10;',
|
|
|
//' DirectorySeparator = ''/'';',
|
|
|
//' DriveSeparator = '''';',
|
|
|
- //' AllowDirectorySeparators : set of char = [''\'',''/''];',
|
|
|
- //' AllowDriveSeparators : set of char = [];',
|
|
|
+ //' AllowDirectorySeparators : set of AnsiChar = [''\'',''/''];',
|
|
|
+ //' AllowDriveSeparators : set of AnsiChar = [];',
|
|
|
if supTObject in Parts then
|
|
|
begin
|
|
|
Intf.AddStrings([
|
|
@@ -2492,7 +2525,9 @@ var
|
|
|
begin
|
|
|
s:='TTestResolver.OnCheckElementParent El='+GetTreeDbg(El)+' '+
|
|
|
ResolverEngine.GetElementSourcePosStr(El)+' '+Msg;
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
writeln('ERROR: ',s);
|
|
|
+{$ENDIF}
|
|
|
Fail(s);
|
|
|
end;
|
|
|
|
|
@@ -2597,7 +2632,7 @@ begin
|
|
|
end;
|
|
|
|
|
|
procedure TCustomTestResolver.OnScannerDirective(Sender: TObject; Directive,
|
|
|
- Param: String; var Handled: boolean);
|
|
|
+ Param: TPasScannerString; var Handled: boolean);
|
|
|
var
|
|
|
aScanner: TPascalScanner;
|
|
|
begin
|
|
@@ -2736,7 +2771,7 @@ procedure TTestResolver.TestAliasOfVarFail;
|
|
|
begin
|
|
|
StartProgram(false);
|
|
|
Add('var');
|
|
|
- Add(' a: char;');
|
|
|
+ Add(' a: AnsiChar;');
|
|
|
Add('type');
|
|
|
Add(' t=a;');
|
|
|
Add('begin');
|
|
@@ -2912,7 +2947,7 @@ procedure TTestResolver.TestVarOfVarFail;
|
|
|
begin
|
|
|
StartProgram(false);
|
|
|
Add('var');
|
|
|
- Add(' a: char;');
|
|
|
+ Add(' a: AnsiChar;');
|
|
|
Add(' b: a;');
|
|
|
Add('begin');
|
|
|
CheckParserException('Expected type, but got variable',PParser.nParserExpectedTypeButGot);
|
|
@@ -3508,7 +3543,7 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add([
|
|
|
'var',
|
|
|
- ' c: char;',
|
|
|
+ ' c: AnsiChar;',
|
|
|
' i: longint;',
|
|
|
'begin',
|
|
|
' i:=ord(c);',
|
|
@@ -3542,7 +3577,7 @@ begin
|
|
|
Add([
|
|
|
'var',
|
|
|
' s: string;',
|
|
|
- ' c: char;',
|
|
|
+ ' c: AnsiChar;',
|
|
|
'begin',
|
|
|
' if s[1]=s then ;',
|
|
|
' if s=s[2] then ;',
|
|
@@ -3581,7 +3616,7 @@ end;
|
|
|
procedure TTestResolver.TestStringElement_AsVarArgFail;
|
|
|
begin
|
|
|
StartProgram(false);
|
|
|
- Add('procedure DoIt(var c: char);');
|
|
|
+ Add('procedure DoIt(var c: AnsiChar);');
|
|
|
Add('begin');
|
|
|
Add('end;');
|
|
|
Add('var s: string;');
|
|
@@ -3630,7 +3665,7 @@ begin
|
|
|
//' j=length(a);',
|
|
|
//' k=chr(97);',
|
|
|
//' l=ord(a[1]);',
|
|
|
- //' m=low(char)+high(char);',
|
|
|
+ //' m=low(AnsiChar)+high(AnsiChar);',
|
|
|
//' n = string(''A'');',
|
|
|
//' o = UnicodeString(''A'');',
|
|
|
//' p = ^C''bird'';',
|
|
@@ -3675,8 +3710,8 @@ begin
|
|
|
' s2 = [''a'',''b''];',
|
|
|
' s3 = [''a''..''c''];',
|
|
|
' s4 = [''a''..''b'',''d''..''e'',''f''];',
|
|
|
- ' s5 = [low(Char)..high(Char)];',
|
|
|
- ' s6 = [succ(low(Char))..pred(high(Char))];',
|
|
|
+ ' s5 = [low(AnsiChar)..high(AnsiChar)];',
|
|
|
+ ' s6 = [succ(low(AnsiChar))..pred(high(AnsiChar))];',
|
|
|
' s7 = [''a''..''c'']*[''b''..''d''];',
|
|
|
' s8 = [''a''..''e'']-[''b'',''e''];',
|
|
|
' s9 = [''a'',''c''..''d'']+[''b'',''e''];',
|
|
@@ -3688,7 +3723,7 @@ begin
|
|
|
' s15 = ''a'' in [''a'',''b''];',
|
|
|
' s16 = [#0..#127,#22823..#23398];',
|
|
|
' s17 = #22823 in s16;',
|
|
|
- 'var c: char;',
|
|
|
+ 'var c: AnsiChar;',
|
|
|
'begin',
|
|
|
' if c in s3 then ;']);
|
|
|
ParseProgram;
|
|
@@ -3706,7 +3741,7 @@ begin
|
|
|
'const',
|
|
|
' crg: TCharRg = ''b'';',
|
|
|
'var',
|
|
|
- ' c: char;',
|
|
|
+ ' c: AnsiChar;',
|
|
|
' crg2: TCharRg2;',
|
|
|
' s: TSetOfCharRg;',
|
|
|
'begin',
|
|
@@ -3728,11 +3763,11 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add([
|
|
|
'var',
|
|
|
- ' c: char;',
|
|
|
+ ' c: AnsiChar;',
|
|
|
' s: string;',
|
|
|
'begin',
|
|
|
' c:=s;']);
|
|
|
- CheckResolverException('Incompatible types: got "String" expected "Char"',
|
|
|
+ CheckResolverException('Incompatible types: got "String" expected "AnsiChar"',
|
|
|
nIncompatibleTypesGotExpected);
|
|
|
end;
|
|
|
|
|
@@ -3742,15 +3777,15 @@ begin
|
|
|
Add([
|
|
|
'type',
|
|
|
' TCharRg = ''a''..''z'';',
|
|
|
- ' TSetOfChar = set of char;',
|
|
|
+ ' TSetOfChar = set of AnsiChar;',
|
|
|
' TSetOfCharRg = set of TCharRg;',
|
|
|
'const Foo = ''foo'';',
|
|
|
'var',
|
|
|
- ' c: char;',
|
|
|
+ ' c: AnsiChar;',
|
|
|
' cr: TCharRg;',
|
|
|
' s: string;',
|
|
|
- ' a: array of char;',
|
|
|
- ' b: array[1..3] of char;',
|
|
|
+ ' a: array of AnsiChar;',
|
|
|
+ ' b: array[1..3] of AnsiChar;',
|
|
|
' soc: TSetOfChar;',
|
|
|
' socr: TSetOfCharRg;',
|
|
|
'begin',
|
|
@@ -3758,7 +3793,7 @@ begin
|
|
|
' for c in s do;',
|
|
|
' for c in a do;',
|
|
|
' for c in b do;',
|
|
|
- ' for c in char do;',
|
|
|
+ ' for c in AnsiChar do;',
|
|
|
' for c in TCharRg do;',
|
|
|
' for c in TSetOfChar do;',
|
|
|
' for c in TSetOfCharRg do;',
|
|
@@ -3830,7 +3865,7 @@ begin
|
|
|
Add('type');
|
|
|
Add(' {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue, {#Gray}Gray, {#Black}Black, {#White}White);');
|
|
|
Add(' {#TFlags}TFlags = set of TFlag;');
|
|
|
- Add(' {#TChars}TChars = set of Char;');
|
|
|
+ Add(' {#TChars}TChars = set of AnsiChar;');
|
|
|
Add(' {#TMyInt}TMyInt = 0..17;');
|
|
|
Add(' {#TMyInts}TMyInts = set of TMyInt;');
|
|
|
Add(' {#TMyBools}TMyBools = set of boolean;');
|
|
@@ -3868,7 +3903,7 @@ begin
|
|
|
Add('type');
|
|
|
Add(' {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue, {#Gray}Gray, {#Black}Black, {#White}White);');
|
|
|
Add(' {#TFlags}TFlags = set of TFlag;');
|
|
|
- Add(' {#TChars}TChars = set of Char;');
|
|
|
+ Add(' {#TChars}TChars = set of AnsiChar;');
|
|
|
Add(' {#TMyInt}TMyInt = 0..17;');
|
|
|
Add(' {#TMyInts}TMyInts = set of TMyInt;');
|
|
|
Add(' {#TMyBools}TMyBools = set of boolean;');
|
|
@@ -4560,7 +4595,7 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add('var');
|
|
|
Add(' vstring:string;');
|
|
|
- Add(' vchar:char;');
|
|
|
+ Add(' vchar:AnsiChar;');
|
|
|
Add('begin');
|
|
|
Add(' vstring:='''';');
|
|
|
Add(' vstring:=''abc'';');
|
|
@@ -4588,7 +4623,7 @@ begin
|
|
|
Add(' v:longint;');
|
|
|
Add('begin');
|
|
|
Add(' v:=''A'';');
|
|
|
- CheckResolverException('Incompatible types: got "Char" expected "Longint"',
|
|
|
+ CheckResolverException('Incompatible types: got "AnsiChar" expected "Longint"',
|
|
|
nIncompatibleTypesGotExpected);
|
|
|
end;
|
|
|
|
|
@@ -4670,7 +4705,7 @@ begin
|
|
|
Add([
|
|
|
'var',
|
|
|
' i,j:string;',
|
|
|
- ' k:char;',
|
|
|
+ ' k:AnsiChar;',
|
|
|
' w:widechar;',
|
|
|
'begin',
|
|
|
' i:='''';',
|
|
@@ -4684,7 +4719,7 @@ begin
|
|
|
' k:=''a'';',
|
|
|
' k:='''''''';',
|
|
|
' k:=j[1];',
|
|
|
- ' k:=char(#10);',
|
|
|
+ ' k:=AnsiChar(#10);',
|
|
|
' w:=k;',
|
|
|
' w:=#66;',
|
|
|
' w:=#6666;',
|
|
@@ -4701,7 +4736,7 @@ begin
|
|
|
ResolverEngine.BaseTypeString:=btUnicodeString;
|
|
|
StartProgram(false);
|
|
|
Add('var');
|
|
|
- Add(' k:char;');
|
|
|
+ Add(' k:AnsiChar;');
|
|
|
Add(' w:widechar;');
|
|
|
Add('begin');
|
|
|
Add(' w:=k;');
|
|
@@ -4753,7 +4788,7 @@ begin
|
|
|
Add(' TFlags = set of TFlag;');
|
|
|
Add('var');
|
|
|
Add(' i: longint;');
|
|
|
- Add(' c: char;');
|
|
|
+ Add(' c: AnsiChar;');
|
|
|
Add(' s: string;');
|
|
|
Add(' d: double;');
|
|
|
Add(' f: TFlag;');
|
|
@@ -4794,7 +4829,7 @@ begin
|
|
|
' fs: single;',
|
|
|
' d: double;',
|
|
|
' b: boolean;',
|
|
|
- ' c: char;',
|
|
|
+ ' c: AnsiChar;',
|
|
|
' s: string;',
|
|
|
'begin',
|
|
|
' d:=double({#a_read}i);',
|
|
@@ -4809,9 +4844,9 @@ begin
|
|
|
' b:=boolean({#k_read}i);',
|
|
|
' i:=longint({#l_read}b);',
|
|
|
' d:=double({#m_read}i);',
|
|
|
- ' c:=char({#n_read}c);',
|
|
|
- ' c:=char({#o_read}i);',
|
|
|
- ' c:=char(65);',
|
|
|
+ ' c:=AnsiChar({#n_read}c);',
|
|
|
+ ' c:=AnsiChar({#o_read}i);',
|
|
|
+ ' c:=AnsiChar(65);',
|
|
|
' s:=string({#p_read}s);',
|
|
|
' s:=string({#q_read}c);',
|
|
|
'']);
|
|
@@ -4827,13 +4862,13 @@ begin
|
|
|
Add(' TCaption = string;');
|
|
|
Add(' TYesNo = boolean;');
|
|
|
Add(' TFloat = double;');
|
|
|
- Add(' TChar = char;');
|
|
|
+ Add(' TChar = AnsiChar;');
|
|
|
Add('var');
|
|
|
Add(' i: longint;');
|
|
|
Add(' s: string;');
|
|
|
Add(' b: boolean;');
|
|
|
Add(' d: double;');
|
|
|
- Add(' c: char;');
|
|
|
+ Add(' c: AnsiChar;');
|
|
|
Add('begin');
|
|
|
Add(' i:=integer({#a_read}i);');
|
|
|
Add(' i:=integer({#h_read}b);');
|
|
@@ -4863,9 +4898,9 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add('var');
|
|
|
Add(' s: string;');
|
|
|
- Add(' c: char;');
|
|
|
+ Add(' c: AnsiChar;');
|
|
|
Add('begin');
|
|
|
- Add(' c:=char(s);');
|
|
|
+ Add(' c:=AnsiChar(s);');
|
|
|
CheckResolverException(sIllegalTypeConversionTo,nIllegalTypeConversionTo);
|
|
|
end;
|
|
|
|
|
@@ -4957,13 +4992,13 @@ begin
|
|
|
'var',
|
|
|
' bo: boolean;',
|
|
|
' by: byte;',
|
|
|
- ' ch: char;',
|
|
|
+ ' ch: AnsiChar;',
|
|
|
' s: string;',
|
|
|
' i: longint = high(abc);',
|
|
|
'begin',
|
|
|
' for bo:=low(boolean) to high(boolean) do;',
|
|
|
' for by:=low(byte) to high(byte) do;',
|
|
|
- ' for ch:=low(char) to high(char) do;',
|
|
|
+ ' for ch:=low(AnsiChar) to high(AnsiChar) do;',
|
|
|
' for i:=low(s) to high(s) do;',
|
|
|
'']);
|
|
|
ParseProgram;
|
|
@@ -5029,11 +5064,11 @@ procedure TTestResolver.TestStr_CharFail;
|
|
|
begin
|
|
|
StartProgram(false);
|
|
|
Add('var');
|
|
|
- Add(' c: char;');
|
|
|
+ Add(' c: AnsiChar;');
|
|
|
Add(' aString: string;');
|
|
|
Add('begin');
|
|
|
Add(' Str(c,aString);');
|
|
|
- CheckResolverException('Incompatible type for arg no. 1: Got "Char", expected "boolean, integer, enum value"',
|
|
|
+ CheckResolverException('Incompatible type for arg no. 1: Got "AnsiChar", expected "boolean, integer, enum value"',
|
|
|
nIncompatibleTypeArgNo);
|
|
|
end;
|
|
|
|
|
@@ -5335,7 +5370,7 @@ begin
|
|
|
' i: longint;',
|
|
|
' f: TFlag;',
|
|
|
' b: boolean;',
|
|
|
- ' c: char;',
|
|
|
+ ' c: AnsiChar;',
|
|
|
' s: string;',
|
|
|
'begin',
|
|
|
' case i of',
|
|
@@ -5384,7 +5419,7 @@ begin
|
|
|
Add(' case i of');
|
|
|
Add(' ''1'': ;');
|
|
|
Add(' end;');
|
|
|
- CheckResolverException('Incompatible types: got "Char" expected "Longint"',
|
|
|
+ CheckResolverException('Incompatible types: got "AnsiChar" expected "Longint"',
|
|
|
nIncompatibleTypesGotExpected);
|
|
|
end;
|
|
|
|
|
@@ -5625,10 +5660,10 @@ end;
|
|
|
procedure TTestResolver.TestForLoopStartIncompFail;
|
|
|
begin
|
|
|
StartProgram(false);
|
|
|
- Add('var i: char;');
|
|
|
+ Add('var i: AnsiChar;');
|
|
|
Add('begin');
|
|
|
Add(' for i:=1 to 2 do ;');
|
|
|
- CheckResolverException('Incompatible types: got "Longint" expected "Char"',
|
|
|
+ CheckResolverException('Incompatible types: got "Longint" expected "AnsiChar"',
|
|
|
nIncompatibleTypesGotExpected);
|
|
|
end;
|
|
|
|
|
@@ -5638,7 +5673,7 @@ begin
|
|
|
Add('var i: longint;');
|
|
|
Add('begin');
|
|
|
Add(' for i:=1 to ''2'' do ;');
|
|
|
- CheckResolverException('Incompatible types: got "Char" expected "Longint"',
|
|
|
+ CheckResolverException('Incompatible types: got "AnsiChar" expected "Longint"',
|
|
|
nIncompatibleTypesGotExpected);
|
|
|
end;
|
|
|
|
|
@@ -6539,7 +6574,7 @@ begin
|
|
|
Add('procedure {#int64}DoIt(p: int64); external; var i6: int64;');
|
|
|
Add('procedure {#comp}DoIt(p: comp); external; var co: comp;');
|
|
|
Add('procedure {#boolean}DoIt(p: boolean); external; var bo: boolean;');
|
|
|
- Add('procedure {#char}DoIt(p: char); external; var ch: char;');
|
|
|
+ Add('procedure {#AnsiChar}DoIt(p: AnsiChar); external; var ch: AnsiChar;');
|
|
|
Add('procedure {#widechar}DoIt(p: widechar); external; var wc: widechar;');
|
|
|
Add('procedure {#string}DoIt(p: string); external; var st: string;');
|
|
|
Add('procedure {#widestring}DoIt(p: widestring); external; var ws: widestring;');
|
|
@@ -6557,7 +6592,7 @@ begin
|
|
|
Add(' {@int64}DoIt(i6);');
|
|
|
Add(' {@comp}DoIt(co);');
|
|
|
Add(' {@boolean}DoIt(bo);');
|
|
|
- Add(' {@char}DoIt(ch);');
|
|
|
+ Add(' {@AnsiChar}DoIt(ch);');
|
|
|
Add(' {@widechar}DoIt(wc);');
|
|
|
Add(' {@string}DoIt(st);');
|
|
|
Add(' {@widestring}DoIt(ws);');
|
|
@@ -6618,7 +6653,7 @@ begin
|
|
|
Add([
|
|
|
'function {#a}StrToDate(const a: String): double; begin end;',
|
|
|
'function {#b}StrToDate(const a: String; const b: string): double; begin end;',
|
|
|
- 'function {#c}StrToDate(const a: String; const b: string; c: char): double; begin end;',
|
|
|
+ 'function {#c}StrToDate(const a: String; const b: string; c: AnsiChar): double; begin end;',
|
|
|
'var d: double;',
|
|
|
'begin',
|
|
|
' d:={@a}StrToDate('''');',
|
|
@@ -7168,7 +7203,7 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add([
|
|
|
'function DoIt: string;',
|
|
|
- ' function Sub: char;',
|
|
|
+ ' function Sub: AnsiChar;',
|
|
|
' begin',
|
|
|
' {#a1}DoIt:=#65;',
|
|
|
' {#a2}DoIt[1]:=#66;',
|
|
@@ -7792,7 +7827,7 @@ begin
|
|
|
'procedure DoIt(p: Pointer);',
|
|
|
'var',
|
|
|
' s: string absolute p;',
|
|
|
- ' t: array of char absolute s;',
|
|
|
+ ' t: array of AnsiChar absolute s;',
|
|
|
'begin',
|
|
|
'end;',
|
|
|
'begin']);
|
|
@@ -10484,12 +10519,12 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add('type');
|
|
|
Add(' TObject = class');
|
|
|
- Add(' procedure ProcA(c: char); virtual; abstract;');
|
|
|
+ Add(' procedure ProcA(c: AnsiChar); virtual; abstract;');
|
|
|
Add(' end;');
|
|
|
Add(' TClassA = class');
|
|
|
- Add(' procedure ProcA(c: char); override;');
|
|
|
+ Add(' procedure ProcA(c: AnsiChar); override;');
|
|
|
Add(' end;');
|
|
|
- Add('procedure TClassA.ProcA(c: char);');
|
|
|
+ Add('procedure TClassA.ProcA(c: AnsiChar);');
|
|
|
Add('begin');
|
|
|
Add(' inherited ProcA(c);');
|
|
|
Add('end;');
|
|
@@ -13376,17 +13411,23 @@ begin
|
|
|
aMarker:=FirstSrcMarker;
|
|
|
while aMarker<>nil do
|
|
|
begin
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
writeln('TTestResolver.TestPropertyInherited ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
|
|
|
+{$ENDIF}
|
|
|
Elements:=FindElementsAt(aMarker);
|
|
|
try
|
|
|
for i:=0 to Elements.Count-1 do
|
|
|
begin
|
|
|
El:=TPasElement(Elements[i]);
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
writeln('TTestResolver.TestPropertyInherited ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' CustomData=',GetObjName(El.CustomData));
|
|
|
+{$ENDIF}
|
|
|
if not (El.CustomData is TResolvedReference) then continue;
|
|
|
Ref:=TResolvedReference(El.CustomData);
|
|
|
if not (Ref.Declaration is TPasProperty) then continue;
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
writeln('TTestResolver.TestPropertyInherited ',GetObjName(Ref.Declaration),' Ref.Access=',Ref.Access);
|
|
|
+{$ENDIF}
|
|
|
case aMarker^.Identifier of
|
|
|
'A': if Ref.Access<>rraAssign then
|
|
|
RaiseErrorAtSrcMarker('expected property write at "#'+aMarker^.Identifier+', but got "'+dbgs(Ref.Access),aMarker);
|
|
@@ -14624,7 +14665,7 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add('type');
|
|
|
Add(' TArrA = array[1..2] of longint;');
|
|
|
- Add(' TArrB = array[char] of boolean;');
|
|
|
+ Add(' TArrB = array[AnsiChar] of boolean;');
|
|
|
Add(' TArrC = array[byte,''a''..''z''] of longint;');
|
|
|
Add('const');
|
|
|
Add(' ArrA: TArrA = (3,4);');
|
|
@@ -14647,18 +14688,22 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add([
|
|
|
'type',
|
|
|
- ' TArrA = array[1..3] of char;',
|
|
|
+ ' TArrA = array[1..3] of AnsiChar;',
|
|
|
'const',
|
|
|
+ {
|
|
|
' A: TArrA = (''p'',''a'',''p'');', // duplicate allowed, this bracket is not a set
|
|
|
' B: TArrA = ''pas'';',
|
|
|
' Three = length(TArrA);',
|
|
|
- ' C: array[1..Three] of char = ''pas'';',
|
|
|
+ ' C: array[1..Three] of AnsiChar = ''pas'';',
|
|
|
' D = ''pp'';',
|
|
|
- ' E: array[length(D)..Three] of char = D;',
|
|
|
+ ' E: array[length(D)..Three] of AnsiChar = D;',
|
|
|
' F: array[1..2] of widechar = ''äö'';',
|
|
|
- ' G: array[1..2] of char = ''ä'';',
|
|
|
- ' H: array[1..4] of char = ''äö'';',
|
|
|
- ' I: array[1..4] of char = ''ä''+''ö'';',
|
|
|
+ }
|
|
|
+ ' G: array[1..2] of AnsiChar = ''ä'';',
|
|
|
+ {
|
|
|
+ ' H: array[1..4] of AnsiChar = ''äö'';',
|
|
|
+ ' I: array[1..4] of AnsiChar = ''ä''+''ö'';',
|
|
|
+ }
|
|
|
'begin']);
|
|
|
ParseProgram;
|
|
|
end;
|
|
@@ -14669,18 +14714,18 @@ begin
|
|
|
Add([
|
|
|
'{$mode delphi}',
|
|
|
'type',
|
|
|
- ' TArrA = array[1..3] of char;',
|
|
|
+ ' TArrA = array[1..3] of AnsiChar;',
|
|
|
'const',
|
|
|
' A: TArrA = (''p'',''a'',''p'');', // duplicate allowed, this bracket is not a set
|
|
|
' B: TArrA = ''pas'';',
|
|
|
' Three = length(TArrA);',
|
|
|
- ' C: array[1..Three] of char = ''pas'';',
|
|
|
+ ' C: array[1..Three] of AnsiChar = ''pas'';',
|
|
|
' D = ''pp'';',
|
|
|
- ' E: array[length(D)..Three] of char = D;',
|
|
|
+ ' E: array[length(D)..Three] of AnsiChar = D;',
|
|
|
' F: array[1..2] of widechar = ''äö'';',
|
|
|
- ' G: array[1..2] of char = ''ä'';',
|
|
|
- ' H: array[1..4] of char = ''äö'';',
|
|
|
- ' I: array[1..4] of char = ''ä''+''ö'';',
|
|
|
+ ' G: array[1..2] of AnsiChar = ''ä'';',
|
|
|
+ ' H: array[1..4] of AnsiChar = ''äö'';',
|
|
|
+ ' I: array[1..4] of AnsiChar = ''ä''+''ö'';',
|
|
|
'begin']);
|
|
|
ParseProgram;
|
|
|
end;
|
|
@@ -14702,11 +14747,11 @@ begin
|
|
|
Add([
|
|
|
'procedure {#a}Run(const s: string); overload;',
|
|
|
'begin end;',
|
|
|
- 'procedure {#b}Run(const a: array of char); overload;',
|
|
|
+ 'procedure {#b}Run(const a: array of AnsiChar); overload;',
|
|
|
'begin end;',
|
|
|
'var',
|
|
|
' s: string;',
|
|
|
- ' c: char;',
|
|
|
+ ' c: AnsiChar;',
|
|
|
'begin',
|
|
|
' {@a}Run(''foo'');',
|
|
|
' {@a}Run(s);',
|
|
@@ -14772,10 +14817,10 @@ procedure TTestResolver.TestArray_LowHigh;
|
|
|
begin
|
|
|
StartProgram(false);
|
|
|
Add('type');
|
|
|
- Add(' TArrA = array[char] of longint;');
|
|
|
+ Add(' TArrA = array[AnsiChar] of longint;');
|
|
|
Add(' TArrB = array of TArrA;');
|
|
|
Add('var');
|
|
|
- Add(' c: char;');
|
|
|
+ Add(' c: AnsiChar;');
|
|
|
Add(' i: longint;');
|
|
|
Add('begin');
|
|
|
Add(' for c:=low(TArrA) to High(TArrA) do ;');
|
|
@@ -15044,7 +15089,7 @@ begin
|
|
|
' Aliases: TarrStr = (''foo'',''b'');',
|
|
|
' OneInt: TArrInt = (7);',
|
|
|
' OneInt2: array of integer = (7);',
|
|
|
- ' Chars: array of char = ''aoc'';',
|
|
|
+ ' Chars: array of AnsiChar = ''aoc'';',
|
|
|
' Names: array of string = (''a'',''foo'');',
|
|
|
' NameCount = low(Names)+high(Names)+length(Names);',
|
|
|
'procedure DoIt(Ints: TArrInt);',
|
|
@@ -15086,7 +15131,7 @@ begin
|
|
|
' Aliases: TarrStr = {#aliases_array}[''foo'',''b'',''b''];',
|
|
|
' OneInt: TArrInt = {#oneint_array}[7];',
|
|
|
' TwoInt: array of integer = {#twoint1_array}[7]+{#twoint2_array}[8];',
|
|
|
- ' Chars: array of char = ''aoc'';',
|
|
|
+ ' Chars: array of AnsiChar = ''aoc'';',
|
|
|
' Names: array of string = {#names_array}[''a'',''a''];',
|
|
|
' NameCount = low(Names)+high(Names)+length(Names);',
|
|
|
'procedure {#DoArrOfSet}DoIt(const s: TArrOfSet); overload; begin end;',
|
|
@@ -15374,10 +15419,10 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add([
|
|
|
'{$mode delphi}',
|
|
|
- 'Function CharInSet(Ch: Char;Const CSet : array of char) : Boolean;',
|
|
|
+ 'Function CharInSet(Ch: AnsiChar;Const CSet : array of AnsiChar) : Boolean;',
|
|
|
'begin',
|
|
|
'end;',
|
|
|
- 'var Key: Char;',
|
|
|
+ 'var Key: AnsiChar;',
|
|
|
'begin',
|
|
|
' if CharInSet(Key, [^V, ^X, ^C]) then ;',
|
|
|
' CharInSet(Key,''abc'');',
|
|
@@ -15391,9 +15436,9 @@ begin
|
|
|
StartProgram(false);
|
|
|
Add([
|
|
|
'{$mode delphi}',
|
|
|
- 'type TArrChr = array of char;',
|
|
|
+ 'type TArrChr = array of AnsiChar;',
|
|
|
'var',
|
|
|
- ' Key: Char;',
|
|
|
+ ' Key: AnsiChar;',
|
|
|
' s: string;',
|
|
|
' a: TArrChr;',
|
|
|
'begin',
|
|
@@ -18040,7 +18085,9 @@ begin
|
|
|
for i:=0 to Elements.Count-1 do
|
|
|
begin
|
|
|
El:=TPasElement(Elements[i]);
|
|
|
+{$IFNDEF NOCONSOLE}
|
|
|
writeln('TTestResolver.TestClassHelper_WithDo ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
|
|
|
+{$ENDIF}
|
|
|
if not (El.CustomData is TResolvedReference) then continue;
|
|
|
Ref:=TResolvedReference(El.CustomData);
|
|
|
if Ref.WithExprScope<>nil then
|
|
@@ -18804,7 +18851,7 @@ begin
|
|
|
' TStringHelper = type helper for String',
|
|
|
' procedure DoIt;',
|
|
|
' end;',
|
|
|
- ' TCharHelper = type helper for char',
|
|
|
+ ' TCharHelper = type helper for AnsiChar',
|
|
|
' procedure Fly;',
|
|
|
' end;',
|
|
|
'procedure TStringHelper.DoIt;',
|
|
@@ -18833,7 +18880,7 @@ begin
|
|
|
' TStringHelper = type helper for String',
|
|
|
' procedure DoIt;',
|
|
|
' end;',
|
|
|
- ' TCharHelper = type helper for char',
|
|
|
+ ' TCharHelper = type helper for AnsiChar',
|
|
|
' procedure Fly;',
|
|
|
' end;',
|
|
|
'']),
|