mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-12 13:49:51 +02:00
pastojs: external class const
git-svn-id: trunk@38077 -
This commit is contained in:
Mattias Gaertner
parent
f812c657db
commit
6ef4c4af92
@ -2275,12 +2275,14 @@ begin
|
||||
RaiseVarModifierNotSupported(ClassFieldModifiersAllowed);
|
||||
if TPasClassType(El.Parent).IsExternal then
|
||||
begin
|
||||
// external class -> make variable external
|
||||
if El.Expr<>nil then
|
||||
RaiseMsg(20180127111830,nIllegalQualifier,sIllegalQualifier,
|
||||
['='],El.Expr);
|
||||
// external class
|
||||
if El.Visibility=visPublished then
|
||||
// Note: an external class has no typeinfo
|
||||
RaiseMsg(20170413221516,nSymbolCannotBePublished,sSymbolCannotBePublished,
|
||||
[],El);
|
||||
if not (vmExternal in El.VarModifiers) then
|
||||
begin
|
||||
// make variable external
|
||||
if (El.ClassType=TPasVariable) or (El.ClassType=TPasConst) then
|
||||
begin
|
||||
if El.ExportName<>nil then
|
||||
@ -2290,10 +2292,9 @@ begin
|
||||
end;
|
||||
Include(El.VarModifiers,vmExternal);
|
||||
end;
|
||||
if El.Visibility=visPublished then
|
||||
// Note: an external class has no typeinfo
|
||||
RaiseMsg(20170413221516,nSymbolCannotBePublished,sSymbolCannotBePublished,
|
||||
[],El);
|
||||
if (El.ClassType=TPasConst) and (TPasConst(El).Expr<>nil) then
|
||||
// external const with expression is not writable
|
||||
TPasConst(El).IsConst:=true;
|
||||
end;
|
||||
end
|
||||
else if ParentC=TPasRecordType then
|
||||
@ -4970,6 +4971,27 @@ begin
|
||||
Result:=CreateArgumentAccess(TPasArgument(Decl),AContext,El);
|
||||
exit;
|
||||
end
|
||||
else if Decl.ClassType=TPasConst then
|
||||
begin
|
||||
if TPasConst(Decl).IsConst and (TPasConst(Decl).Expr<>nil) then
|
||||
begin
|
||||
Value:=AContext.Resolver.Eval(TPasConst(Decl).Expr,[refConst]);
|
||||
if (Value<>nil)
|
||||
and (Value.Kind in [revkNil,revkBool,revkInt,revkUInt,revkFloat,revkEnum]) then
|
||||
try
|
||||
Result:=ConvertConstValue(Value,AContext,El);
|
||||
exit;
|
||||
finally
|
||||
ReleaseEvalValue(Value);
|
||||
end;
|
||||
if vmExternal in TPasConst(Decl).VarModifiers then
|
||||
begin
|
||||
// external constant are always added by value, not by reference
|
||||
Result:=ConvertElement(TPasConst(Decl).Expr,AContext);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else if Decl.ClassType=TPasResString then
|
||||
begin
|
||||
// read resourcestring -> rtl.getResStr($mod,"name")
|
||||
@ -9758,6 +9780,11 @@ end;
|
||||
|
||||
function TPasToJSConverter.ConvertConstValue(Value: TResEvalValue;
|
||||
AContext: TConvertContext; El: TPasElement): TJSElement;
|
||||
var
|
||||
Ranges: TResEvalSet.TItems;
|
||||
Range: TResEvalSet.TItem;
|
||||
Call: TJSCallExpression;
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=nil;
|
||||
if Value=nil then
|
||||
@ -9783,7 +9810,35 @@ begin
|
||||
{$IFDEF VerbosePas2JS}
|
||||
writeln('TPasToJSConverter.ConvertConstValue Value=',Value.AsDebugString,' IdentEl=',GetObjName(Value.IdentEl));
|
||||
{$ENDIF}
|
||||
RaiseNotSupported(El,AContext,20171221125842);
|
||||
// rtl.createSet()
|
||||
Call:=CreateCallExpression(El);
|
||||
try
|
||||
Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Create]]);
|
||||
Ranges:=TResEvalSet(Value).Ranges;
|
||||
for i:=0 to length(Ranges)-1 do
|
||||
begin
|
||||
Range:=Ranges[i];
|
||||
{$IFDEF VerbosePas2JS}
|
||||
writeln('TPasToJSConverter.ConvertConstValue SetLiteral ',i,' ',Range.RangeStart,'..',Range.RangeEnd);
|
||||
{$ENDIF}
|
||||
if Range.RangeStart=Range.RangeEnd then
|
||||
begin
|
||||
// add one integer
|
||||
Call.AddArg(CreateLiteralNumber(El,Range.RangeStart));
|
||||
end
|
||||
else
|
||||
begin
|
||||
// range -> add three parameters: null,left,right
|
||||
Call.AddArg(CreateLiteralNull(El));
|
||||
Call.AddArg(CreateLiteralNumber(El,Range.RangeStart));
|
||||
Call.AddArg(CreateLiteralNumber(El,Range.RangeEnd));
|
||||
end;
|
||||
end;
|
||||
Result:=Call;
|
||||
finally
|
||||
if Result=nil then
|
||||
Call.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
{$IFDEF VerbosePas2JS}
|
||||
|
||||
@ -109,7 +109,7 @@ constructor TPas2jsPasParser.Create(AScanner: TPascalScanner;
|
||||
AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer);
|
||||
begin
|
||||
inherited Create(AScanner,AFileResolver,AEngine);
|
||||
Options:=Options+[po_asmwhole,po_resolvestandardtypes];
|
||||
Options:=Options+[po_AsmWhole,po_ResolveStandardTypes,po_ExtClassConstWithoutExpr];
|
||||
end;
|
||||
|
||||
procedure TPas2jsPasParser.SetLastMsg(MsgType: TMessageType;
|
||||
|
||||
@ -31,7 +31,7 @@ uses
|
||||
|
||||
const
|
||||
// default parser+scanner options
|
||||
po_pas2js = [po_asmwhole,po_resolvestandardtypes];
|
||||
po_pas2js = [po_asmwhole,po_resolvestandardtypes,po_ExtClassConstWithoutExpr];
|
||||
co_tcmodules = [coNoTypeInfo];
|
||||
type
|
||||
|
||||
@ -427,7 +427,7 @@ type
|
||||
|
||||
// external class
|
||||
Procedure TestExternalClass_Var;
|
||||
Procedure TestExternalClass_ConstFail;
|
||||
Procedure TestExternalClass_Const;
|
||||
Procedure TestExternalClass_Dollar;
|
||||
Procedure TestExternalClass_DuplicateVarFail;
|
||||
Procedure TestExternalClass_Method;
|
||||
@ -3144,10 +3144,10 @@ begin
|
||||
CheckSource('TestProc_ConstOrder',
|
||||
LinesToStr([ // statements
|
||||
'this.A = 3;',
|
||||
'this.B = $mod.A + 1;',
|
||||
'var C = $mod.A + 1;',
|
||||
'var D = $mod.B + 1;',
|
||||
'var E = ((D + C) + $mod.B) + $mod.A;',
|
||||
'this.B = 3 + 1;',
|
||||
'var C = 3 + 1;',
|
||||
'var D = 4 + 1;',
|
||||
'var E = ((5 + 4) + 4) + 3;',
|
||||
'this.DoIt = function () {',
|
||||
'};',
|
||||
'']),
|
||||
@ -3933,10 +3933,10 @@ begin
|
||||
'this.Enums = {};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$mod.Enums = rtl.includeSet($mod.Enums, $mod.Orange);',
|
||||
'$mod.Enums = rtl.excludeSet($mod.Enums, $mod.Orange);',
|
||||
'if ($mod.Orange in $mod.Enums) ;',
|
||||
'if ($mod.Orange in rtl.createSet($mod.Orange, $mod.TEnum.Red)) ;',
|
||||
'$mod.Enums = rtl.includeSet($mod.Enums, $mod.TEnum.Red);',
|
||||
'$mod.Enums = rtl.excludeSet($mod.Enums, $mod.TEnum.Red);',
|
||||
'if ($mod.TEnum.Red in $mod.Enums) ;',
|
||||
'if ($mod.TEnum.Red in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Red)) ;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
@ -3977,16 +3977,16 @@ begin
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
|
||||
'$mod.f = rtl.includeSet($mod.f, $mod.favorite);',
|
||||
'$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
|
||||
'$mod.i = $mod.TFlags$a.red;',
|
||||
'$mod.i = $mod.TFlags$a.red;',
|
||||
'$mod.i = $mod.favorite;',
|
||||
'$mod.i = $mod.TFlags$a.red;',
|
||||
'$mod.i = $mod.TFlags$a.red;',
|
||||
'$mod.i = $mod.TFlags$a.red;',
|
||||
'$mod.i = $mod.TFlags$a.green;',
|
||||
'$mod.i = $mod.TFlags$a.green;',
|
||||
'$mod.i = $mod.TFlags$a.green;',
|
||||
'$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.favorite);',
|
||||
'$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.TFlags$a.red);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
@ -4301,10 +4301,10 @@ begin
|
||||
'var cB$1 = 4;',
|
||||
'this.DoIt = function () {',
|
||||
' function Sub() {',
|
||||
' cB$1 = cB$1 + csA;',
|
||||
' cA = (cA + csA) + 5;',
|
||||
' cB$1 = cB$1 + 3;',
|
||||
' cA = (cA + 3) + 5;',
|
||||
' };',
|
||||
' cA = (cA + cB) + 6;',
|
||||
' cA = (cA + 2) + 6;',
|
||||
'};'
|
||||
]),
|
||||
LinesToStr([
|
||||
@ -10480,18 +10480,47 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_ConstFail;
|
||||
procedure TTestModule.TestExternalClass_Const;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch externalclass}',
|
||||
'type',
|
||||
' TExtA = class external name ''ExtObj''',
|
||||
' const Id: longint = 3;',
|
||||
' const Two: longint = 2;',
|
||||
' const Three = 3;',
|
||||
' const Id: longint;',
|
||||
' end;',
|
||||
'begin']);
|
||||
SetExpectedPasResolverError('illegal qualifier "="',nIllegalQualifier);
|
||||
' TExtB = class external name ''ExtB''',
|
||||
' A: TExtA;',
|
||||
' end;',
|
||||
'var',
|
||||
' A: texta;',
|
||||
' B: textb;',
|
||||
' i: longint;',
|
||||
'begin',
|
||||
' i:=a.two;',
|
||||
' i:=texta.two;',
|
||||
' i:=a.three;',
|
||||
' i:=texta.three;',
|
||||
' i:=a.id;',
|
||||
' i:=texta.id;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_Dollar',
|
||||
LinesToStr([ // statements
|
||||
'this.A = null;',
|
||||
'this.B = null;',
|
||||
'this.i = 0;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.i = 2;',
|
||||
'$mod.i = 2;',
|
||||
'$mod.i = 3;',
|
||||
'$mod.i = 3;',
|
||||
'$mod.i = $mod.A.Id;',
|
||||
'$mod.i = ExtObj.Id;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_Dollar;
|
||||
@ -11111,7 +11140,7 @@ begin
|
||||
Add(' constructor New;');
|
||||
Add(' end;');
|
||||
Add('function DoIt: longint;');
|
||||
Add('const ExtA = 3;');
|
||||
Add('const ExtA: longint = 3;');
|
||||
Add('begin');
|
||||
Add(' Result:=ExtA;');
|
||||
Add('end;');
|
||||
|
||||
@ -264,7 +264,7 @@ begin
|
||||
'var d = 6;',
|
||||
'this.DoIt = function () {',
|
||||
' var Result = 0;',
|
||||
' Result = b + d;',
|
||||
' Result = 4 + d;',
|
||||
' return Result;',
|
||||
'};',
|
||||
'']),
|
||||
@ -819,7 +819,7 @@ begin
|
||||
' });',
|
||||
' this.T = null;',
|
||||
' $mod.$main = function () {',
|
||||
' $mod.T = $mod.TObject.$create("Create",[$mod.gcBlack]);',
|
||||
' $mod.T = $mod.TObject.$create("Create",[0]);',
|
||||
' };',
|
||||
'});',
|
||||
'']);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user