From 55ebba76b26a13189c0ed2f13d8038ae788901ad Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 12 Nov 2020 23:39:17 +0000 Subject: [PATCH] fcl-passrc: fixed var arg char=widechar --- .../packages/fcl-passrc/src/pasresolver.pp | 10 +++- compiler/packages/pastojs/tests/tcmodules.pas | 55 ++++++++++++++++++- 2 files changed, 62 insertions(+), 3 deletions(-) diff --git a/compiler/packages/fcl-passrc/src/pasresolver.pp b/compiler/packages/fcl-passrc/src/pasresolver.pp index 4fd35e0..b40230b 100644 --- a/compiler/packages/fcl-passrc/src/pasresolver.pp +++ b/compiler/packages/fcl-passrc/src/pasresolver.pp @@ -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; diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas index 9e8940a..ff0494f 100644 --- a/compiler/packages/pastojs/tests/tcmodules.pas +++ b/compiler/packages/pastojs/tests/tcmodules.pas @@ -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);