mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 17:19:19 +02:00
pastojs: array of const
git-svn-id: trunk@41327 -
This commit is contained in:
Mattias Gaertner
parent
28e509f8f9
commit
d4512cc714
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -7029,6 +7029,7 @@ packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
|
||||
packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
|
||||
packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
|
||||
packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
|
||||
packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
|
||||
packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
|
||||
packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
|
||||
packages/pastojs/tests/tcfiler.pas svneol=native#text/plain
|
||||
|
||||
@ -55,6 +55,7 @@ begin
|
||||
T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
|
||||
T:=P.Targets.AddUnit('pas2jslogger.pp');
|
||||
T:=P.Targets.AddUnit('pas2jspparser.pp');
|
||||
T:=P.Targets.AddUnit('pas2jsuseanalyzer.pp');
|
||||
T:=P.Targets.AddUnit('pas2jscompiler.pp');
|
||||
T:=P.Targets.AddUnit('pas2jsfscompiler.pp');
|
||||
T.Dependencies.AddUnit('pas2jscompiler');
|
||||
|
||||
@ -87,6 +87,7 @@ Works:
|
||||
- skip clone record of new record
|
||||
- use rtl.recNewT to create a record type
|
||||
- use TRec.$new to instantiate records, using Object.create to instantiate
|
||||
- record field external name
|
||||
- advanced records:
|
||||
- public, private, strict private
|
||||
- class var
|
||||
@ -396,6 +397,7 @@ Works:
|
||||
- pass property getter field, property getter function,
|
||||
- pass class property, static class property
|
||||
- pass array property
|
||||
- array of const, TVarRec
|
||||
|
||||
ToDos:
|
||||
- cmd line param to set modeswitch
|
||||
@ -418,7 +420,6 @@ ToDos:
|
||||
- range check:
|
||||
arr[i]:=value check if value is in range
|
||||
astring[i]:=value check if value is in range
|
||||
- record field external name
|
||||
- 1 as TEnum, ERangeError
|
||||
- ifthen<T>
|
||||
- stdcall of methods: pass original 'this' as first parameter
|
||||
@ -1067,6 +1068,7 @@ type
|
||||
|
||||
TPas2JSModuleScope = class(TPasModuleScope)
|
||||
public
|
||||
SystemVarRecs: TPasFunction;
|
||||
end;
|
||||
|
||||
{ TPas2JSSectionScope }
|
||||
@ -1304,6 +1306,12 @@ type
|
||||
procedure FinishArgument(El: TPasArgument); override;
|
||||
procedure FinishProcedureType(El: TPasProcedureType); override;
|
||||
procedure FinishProperty(PropEl: TPasProperty); override;
|
||||
procedure FinishProcParamAccess(ProcType: TPasProcedureType;
|
||||
Params: TParamsExpr); override;
|
||||
procedure FinishPropertyParamAccess(Params: TParamsExpr; Prop: TPasProperty
|
||||
); override;
|
||||
procedure FindCreatorArrayOfConst(Args: TFPList; ErrorEl: TPasElement);
|
||||
function FindProc_ArrLitToArrayOfConst(ErrorEl: TPasElement): TPasFunction; virtual;
|
||||
procedure CheckExternalClassConstructor(Ref: TResolvedReference); virtual;
|
||||
procedure CheckConditionExpr(El: TPasExpr;
|
||||
const ResolvedEl: TPasResolverResult); override;
|
||||
@ -1974,6 +1982,31 @@ type
|
||||
otUIntDouble // 7 NativeUInt
|
||||
);
|
||||
Function GetOrdType(MinValue, MaxValue: TMaxPrecInt; ErrorEl: TPasElement): TOrdType; virtual;
|
||||
Public
|
||||
// array of const, TVarRec
|
||||
const
|
||||
pas2js_vtInteger = 0;
|
||||
pas2js_vtBoolean = 1;
|
||||
//vtChar = 2; // Delphi/FPC: ansichar
|
||||
pas2js_vtExtended = 3; // Note: double in pas2js, PExtended in Delphi/FPC
|
||||
//vtString = 4; // Delphi/FPC: PShortString
|
||||
pas2js_vtPointer = 5;
|
||||
//vtPChar = 6;
|
||||
pas2js_vtObject = 7;
|
||||
pas2js_vtClass = 8;
|
||||
pas2js_vtWideChar = 9;
|
||||
//vtPWideChar = 10;
|
||||
//vtAnsiString = 11;
|
||||
pas2js_vtCurrency = 12; // Note: currency in pas2js, PCurrency in Delphi/FPC
|
||||
//vtVariant = 13;
|
||||
pas2js_vtInterface = 14;
|
||||
//vtWideString = 15;
|
||||
//vtInt64 = 16;
|
||||
//vtQWord = 17;
|
||||
pas2js_vtUnicodeString = 18;
|
||||
// only pas2js, not in Delphi/FPC:
|
||||
pas2js_vtNativeInt = 19;
|
||||
pas2js_vtJSValue = 20;
|
||||
Public
|
||||
Constructor Create;
|
||||
Destructor Destroy; override;
|
||||
@ -3952,6 +3985,87 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
|
||||
Params: TParamsExpr);
|
||||
begin
|
||||
inherited FinishProcParamAccess(ProcType, Params);
|
||||
FindCreatorArrayOfConst(ProcType.Args,Params);
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.FinishPropertyParamAccess(Params: TParamsExpr;
|
||||
Prop: TPasProperty);
|
||||
var
|
||||
Args: TFPList;
|
||||
begin
|
||||
inherited FinishPropertyParamAccess(Params, Prop);
|
||||
Args:=GetPasPropertyArgs(Prop);
|
||||
if Args=nil then
|
||||
RaiseNotYetImplemented(20190215210914,Params,GetObjName(Prop));
|
||||
FindCreatorArrayOfConst(Args,Params);
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.FindCreatorArrayOfConst(Args: TFPList;
|
||||
ErrorEl: TPasElement);
|
||||
var
|
||||
i: Integer;
|
||||
Arg: TPasArgument;
|
||||
begin
|
||||
for i:=0 to Args.Count-1 do
|
||||
begin
|
||||
Arg:=TPasArgument(Args[i]);
|
||||
if not IsArrayOfConst(Arg.ArgType) then continue;
|
||||
FindProc_ArrLitToArrayOfConst(ErrorEl);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPas2JSResolver.FindProc_ArrLitToArrayOfConst(ErrorEl: TPasElement
|
||||
): TPasFunction;
|
||||
var
|
||||
aMod, UtilsMod: TPasModule;
|
||||
ModScope: TPas2JSModuleScope;
|
||||
SectionScope: TPasSectionScope;
|
||||
Identifier: TPasIdentifier;
|
||||
El: TPasElement;
|
||||
FuncType: TPasFunctionType;
|
||||
begin
|
||||
aMod:=RootElement;
|
||||
ModScope:=aMod.CustomData as TPas2JSModuleScope;
|
||||
Result:=ModScope.SystemVarRecs;
|
||||
if Result<>nil then exit;
|
||||
|
||||
// find unit in uses clauses
|
||||
UtilsMod:=FindUsedUnit('system',aMod);
|
||||
if UtilsMod=nil then
|
||||
RaiseIdentifierNotFound(20190215211531,'System.VarRecs',ErrorEl);
|
||||
|
||||
// find class in interface
|
||||
if UtilsMod.InterfaceSection=nil then
|
||||
RaiseIdentifierNotFound(20190215211538,'System.VarRecs',ErrorEl);
|
||||
|
||||
// find function VarRecs
|
||||
SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
|
||||
Identifier:=SectionScope.FindLocalIdentifier('VarRecs');
|
||||
if Identifier=nil then
|
||||
RaiseIdentifierNotFound(20190215211551,'System.VarRecs',ErrorEl);
|
||||
El:=Identifier.Element;
|
||||
if El.ClassType<>TPasFunction then
|
||||
RaiseXExpectedButYFound(20190215211559,'function System.VarRecs',GetElementTypeName(El),ErrorEl);
|
||||
Result:=TPasFunction(El);
|
||||
ModScope.SystemVarRecs:=Result;
|
||||
|
||||
// check signature
|
||||
FuncType:=Result.ProcType as TPasFunctionType;
|
||||
if FuncType.Args.Count>0 then
|
||||
RaiseXExpectedButYFound(20190215211953,'function System.VarRecs with 0 args',
|
||||
IntToStr(FuncType.Args.Count),ErrorEl);
|
||||
if FuncType.Modifiers<>[ptmVarargs] then
|
||||
RaiseXExpectedButYFound(20190215212151,'function System.VarRecs; varargs',
|
||||
'?',ErrorEl);
|
||||
if FuncType.CallingConvention<>ccDefault then
|
||||
RaiseXExpectedButYFound(20190215211824,'function System.VarRecs with default calling convention',
|
||||
cCallingConventions[FuncType.CallingConvention],ErrorEl);
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.CheckExternalClassConstructor(Ref: TResolvedReference
|
||||
);
|
||||
var
|
||||
@ -4253,7 +4367,7 @@ begin
|
||||
exit;
|
||||
if (RHS.BaseType<>btContext) or (RTypeEl.ClassType<>TPasArrayType) then
|
||||
exit;
|
||||
ComputeElement(LArray.ElType,ElTypeResolved,[rcType]);
|
||||
ComputeElement(GetArrayElType(LArray),ElTypeResolved,[rcType]);
|
||||
if IsJSBaseType(ElTypeResolved,pbtJSValue) then
|
||||
begin
|
||||
// array of jsvalue := array
|
||||
@ -8555,7 +8669,7 @@ var
|
||||
break;
|
||||
// continue in sub array
|
||||
ArrayEl:=AContext.Resolver.ResolveAliasType(ArrayEl.ElType) as TPasArrayType;
|
||||
until false;
|
||||
until ArrayEl=nil;
|
||||
|
||||
IsRangeCheck:=NeedRangeCheck
|
||||
and (bsRangeChecks in AContext.ScannerBoolSwitches)
|
||||
@ -10107,12 +10221,14 @@ var
|
||||
AssignContext: TAssignContext;
|
||||
ElType, TypeEl: TPasType;
|
||||
i: Integer;
|
||||
aResolver: TPas2JSResolver;
|
||||
begin
|
||||
Result:=nil;
|
||||
Param0:=El.Params[0];
|
||||
if AContext.Access<>caRead then
|
||||
RaiseInconsistency(20170213213621,El);
|
||||
AContext.Resolver.ComputeElement(Param0,ResolvedParam0,[rcNoImplicitProc]);
|
||||
aResolver:=AContext.Resolver;
|
||||
aResolver.ComputeElement(Param0,ResolvedParam0,[rcNoImplicitProc]);
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasToJSConverter.ConvertBuiltInSetLength ',GetResolverResultDbg(ResolvedParam0));
|
||||
{$ENDIF}
|
||||
@ -10128,7 +10244,7 @@ begin
|
||||
// -> AnArray = rtl.setArrayLength(AnArray,defaultvalue,dim1,dim2,...)
|
||||
AssignContext:=TAssignContext.Create(El,nil,AContext);
|
||||
try
|
||||
AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
|
||||
aResolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
|
||||
AssignContext.RightResolved:=ResolvedParam0;
|
||||
|
||||
// create right side
|
||||
@ -10141,10 +10257,10 @@ begin
|
||||
// 2nd param: default value
|
||||
for i:=3 to length(El.Params) do
|
||||
begin
|
||||
ElType:=AContext.Resolver.ResolveAliasType(ArrayType.ElType);
|
||||
ElType:=aResolver.ResolveAliasType(aResolver.GetArrayElType(ArrayType));
|
||||
ArrayType:=ElType as TPasArrayType;
|
||||
end;
|
||||
ElType:=AContext.Resolver.ResolveAliasType(ArrayType.ElType);
|
||||
ElType:=aResolver.ResolveAliasType(aResolver.GetArrayElType(ArrayType));
|
||||
if ElType.ClassType=TPasRecordType then
|
||||
ValInit:=CreateReferencePathExpr(ElType,AContext)
|
||||
else
|
||||
@ -10169,7 +10285,7 @@ begin
|
||||
{$ENDIF}
|
||||
AssignContext:=TAssignContext.Create(El,nil,AContext);
|
||||
try
|
||||
AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
|
||||
aResolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
|
||||
AssignContext.RightResolved:=AssignContext.LeftResolved;
|
||||
|
||||
// create right side rtl.strSetLength(aString,NewLen)
|
||||
@ -11395,17 +11511,19 @@ var
|
||||
TypeParam: TJSElement;
|
||||
Call: TJSCallExpression;
|
||||
ArrayType: TPasArrayType;
|
||||
aResolver: TPas2JSResolver;
|
||||
begin
|
||||
Result:=nil;
|
||||
aResolver:=AContext.Resolver;
|
||||
Call:=nil;
|
||||
try
|
||||
Param:=El.Params[0];
|
||||
AContext.Resolver.ComputeElement(El,ParamResolved,[]);
|
||||
aResolver.ComputeElement(El,ParamResolved,[]);
|
||||
if (ParamResolved.BaseType=btContext)
|
||||
and (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
|
||||
begin
|
||||
ArrayType:=TPasArrayType(ParamResolved.LoTypeEl);
|
||||
AContext.Resolver.ComputeElement(ArrayType.ElType,ElTypeResolved,[rcType]);
|
||||
aResolver.ComputeElement(aResolver.GetArrayElType(ArrayType),ElTypeResolved,[rcType]);
|
||||
end
|
||||
else if ParamResolved.BaseType=btArrayLit then
|
||||
begin
|
||||
@ -14906,16 +15024,23 @@ function TPasToJSConverter.CreateArrayConcat(ArrayType: TPasArrayType;
|
||||
PosEl: TPasElement; AContext: TConvertContext): TJSCallExpression;
|
||||
var
|
||||
ElTypeResolved: TPasResolverResult;
|
||||
aResolver: TPas2JSResolver;
|
||||
begin
|
||||
if length(ArrayType.Ranges)>1 then
|
||||
RaiseNotSupported(PosEl,AContext,20170331001021);
|
||||
AContext.Resolver.ComputeElement(ArrayType.ElType,ElTypeResolved,[rcType]);
|
||||
aResolver:=AContext.Resolver;
|
||||
aResolver.ComputeElement(aResolver.GetArrayElType(ArrayType),ElTypeResolved,[rcType]);
|
||||
Result:=CreateArrayConcat(ElTypeResolved,PosEl,AContext);
|
||||
end;
|
||||
|
||||
function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
|
||||
Expr: TPasExpr; El: TPasElement; AContext: TConvertContext): TJSElement;
|
||||
|
||||
function IsAdd(AnExpr: TPasExpr): Boolean;
|
||||
begin
|
||||
Result:=(AnExpr.ClassType=TBinaryExpr) and (AnExpr.OpCode=eopAdd);
|
||||
end;
|
||||
|
||||
function ConvertArrayExpr(CurArrType: TPasArrayType; RgIndex: integer;
|
||||
CurExpr: TPasExpr): TJSElement;
|
||||
var
|
||||
@ -14947,11 +15072,6 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
|
||||
end;
|
||||
end;
|
||||
|
||||
function IsAdd(AnExpr: TPasExpr): Boolean;
|
||||
begin
|
||||
Result:=(AnExpr.ClassType=TBinaryExpr) and (AnExpr.OpCode=eopAdd);
|
||||
end;
|
||||
|
||||
procedure TraverseAdd(Bin: TBinaryExpr; ConcatCall: TJSCallExpression);
|
||||
// A+B -> A,B
|
||||
// (A+B)+C -> A,B,C
|
||||
@ -14969,6 +15089,7 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
|
||||
var
|
||||
ElTypeResolved: TPasResolverResult;
|
||||
Call: TJSCallExpression;
|
||||
aResolver: TPas2JSResolver;
|
||||
begin
|
||||
Result:=nil;
|
||||
IsLastRange:=false;
|
||||
@ -14976,7 +15097,8 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
|
||||
NextRgIndex:=RgIndex+1;
|
||||
if RgIndex>=length(CurArrType.Ranges)-1 then
|
||||
begin
|
||||
AContext.Resolver.ComputeElement(CurArrType.ElType,ElTypeResolved,[rcType]);
|
||||
aResolver:=AContext.Resolver;
|
||||
aResolver.ComputeElement(aResolver.GetArrayElType(CurArrType),ElTypeResolved,[rcType]);
|
||||
if (ElTypeResolved.BaseType=btContext)
|
||||
and (ElTypeResolved.LoTypeEl.ClassType=TPasArrayType) then
|
||||
begin
|
||||
@ -15015,6 +15137,112 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
|
||||
Result:=ConvertExpression(CurExpr,AContext);
|
||||
end;
|
||||
|
||||
function ConvertExprToVarRec(CurExpr: TPasExpr): TJSElement;
|
||||
// convert [true,Int] to system.varrecs(1,true,0,Int)
|
||||
var
|
||||
aResolver: TPas2JSResolver;
|
||||
Param: TPasExpr;
|
||||
ParamResolved: TPasResolverResult;
|
||||
|
||||
procedure RaiseWrongTypeInArrayConstructor(id: TMaxPrecInt);
|
||||
begin
|
||||
aResolver.RaiseMsg(id,nWrongTypeXInArrayConstructor,sWrongTypeXInArrayConstructor,
|
||||
[aResolver.GetResolverResultDescription(ParamResolved)],Param);
|
||||
end;
|
||||
|
||||
var
|
||||
Params: TParamsExpr;
|
||||
ModScope: TPas2JSModuleScope;
|
||||
Call: TJSCallExpression;
|
||||
i, VType: Integer;
|
||||
LoTypeEl: TPasType;
|
||||
ParamsArr: TPasExprArray;
|
||||
begin
|
||||
Result:=nil;
|
||||
aResolver:=AContext.Resolver;
|
||||
if IsAdd(CurExpr) then
|
||||
aResolver.RaiseMsg(20190215222435,nXExpectedButYFound,sXExpectedButYFound,
|
||||
['array of const',GetElementTypeName(CurExpr)],CurExpr);
|
||||
if (not (CurExpr is TParamsExpr)) or (TParamsExpr(CurExpr).Kind<>pekSet) then
|
||||
begin
|
||||
// e.g. Format(args)
|
||||
Result:=ConvertExpression(CurExpr,AContext);
|
||||
exit;
|
||||
end;
|
||||
Params:=TParamsExpr(CurExpr);
|
||||
ParamsArr:=Params.Params;
|
||||
if length(ParamsArr)=0 then
|
||||
begin
|
||||
// e.g. Format([])
|
||||
Result:=CreateElement(TJSArrayLiteral,Params);
|
||||
exit;
|
||||
end;
|
||||
|
||||
ModScope:=NoNil(aResolver.RootElement.CustomData) as TPas2JSModuleScope;
|
||||
if ModScope.SystemVarRecs=nil then
|
||||
RaiseNotSupported(Params,AContext,20190215215148);
|
||||
Call:=CreateCallExpression(Params);
|
||||
try
|
||||
Call.Expr:=CreateReferencePathExpr(ModScope.SystemVarRecs,AContext);
|
||||
for i:=0 to length(ParamsArr)-1 do
|
||||
begin
|
||||
Param:=ParamsArr[i];
|
||||
aResolver.ComputeElement(Param,ParamResolved,[]);
|
||||
if not (rrfReadable in ParamResolved.Flags) then
|
||||
begin
|
||||
if (ParamResolved.BaseType=btContext)
|
||||
and (ParamResolved.IdentEl is TPasClassType)
|
||||
and (TPasClassType(ParamResolved.IdentEl).ObjKind=okClass) then
|
||||
VType:=pas2js_vtClass
|
||||
else
|
||||
RaiseWrongTypeInArrayConstructor(20190215221549);
|
||||
end
|
||||
else if ParamResolved.BaseType in [btByte,btShortInt,btWord,btSmallInt,btLongint] then
|
||||
VType:=pas2js_vtInteger
|
||||
else if ParamResolved.BaseType in [btLongWord,btUIntDouble,btIntDouble] then
|
||||
VType:=pas2js_vtNativeInt
|
||||
else if ParamResolved.BaseType in btAllJSBooleans then
|
||||
VType:=pas2js_vtBoolean
|
||||
else if ParamResolved.BaseType in btAllJSFloats then
|
||||
VType:=pas2js_vtExtended
|
||||
else if ParamResolved.BaseType in btAllJSChars then
|
||||
VType:=pas2js_vtWideChar
|
||||
else if ParamResolved.BaseType in btAllJSStrings then
|
||||
VType:=pas2js_vtUnicodeString
|
||||
else if ParamResolved.BaseType in [btNil,btPointer] then
|
||||
VType:=pas2js_vtPointer
|
||||
else if ParamResolved.BaseType=btCurrency then
|
||||
VType:=pas2js_vtCurrency
|
||||
else if ParamResolved.BaseType=btContext then
|
||||
begin
|
||||
LoTypeEl:=ParamResolved.LoTypeEl;
|
||||
if LoTypeEl.ClassType=TPasClassType then
|
||||
case TPasClassType(LoTypeEl).ObjKind of
|
||||
okClass: VType:=pas2js_vtObject;
|
||||
okInterface: VType:=pas2js_vtInterface;
|
||||
else
|
||||
RaiseWrongTypeInArrayConstructor(20190215221106);
|
||||
end
|
||||
else if LoTypeEl.ClassType=TPasClassOfType then
|
||||
VType:=pas2js_vtClass
|
||||
else
|
||||
RaiseWrongTypeInArrayConstructor(20190215221122);
|
||||
end
|
||||
else if (ParamResolved.BaseType=btCustom)
|
||||
and aResolver.IsJSBaseType(ParamResolved,pbtJSValue) then
|
||||
VType:=pas2js_vtJSValue
|
||||
else
|
||||
RaiseWrongTypeInArrayConstructor(20190215221457);
|
||||
Call.AddArg(CreateLiteralNumber(Param,VType));
|
||||
Call.AddArg(ConvertExpression(Param,AContext));
|
||||
end;
|
||||
Result:=Call;
|
||||
finally
|
||||
if Result=nil then
|
||||
Call.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
Call: TJSCallExpression;
|
||||
ArrLit: TJSArrayLiteral;
|
||||
@ -15027,7 +15255,6 @@ var
|
||||
US: TJSString;
|
||||
DimLits: TObjectList;
|
||||
aResolver: TPas2JSResolver;
|
||||
CompFlags: TPasResolverComputeFlags;
|
||||
begin
|
||||
{$IFDEF VerbosePas2JS}
|
||||
writeln('TPasToJSConverter.CreateArrayInit ',GetObjName(ArrayType),' ',ArrayType.ParentPath,' Expr=',GetObjName(Expr));
|
||||
@ -15035,18 +15262,19 @@ begin
|
||||
aResolver:=AContext.Resolver;
|
||||
if Assigned(Expr) then
|
||||
begin
|
||||
// init array with constant(s)
|
||||
// init array with expression
|
||||
if aResolver=nil then
|
||||
DoError(20161024192739,nInitializedArraysNotSupported,sInitializedArraysNotSupported,[],ArrayType);
|
||||
if aResolver.ExprEvaluator.IsConst(Expr) then
|
||||
CompFlags:=[rcConstant]
|
||||
else
|
||||
CompFlags:=[];
|
||||
aResolver.ComputeElement(Expr,ExprResolved,CompFlags);
|
||||
aResolver.ComputeElement(Expr,ExprResolved,[]);
|
||||
if (ExprResolved.BaseType in [btArrayOrSet,btArrayLit])
|
||||
or ((ExprResolved.BaseType=btContext)
|
||||
and (ExprResolved.LoTypeEl.ClassType=TPasArrayType)) then
|
||||
Result:=ConvertArrayExpr(ArrayType,0,Expr)
|
||||
begin
|
||||
if ArrayType.ElType=nil then
|
||||
Result:=ConvertExprToVarRec(Expr)
|
||||
else
|
||||
Result:=ConvertArrayExpr(ArrayType,0,Expr);
|
||||
end
|
||||
else if ExprResolved.BaseType in btAllStringAndChars then
|
||||
begin
|
||||
US:=StrToJSString(aResolver.ComputeConstString(Expr,false,true));
|
||||
@ -15094,7 +15322,7 @@ begin
|
||||
Lit:=CreateLiteralNumber(El,DimSize);
|
||||
DimLits.Add(Lit);
|
||||
end;
|
||||
aResolver.ComputeElement(CurArrayType.ElType,ElTypeResolved,[rcType]);
|
||||
aResolver.ComputeElement(aResolver.GetArrayElType(CurArrayType),ElTypeResolved,[rcType]);
|
||||
if (ElTypeResolved.LoTypeEl is TPasArrayType) then
|
||||
begin
|
||||
CurArrayType:=TPasArrayType(ElTypeResolved.LoTypeEl);
|
||||
@ -16034,7 +16262,9 @@ var
|
||||
ArgName: String;
|
||||
Flags: Integer;
|
||||
ArrType: TPasArrayType;
|
||||
aResolver: TPas2JSResolver;
|
||||
begin
|
||||
aResolver:=AContext.Resolver;
|
||||
// for each param add "["argname",argtype,flags]" Note: flags only if >0
|
||||
Param:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,Arg));
|
||||
TargetParams.Elements.AddElement.Expr:=Param;
|
||||
@ -16051,7 +16281,8 @@ begin
|
||||
// open array param
|
||||
inc(Flags,pfArray);
|
||||
ArrType:=TPasArrayType(Arg.ArgType);
|
||||
Param.Elements.AddElement.Expr:=CreateTypeInfoRef(ArrType.ElType,AContext,Arg);
|
||||
Param.Elements.AddElement.Expr:=
|
||||
CreateTypeInfoRef(aResolver.GetArrayElType(ArrType),AContext,Arg);
|
||||
end
|
||||
else
|
||||
Param.Elements.AddElement.Expr:=CreateTypeInfoRef(Arg.ArgType,AContext,Arg);
|
||||
|
||||
@ -38,8 +38,8 @@ uses
|
||||
// !! No filesystem units here.
|
||||
Classes, SysUtils, contnrs,
|
||||
jsbase, jstree, jswriter, JSSrcMap,
|
||||
PScanner, PParser, PasTree, PasResolver, PasUseAnalyzer, PasResolveEval,
|
||||
FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser;
|
||||
PScanner, PParser, PasTree, PasResolver, PasResolveEval, PasUseAnalyzer,
|
||||
FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer;
|
||||
|
||||
const
|
||||
VersionMajor = 1;
|
||||
@ -346,7 +346,7 @@ type
|
||||
FScanner: TPas2jsPasScanner;
|
||||
FShowDebug: boolean;
|
||||
FUnitFilename: string;
|
||||
FUseAnalyzer: TPasAnalyzer;
|
||||
FUseAnalyzer: TPas2JSAnalyzer;
|
||||
FUsedBy: array[TUsedBySection] of TFPList; // list of TPas2jsCompilerFile
|
||||
function GetUsedBy(Section: TUsedBySection; Index: integer): TPas2jsCompilerFile;
|
||||
function GetUsedByCount(Section: TUsedBySection): integer;
|
||||
@ -413,7 +413,7 @@ type
|
||||
property Scanner: TPas2jsPasScanner read FScanner;
|
||||
property ShowDebug: boolean read FShowDebug write FShowDebug;
|
||||
property UnitFilename: string read FUnitFilename;
|
||||
property UseAnalyzer: TPasAnalyzer read FUseAnalyzer; // unit analysis
|
||||
property UseAnalyzer: TPas2JSAnalyzer read FUseAnalyzer; // unit analysis
|
||||
property UsedByCount[Section: TUsedBySection]: integer read GetUsedByCount;
|
||||
property UsedBy[Section: TUsedBySection; Index: integer]: TPas2jsCompilerFile read GetUsedBy;
|
||||
end;
|
||||
@ -454,11 +454,6 @@ type
|
||||
property Compiler: TPas2jsCompiler Read FCompiler;
|
||||
end;
|
||||
|
||||
{ TPas2JSWPOptimizer }
|
||||
|
||||
TPas2JSWPOptimizer = class(TPasAnalyzer)
|
||||
end;
|
||||
|
||||
{ TPas2jsCompiler }
|
||||
|
||||
TPas2jsCompiler = class
|
||||
@ -484,7 +479,7 @@ type
|
||||
FParamMacros: TPas2jsMacroEngine;
|
||||
FSrcMapSourceRoot: string;
|
||||
FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
|
||||
FWPOAnalyzer: TPas2JSWPOptimizer;
|
||||
FWPOAnalyzer: TPas2JSAnalyzer;
|
||||
FInterfaceType: TPasClassInterfaceType;
|
||||
FPrecompileGUID: TGUID;
|
||||
FInsertFilenames: TStringList;
|
||||
@ -564,7 +559,7 @@ type
|
||||
function CreateLog: TPas2jsLogger; virtual;
|
||||
function CreateMacroEngine: TPas2jsMacroEngine;virtual;
|
||||
function CreateSrcMap(const aFileName: String): TPas2JSSrcMap; virtual;
|
||||
function CreateOptimizer: TPas2JSWPOptimizer;
|
||||
function CreateOptimizer: TPas2JSAnalyzer;
|
||||
// These are mandatory !
|
||||
function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; virtual; abstract;
|
||||
function CreateFS: TPas2JSFS; virtual; abstract;
|
||||
@ -672,7 +667,7 @@ type
|
||||
property SkipDefaultConfig: Boolean read GetSkipDefaultConfig write SetSkipDefaultConfig;
|
||||
property TargetPlatform: TPasToJsPlatform read GetTargetPlatform write SetTargetPlatform;
|
||||
property TargetProcessor: TPasToJsProcessor read GetTargetProcessor write SetTargetProcessor;
|
||||
property WPOAnalyzer: TPas2JSWPOptimizer read FWPOAnalyzer; // Whole Program Optimization
|
||||
property WPOAnalyzer: TPas2JSAnalyzer read FWPOAnalyzer; // Whole Program Optimization
|
||||
property WriteDebugLog: boolean read GetWriteDebugLog write SetWriteDebugLog;
|
||||
property WriteMsgToStdErr: boolean read GetWriteMsgToStdErr write SetWriteMsgToStdErr;
|
||||
property AllJSIntoMainJS: Boolean Read FAllJSIntoMainJS Write SetAllJSIntoMainJS;
|
||||
@ -936,7 +931,7 @@ begin
|
||||
for ub in TUsedBySection do
|
||||
FUsedBy[ub]:=TFPList.Create;
|
||||
|
||||
FUseAnalyzer:=TPasAnalyzer.Create;
|
||||
FUseAnalyzer:=TPas2JSAnalyzer.Create;
|
||||
FUseAnalyzer.OnMessage:=@OnUseAnalyzerMessage;
|
||||
FUseAnalyzer.Resolver:=FPasResolver;
|
||||
|
||||
@ -1938,10 +1933,10 @@ begin
|
||||
Result:=aFile.NeedBuild;
|
||||
end;
|
||||
|
||||
function TPas2jsCompiler.CreateOptimizer: TPas2JSWPOptimizer;
|
||||
function TPas2jsCompiler.CreateOptimizer: TPas2JSAnalyzer;
|
||||
|
||||
begin
|
||||
Result:=TPas2JSWPOptimizer.Create;
|
||||
Result:=TPas2JSAnalyzer.Create;
|
||||
end;
|
||||
|
||||
procedure TPas2jsCompiler.OptimizeProgram(aFile: TPas2jsCompilerFile);
|
||||
|
||||
@ -860,6 +860,8 @@ type
|
||||
procedure Set_ModScope_AssertMsgConstructor(RefEl: TPasElement; Data: TObject);
|
||||
procedure Set_ModScope_RangeErrorClass(RefEl: TPasElement; Data: TObject);
|
||||
procedure Set_ModScope_RangeErrorConstructor(RefEl: TPasElement; Data: TObject);
|
||||
procedure Set_ModScope_SystemTVarRec(RefEl: TPasElement; Data: TObject);
|
||||
procedure Set_ModScope_SystemVarRecs(RefEl: TPasElement; Data: TObject);
|
||||
procedure Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement; Data: TObject);
|
||||
procedure Set_PropertyScope_AncestorProp(RefEl: TPasElement; Data: TObject);
|
||||
procedure Set_ProcedureScope_ImplProc(RefEl: TPasElement; Data: TObject);
|
||||
@ -2511,6 +2513,8 @@ begin
|
||||
AddReferenceToObj(Obj,'AssertMsgConstructor',Scope.AssertMsgConstructor);
|
||||
AddReferenceToObj(Obj,'RangeErrorClass',Scope.RangeErrorClass);
|
||||
AddReferenceToObj(Obj,'RangeErrorConstructor',Scope.RangeErrorConstructor);
|
||||
AddReferenceToObj(Obj,'SystemTVarRec',Scope.SystemTVarRec);
|
||||
AddReferenceToObj(Obj,'SystemVarRecs',Scope.SystemVarRecs);
|
||||
WritePasScope(Obj,Scope,aContext);
|
||||
end;
|
||||
|
||||
@ -4399,6 +4403,28 @@ begin
|
||||
RaiseMsg(20180211123100,Scope.Element,GetObjName(RefEl));
|
||||
end;
|
||||
|
||||
procedure TPCUReader.Set_ModScope_SystemTVarRec(RefEl: TPasElement;
|
||||
Data: TObject);
|
||||
var
|
||||
Scope: TPas2JSModuleScope absolute Data;
|
||||
begin
|
||||
if RefEl is TPasRecordType then
|
||||
Scope.SystemTVarRec:=TPasRecordType(RefEl)
|
||||
else
|
||||
RaiseMsg(20190215230826,Scope.Element,GetObjName(RefEl));
|
||||
end;
|
||||
|
||||
procedure TPCUReader.Set_ModScope_SystemVarRecs(RefEl: TPasElement;
|
||||
Data: TObject);
|
||||
var
|
||||
Scope: TPas2JSModuleScope absolute Data;
|
||||
begin
|
||||
if RefEl is TPasFunction then
|
||||
Scope.SystemVarRecs:=TPasFunction(RefEl)
|
||||
else
|
||||
RaiseMsg(20190215230857,Scope.Element,GetObjName(RefEl));
|
||||
end;
|
||||
|
||||
procedure TPCUReader.Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement;
|
||||
Data: TObject);
|
||||
var
|
||||
@ -6262,6 +6288,8 @@ begin
|
||||
ReadElementReference(Obj,Scope,'AssertMsgConstructor',@Set_ModScope_AssertMsgConstructor);
|
||||
ReadElementReference(Obj,Scope,'RangeErrorClass',@Set_ModScope_RangeErrorClass);
|
||||
ReadElementReference(Obj,Scope,'RangeErrorConstructor',@Set_ModScope_RangeErrorConstructor);
|
||||
ReadElementReference(Obj,Scope,'SystemTVarRec',@Set_ModScope_SystemTVarRec);
|
||||
ReadElementReference(Obj,Scope,'SystemVarRecs',@Set_ModScope_SystemVarRecs);
|
||||
ReadPasScope(Obj,Scope,aContext);
|
||||
end;
|
||||
|
||||
|
||||
58
packages/pastojs/src/pas2jsuseanalyzer.pp
Normal file
58
packages/pastojs/src/pas2jsuseanalyzer.pp
Normal file
@ -0,0 +1,58 @@
|
||||
{
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 2019 Mattias Gaertner mattias@freepascal.org
|
||||
|
||||
Pascal to Javascript converter class.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************
|
||||
|
||||
Abstract:
|
||||
Extends the FCL Pascal use analyzer for the language subset of pas2js.
|
||||
}
|
||||
unit Pas2jsUseAnalyzer;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$inline on}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
PasUseAnalyzer, PasTree,
|
||||
FPPas2Js;
|
||||
|
||||
type
|
||||
|
||||
{ TPas2JSAnalyzer }
|
||||
|
||||
TPas2JSAnalyzer = class(TPasAnalyzer)
|
||||
public
|
||||
function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean;
|
||||
override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TPas2JSAnalyzer }
|
||||
|
||||
function TPas2JSAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode
|
||||
): boolean;
|
||||
var
|
||||
ModScope: TPas2JSModuleScope;
|
||||
begin
|
||||
Result:=inherited UseModule(aModule, Mode);
|
||||
if not Result then exit;
|
||||
ModScope:=aModule.CustomData as TPas2JSModuleScope;
|
||||
if ModScope.SystemVarRecs<>nil then
|
||||
UseProcedure(ModScope.SystemVarRecs);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -24,9 +24,10 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry,
|
||||
jstree,
|
||||
PasTree, PScanner, PParser, PasResolveEval, PasResolver, PasUseAnalyzer,
|
||||
FPPas2Js, Pas2JsFiler,
|
||||
tcmodules, jstree;
|
||||
Pas2jsUseAnalyzer, FPPas2Js, Pas2JsFiler,
|
||||
tcmodules;
|
||||
|
||||
type
|
||||
|
||||
@ -34,11 +35,11 @@ type
|
||||
|
||||
TCustomTestPrecompile = Class(TCustomTestModule)
|
||||
private
|
||||
FAnalyzer: TPasAnalyzer;
|
||||
FAnalyzer: TPas2JSAnalyzer;
|
||||
FInitialFlags: TPCUInitialFlags;
|
||||
FPCUReader: TPCUReader;
|
||||
FPCUWriter: TPCUWriter;
|
||||
FRestAnalyzer: TPasAnalyzer;
|
||||
FRestAnalyzer: TPas2JSAnalyzer;
|
||||
procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar;
|
||||
out Count: integer);
|
||||
function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
|
||||
@ -121,8 +122,8 @@ type
|
||||
procedure CheckRestoredProcedure(const Path: string; Orig, Rest: TPasProcedure); virtual;
|
||||
procedure CheckRestoredOperator(const Path: string; Orig, Rest: TPasOperator); virtual;
|
||||
public
|
||||
property Analyzer: TPasAnalyzer read FAnalyzer;
|
||||
property RestAnalyzer: TPasAnalyzer read FRestAnalyzer;
|
||||
property Analyzer: TPas2JSAnalyzer read FAnalyzer;
|
||||
property RestAnalyzer: TPas2JSAnalyzer read FRestAnalyzer;
|
||||
property PCUWriter: TPCUWriter read FPCUWriter write FPCUWriter;
|
||||
property PCUReader: TPCUReader read FPCUReader write FPCUReader;
|
||||
property InitialFlags: TPCUInitialFlags read FInitialFlags;
|
||||
@ -155,6 +156,7 @@ type
|
||||
procedure TestPC_Proc_Arg;
|
||||
procedure TestPC_ProcType;
|
||||
procedure TestPC_Proc_Anonymous;
|
||||
procedure TestPC_Proc_ArrayOfConst;
|
||||
procedure TestPC_Class;
|
||||
procedure TestPC_ClassForward;
|
||||
procedure TestPC_ClassConstructor;
|
||||
@ -278,7 +280,7 @@ procedure TCustomTestPrecompile.SetUp;
|
||||
begin
|
||||
inherited SetUp;
|
||||
FInitialFlags:=TPCUInitialFlags.Create;
|
||||
FAnalyzer:=TPasAnalyzer.Create;
|
||||
FAnalyzer:=TPas2JSAnalyzer.Create;
|
||||
Analyzer.Resolver:=Engine;
|
||||
Analyzer.Options:=Analyzer.Options+[paoImplReferences];
|
||||
Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
|
||||
@ -378,7 +380,7 @@ begin
|
||||
end;
|
||||
|
||||
// analyze
|
||||
FRestAnalyzer:=TPasAnalyzer.Create;
|
||||
FRestAnalyzer:=TPas2JSAnalyzer.Create;
|
||||
FRestAnalyzer.Resolver:=RestResolver;
|
||||
try
|
||||
RestAnalyzer.AnalyzeModule(RestResolver.RootElement);
|
||||
@ -617,6 +619,8 @@ begin
|
||||
CheckRestoredReference(Path+'.AssertMsgConstructor',Orig.AssertMsgConstructor,Rest.AssertMsgConstructor);
|
||||
CheckRestoredReference(Path+'.RangeErrorClass',Orig.RangeErrorClass,Rest.RangeErrorClass);
|
||||
CheckRestoredReference(Path+'.RangeErrorConstructor',Orig.RangeErrorConstructor,Rest.RangeErrorConstructor);
|
||||
CheckRestoredReference(Path+'.SystemTVarRec',Orig.SystemTVarRec,Rest.SystemTVarRec);
|
||||
CheckRestoredReference(Path+'.SystemVarRecs',Orig.SystemVarRecs,Rest.SystemVarRecs);
|
||||
CheckRestoredPasScope(Path,Orig,Rest);
|
||||
end;
|
||||
|
||||
@ -2021,6 +2025,23 @@ begin
|
||||
WriteReadUnit;
|
||||
end;
|
||||
|
||||
procedure TTestPrecompile.TestPC_Proc_ArrayOfConst;
|
||||
begin
|
||||
StartUnit(true,[supTVarRec]);
|
||||
Add([
|
||||
'interface',
|
||||
'procedure Fly(arr: array of const);',
|
||||
'implementation',
|
||||
'procedure Fly(arr: array of const);',
|
||||
'begin',
|
||||
' if arr[1].VType=1 then ;',
|
||||
' if arr[2].VInteger=1 then ;',
|
||||
' Fly([true,0.3]);',
|
||||
'end;',
|
||||
'']);
|
||||
WriteReadUnit;
|
||||
end;
|
||||
|
||||
procedure TTestPrecompile.TestPC_Class;
|
||||
begin
|
||||
StartUnit(false);
|
||||
|
||||
@ -49,6 +49,12 @@ type
|
||||
Next: PSrcMarker;
|
||||
end;
|
||||
|
||||
TSystemUnitPart = (
|
||||
supTObject,
|
||||
supTVarRec
|
||||
);
|
||||
TSystemUnitParts = set of TSystemUnitPart;
|
||||
|
||||
{ TTestHintMessage }
|
||||
|
||||
TTestHintMessage = class
|
||||
@ -153,9 +159,9 @@ type
|
||||
function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver; virtual;
|
||||
function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
|
||||
ImplementationSrc: string): TTestEnginePasResolver; virtual;
|
||||
procedure AddSystemUnit; virtual;
|
||||
procedure StartProgram(NeedSystemUnit: boolean); virtual;
|
||||
procedure StartUnit(NeedSystemUnit: boolean); virtual;
|
||||
procedure AddSystemUnit(Parts: TSystemUnitParts = []); virtual;
|
||||
procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
|
||||
procedure StartUnit(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
|
||||
procedure ConvertModule; virtual;
|
||||
procedure ConvertProgram; virtual;
|
||||
procedure ConvertUnit; virtual;
|
||||
@ -412,8 +418,6 @@ type
|
||||
Procedure TestArrayOfRecord;
|
||||
Procedure TestArray_StaticRecord;
|
||||
Procedure TestArrayOfSet;
|
||||
// call(set) literal and clone var
|
||||
// call([set]) literal and clone var
|
||||
Procedure TestArray_DynAsParam;
|
||||
Procedure TestArray_StaticAsParam;
|
||||
Procedure TestArrayElement_AsParams;
|
||||
@ -434,6 +438,10 @@ type
|
||||
Procedure TestArray_ForInArrOfString;
|
||||
Procedure TestExternalClass_TypeCastArrayToExternalClass;
|
||||
Procedure TestExternalClass_TypeCastArrayFromExternalClass;
|
||||
Procedure TestArrayOfConst_TVarRec;
|
||||
Procedure TestArrayOfConst_PassBaseTypes;
|
||||
Procedure TestArrayOfConst_PassObj;
|
||||
// ToDo: tcfiler TPasModuleScope.SystemTVarRec TPas2JSModuleScope.SystemVarRecs
|
||||
|
||||
// record
|
||||
Procedure TestRecord_Empty;
|
||||
@ -452,7 +460,6 @@ type
|
||||
Procedure TestRecord_Const;
|
||||
Procedure TestRecord_TypecastFail;
|
||||
Procedure TestRecord_InFunction;
|
||||
// ToDo: Procedure TestRecord_ExternalField;
|
||||
// ToDo: RTTI of local record
|
||||
// ToDo: pcu local record, name clash and rtti
|
||||
|
||||
@ -1512,36 +1519,136 @@ begin
|
||||
Result:=AddModuleWithSrc(aFilename,Src);
|
||||
end;
|
||||
|
||||
procedure TCustomTestModule.AddSystemUnit;
|
||||
procedure TCustomTestModule.AddSystemUnit(Parts: TSystemUnitParts);
|
||||
var
|
||||
Intf, Impl: TStringList;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('system.pp',
|
||||
// interface
|
||||
LinesToStr([
|
||||
Intf:=TStringList.Create;
|
||||
// interface
|
||||
if supTVarRec in Parts then
|
||||
Intf.Add('{$modeswitch externalclass}');
|
||||
Intf.Add('type');
|
||||
Intf.Add(' integer=longint;');
|
||||
Intf.Add(' sizeint=nativeint;');
|
||||
//'const',
|
||||
//' LineEnding = #10;',
|
||||
//' DirectorySeparator = ''/'';',
|
||||
//' DriveSeparator = '''';',
|
||||
//' AllowDirectorySeparators : set of char = [''\'',''/''];',
|
||||
//' AllowDriveSeparators : set of char = [];',
|
||||
if supTObject in Parts then
|
||||
Intf.AddStrings([
|
||||
'type',
|
||||
' integer=longint;',
|
||||
' TClass = class of TObject;',
|
||||
' TObject = class',
|
||||
' constructor Create;',
|
||||
' destructor Destroy; virtual;',
|
||||
' class function ClassType: TClass; assembler;',
|
||||
' class function ClassName: String; assembler;',
|
||||
' class function ClassNameIs(const Name: string): boolean;',
|
||||
' class function ClassParent: TClass; assembler;',
|
||||
' class function InheritsFrom(aClass: TClass): boolean; assembler;',
|
||||
' class function UnitName: String; assembler;',
|
||||
' procedure AfterConstruction; virtual;',
|
||||
' procedure BeforeDestruction;virtual;',
|
||||
' function Equals(Obj: TObject): boolean; virtual;',
|
||||
' function ToString: String; virtual;',
|
||||
' end;']);
|
||||
if supTVarRec in Parts then
|
||||
Intf.AddStrings([
|
||||
'const',
|
||||
' vtInteger = 0;',
|
||||
' vtBoolean = 1;',
|
||||
' vtJSValue = 19;',
|
||||
'type',
|
||||
' PVarRec = ^TVarRec;',
|
||||
' TVarRec = record',
|
||||
' VType : byte;',
|
||||
' VJSValue: JSValue;',
|
||||
' vInteger: longint external name ''VJSValue'';',
|
||||
' vBoolean: boolean external name ''VJSValue'';',
|
||||
' end;',
|
||||
' TVarRecArray = array of TVarRec;',
|
||||
'function VarRecs: TVarRecArray; varargs;',
|
||||
'']);
|
||||
Intf.Add('var');
|
||||
Intf.Add(' ExitCode: Longint = 0;');
|
||||
|
||||
// implementation
|
||||
Impl:=TStringList.Create;
|
||||
if supTObject in Parts then
|
||||
Impl.AddStrings([
|
||||
'// needed by ClassNameIs, the real SameText is in SysUtils',
|
||||
'function SameText(const s1, s2: String): Boolean; assembler;',
|
||||
'asm',
|
||||
'end;',
|
||||
'constructor TObject.Create; begin end;',
|
||||
'destructor TObject.Destroy; begin end;',
|
||||
'class function TObject.ClassType: TClass; assembler;',
|
||||
'asm',
|
||||
'end;',
|
||||
'class function TObject.ClassName: String; assembler;',
|
||||
'asm',
|
||||
'end;',
|
||||
'class function TObject.ClassNameIs(const Name: string): boolean;',
|
||||
'begin',
|
||||
' Result:=SameText(Name,ClassName);',
|
||||
'end;',
|
||||
'class function TObject.ClassParent: TClass; assembler;',
|
||||
'asm',
|
||||
'end;',
|
||||
'class function TObject.InheritsFrom(aClass: TClass): boolean; assembler;',
|
||||
'asm',
|
||||
'end;',
|
||||
'class function TObject.UnitName: String; assembler;',
|
||||
'asm',
|
||||
'end;',
|
||||
'procedure TObject.AfterConstruction; begin end;',
|
||||
'procedure TObject.BeforeDestruction; begin end;',
|
||||
'function TObject.Equals(Obj: TObject): boolean;',
|
||||
'begin',
|
||||
' Result:=Obj=Self;',
|
||||
'end;',
|
||||
'function TObject.ToString: String;',
|
||||
'begin',
|
||||
' Result:=ClassName;',
|
||||
'end;'
|
||||
]);
|
||||
if supTVarRec in Parts then
|
||||
Impl.AddStrings([
|
||||
'function VarRecs: TVarRecArray; varargs;',
|
||||
'var',
|
||||
' ExitCode: Longint;',
|
||||
''
|
||||
// implementation
|
||||
]),LinesToStr([
|
||||
''
|
||||
]));
|
||||
' v: PVarRec;',
|
||||
'begin',
|
||||
' v^.VType:=1;',
|
||||
' v^.VJSValue:=2;',
|
||||
'end;',
|
||||
'']);
|
||||
|
||||
try
|
||||
AddModuleWithIntfImplSrc('system.pp',Intf.Text,Impl.Text);
|
||||
finally
|
||||
Intf.Free;
|
||||
Impl.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean);
|
||||
procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean;
|
||||
SystemUnitParts: TSystemUnitParts);
|
||||
begin
|
||||
if NeedSystemUnit then
|
||||
AddSystemUnit
|
||||
AddSystemUnit(SystemUnitParts)
|
||||
else
|
||||
Parser.ImplicitUses.Clear;
|
||||
Add('program '+ExtractFileUnitName(Filename)+';');
|
||||
Add('');
|
||||
end;
|
||||
|
||||
procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean);
|
||||
procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean;
|
||||
SystemUnitParts: TSystemUnitParts);
|
||||
begin
|
||||
if NeedSystemUnit then
|
||||
AddSystemUnit
|
||||
AddSystemUnit(SystemUnitParts)
|
||||
else
|
||||
Parser.ImplicitUses.Clear;
|
||||
Add('unit Test1;');
|
||||
@ -9481,10 +9588,154 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestArrayOfConst_TVarRec;
|
||||
begin
|
||||
StartProgram(true,[supTVarRec]);
|
||||
Add([
|
||||
'procedure Say(args: array of const);',
|
||||
'var',
|
||||
' i: longint;',
|
||||
' v: TVarRec;',
|
||||
'begin',
|
||||
' for i:=low(args) to high(args) do begin',
|
||||
' v:=args[i];',
|
||||
' case v.vtype of',
|
||||
' vtInteger: if length(args)=args[i].vInteger then ;',
|
||||
' end;',
|
||||
' end;',
|
||||
' for v in args do ;',
|
||||
' args:=nil;',
|
||||
' SetLength(args,2);',
|
||||
'end;',
|
||||
'begin']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestArrayOfConst_TVarRec',
|
||||
LinesToStr([ // statements
|
||||
'this.Say = function (args) {',
|
||||
' var i = 0;',
|
||||
' var v = pas.system.TVarRec.$new();',
|
||||
' for (var $l1 = 0, $end2 = rtl.length(args) - 1; $l1 <= $end2; $l1++) {',
|
||||
' i = $l1;',
|
||||
' v.$assign(args[i]);',
|
||||
' var $tmp3 = v.VType;',
|
||||
' if ($tmp3 === 0) if (rtl.length(args) === args[i].VJSValue) ;',
|
||||
' };',
|
||||
' for (var $in4 = args, $l5 = 0, $end6 = rtl.length($in4) - 1; $l5 <= $end6; $l5++) v = $in4[$l5];',
|
||||
' args = [];',
|
||||
' args = rtl.arraySetLength(args, pas.system.TVarRec, 2);',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
]));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestArrayOfConst_PassBaseTypes;
|
||||
begin
|
||||
StartProgram(true,[supTVarRec]);
|
||||
Add([
|
||||
'procedure Say(args: array of const);',
|
||||
'begin',
|
||||
' Say(args);',
|
||||
'end;',
|
||||
'var',
|
||||
' p: Pointer;',
|
||||
' j: jsvalue;',
|
||||
' c: currency;',
|
||||
'begin',
|
||||
' Say([]);',
|
||||
' Say([1]);',
|
||||
' Say([''c'',''foo'',nil,true,1.3,p,j,c]);',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestArrayOfConst_PassBaseTypes',
|
||||
LinesToStr([ // statements
|
||||
'this.Say = function (args) {',
|
||||
' $mod.Say(args);',
|
||||
'};',
|
||||
'this.p = null;',
|
||||
'this.j = undefined;',
|
||||
'this.c = 0;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.Say([]);',
|
||||
'$mod.Say(pas.system.VarRecs(0, 1));',
|
||||
'$mod.Say(pas.system.VarRecs(',
|
||||
' 9,',
|
||||
' "c",',
|
||||
' 18,',
|
||||
' "foo",',
|
||||
' 5,',
|
||||
' null,',
|
||||
' 1,',
|
||||
' true,',
|
||||
' 3,',
|
||||
' 1.3,',
|
||||
' 5,',
|
||||
' $mod.p,',
|
||||
' 20,',
|
||||
' $mod.j,',
|
||||
' 12,',
|
||||
' $mod.c',
|
||||
' ));',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestArrayOfConst_PassObj;
|
||||
begin
|
||||
StartProgram(true,[supTVarRec]);
|
||||
Add([
|
||||
'{$interfaces corba}',
|
||||
'type',
|
||||
' TObject = class',
|
||||
' end;',
|
||||
' TClass = class of TObject;',
|
||||
' IUnknown = interface',
|
||||
' end;',
|
||||
'procedure Say(args: array of const);',
|
||||
'begin',
|
||||
'end;',
|
||||
'var',
|
||||
' o: TObject;',
|
||||
' c: TClass;',
|
||||
' i: IUnknown;',
|
||||
'begin',
|
||||
' Say([o,c,TObject]);',
|
||||
' Say([nil,i]);',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestArrayOfConst_PassObj',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
|
||||
'this.Say = function (args) {',
|
||||
'};',
|
||||
'this.o = null;',
|
||||
'this.c = null;',
|
||||
'this.i = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.Say(pas.system.VarRecs(',
|
||||
' 7,',
|
||||
' $mod.o,',
|
||||
' 8,',
|
||||
' $mod.c,',
|
||||
' 8,',
|
||||
' $mod.TObject',
|
||||
'));',
|
||||
'$mod.Say(pas.system.VarRecs(5, null, 14, $mod.i));',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRecord_Empty;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add(['type',
|
||||
Add([
|
||||
'type',
|
||||
' TRecA = record',
|
||||
' end;',
|
||||
'var a,b: TRecA;',
|
||||
|
||||
@ -25,7 +25,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, testregistry, fppas2js, pastree,
|
||||
PScanner, PasUseAnalyzer, PasResolver, PasResolveEval,
|
||||
PScanner, Pas2jsUseAnalyzer, PasResolver, PasResolveEval,
|
||||
tcmodules;
|
||||
|
||||
type
|
||||
@ -34,8 +34,8 @@ type
|
||||
|
||||
TCustomTestOptimizations = class(TCustomTestModule)
|
||||
private
|
||||
FAnalyzerModule: TPasAnalyzer;
|
||||
FAnalyzerProgram: TPasAnalyzer;
|
||||
FAnalyzerModule: TPas2JSAnalyzer;
|
||||
FAnalyzerProgram: TPas2JSAnalyzer;
|
||||
FWholeProgramOptimization: boolean;
|
||||
function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
|
||||
function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
|
||||
@ -46,8 +46,8 @@ type
|
||||
procedure ParseProgram; override;
|
||||
function CreateConverter: TPasToJSConverter; override;
|
||||
public
|
||||
property AnalyzerModule: TPasAnalyzer read FAnalyzerModule;
|
||||
property AnalyzerProgram: TPasAnalyzer read FAnalyzerProgram;
|
||||
property AnalyzerModule: TPas2JSAnalyzer read FAnalyzerModule;
|
||||
property AnalyzerProgram: TPas2JSAnalyzer read FAnalyzerProgram;
|
||||
property WholeProgramOptimization: boolean read FWholeProgramOptimization
|
||||
write FWholeProgramOptimization;
|
||||
end;
|
||||
@ -78,6 +78,7 @@ type
|
||||
procedure TestWPO_Class_OmitPropertySetter2;
|
||||
procedure TestWPO_CallInherited;
|
||||
procedure TestWPO_UseUnit;
|
||||
procedure TestWPO_ArrayOfConst;
|
||||
procedure TestWPO_Class_PropertyInOtherUnit;
|
||||
procedure TestWPO_ProgramPublicDeclaration;
|
||||
procedure TestWPO_ConstructorDefaultValueConst;
|
||||
@ -92,7 +93,7 @@ implementation
|
||||
function TCustomTestOptimizations.OnConverterIsElementUsed(Sender: TObject;
|
||||
El: TPasElement): boolean;
|
||||
var
|
||||
A: TPasAnalyzer;
|
||||
A: TPas2JSAnalyzer;
|
||||
begin
|
||||
if WholeProgramOptimization then
|
||||
A:=AnalyzerProgram
|
||||
@ -114,7 +115,7 @@ end;
|
||||
function TCustomTestOptimizations.OnConverterIsTypeInfoUsed(Sender: TObject;
|
||||
El: TPasElement): boolean;
|
||||
var
|
||||
A: TPasAnalyzer;
|
||||
A: TPas2JSAnalyzer;
|
||||
begin
|
||||
if WholeProgramOptimization then
|
||||
A:=AnalyzerProgram
|
||||
@ -137,9 +138,9 @@ procedure TCustomTestOptimizations.SetUp;
|
||||
begin
|
||||
inherited SetUp;
|
||||
FWholeProgramOptimization:=false;
|
||||
FAnalyzerModule:=TPasAnalyzer.Create;
|
||||
FAnalyzerModule:=TPas2JSAnalyzer.Create;
|
||||
FAnalyzerModule.Resolver:=Engine;
|
||||
FAnalyzerProgram:=TPasAnalyzer.Create;
|
||||
FAnalyzerProgram:=TPas2JSAnalyzer.Create;
|
||||
FAnalyzerProgram.Resolver:=Engine;
|
||||
end;
|
||||
|
||||
@ -814,6 +815,42 @@ begin
|
||||
CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc);
|
||||
end;
|
||||
|
||||
procedure TTestOptimizations.TestWPO_ArrayOfConst;
|
||||
begin
|
||||
StartProgram(true,[supTVarRec]);
|
||||
Add([
|
||||
'procedure Say(arr: array of const);',
|
||||
'begin end;',
|
||||
'begin',
|
||||
' Say([true]);']);
|
||||
ConvertProgram;
|
||||
CheckUnit('system.pp',
|
||||
LinesToStr([
|
||||
'rtl.module("system", [], function () {',
|
||||
' var $mod = this;',
|
||||
' rtl.recNewT($mod, "TVarRec", function () {',
|
||||
' this.VType = 0;',
|
||||
' this.VJSValue = undefined;',
|
||||
' this.$eq = function (b) {',
|
||||
' return (this.VType === b.VType) && (this.VJSValue === b.VJSValue);',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.VType = s.VType;',
|
||||
' this.VJSValue = s.VJSValue;',
|
||||
' return this;',
|
||||
' };',
|
||||
' });',
|
||||
' this.VarRecs = function () {',
|
||||
' var Result = [];',
|
||||
' var v = null;',
|
||||
' v.VType = 1;',
|
||||
' v.VJSValue = 2;',
|
||||
' return Result;',
|
||||
' };',
|
||||
'});',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestOptimizations.TestWPO_Class_PropertyInOtherUnit;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit1.pp',
|
||||
|
||||
@ -32,7 +32,7 @@
|
||||
<PackageName Value="FCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="11">
|
||||
<Units Count="12">
|
||||
<Unit0>
|
||||
<Filename Value="testpas2js.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -83,6 +83,11 @@
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TCPrecompile"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="../src/pas2jsuseanalyzer.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Pas2jsUseAnalyzer"/>
|
||||
</Unit11>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
@ -21,7 +21,7 @@ uses
|
||||
MemCheck,
|
||||
{$ENDIF}
|
||||
Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations, tcsrcmap,
|
||||
tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile;
|
||||
tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile, pas2jsuseanalyzer;
|
||||
|
||||
type
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user