mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 15:49:26 +02:00
* Patch from Mattias Gaertner for pas2js:
jsbase: Changed TJSString from WideString to UnicodeString to use ref counting on Windows.
jsbase: Added TJSValue.CustomValue.
fppas2js: Changed context from pas to js context.
The pas context is already in the resolver values.
fppas2js: Support for type alias
fppas2js: Built in functions inc/dec for integers
git-svn-id: trunk@34851 -
This commit is contained in:
michael
parent
ff02b2dfb5
commit
8bbc792a4f
@ -25,7 +25,7 @@ uses
|
||||
Type
|
||||
TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,JSTCompletion);
|
||||
|
||||
TJSString = WideString;
|
||||
TJSString = UnicodeString;
|
||||
TJSNumber = Double;
|
||||
|
||||
{ TJSValue }
|
||||
@ -39,6 +39,7 @@ Type
|
||||
1 : (F : TJSNumber);
|
||||
2 : (I : Integer);
|
||||
end;
|
||||
FCustomValue: TJSString;
|
||||
procedure ClearValue(ANewValue: TJSType);
|
||||
function GetAsBoolean: Boolean;
|
||||
function GetAsCompletion: TObject;
|
||||
@ -64,6 +65,7 @@ Type
|
||||
Constructor Create(AString: TJSString);
|
||||
Destructor Destroy; override;
|
||||
Property ValueType : TJSType Read FValueType;
|
||||
Property CustomValue: TJSString Read FCustomValue Write FCustomValue;
|
||||
Property IsUndefined : Boolean Read GetIsUndefined Write SetIsUndefined;
|
||||
Property IsNull : Boolean Read GetIsNull Write SetIsNull;
|
||||
Property AsNumber : TJSNumber Read GetAsNumber Write SetAsNumber;
|
||||
@ -144,6 +146,7 @@ begin
|
||||
FValue.I:=0;
|
||||
end;
|
||||
FValueType:=ANewValue;
|
||||
FCustomValue:='';
|
||||
end;
|
||||
|
||||
procedure TJSValue.SetAsBoolean(const AValue: Boolean);
|
||||
@ -184,40 +187,46 @@ end;
|
||||
|
||||
procedure TJSValue.SetIsNull(const AValue: Boolean);
|
||||
begin
|
||||
ClearValue(jstNull);
|
||||
if AValue then
|
||||
ClearValue(jstNull)
|
||||
else if IsNull then
|
||||
ClearValue(jstUNDEFINED);
|
||||
end;
|
||||
|
||||
procedure TJSValue.SetIsUndefined(const AValue: Boolean);
|
||||
begin
|
||||
ClearValue(jstUndefined);
|
||||
if AValue then
|
||||
ClearValue(jstUndefined)
|
||||
else if IsUndefined then
|
||||
ClearValue(jstNull);
|
||||
end;
|
||||
|
||||
Constructor TJSValue.CreateNull;
|
||||
constructor TJSValue.CreateNull;
|
||||
begin
|
||||
IsNull:=True;
|
||||
end;
|
||||
|
||||
Constructor TJSValue.Create;
|
||||
constructor TJSValue.Create;
|
||||
begin
|
||||
IsUndefined:=True;
|
||||
end;
|
||||
|
||||
Constructor TJSValue.Create(ANumber: TJSNumber);
|
||||
constructor TJSValue.Create(ANumber: TJSNumber);
|
||||
begin
|
||||
AsNumber:=ANumber;
|
||||
end;
|
||||
|
||||
Constructor TJSValue.Create(ABoolean: Boolean);
|
||||
constructor TJSValue.Create(ABoolean: Boolean);
|
||||
begin
|
||||
AsBoolean:=ABoolean;
|
||||
end;
|
||||
|
||||
Constructor TJSValue.Create(AString: TJSString);
|
||||
constructor TJSValue.Create(AString: TJSString);
|
||||
begin
|
||||
AsString:=AString;
|
||||
end;
|
||||
|
||||
Destructor TJSValue.Destroy;
|
||||
destructor TJSValue.Destroy;
|
||||
begin
|
||||
ClearValue(jstUndefined);
|
||||
inherited Destroy;
|
||||
|
||||
@ -425,20 +425,23 @@ procedure TJSWriter.WriteValue(V: TJSValue);
|
||||
Var
|
||||
S : String;
|
||||
begin
|
||||
Case V.ValueType of
|
||||
jstUNDEFINED : S:='undefined';
|
||||
jstNull : s:='null';
|
||||
jstBoolean : if V.AsBoolean then s:='true' else s:='false';
|
||||
jstString : S:='"'+EscapeString(V.AsString)+'"';
|
||||
jstNumber :
|
||||
if Frac(V.AsNumber)=0 then // this needs to be improved
|
||||
Str(Round(V.AsNumber),S)
|
||||
else
|
||||
Str(V.AsNumber,S);
|
||||
jstObject : ;
|
||||
jstReference : ;
|
||||
JSTCompletion : ;
|
||||
end;
|
||||
if V.CustomValue<>'' then
|
||||
S:=V.CustomValue
|
||||
else
|
||||
Case V.ValueType of
|
||||
jstUNDEFINED : S:='undefined';
|
||||
jstNull : s:='null';
|
||||
jstBoolean : if V.AsBoolean then s:='true' else s:='false';
|
||||
jstString : S:='"'+EscapeString(V.AsString)+'"';
|
||||
jstNumber :
|
||||
if Frac(V.AsNumber)=0 then // this needs to be improved
|
||||
Str(Round(V.AsNumber),S)
|
||||
else
|
||||
Str(V.AsNumber,S);
|
||||
jstObject : ;
|
||||
jstReference : ;
|
||||
JSTCompletion : ;
|
||||
end;
|
||||
Write(S);
|
||||
end;
|
||||
|
||||
|
||||
@ -91,10 +91,10 @@
|
||||
- arrays TPasArrayType
|
||||
- check if var initexpr fits vartype: var a: type = expr;
|
||||
- built-in functions high, low for range type and arrays
|
||||
|
||||
ToDo:
|
||||
- procedure type
|
||||
- method type
|
||||
|
||||
ToDo:
|
||||
- char constant #0, #10, #13, UTF-8 char
|
||||
- const TArrayValues
|
||||
- classes - TPasClassType
|
||||
@ -370,6 +370,7 @@ const
|
||||
|
||||
type
|
||||
TResolverBuiltInProc = (
|
||||
bfCustom,
|
||||
bfLength,
|
||||
bfSetLength,
|
||||
bfInclude,
|
||||
@ -385,6 +386,7 @@ type
|
||||
TResolverBuiltInProcs = set of TResolverBuiltInProc;
|
||||
const
|
||||
ResolverBuiltInProcNames: array[TResolverBuiltInProc] of shortstring = (
|
||||
'Custom',
|
||||
'Length',
|
||||
'SetLength',
|
||||
'Include',
|
||||
@ -397,7 +399,7 @@ const
|
||||
'Low',
|
||||
'High'
|
||||
);
|
||||
bfAllStandardProcs = [low(TResolverBuiltInProc)..high(TResolverBuiltInProc)];
|
||||
bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
|
||||
|
||||
const
|
||||
ResolverResultVar = 'Result';
|
||||
@ -766,12 +768,13 @@ type
|
||||
TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
|
||||
out ResolvedEl: TPasResolverResult) of object;
|
||||
|
||||
{ TResElDataBuiltInProc - CustomData for compiler built-in procs like 'length' }
|
||||
{ TResElDataBuiltInProc - TPasUnresolvedSymbolRef(aType).CustomData for compiler built-in procs like 'length' }
|
||||
|
||||
TResElDataBuiltInProc = Class(TResElDataBuiltInSymbol)
|
||||
public
|
||||
Proc: TPasUnresolvedSymbolRef;
|
||||
Signature: string;
|
||||
BuiltIn: TResolverBuiltInProc;
|
||||
GetCallCompatibility: TOnGetCallCompatibility;
|
||||
GetCallResult: TOnGetCallResult;
|
||||
end;
|
||||
@ -982,7 +985,8 @@ type
|
||||
function IsBaseType(aType: TPasType; BaseType: TResolverBaseType): boolean;
|
||||
function AddBuiltInProc(aName: shortstring; Signature: string;
|
||||
const GetCallCompatibility: TOnGetCallCompatibility;
|
||||
const GetCallResult: TOnGetCallResult): TResElDataBuiltInProc;
|
||||
const GetCallResult: TOnGetCallResult;
|
||||
BuiltIn: TResolverBuiltInProc = bfCustom): TResElDataBuiltInProc;
|
||||
// add extra TResolveData (E.CustomData) to free list
|
||||
procedure AddResolveData(El: TPasElement; Data: TResolveData;
|
||||
Kind: TResolveDataListKind);
|
||||
@ -6214,37 +6218,37 @@ begin
|
||||
AddBaseType(BaseTypeNames[bt],bt);
|
||||
if bfLength in BaseProcs then
|
||||
AddBuiltInProc('Length','function Length(const String or Array): sizeint',
|
||||
@OnGetCallCompatibility_Length,@OnGetCallResult_Length);
|
||||
@OnGetCallCompatibility_Length,@OnGetCallResult_Length,bfLength);
|
||||
if bfSetLength in BaseProcs then
|
||||
AddBuiltInProc('SetLength','procedure SetLength(var String or Array; NewLength: sizeint)',
|
||||
@OnGetCallCompatibility_SetLength,nil);
|
||||
@OnGetCallCompatibility_SetLength,nil,bfSetLength);
|
||||
if bfInclude in BaseProcs then
|
||||
AddBuiltInProc('Include','procedure Include(var Set of Enum; const Enum)',
|
||||
@OnGetCallCompatibility_InExclude,nil);
|
||||
@OnGetCallCompatibility_InExclude,nil,bfInclude);
|
||||
if bfExclude in BaseProcs then
|
||||
AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
|
||||
@OnGetCallCompatibility_InExclude,nil);
|
||||
@OnGetCallCompatibility_InExclude,nil,bfExclude);
|
||||
if bfOrd in BaseProcs then
|
||||
AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
|
||||
@OnGetCallCompatibility_Ord,@OnGetCallResult_Ord);
|
||||
@OnGetCallCompatibility_Ord,@OnGetCallResult_Ord,bfOrd);
|
||||
if bfExit in BaseProcs then
|
||||
AddBuiltInProc('Exit','procedure Exit(result)',
|
||||
@OnGetCallCompatibility_Exit,nil);
|
||||
@OnGetCallCompatibility_Exit,nil,bfExit);
|
||||
if bfInc in BaseProcs then
|
||||
AddBuiltInProc('Inc','procedure Inc(var Integer; const Incr: Integer = 1)',
|
||||
@OnGetCallCompatibility_IncDec,nil);
|
||||
@OnGetCallCompatibility_IncDec,nil,bfInc);
|
||||
if bfDec in BaseProcs then
|
||||
AddBuiltInProc('Dec','procedure Dec(var Integer; const Decr: Integer = 1)',
|
||||
@OnGetCallCompatibility_IncDec,nil);
|
||||
@OnGetCallCompatibility_IncDec,nil,bfDec);
|
||||
if bfAssigned in BaseProcs then
|
||||
AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
|
||||
@OnGetCallCompatibility_Assigned,@OnGetCallResult_Assigned);
|
||||
@OnGetCallCompatibility_Assigned,@OnGetCallResult_Assigned,bfAssigned);
|
||||
if bfLow in BaseProcs then
|
||||
AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh);
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfLow);
|
||||
if bfHigh in BaseProcs then
|
||||
AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh);
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfHigh);
|
||||
end;
|
||||
|
||||
function TPasResolver.AddBaseType(aName: shortstring; Typ: TResolverBaseType
|
||||
@ -6272,7 +6276,8 @@ end;
|
||||
|
||||
function TPasResolver.AddBuiltInProc(aName: shortstring; Signature: string;
|
||||
const GetCallCompatibility: TOnGetCallCompatibility;
|
||||
const GetCallResult: TOnGetCallResult): TResElDataBuiltInProc;
|
||||
const GetCallResult: TOnGetCallResult; BuiltIn: TResolverBuiltInProc
|
||||
): TResElDataBuiltInProc;
|
||||
var
|
||||
El: TPasUnresolvedSymbolRef;
|
||||
begin
|
||||
@ -6280,6 +6285,7 @@ begin
|
||||
Result:=TResElDataBuiltInProc.Create;
|
||||
Result.Proc:=El;
|
||||
Result.Signature:=Signature;
|
||||
Result.BuiltIn:=BuiltIn;
|
||||
Result.GetCallCompatibility:=GetCallCompatibility;
|
||||
Result.GetCallResult:=GetCallResult;
|
||||
AddResolveData(El,Result,lkBuiltIn);
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -611,7 +611,7 @@ begin
|
||||
AssertNull('No second statement',L.B);
|
||||
L:=AssertListStatement('try..except block is statement list',El.BCatch);
|
||||
AssertAssignStatement('Correct assignment in except..end block',L.A,'b','c');
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),El.Ident);
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
|
||||
AssertNull('No second statement',L.B);
|
||||
end;
|
||||
|
||||
@ -648,7 +648,7 @@ begin
|
||||
O.Body:=CreateAssignStatement('b','c');
|
||||
// Convert
|
||||
El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),EL.Ident);
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
|
||||
L:=AssertListStatement('try..except block is statement list',El.BCatch);
|
||||
AssertNull('No second statement',L.B);
|
||||
I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
|
||||
@ -696,7 +696,7 @@ begin
|
||||
O.Body:=TPasImplRaise.Create('',Nil);
|
||||
// Convert
|
||||
El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),EL.Ident);
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
|
||||
L:=AssertListStatement('try..except block is statement list',El.BCatch);
|
||||
AssertNull('No second statement',L.B);
|
||||
I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
|
||||
@ -782,7 +782,7 @@ begin
|
||||
S:=TPrimitiveExpr.Create(Nil,pekString,'''me''');
|
||||
E:=TestLiteralExpression(S,TJSLiteral);
|
||||
AssertEquals('Correct literal type',jstString,E.Value.ValueType);
|
||||
AssertEquals('Correct literal value','me',E.Value.AsString);
|
||||
AssertEquals('Correct literal value','me',String(E.Value.AsString));
|
||||
end;
|
||||
|
||||
Procedure TTestExpressionConverter.TestPrimitiveNumber;
|
||||
@ -843,7 +843,7 @@ Var
|
||||
begin
|
||||
Id:=TPrimitiveExpr.Create(Nil,pekIdent,'a');
|
||||
Res:=TJSPrimaryExpressionIdent(Convert(Id,TJSPrimaryExpressionIdent));
|
||||
AssertEquals('Correct identifier name','a',Res.Name);
|
||||
AssertEquals('Correct identifier name','a',String(Res.Name));
|
||||
end;
|
||||
|
||||
Procedure TTestExpressionConverter.TestUnaryMinus;
|
||||
@ -1203,7 +1203,7 @@ begin
|
||||
Uni:=TJSUnary(AssertElement('Sl.A is TJSUnary',TJSUnary,Sl.A));
|
||||
Asi:=TJSSimpleAssignStatement(AssertElement('Sl.A is TJSUnary',TJSSimpleAssignStatement,Uni.A));
|
||||
pex:=TJSPrimaryExpressionIdent(AssertElement('Asi.LHS is TJSPrimaryExpressionIdent',TJSPrimaryExpressionIdent,Asi.LHS));
|
||||
AssertEquals('Correct name','myclass',pex.Name);
|
||||
AssertEquals('Correct name','myclass',String(pex.Name));
|
||||
Call:=TJSCallExpression(AssertElement('Asi.Expr is TJSCallExpression',TJSCallExpression,Asi.Expr));
|
||||
if Call=nil then ;
|
||||
end;
|
||||
@ -1264,7 +1264,7 @@ end;
|
||||
Class procedure TTestConverter.AssertLiteral(Const Msg : String; Lit: TJSElement; AValue: TJSString);
|
||||
begin
|
||||
AssertLiteral(Msg,Lit,jstString);
|
||||
AssertEquals(Msg+': Correct value',AValue,TJSLiteral(Lit).Value.AsString);
|
||||
AssertEquals(Msg+': Correct value',String(AValue),String(TJSLiteral(Lit).Value.AsString));
|
||||
end;
|
||||
|
||||
Class procedure TTestConverter.AssertLiteral(Const Msg : String; Lit: TJSElement; AValue: TJSNumber);
|
||||
@ -1278,12 +1278,12 @@ Class procedure TTestConverter.AssertIdentifier(Const Msg: String;
|
||||
begin
|
||||
AssertNotNull(Msg+': Have instance',Ident);
|
||||
AssertEquals(Msg+': Correct class',TJSPrimaryExpressionIdent,Ident.ClassType);
|
||||
AssertEquals(Msg+': Correct name',AName,TJSPrimaryExpressionIdent(Ident).Name);
|
||||
AssertEquals(Msg+': Correct name',AName,String(TJSPrimaryExpressionIdent(Ident).Name));
|
||||
end;
|
||||
|
||||
Class Function TTestConverter.CreateLiteral(AValue: String): TPasExpr;
|
||||
begin
|
||||
Result:=TPrimitiveExpr.Create(Nil,pekString,'me');
|
||||
Result:=TPrimitiveExpr.Create(Nil,pekString,AValue);
|
||||
end;
|
||||
|
||||
Class Function TTestConverter.CreateLiteral(AValue: Double): TPasExpr;
|
||||
@ -1293,7 +1293,7 @@ Var
|
||||
|
||||
begin
|
||||
Str(AValue,S);
|
||||
Result:=TPrimitiveExpr.Create(Nil,pekNumber,S);
|
||||
Result:=TPrimitiveExpr.Create(Nil,pekNumber,Trim(S));
|
||||
end;
|
||||
|
||||
Class Function TTestConverter.CreateIdent(AName: String): TPrimitiveExpr;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user