paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 00:09:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: test UTF-16 surrogate

Browse Source 
git-svn-id: trunk@38259 -
This commit is contained in:
Mattias Gaertner 2018-02-16 19:21:40 +00:00
parent fc8e95f8f5
commit fb2a664640
4 changed files with 568 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
packages/pastojs/src/fppas2js.pp
View File

@ -3201,7 +3201,7 @@ var
begin
Result:='';
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.ExtractPasStringLiteral "',S,'"');
writeln('TPasToJSConverter.ExtractPasStringLiteral S="',S,'" ',RawStrToCaption(S,100),' ',length(S));
{$ENDIF}
if S='' then
RaiseInternalError(20170207154543);
@ -3221,7 +3221,7 @@ begin
'''':
begin
if p>StartP then
Result:=Result+TJSString(copy(S,StartP-PChar(S)+1,p-StartP));
Result:=Result+TJSString(UTF8Decode(copy(S,StartP-PChar(S)+1,p-StartP)));
inc(p);
StartP:=p;
if p^<>'''' then
@ -3235,7 +3235,7 @@ begin
end;
until false;
if p>StartP then
Result:=Result+TJSString(copy(S,StartP-PChar(S)+1,p-StartP));
Result:=Result+TJSString(UTF8Decode(copy(S,StartP-PChar(S)+1,p-StartP)));
end;
'#':
begin
@ -3301,7 +3301,11 @@ begin
end;
until false;
{$IFDEF VerbosePas2JS}
{AllowWriteln}
writeln('TPasToJSConverter.ExtractPasStringLiteral Result="',Result,'"');
//for i:=1 to length(Result) do
// writeln(' Result[',i,']',HexStr(ord(Result[i]),4));
{AllowWriteln-}
{$ENDIF}
end;

501
packages/pastojs/src/pas2jsfiler.pp
View File

@ -16,18 +16,32 @@
Abstract:
Write and read a precompiled module (pju).
Default format is gzipped json
Works:
- store used source files and checksums
- store compiler flags
- restore module as json
- restore types
- references to built in symbols via Id
- references to module's TPasElement via Id
- resolving forward references
- restore resolver scopes
- restore resolved references and access flags
Store whole unit, except all
procedure declarations, proc bodies, finalization/initialization sections are
replaced by
-precompiled code
-lists of references
-local consts
The useanalyzer needs the references - TPas2jsUseAnalyzer.
ToDo:
- test restoring types
- test restoring expressions
- interface/implementation references
- store converted proc implementation
- store references
- local const
- use stored converted proc implementation
- store converted initialization/finalization
- use stored converted initialization/finalization
- uses section
- external references
- stop after uses section and continue reading
- gzipped json
Due to uses cycles, ability to stop read after interface uses and implementation uses
Needs function to find out where it stopped, and a procedure ReadContinue
}
unit Pas2JsFiler;
@ -411,6 +425,16 @@ const
'ParamToUnknownProc'
);
PJUResolvedReferenceFlagNames: array[TResolvedReferenceFlag] of string = (
'Dot',
'ImplicitCall',
'NoImplicitCall',
'NewInst',
'FreeInst',
'VMT',
'ConstInh'
);
type
{ TPJUInitialFlags }
@ -514,6 +538,7 @@ type
function GetDefaultClassScopeFlags(Scope: TPas2JSClassScope): TPasClassScopeFlags; virtual;
function GetDefaultProcModifiers(Proc: TPasProcedure): TProcedureModifiers; virtual;
function GetDefaultProcTypeModifiers(Proc: TPasProcedureType): TProcTypeModifiers; virtual;
function GetDefaultExprHasEvalValue(Expr: TPasExpr): boolean; virtual;
function GetSrcCheckSum(aFilename: string): TPJUSourceFileChecksum; virtual;
function GetElementReference(El: TPasElement; AutoCreate: boolean = true): TPJUFilerElementRef;
public
@ -594,6 +619,8 @@ type
procedure WriteElement(Obj: TJSONObject; El: TPasElement; aContext: TPJUWriterContext); virtual;
procedure WriteElType(Obj: TJSONObject; El: TPasElement; const PropName: string; aType: TPasType; aContext: TPJUWriterContext); virtual;
procedure WriteVarModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TVariableModifiers); virtual;
procedure WriteResolvedRefFlags(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TResolvedReferenceFlags); virtual;
procedure WriteExprCustomData(Obj: TJSONObject; Expr: TPasExpr; aContext: TPJUWriterContext); virtual;
procedure WriteExpr(Obj: TJSONObject; Parent: TPasElement;
const PropName: string; Expr: TPasExpr; aContext: TPJUWriterContext); virtual;
procedure WritePasExpr(Obj: TJSONObject; Expr: TPasExpr;
@ -647,7 +674,7 @@ type
destructor Destroy; override;
procedure Clear; override;
procedure WritePJU(aResolver: TPas2JSResolver;
InitFlags: TPJUInitialFlags; aStream: TStream); virtual;
InitFlags: TPJUInitialFlags; aStream: TStream; Compressed: boolean); virtual;
function WriteJSON(aResolver: TPas2JSResolver;
InitFlags: TPJUInitialFlags): TJSONObject; virtual;
function IndexOfSourceFile(const Filename: string): integer;
@ -716,6 +743,7 @@ type
procedure Set_ModScope_RangeErrorConstructor(RefEl: TPasElement; Data: TObject);
procedure Set_PropertyScope_AncestorProp(RefEl: TPasElement; Data: TObject);
procedure Set_ProcedureScope_Overridden(RefEl: TPasElement; Data: TObject);
procedure Set_ResolvedReference_Declaration(RefEl: TPasElement; Data: TObject);
protected
procedure RaiseMsg(Id: int64; const Msg: string = ''); overload; override;
function CheckJSONArray(Data: TJSONData; El: TPasElement; const PropName: string): TJSONArray;
@ -744,7 +772,6 @@ type
procedure ReadSectionScope(Obj: TJSONObject; Scope: TPasSectionScope; aContext: TPJUReaderContext); virtual;
procedure ReadSection(Obj: TJSONObject; Section: TPasSection; aContext: TPJUReaderContext); virtual;
procedure ReadDeclarations(Obj: TJSONObject; Section: TPasSection; aContext: TPJUReaderContext); virtual;
procedure ReadDeclaration(Obj: TJSONObject; Section: TPasSection; aContext: TPJUReaderContext); virtual;
function ReadElement(Obj: TJSONObject; Parent: TPasElement; aContext: TPJUReaderContext): TPasElement; virtual;
function ReadElementProperty(Obj: TJSONObject; Parent: TPasElement;
const PropName: string; BaseClass: TPTreeElement; aContext: TPJUReaderContext): TPasElement; virtual;
@ -754,6 +781,9 @@ type
const PropName: string; ListOfElements: TFPList; aContext: TPJUReaderContext); virtual;
procedure ReadElType(Obj: TJSONObject; const PropName: string; El: TPasElement;
const Setter: TOnSetElReference; aContext: TPJUReaderContext); virtual;
function ReadResolvedRefFlags(Obj: TJSONObject; El: TPasElement;
const PropName: string; const DefaultValue: TResolvedReferenceFlags): TResolvedReferenceFlags; virtual;
procedure ReadExprCustomData(Obj: TJSONObject; Expr: TPasExpr; aContext: TPJUReaderContext); virtual;
function ReadExpr(Obj: TJSONObject; Parent: TPasElement; const PropName: string;
aContext: TPJUReaderContext): TPasExpr; virtual;
procedure ReadPasScope(Obj: TJSONObject; Scope: TPasScope; aContext: TPJUReaderContext); virtual;
@ -815,6 +845,7 @@ type
procedure ReadOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPJUReaderContext); virtual;
// ToDo: procedure ReadExternalReferences(ParentJSON: TJSONObject); virtual;
procedure ResolvePending; virtual;
procedure ReadSystemSymbols(Obj: TJSONObject; ErrorEl: TPasElement); virtual;
public
constructor Create; override;
destructor Destroy; override;
@ -1257,6 +1288,17 @@ begin
if Proc=nil then ;
end;
function TPJUFiler.GetDefaultExprHasEvalValue(Expr: TPasExpr): boolean;
var
C: TClass;
begin
if Expr.Parent is TPasExpr then exit(false);
C:=Expr.ClassType;
if C=TArrayValues then exit(false);
if C=TRecordValues then exit(false);
Result:=true;
end;
function TPJUFiler.GetSrcCheckSum(aFilename: string): TPJUSourceFileChecksum;
var
p: PChar;
@ -1270,19 +1312,21 @@ function TPJUFiler.GetElementReference(El: TPasElement; AutoCreate: boolean
): TPJUFilerElementRef;
var
Node: TAVLTreeNode;
Data: TObject;
MyEl: TPasElement;
begin
{$IFDEF VerbosePJUFiler}
//writeln('TPJUFiler.GetElementReference ',GetObjName(El));
{$ENDIF}
if El.CustomData is TResElDataBuiltInSymbol then
begin
// built-in symbol -> redirect to symbol of this module
Data:=El.CustomData;
if Data is TResElDataBaseType then
El:=Resolver.BaseTypes[TResElDataBaseType(Data).BaseType]
else if Data is TResElDataBuiltInProc then
El:=TResElDataBuiltInProc(Data).Proc
else
RaiseMsg(20180207121004,El,Data.ClassName);
end;
MyEl:=Resolver.FindLocalBuiltInSymbol(El);
if MyEl=nil then
RaiseMsg(20180207121004,El,GetObjName(El.CustomData));
El:=MyEl;
end
else if El is TPasUnresolvedSymbolRef then
RaiseMsg(20180215190054,El,GetObjName(El));
Node:=FElementRefs.FindKey(El,@CompareElWithPJUFilerElementRef);
if Node<>nil then
Result:=TPJUFilerElementRef(Node.Data)
@ -1656,8 +1700,6 @@ begin
Obj.Add('HintMessage',El.HintMessage);
// not needed El.DocComment
// ToDo: El.CustomData
end;
procedure TPJUWriter.WriteModuleScopeFlags(Obj: TJSONObject; const Value,
@ -2171,7 +2213,6 @@ begin
// reference
AddReferenceToObj(Obj,PropName,aType);
end;
RaiseMsg(20180206183542,El);
end;
procedure TPJUWriter.WriteVarModifiers(Obj: TJSONObject;
@ -2187,6 +2228,69 @@ begin
AddArrayFlag(Obj,Arr,PropName,PJUVarModifierNames[f],f in Value);
end;
procedure TPJUWriter.WriteResolvedRefFlags(Obj: TJSONObject;
const PropName: string; const Value, DefaultValue: TResolvedReferenceFlags);
var
Arr: TJSONArray;
f: TResolvedReferenceFlag;
begin
if Value=DefaultValue then exit;
Arr:=nil;
for f in TResolvedReferenceFlag do
if (f in Value)<>(f in DefaultValue) then
AddArrayFlag(Obj,Arr,PropName,PJUResolvedReferenceFlagNames[f],f in Value);
end;
procedure TPJUWriter.WriteExprCustomData(Obj: TJSONObject; Expr: TPasExpr;
aContext: TPJUWriterContext);
procedure CheckNext(Data: TObject);
var
Value: TResEvalValue;
DefHasEvalValue: Boolean;
begin
DefHasEvalValue:=GetDefaultExprHasEvalValue(Expr);
//writeln('TPJUWriter.WriteExprCustomData.CheckNext Expr=',GetObjName(Expr),' Parent=',GetObjName(Expr.Parent),' Def=',DefHasEvalValue,' Data=',GetObjName(Data));
if Data=nil then
begin
if DefHasEvalValue then
Obj.Add('Eval',false);
end
else if Data is TResEvalValue then
begin
Value:=TResEvalValue(Data);
if not DefHasEvalValue then
Obj.Add('Eval',true);
// value is not stored
if Value.CustomData<>nil then
RaiseMsg(20180215143045,Expr,GetObjName(Data));
end
else
RaiseMsg(20180215143108,Expr,GetObjName(Data));
end;
var
Ref: TResolvedReference;
begin
if Expr.CustomData=nil then exit;
if Expr.CustomData is TResolvedReference then
begin
Ref:=TResolvedReference(Expr.CustomData);
WriteResolvedRefFlags(Obj,'RefFlags',Ref.Flags,[]);
if Ref.Access<>rraRead then
Obj.Add('RefAccess',PJUResolvedRefAccessNames[Ref.Access]);
if Ref.WithExprScope<>nil then
RaiseMsg(20180215132828,Expr);
if Ref.Context<>nil then
RaiseMsg(20180215132849,Expr,GetObjName(Ref.Context));
AddReferenceToObj(Obj,'RefDecl',Ref.Declaration);
CheckNext(Ref.CustomData);
end
else
CheckNext(Expr.CustomData);
if aContext<>nil then ;
end;
procedure TPJUWriter.WriteExpr(Obj: TJSONObject; Parent: TPasElement;
const PropName: string; Expr: TPasExpr; aContext: TPJUWriterContext);
var
@ -2199,6 +2303,7 @@ begin
SubObj:=TJSONObject.Create;
Obj.Add(PropName,SubObj);
WriteElement(SubObj,Expr,aContext);
WriteExprCustomData(SubObj,Expr,aContext);
end;
procedure TPJUWriter.WritePasExpr(Obj: TJSONObject; Expr: TPasExpr;
@ -2246,8 +2351,8 @@ end;
procedure TPJUWriter.WriteBinaryExpr(Obj: TJSONObject; Expr: TBinaryExpr;
aContext: TPJUWriterContext);
begin
WriteExpr(Obj,Expr,'left',Expr.left,aContext);
WriteExpr(Obj,Expr,'right',Expr.right,aContext);
WriteExpr(Obj,Expr,'Left',Expr.left,aContext);
WriteExpr(Obj,Expr,'Right',Expr.right,aContext);
WritePasExpr(Obj,Expr,false,eopAdd,aContext);
end;
@ -2718,22 +2823,24 @@ begin
begin
Ref:=TPJUFilerElementRef(Node.Data);
Node:=FElementRefs.FindSuccessor(Node);
if Ref.Pending=nil then continue;
if Ref.Pending=nil then
continue; // not used
El:=Ref.Element;
Data:=El.CustomData;
if Data is TResElDataBuiltInSymbol then
begin
// add built-in symbol to System array
if El.GetModule<>Resolver.RootElement then
if El<>Resolver.FindLocalBuiltInSymbol(El) then
RaiseMsg(20180207124914,El);
if SystemArr=nil then
begin
SystemArr:=TJSONArray.Create;
ParentJSON.Add('System');
ParentJSON.Add('System',SystemArr);
end;
Obj:=TJSONObject.Create;
SystemArr.Add(Obj);
Obj.Add('Name',El.Name);
// Ref.Id is written in ResolvePendingElRefs
if Data is TResElDataBuiltInProc then
case TResElDataBuiltInProc(Data).BuiltIn of
bfStrFunc: Obj.Add('Type','Func');
@ -2748,7 +2855,7 @@ begin
if ExtArr=nil then
begin
ExtArr:=TJSONArray.Create;
ParentJSON.Add('External');
ParentJSON.Add('External',ExtArr);
end;
Obj:=TJSONObject.Create;
ExtArr.Add(Obj);
@ -2757,6 +2864,7 @@ begin
// ToDo
RaiseMsg(20180207115730,Ref.Element);
Ref.Obj:=Obj;
// Ref.Id is written in ResolvePendingElRefs
ResolvePendingElRefs(Ref);
end;
end;
@ -2781,13 +2889,141 @@ begin
end;
procedure TPJUWriter.WritePJU(aResolver: TPas2JSResolver;
InitFlags: TPJUInitialFlags; aStream: TStream);
InitFlags: TPJUInitialFlags; aStream: TStream; Compressed: boolean);
var
CurIndent: integer;
Spaces: string;
procedure WriteString(const s: string);
begin
if s='' then exit;
aStream.Write(s[1],length(s));
end;
procedure WriteChar(const c: char);
begin
aStream.Write(c,1);
end;
procedure WriteLn;
begin
WriteString(sLineBreak);
if CurIndent>0 then
aStream.Write(Spaces[1],CurIndent);
end;
procedure Indent;
begin
if Compressed then exit;
inc(CurIndent,2);
if CurIndent>length(Spaces) then
Spaces:=Spaces+' ';
end;
procedure Unindent;
begin
if Compressed then exit;
dec(CurIndent,2);
end;
procedure WriteData(Data: TJSONData); forward;
procedure WriteObj(Obj: TJSONObject);
var
i: Integer;
Name: String;
begin
WriteChar('{');
if not Compressed then
begin
Indent;
WriteLn;
end;
for i:=0 to Obj.Count-1 do
begin
if i>0 then
begin
WriteChar(',');
if not Compressed then
WriteLn;
end;
Name:=Obj.Names[i];
WriteChar('"');
if IsValidIdent(Name) then
WriteString(Name)
else
WriteString(StringToJSONString(Name,false));
WriteString('":');
WriteData(Obj.Elements[Name]);
end;
if not Compressed then
begin
Unindent;
WriteLn;
end;
WriteChar('}');
end;
procedure WriteArray(Arr: TJSONArray);
var
i: Integer;
begin
WriteChar('[');
if not Compressed then
begin
Indent;
WriteLn;
end;
for i:=0 to Arr.Count-1 do
begin
if i>0 then
begin
WriteChar(',');
if not Compressed then
WriteLn;
end;
WriteData(Arr[i]);
end;
if not Compressed then
begin
Unindent;
WriteLn;
end;
WriteChar(']');
end;
procedure WriteData(Data: TJSONData);
var
C: TClass;
begin
C:=Data.ClassType;
if C=TJSONObject then
WriteObj(TJSONObject(Data))
else if C=TJSONArray then
WriteArray(TJSONArray(Data))
else if C.InheritsFrom(TJSONNumber)
or (C=TJSONBoolean)
then
WriteString(Data.AsString)
else if (C=TJSONNull) then
WriteString('null')
else if C=TJSONString then
begin
WriteChar('"');
WriteString(StringToJSONString(Data.AsString));
WriteChar('"');
end
else
raise EPas2JsWriteError.Create('unknown JSON data '+GetObjName(Data));
end;
var
aJSON: TJSONObject;
begin
CurIndent:=0;
aJSON:=WriteJSON(aResolver,InitFlags);
try
aJSON.DumpJSON(aStream);
WriteObj(aJSON);
finally
aJSON.Free;
end;
@ -3114,6 +3350,14 @@ begin
RaiseMsg(20180213215959,Scope.Element,GetObjName(RefEl));
end;
procedure TPJUReader.Set_ResolvedReference_Declaration(RefEl: TPasElement;
Data: TObject);
var
Ref: TResolvedReference absolute Data;
begin
Ref.Declaration:=RefEl;
end;
procedure TPJUReader.RaiseMsg(Id: int64; const Msg: string);
var
E: EPas2JsReadError;
@ -3789,6 +4033,7 @@ var
Arr: TJSONArray;
i: Integer;
Data: TJSONData;
El: TPasElement;
begin
if not ReadArray(Obj,'Declarations',Arr,Section) then exit;
{$IFDEF VerbosePJUFiler}
@ -3799,33 +4044,9 @@ begin
Data:=Arr[i];
if not (Data is TJSONObject) then
RaiseMsg(20180207182304,Section,IntToStr(i)+' '+GetObjName(Data));
ReadDeclaration(TJSONObject(Data),Section,aContext);
end;
end;
procedure TPJUReader.ReadDeclaration(Obj: TJSONObject; Section: TPasSection;
aContext: TPJUReaderContext);
var
aType, Name: string;
El: TPasConst;
begin
if not ReadString(Obj,'Type',aType,Section) then
RaiseMsg(20180207183050,Section);
if not ReadString(Obj,'Name',Name,Section) then
RaiseMsg(20180207183415,Section);
{$IFDEF VerbosePJUFiler}
writeln('TPJUReader.ReadDeclaration ',GetObjName(Section),' Type="',aType,'" Name="',Name,'"');
{$ENDIF}
case aType of
'Const':
begin
El:=TPasConst.Create(Name,Section);
El:=ReadElement(TJSONObject(Data),Section,aContext);
Section.Declarations.Add(El);
ReadConst(Obj,TPasConst(El),aContext);
end
else
RaiseMsg(20180207183141,Section,'unknown type "'+LeftStr(aType,100)+'"');
end;
end;
end;
function TPJUReader.ReadElement(Obj: TJSONObject; Parent: TPasElement;
@ -3885,6 +4106,8 @@ begin
'Binary':
begin
Result:=TBinaryExpr.Create(Name,Parent);
TBinaryExpr(Result).Kind:=pekBinary;
TBinaryExpr(Result).OpCode:=eopAdd;
ReadBinaryExpr(Obj,TBinaryExpr(Result),aContext);
end;
'Ident': ReadPrimitive(pekIdent);
@ -3918,26 +4141,31 @@ begin
'A[]':
begin
Result:=TParamsExpr.Create(Parent,pekArrayParams);
Result.Name:='';
ReadParamsExpr(Obj,TParamsExpr(Result),aContext);
end;
'F()':
begin
Result:=TParamsExpr.Create(Parent,pekFuncParams);
Result.Name:='';
ReadParamsExpr(Obj,TParamsExpr(Result),aContext);
end;
'[]':
begin
Result:=TParamsExpr.Create(Parent,pekSet);
Result.Name:='';
ReadParamsExpr(Obj,TParamsExpr(Result),aContext);
end;
'RecValues':
begin
Result:=TRecordValues.Create(Parent);
Result.Name:='';
ReadRecordValues(Obj,TRecordValues(Result),aContext);
end;
'ArrValues':
begin
Result:=TArrayValues.Create(Parent);
Result.Name:='';
ReadArrayValues(Obj,TArrayValues(Result),aContext);
end;
'ResString':
@ -4193,6 +4421,88 @@ begin
RaiseMsg(20180207185313,El,PropName+':'+GetObjName(Data));
end;
function TPJUReader.ReadResolvedRefFlags(Obj: TJSONObject; El: TPasElement;
const PropName: string; const DefaultValue: TResolvedReferenceFlags
): TResolvedReferenceFlags;
var
Names: TStringDynArray;
Enable: TBooleanDynArray;
s: String;
f: TResolvedReferenceFlag;
i: Integer;
Found: Boolean;
Data: TJSONData;
begin
Result:=DefaultValue;
{$IFDEF VerbosePJUFiler}
writeln('TPJUReader.ReadResolvedRefFlags START');
{$ENDIF}
Data:=Obj.Find(PropName);
if Data=nil then exit;
ReadArrayFlags(Data,El,PropName,Names,Enable);
for i:=0 to length(Names)-1 do
begin
s:=Names[i];
Found:=false;
for f in TResolvedReferenceFlag do
if s=PJUResolvedReferenceFlagNames[f] then
begin
if Enable[i] then
Include(Result,f)
else
Exclude(Result,f);
Found:=true;
break;
end;
if not Found then
RaiseMsg(20180215134501,'unknown resolvedreference flag "'+s+'"');
end;
end;
procedure TPJUReader.ReadExprCustomData(Obj: TJSONObject; Expr: TPasExpr;
aContext: TPJUReaderContext);
var
Ref: TResolvedReference;
s: string;
Found, NeedEvalValue: Boolean;
a: TResolvedRefAccess;
Value: TResEvalValue;
begin
Ref:=TResolvedReference(Expr.CustomData);
if Obj.Find('RefDecl')<>nil then
begin
Ref:=TResolvedReference.Create;
Resolver.AddResolveData(Expr,Ref,lkModule);
ReadElementReference(Obj,Ref,'RefDecl',@Set_ResolvedReference_Declaration);
Ref.Flags:=ReadResolvedRefFlags(Obj,Expr,'RefFlags',[]);
Ref.Access:=rraRead;
if ReadString(Obj,'RefAccess',s,Expr) then
begin
Found:=false;
for a in TResolvedRefAccess do
if s=PJUResolvedRefAccessNames[a] then
begin
Ref.Access:=a;
Found:=true;
break;
end;
if not Found then
RaiseMsg(20180215134804,Expr,s);
end;
end;
if not ReadBoolean(Obj,'Eval',NeedEvalValue,Expr) then
NeedEvalValue:=GetDefaultExprHasEvalValue(Expr);
if NeedEvalValue then
begin
Value:=Resolver.Eval(Expr,[refAutoConst]);
if Value<>nil then
ReleaseEvalValue(Value);
end;
if aContext=nil then ;
end;
function TPJUReader.ReadExpr(Obj: TJSONObject; Parent: TPasElement;
const PropName: string; aContext: TPJUReaderContext): TPasExpr;
var
@ -4214,6 +4524,7 @@ begin
RaiseMsg(20180210152134,Parent,PropName+' got '+s);
end;
Result:=TPasExpr(El);
ReadExprCustomData(SubObj,Result,aContext);
end
else
RaiseMsg(20180207190200,Parent,PropName+':'+GetObjName(Data));
@ -4391,12 +4702,14 @@ begin
RaiseMsg(20180203100748);
end;
Resolver.RootElement:=aModule;
ReadPasElement(Obj,aModule,aContext);
// modscope
ModScope:=TPasModuleScope(Resolver.CreateScope(aModule,TPasModuleScope));
ReadModuleScope(Obj,ModScope,aContext);
ReadSystemSymbols(Obj,aModule);
// modscope
OldBoolSwitches:=aContext.BoolSwitches;
aContext.BoolSwitches:=ModScope.BoolSwitches;
try
@ -4519,8 +4832,8 @@ procedure TPJUReader.ReadBinaryExpr(Obj: TJSONObject; Expr: TBinaryExpr;
aContext: TPJUReaderContext);
begin
ReadPasExpr(Obj,Expr,false,aContext);
Expr.left:=ReadExpr(Obj,Expr,'left',aContext);
Expr.right:=ReadExpr(Obj,Expr,'right',aContext);
Expr.left:=ReadExpr(Obj,Expr,'Left',aContext);
Expr.right:=ReadExpr(Obj,Expr,'Right',aContext);
end;
procedure TPJUReader.ReadBoolConstExpr(Obj: TJSONObject; Expr: TBoolConstExpr;
@ -5251,12 +5564,12 @@ begin
while Node<>nil do
begin
Ref:=TPJUFilerElementRef(Node.Data);
{$IFDEF VerbosePJUFiler}
write('TPJUReader.ResolvePending Ref.Id=',Ref.Id,' Ref.Element=',GetObjName(Ref.Element));
{$ENDIF}
Node:=FElementRefs.FindSuccessor(Node);
if Ref.Pending<>nil then
begin
{$IFDEF VerbosePJUFiler}
writeln('TPJUReader.ResolvePending Ref.Id=',Ref.Id,' Ref.Element=',GetObjName(Ref.Element));
{$ENDIF}
if Ref.Pending.ErrorEl<>nil then
RaiseMsg(20180207194340,Ref.Pending.ErrorEl,IntToStr(Ref.Id))
else
@ -5265,6 +5578,64 @@ begin
end;
end;
procedure TPJUReader.ReadSystemSymbols(Obj: TJSONObject; ErrorEl: TPasElement);
var
Arr: TJSONArray;
Data: TJSONData;
SubObj: TJSONObject;
aName, s: string;
bt: TResolverBaseType;
El: TPasElement;
Id, i: integer;
Found: Boolean;
BuiltInProc: TResElDataBuiltInProc;
bp: TResolverBuiltInProc;
begin
if not ReadArray(Obj,'System',Arr,ErrorEl) then exit;
for i:=0 to Arr.Count-1 do
begin
Data:=Arr[i];
if not (Data is TJSONObject) then
RaiseMsg(20180215152600,ErrorEl);
SubObj:=TJSONObject(Data);
if not ReadString(SubObj,'Name',aName,ErrorEl) then
RaiseMsg(20180215153027,ErrorEl);
if not ReadInteger(SubObj,'Id',Id,ErrorEl) then
RaiseMsg(20180215153028,ErrorEl,aName);
Found:=false;
for bt in TResolverBaseType do
begin
El:=Resolver.BaseTypes[bt];
if (El<>nil) and (CompareText(El.Name,aName)=0) then
begin
AddElReference(Id,ErrorEl,El);
Found:=true;
break;
end;
end;
if not Found then
begin
for bp in TResolverBuiltInProc do
begin
BuiltInProc:=Resolver.BuiltInProcs[bp];
El:=BuiltInProc.Element;
if (El<>nil) and (CompareText(El.Name,aName)=0) then
begin
if bp in [bfStrProc,bfStrFunc] then
begin
if not ReadString(SubObj,'Type',s,ErrorEl) then
s:='Proc';
if (s='Func')<>(bp=bfStrFunc) then continue;
end;
AddElReference(Id,ErrorEl,El);
Found:=true;
break;
end;
end;
end;
end;
end;
constructor TPJUReader.Create;
begin
inherited Create;

99
packages/pastojs/tests/tcfiler.pas
View File

@ -62,7 +62,8 @@ type
procedure CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope); virtual;
procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope); virtual;
procedure CheckRestoredResolvedReference(const Path: string; Orig, Rest: TResolvedReference); virtual;
procedure CheckRestoredCustomData(const Path: string; El: TPasElement; Orig, Rest: TObject); virtual;
procedure CheckRestoredEvalValue(const Path: string; Orig, Rest: TResEvalValue); virtual;
procedure CheckRestoredCustomData(const Path: string; RestoredEl: TPasElement; Orig, Rest: TObject); virtual;
procedure CheckRestoredReference(const Path: string; Orig, Rest: TPasElement); virtual;
procedure CheckRestoredElOrRef(const Path: string; Orig, OrigProp, Rest, RestProp: TPasElement); virtual;
procedure CheckRestoredElement(const Path: string; Orig, Rest: TPasElement); virtual;
@ -117,6 +118,7 @@ type
procedure TestPC_EmptyUnit;
procedure TestPC_Const;
procedure TestPC_Var;
end;
implementation
@ -175,7 +177,7 @@ begin
try
try
PJUWriter.OnGetSrc:=@OnFilerGetSrc;
PJUWriter.WritePJU(Engine,InitialFlags,ms);
PJUWriter.WritePJU(Engine,InitialFlags,ms,false);
except
on E: Exception do
begin
@ -292,7 +294,7 @@ procedure TCustomTestPrecompile.CheckRestoredSection(const Path: string; Orig,
begin
if length(Orig.UsesClause)>0 then
; // ToDo
CheckRestoredDeclarations(Path,Rest,Orig);
CheckRestoredDeclarations(Path,Orig,Rest);
end;
procedure TCustomTestPrecompile.CheckRestoredModule(const Path: string; Orig,
@ -500,8 +502,69 @@ begin
CheckRestoredResolveData(Path,Orig,Rest);
end;
procedure TCustomTestPrecompile.CheckRestoredEvalValue(const Path: string;
Orig, Rest: TResEvalValue);
var
i: Integer;
begin
if not CheckRestoredObject(Path,Orig,Rest) then exit;
if Orig.Kind<>Rest.Kind then
Fail(Path+'.Kind');
if not CheckRestoredObject(Path+'.Element',Orig.Element,Rest.Element) then exit;
CheckRestoredReference(Path+'.IdentEl',Orig.IdentEl,Rest.IdentEl);
case Orig.Kind of
revkNone: Fail(Path+'.Kind=revkNone');
revkCustom: Fail(Path+'.Kind=revkNone');
revkNil: ;
revkBool: AssertEquals(Path+'.B',TResEvalBool(Orig).B,TResEvalBool(Rest).B);
revkInt: AssertEquals(Path+'.Int',TResEvalInt(Orig).Int,TResEvalInt(Rest).Int);
revkUInt:
if TResEvalUInt(Orig).UInt<>TResEvalUInt(Rest).UInt then
Fail(Path+'.UInt');
revkFloat: AssertEquals(Path+'.FloatValue',TResEvalFloat(Orig).FloatValue,TResEvalFloat(Rest).FloatValue);
revkString: AssertEquals(Path+'.S,Raw',TResEvalString(Orig).S,TResEvalString(Rest).S);
revkUnicodeString: AssertEquals(Path+'.S,UTF16',String(TResEvalUTF16(Orig).S),String(TResEvalUTF16(Rest).S));
revkEnum:
begin
AssertEquals(Path+'.Index',TResEvalEnum(Orig).Index,TResEvalEnum(Rest).Index);
CheckRestoredReference(Path+'.ElType',TResEvalEnum(Orig).ElType,TResEvalEnum(Rest).ElType);
end;
revkRangeInt:
begin
if TResEvalRangeInt(Orig).ElKind<>TResEvalRangeInt(Rest).ElKind then
Fail(Path+'.Int/ElKind');
CheckRestoredReference(Path+'.Int/ElType',TResEvalRangeInt(Orig).ElType,TResEvalRangeInt(Rest).ElType);
AssertEquals(Path+'.Int/RangeStart',TResEvalRangeInt(Orig).RangeStart,TResEvalRangeInt(Rest).RangeStart);
AssertEquals(Path+'.Int/RangeEnd',TResEvalRangeInt(Orig).RangeEnd,TResEvalRangeInt(Rest).RangeEnd);
end;
revkRangeUInt:
begin
if TResEvalRangeUInt(Orig).RangeStart<>TResEvalRangeUInt(Rest).RangeStart then
Fail(Path+'.UInt/RangeStart');
if TResEvalRangeUInt(Orig).RangeEnd<>TResEvalRangeUInt(Rest).RangeEnd then
Fail(Path+'.UInt/RangeEnd');
end;
revkSetOfInt:
begin
if TResEvalSet(Orig).ElKind<>TResEvalSet(Rest).ElKind then
Fail(Path+'.SetInt/ElKind');
CheckRestoredReference(Path+'.SetInt/ElType',TResEvalSet(Orig).ElType,TResEvalSet(Rest).ElType);
AssertEquals(Path+'.SetInt/RangeStart',TResEvalSet(Orig).RangeStart,TResEvalSet(Rest).RangeStart);
AssertEquals(Path+'.SetInt/RangeEnd',TResEvalSet(Orig).RangeEnd,TResEvalSet(Rest).RangeEnd);
AssertEquals(Path+'.SetInt/length(Items)',length(TResEvalSet(Orig).Ranges),length(TResEvalSet(Rest).Ranges));
for i:=0 to length(TResEvalSet(Orig).Ranges)-1 do
begin
AssertEquals(Path+'.SetInt/Items['+IntToStr(i)+'].RangeStart',
TResEvalSet(Orig).Ranges[i].RangeStart,TResEvalSet(Rest).Ranges[i].RangeStart);
AssertEquals(Path+'.SetInt/Items['+IntToStr(i)+'].RangeEnd',
TResEvalSet(Orig).Ranges[i].RangeEnd,TResEvalSet(Rest).Ranges[i].RangeEnd);
end;
end;
end;
end;
procedure TCustomTestPrecompile.CheckRestoredCustomData(const Path: string;
El: TPasElement; Orig, Rest: TObject);
RestoredEl: TPasElement; Orig, Rest: TObject);
var
C: TClass;
begin
@ -524,8 +587,10 @@ begin
CheckRestoredProcScope(Path+'[TPas2JSProcedureScope]',TPas2JSProcedureScope(Orig),TPas2JSProcedureScope(Rest))
else if C=TPasPropertyScope then
CheckRestoredPropertyScope(Path+'[TPasPropertyScope]',TPasPropertyScope(Orig),TPasPropertyScope(Rest))
else if C.InheritsFrom(TResEvalValue) then
CheckRestoredEvalValue(Path+'['+Orig.ClassName+']',TResEvalValue(Orig),TResEvalValue(Rest))
else
Fail(Path+': unknown CustomData "'+GetObjName(Orig)+'" El='+GetObjName(El));
Fail(Path+': unknown CustomData "'+GetObjName(Orig)+'" El='+GetObjName(RestoredEl));
end;
procedure TCustomTestPrecompile.CheckRestoredReference(const Path: string;
@ -558,9 +623,14 @@ procedure TCustomTestPrecompile.CheckRestoredElement(const Path: string; Orig,
Rest: TPasElement);
var
C: TClass;
AModule: TPasModule;
begin
if not CheckRestoredObject(Path,Orig,Rest) then exit;
AModule:=Orig.GetModule;
if AModule<>Module then
Fail(Path+' wrong module: Orig='+GetObjName(AModule)+' '+GetObjName(Module));
AssertEquals(Path+': Name',Orig.Name,Rest.Name);
AssertEquals(Path+': SourceFilename',Orig.SourceFilename,Rest.SourceFilename);
AssertEquals(Path+': SourceLinenumber',Orig.SourceLinenumber,Rest.SourceLinenumber);
@ -1069,7 +1139,24 @@ begin
StartUnit(false);
Add([
'interface',
'const c = 3;',
'const',
' Three = 3;',
' FourPlusFive: longint = 4+5 deprecated ''deprtext'';',
' Four: byte = 6-2*2 platform;',
'implementation']);
WriteReadUnit;
end;
procedure TTestPrecompile.TestPC_Var;
begin
StartUnit(false);
Add([
'interface',
'var',
' FourPlusFive: longint = 4+5 deprecated ''deprtext'';',
' e: double external name ''Math.e'';',
' AnoArr: array of longint = (1,2,3);',
' s: string = ''aaaäö'';',
'implementation']);
WriteReadUnit;
end;

42
packages/pastojs/tests/tcmodules.pas
View File

@ -217,6 +217,7 @@ type
Procedure TestChar_Ord;
Procedure TestChar_Chr;
Procedure TestStringConst;
Procedure TestStringConstSurrogate;
Procedure TestString_Length;
Procedure TestString_Compare;
Procedure TestString_SetLength;
@ -4801,16 +4802,18 @@ end;
procedure TTestModule.TestStringConst;
begin
StartProgram(false);
Add('var');
Add(' s: string = ''abc'';');
Add('begin');
Add(' s:='''';');
Add(' s:=#13#10;');
Add(' s:=#9''foo'';');
Add(' s:=#$A9;');
Add(' s:=''foo''#13''bar'';');
Add(' s:=''"'';');
Add(' s:=''"''''"'';');
Add([
'var',
' s: string = ''abc'';',
'begin',
' s:='''';',
' s:=#13#10;',
' s:=#9''foo'';',
' s:=#$A9;',
' s:=''foo''#13''bar'';',
' s:=''"'';',
' s:=''"''''"'';',
'']);
ConvertProgram;
CheckSource('TestStringConst',
LinesToStr([
@ -4827,6 +4830,25 @@ begin
]));
end;
procedure TTestModule.TestStringConstSurrogate;
begin
StartProgram(false);
Add([
'var',
' s: string;',
'begin',
' s:=''😊'';', // 1F60A
'']);
ConvertProgram;
CheckSource('TestStringConstSurrogate',
LinesToStr([
'this.s="";'
]),
LinesToStr([
'$mod.s="😊";'
]));
end;
procedure TTestModule.TestString_Length;
begin
StartProgram(false);