paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-07 06:27:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed var arg char=widechar

Browse Source
This commit is contained in:
mattias 2020-11-12 23:39:17 +00:00
parent 3c19035a27
commit 55ebba76b2
2 changed files with 62 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -25829,7 +25829,7 @@ begin
end;
if (Param.ArgType=nil) then
exit(cExact); // untyped argument
if (ParamResolved.BaseType=ExprResolved.BaseType) then
if GetActualBaseType(ParamResolved.BaseType)=GetActualBaseType(ExprResolved.BaseType) then
begin
if msDelphi in CurrentParser.CurrentModeswitches then
begin
@ -27921,6 +27921,8 @@ end;
function TPasResolver.IsSameType(TypeA, TypeB: TPasType;
ResolveAlias: TPRResolveAlias): boolean;
var
btA, btB: TResolverBaseType;
begin
if (TypeA=nil) or (TypeB=nil) then exit(false);
case ResolveAlias of
@ -27939,7 +27941,11 @@ begin
if (TypeA.ClassType=TPasUnresolvedSymbolRef)
and (TypeB.ClassType=TPasUnresolvedSymbolRef) then
begin
Result:=CompareText(TypeA.Name,TypeB.Name)=0;
if CompareText(TypeA.Name,TypeB.Name)=0 then
exit(true);
btA:=TResElDataBaseType(TypeA.CustomData).BaseType;
btB:=TResElDataBaseType(TypeB.CustomData).BaseType;
Result:=GetActualBaseType(btA)=GetActualBaseType(btB);
exit;
end;
Result:=false;

55
compiler/packages/pastojs/tests/tcmodules.pas
View File

@ -294,6 +294,7 @@ type
Procedure TestBaseType_RawByteStringFail;
Procedure TestTypeShortstring_Fail;
Procedure TestCharSet_Custom;
Procedure TestWideChar_VarArg;
Procedure TestForCharDo;
Procedure TestForCharInDo;
@ -7435,6 +7436,7 @@ begin
'const',
' a = #$00F3;',
' c: char = ''1'';',
' wc: widechar = ''ä'';',
'begin',
' c:=#0;',
' c:=#1;',
@ -7462,7 +7464,8 @@ begin
CheckSource('TestCharConst',
LinesToStr([
'this.a="ó";',
'this.c="1";'
'this.c="1";',
'this.wc="ä";'
]),
LinesToStr([
'$mod.c="\x00";',
@ -7921,6 +7924,56 @@ begin
'']));
end;
procedure TTestModule.TestWideChar_VarArg;
begin
StartProgram(false);
Add([
'procedure Fly(var c: char);',
'begin',
'end;',
'procedure Run(var c: widechar);',
'begin',
'end;',
'var',
' c: char;',
' wc: widechar;',
'begin',
' Fly(wc);',
' Run(c);',
'']);
ConvertProgram;
CheckSource('TestWideChar_VarArg',
LinesToStr([ // statements
'this.Fly = function (c) {',
'};',
'this.Run = function (c) {',
'};',
'this.c = "";',
'this.wc = "";',
'']),
LinesToStr([ // this.$main
'$mod.Fly({',
' p: $mod,',
' get: function () {',
' return this.p.wc;',
' },',
' set: function (v) {',
' this.p.wc = v;',
' }',
'});',
'$mod.Run({',
' p: $mod,',
' get: function () {',
' return this.p.c;',
' },',
' set: function (v) {',
' this.p.c = v;',
' }',
'});',
'',
'']));
end;
procedure TTestModule.TestForCharDo;
begin
StartProgram(false);