Browse Source

# revisions: 40806,40807,40808,40809,40819,40846,40847,40859,40869,40870,40871,40872,40881,40882,40886

git-svn-id: branches/fixes_3_2@41994 -
marco 6 years ago
parent
commit
5611e2f10b

+ 4 - 1
packages/fcl-passrc/src/pasresolveeval.pas

@@ -176,7 +176,8 @@ const
   nCantAssignValuesToConstVariable = 3110;
   nIllegalAssignmentToForLoopVar = 3111;
   nFunctionHidesIdentifier_NonProc = 3112;
-  // Note: use one of the free IDs above
+  nTypeXCannotBeExtendedByATypeHelper = 3113;
+  nDerivedXMustExtendASubClassY = 3114;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -300,6 +301,8 @@ resourcestring
   sMissingFieldsX = 'Missing fields: "%s"';
   sCantAssignValuesToConstVariable = 'Can''t assign values to const variable';
   sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
+  sTypeXCannotBeExtendedByATypeHelper = 'Type "%s" cannot be extended by a type helper';
+  sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

File diff suppressed because it is too large
+ 558 - 376
packages/fcl-passrc/src/pasresolver.pp


+ 4 - 3
packages/fcl-passrc/src/pastree.pp

@@ -203,7 +203,7 @@ type
                  eopEqual, eopNotEqual,  // Logical
                  eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual, // ordering
                  eopIn,eopIs,eopAs, eopSymmetricaldifference, // Specials
-                 eopAddress, eopDeref, eopMemAddress, // Pointers
+                 eopAddress, eopDeref, eopMemAddress, // Pointers  eopMemAddress=**
                  eopSubIdent); // SomeRec.A, A is subIdent of SomeRec
 
   { TPasExpr }
@@ -736,7 +736,8 @@ type
   end;
 
   TPasObjKind = (
-    okObject, okClass, okInterface, okGeneric,
+    okObject, okClass, okInterface,
+    okGeneric, // MG: what is okGeneric?
     // okSpecialize removed in FPC 3.1.1
     okClassHelper,okRecordHelper,okTypeHelper,
     okDispInterface);
@@ -761,7 +762,7 @@ type
     ObjKind: TPasObjKind;
     AncestorType: TPasType;   // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
                               // Note: AncestorType can be nil even though it has a default ancestor
-    HelperForType: TPasType;  // TPasClassType or TPasUnresolvedTypeRef
+    HelperForType: TPasType;  // any type, except helper
     IsForward: Boolean;
     IsExternal : Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end

+ 135 - 108
packages/fcl-passrc/src/pparser.pp

@@ -72,7 +72,7 @@ const
   nParserNotAProcToken = 2026;
   nRangeExpressionExpected = 2027;
   nParserExpectCase = 2028;
-  nParserHelperNotAllowed = 2029;
+  // free 2029;
   nLogStartImplementation = 2030;
   nLogStartInterface = 2031;
   nParserNoConstructorAllowed = 2032;
@@ -132,11 +132,11 @@ resourcestring
   SParserNotAProcToken = 'Not a procedure or function token';
   SRangeExpressionExpected = 'Range expression expected';
   SParserExpectCase = 'Case label expression expected';
-  SParserHelperNotAllowed = 'Helper objects not allowed for "%s"';
+  // free for 2029
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartInterface = 'Start parsing interface section';
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
-  SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
+  SParserNoFieldsAllowedInX = 'Fields are not allowed in %s';
   SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
   SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
   SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
@@ -341,8 +341,6 @@ type
     function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TBinaryExpr; overload;
     procedure AddToBinaryExprChain(var ChainFirst: TPasExpr;
       Element: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos);
-    procedure AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
-      Params: TParamsExpr);
     {$IFDEF VerbosePasParser}
     procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
     {$ENDIF}
@@ -1255,6 +1253,7 @@ begin
         if not (PM in [pmOverload, pmMessage,
                         pmDispId,pmNoReturn,pmFar,pmFinal]) then exit(false);
       end;
+      exit;
       end
     else if Parent is TPasRecordType then
       begin
@@ -1262,6 +1261,7 @@ begin
                      pmInline, pmAssembler,
                      pmExternal,
                      pmNoReturn, pmFar, pmFinal]) then exit(false);
+      exit;
       end;
     Parent:=Parent.Parent;
     end;
@@ -1741,12 +1741,40 @@ begin
       tkInterface:
         Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
       tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
-      tkClass: Result := ParseClassDecl(Parent, NamePos, TypeName, okClass, PM, GenericArgs);
-      tkType:
+      tkClass:
         begin
+        isHelper:=false;
         NextToken;
-        isHelper:=CurTokenIsIdentifier('helper');
-        UnGetToken;
+        if CurTokenIsIdentifier('Helper') then
+          begin
+          // class helper: atype end;
+          // class helper for atype end;
+          NextToken;
+          isHelper:=CurToken in [tkfor,tkBraceOpen];
+          UnGetToken;
+          end;
+        UngetToken;
+        if isHelper then
+          Result:=ParseClassDecl(Parent,NamePos,TypeName,okClassHelper,PM, GenericArgs)
+        else
+          Result:=ParseClassDecl(Parent, NamePos, TypeName, okClass, PM, GenericArgs);
+        end;
+      tkType:
+        begin
+        isHelper:=false;
+        if msTypeHelpers in Scanner.CurrentModeSwitches then
+          begin
+          NextToken;
+          if CurTokenIsIdentifier('helper') then
+            begin
+            // atype = type helper;
+            // atype = type helper for atype end;
+            NextToken;
+            isHelper:=CurToken in [tkfor,tkBraceOpen];
+            UnGetToken;
+            end;
+          UnGetToken;
+          end;
         if isHelper then
           Result:=ParseClassDecl(Parent,NamePos,TypeName,okTypeHelper,PM)
         else
@@ -1775,16 +1803,20 @@ begin
       tkRecord:
         begin
         NextToken;
+        isHelper:=false;
         if CurTokenIsIdentifier('Helper') then
           begin
+          // record helper: atype end;
+          // record helper for atype end;
+          NextToken;
+          isHelper:=CurToken in [tkfor,tkBraceOpen];
           UnGetToken;
-          Result:=ParseClassDecl(Parent,NamePos,TypeName,okRecordHelper,PM);
-          end
-        else
-          begin
-          UnGetToken;
-          Result := ParseRecordDecl(Parent,NamePos,TypeName,PM);
           end;
+        UngetToken;
+        if isHelper then
+          Result:=ParseClassDecl(Parent,NamePos,TypeName,okRecordHelper,PM)
+        else
+          Result:=ParseRecordDecl(Parent,NamePos,TypeName,PM);
         end;
       tkNumber,tkMinus,tkChar:
         begin
@@ -2329,9 +2361,9 @@ begin
         if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
           begin
           aName:=aName+'.'+CurTokenString;
-          expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
-          AddToBinaryExprChain(Result,expr,eopSubIdent,ScrPos);
-          Func:=expr;
+          Expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
+          AddToBinaryExprChain(Result,Expr,eopSubIdent,ScrPos);
+          Func:=Expr;
           NextToken;
           end
         else
@@ -2347,14 +2379,18 @@ begin
         else
           Params:=ParseParams(AParent,pekArrayParams);
         if not Assigned(Params) then Exit;
-        AddParamsToBinaryExprChain(Result,Params);
+        Params.Value:=Result;
+        Result.Parent:=Params;
+        Result:=Params;
         CanSpecialize:=false;
+        Func:=nil;
         end;
       tkCaret:
         begin
         Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
         NextToken;
         CanSpecialize:=false;
+        Func:=nil;
         end;
       tkLessThan:
         begin
@@ -2376,6 +2412,7 @@ begin
           CanSpecialize:=false;
           NextToken;
           end;
+        Func:=nil;
         end
       else
         break;
@@ -2542,26 +2579,40 @@ begin
             CheckToken(tkBraceClose);
             end;
           NextToken;
-          // for expressions like (ppdouble)^^;
-          while (CurToken=tkCaret) do
-            begin
-            x:=CreateUnaryExpr(AParent,x, TokenToExprOp(tkCaret));
-            NextToken;
-            end;
-          // for expressions like (PChar(a)+10)[0];
-          if (CurToken=tkSquaredBraceOpen) then
-            begin
-            ArrParams:=ParseParams(AParent,pekArrayParams,False);
-            ArrParams.Value:=x;
-            x.Parent:=ArrParams;
-            x:=ArrParams;
-            end;
-          // for expressions like (TObject(m)).Free;
-          if (CurToken=tkDot) then
-            begin
-            NextToken;
-            x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
+          repeat
+            case CurToken of
+            tkCaret:
+              begin
+              // for expressions like (ppdouble)^^;
+              x:=CreateUnaryExpr(AParent,x, TokenToExprOp(tkCaret));
+              NextToken;
+              end;
+            tkBraceOpen:
+              begin
+              // for expressions like (a+b)(0);
+              ArrParams:=ParseParams(AParent,pekFuncParams,False);
+              ArrParams.Value:=x;
+              x.Parent:=ArrParams;
+              x:=ArrParams;
+              end;
+            tkSquaredBraceOpen:
+              begin
+              // for expressions like (PChar(a)+10)[0];
+              ArrParams:=ParseParams(AParent,pekArrayParams,False);
+              ArrParams.Value:=x;
+              x.Parent:=ArrParams;
+              x:=ArrParams;
+              end;
+            tkDot:
+              begin
+              // for expressions like (TObject(m)).Free;
+              NextToken;
+              x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
+              end
+            else
+              break;
             end;
+          until false;
           end
         else
           begin
@@ -5202,7 +5253,9 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
       Result := Result + '[';
       Params:=TParamsExpr(CreateElement(TParamsExpr,'',aParent));
       Params.Kind:=pekArrayParams;
-      AddParamsToBinaryExprChain(Expr,Params);
+      Params.Value:=Expr;
+      Expr.Parent:=Params;
+      Expr:=Params;
       NextToken;
       case CurToken of
         tkChar:             Param:=CreatePrimitiveExpr(aParent,pekString, CurTokenText);
@@ -6652,6 +6705,7 @@ begin
   LastToken:=CurToken;
   while (CurToken<>tkEnd) do
     begin
+    //writeln('TPasParser.ParseClassMembers LastToken=',LastToken,' CurToken=',CurToken,' haveClass=',haveClass,' CurSection=',CurSection);
     case CurToken of
       tkType:
         begin
@@ -6677,18 +6731,18 @@ begin
         CurSection:=stConst;
         end;
       tkVar:
-        begin
-        case AType.ObjKind of
-        okClass,okObject,okGeneric,
-        okClassHelper,okRecordHelper,okTypeHelper: ;
-        else
-          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
-        end;
-        if LastToken=tkClass then
-          CurSection:=stClassVar
-        else
-          CurSection:=stVar;
-        end;
+        if not (CurSection in [stVar,stClassVar]) then
+          begin
+          if (AType.ObjKind in [okClass,okObject,okGeneric])
+          or (haveClass and (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper])) then
+            // ok
+          else
+            ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
+          if LastToken=tkClass then
+            CurSection:=stClassVar
+          else
+            CurSection:=stVar;
+          end;
       tkIdentifier:
         if CheckVisibility(CurtokenString,CurVisibility) then
           CurSection:=stNone
@@ -6702,11 +6756,17 @@ begin
           stConst :
             ParseMembersLocalConsts(AType,CurVisibility);
           stNone,
-          stVar,
+          stVar:
+            begin
+            if not (AType.ObjKind in [okObject,okClass,okGeneric]) then
+              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
+            ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
+            HaveClass:=False;
+            end;
           stClassVar:
             begin
-            if (AType.ObjKind in [okInterface,okDispInterface]) then
-              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowed);
+            if not (AType.ObjKind in [okObject,okClass,okGeneric,okClassHelper,okRecordHelper,okTypeHelper]) then
+              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
             ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
             HaveClass:=False;
             end;
@@ -6719,7 +6779,11 @@ begin
         curSection:=stNone;
         if not haveClass then
           SaveComments;
-        if AType.ObjKind in [okInterface,okDispInterface,okRecordHelper] then
+        if (AType.ObjKind in [okObject,okClass,okGeneric])
+            or ((CurToken=tkconstructor)
+              and (AType.ObjKind in [okClassHelper,okTypeHelper,okRecordHelper])) then
+          // ok
+        else
           ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
         ProcessMethod(AType,HaveClass,CurVisibility);
         haveClass:=False;
@@ -6810,18 +6874,23 @@ begin
   if (CurToken=tkBraceOpen) then
     begin
     // read ancestor and interfaces
+    if (AType.ObjKind=okRecordHelper)
+        and ([msTypeHelpers,msDelphi]*Scanner.CurrentModeSwitches=[msDelphi]) then
+      // Delphi does not support ancestors in record helpers
+      CheckToken(tkend);
     NextToken;
     AType.AncestorType := ParseTypeReference(AType,false,Expr);
-    while CurToken=tkComma do
-      begin
-      NextToken;
-      AType.Interfaces.Add(ParseTypeReference(AType,false,Expr));
-      end;
+    if AType.ObjKind in [okClass,okGeneric] then
+      while CurToken=tkComma do
+        begin
+        NextToken;
+        AType.Interfaces.Add(ParseTypeReference(AType,false,Expr));
+        end;
     CheckToken(tkBraceClose);
     NextToken;
     AType.IsShortDefinition:=(CurToken=tkSemicolon);
     end;
-  if (AType.ObjKind in [okClassHelper,okRecordHelper]) then
+  if (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper]) then
     begin
     CheckToken(tkfor);
     NextToken;
@@ -6850,12 +6919,10 @@ function TPasParser.ParseClassDecl(Parent: TPasElement;
 
 Var
   ok: Boolean;
-  FT : TPasType;
   AExternalNameSpace,AExternalName : String;
   PCT:TPasClassType;
 begin
   NextToken;
-  FT:=Nil;
   if (AObjKind = okClass) and (CurToken = tkOf) then
     begin
     Result := TPasClassOfType(CreateElement(TPasClassOfType, AClassName,
@@ -6873,7 +6940,7 @@ begin
     end;
     exit;
     end;
-  if ((AObjKind in [okClass,OKInterface]) and (msExternalClass in CurrentModeswitches)
+  if ((AObjKind in [okClass,okInterface]) and (msExternalClass in CurrentModeswitches)
       and CurTokenIsIdentifier('external')) then
     begin
     NextToken;
@@ -6895,19 +6962,10 @@ begin
     AExternalNameSpace:='';
     AExternalName:='';
     end;
-  if (CurTokenIsIdentifier('Helper')) then
+  if AObjKind in [okClassHelper,okRecordHelper,okTypeHelper] then
     begin
-    if Not (AObjKind in [okClass,okTypeHelper,okRecordHelper]) then
-      ParseExc(nParserHelperNotAllowed,SParserHelperNotAllowed,[ObjKindNames[AObjKind]]);
-    Case AObjKind of
-     okClass:
-       AObjKind:=okClassHelper;
-     okTypeHelper:
-       begin
-       ExpectToken(tkFor);
-       FT:=ParseType(Parent,CurSourcePos,'',False);
-       end
-    end;
+    if not CurTokenIsIdentifier('Helper') then
+      ParseExcSyntaxError;
     NextToken;
     end;
   PCT := TPasClassType(CreateElement(TPasClassType, AClassName,
@@ -6915,7 +6973,7 @@ begin
   Result:=PCT;
   ok:=false;
   try
-    PCT.HelperForType:=FT;
+    PCT.HelperForType:=nil;
     PCT.IsExternal:=(AExternalName<>'');
     if AExternalName<>'' then
       PCT.ExternalName:={$ifdef pas2js}DeQuoteString{$else}AnsiDequotedStr{$endif}(AExternalName,'''');
@@ -7029,37 +7087,6 @@ begin
     end;
 end;
 
-procedure TPasParser.AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
-  Params: TParamsExpr);
-// append Params to chain, using the last(right) element as Params.Value
-var
-  Bin: TBinaryExpr;
-begin
-  if Params.Value<>nil then
-    ParseExcSyntaxError;
-  if ChainFirst=nil then
-    ParseExcSyntaxError;
-  if ChainFirst is TBinaryExpr then
-    begin
-    Bin:=TBinaryExpr(ChainFirst);
-    if Bin.left=nil then
-      ParseExcSyntaxError;
-    if Bin.right=nil then
-      ParseExcSyntaxError;
-    Params.Value:=Bin.right;
-    Params.Value.Parent:=Params;
-    Bin.right:=Params;
-    Params.Parent:=Bin;
-    end
-  else
-    begin
-    Params.Value:=ChainFirst;
-    Params.Parent:=ChainFirst.Parent;
-    ChainFirst.Parent:=Params;
-    ChainFirst:=Params;
-    end;
-end;
-
 {$IFDEF VerbosePasParser}
 {AllowWriteln}
 procedure TPasParser.WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr

+ 121 - 14
packages/fcl-passrc/tests/tcexprparser.pas

@@ -96,14 +96,19 @@ type
     Procedure TestBinaryLessThanEqual;
     Procedure TestBinaryLargerThan;
     Procedure TestBinaryLargerThanEqual;
-    procedure TestBinaryFullIdent;
+    procedure TestBinarySubIdent;
     Procedure TestArrayElement;
-    Procedure TestArrayElementrecord;
+    Procedure TestArrayElementRecord;
     Procedure TestArrayElement2Dims;
     Procedure TestFunctionCall;
     Procedure TestFunctionCall2args;
     Procedure TestFunctionCallNoArgs;
-    Procedure ParseStrWithFormatFullyQualified;
+    Procedure TestSubIdentStrWithFormat;
+    Procedure TestAPlusCallB;
+    Procedure TestAPlusBBracketFuncParams;
+    Procedure TestAPlusBBracketArrayParams;
+    Procedure TestAPlusBBracketDotC;
+    Procedure TestADotBDotC;
     Procedure TestRange;
     Procedure TestBracketsTotal;
     Procedure TestBracketsLeft;
@@ -257,7 +262,7 @@ begin
   AssertExpression('Simple identifier',theExpr,pekIdent,'b');
 end;
 
-procedure TTestExpressions.TestBinaryFullIdent;
+procedure TTestExpressions.TestBinarySubIdent;
 begin
   DeclareVar('integer','a');
   DeclareVar('record x,y : integer; end','b');
@@ -282,7 +287,7 @@ begin
   AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
 end;
 
-procedure TTestExpressions.TestArrayElementrecord;
+procedure TTestExpressions.TestArrayElementRecord;
 
 Var
   P : TParamsExpr;
@@ -290,14 +295,15 @@ Var
 begin
   DeclareVar('record a : array[1..2] of integer; end ','b');
   ParseExpression('b.a[1]');
-  B:=AssertExpression('Binary of record',TheExpr,pekBinary,TBinaryExpr) as TBinaryExpr;
-  AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
-  AssertExpression('Name of array',B.Left,pekIdent,'b');
-  P:=TParamsExpr(AssertExpression('Simple identifier',B.right,pekArrayParams,TParamsExpr));
-  AssertExpression('Name of array',P.Value,pekIdent,'a');
+  P:=TParamsExpr(AssertExpression('Array Param',TheExpr,pekArrayParams,TParamsExpr));
   TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
   AssertEquals('One dimension',1,Length(P.params));
   AssertExpression('Simple identifier',P.params[0],pekNumber,'1');
+
+  B:=TBinaryExpr(AssertExpression('Binary of record',P.Value,pekBinary,TBinaryExpr));
+  AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
+  AssertExpression('Name of array',B.Left,pekIdent,'b');
+  AssertExpression('Name of array',B.right,pekIdent,'a');
   TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
   TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;
@@ -1124,7 +1130,7 @@ begin
   AssertNotNull('Have left',AOperand);
 end;
 
-Procedure TTestExpressions.ParseStrWithFormatFullyQualified;
+procedure TTestExpressions.TestSubIdentStrWithFormat;
 
 Var
   P : TParamsExpr;
@@ -1134,12 +1140,113 @@ begin
   DeclareVar('string','a');
   DeclareVar('integer','i');
   ParseExpression('system.str(i:0:3,a)');
-  B:=TBinaryExpr(AssertExpression('Binary identifier',theExpr,pekBinary,TBinaryExpr));
-  P:=TParamsExpr(AssertExpression('Simple identifier',B.Right,pekFuncParams,TParamsExpr));
-  AssertExpression('Name of function',P.Value,pekIdent,'str');
+  P:=TParamsExpr(AssertExpression('Params',TheExpr,pekFuncParams,TParamsExpr));
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
   AssertEquals('2 argument',2,Length(p.params));
   AssertExpression('Simple identifier',p.params[0],pekIdent,'i');
   AssertExpression('Simple identifier',p.params[1],pekIdent,'a');
+  TAssert.AssertSame('P.params[0].parent=P',P,P.params[0].Parent);
+  TAssert.AssertSame('P.params[1].parent=P',P,P.params[1].Parent);
+  B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  AssertExpression('Name of unit',B.left,pekIdent,'system');
+  AssertExpression('Name of function',B.right,pekIdent,'str');
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+end;
+
+procedure TTestExpressions.TestAPlusCallB;
+var
+  B: TBinaryExpr;
+  P: TParamsExpr;
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','b');
+  ParseExpression('a+b(1)');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
+  AssertExpression('left a',B.left,pekIdent,'a');
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  P:=TParamsExpr(AssertExpression('Params',B.right,pekFuncParams,TParamsExpr));
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
+  AssertEquals('1 argument',1,Length(p.params));
+  AssertExpression('param 1',p.params[0],pekNumber,'1');
+end;
+
+procedure TTestExpressions.TestAPlusBBracketFuncParams;
+var
+  P: TParamsExpr;
+  B: TBinaryExpr;
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','b');
+  ParseExpression('(a+b)(1)');
+  P:=TParamsExpr(AssertExpression('Params',TheExpr,pekFuncParams,TParamsExpr));
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
+  AssertEquals('1 argument',1,Length(p.params));
+  AssertExpression('param 1',p.params[0],pekNumber,'1');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertExpression('left a',B.left,pekIdent,'a');
+  AssertExpression('right b',B.right,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestAPlusBBracketArrayParams;
+var
+  B: TBinaryExpr;
+  P: TParamsExpr;
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','b');
+  ParseExpression('(a+b)[1]');
+  P:=TParamsExpr(AssertExpression('Params',TheExpr,pekArrayParams,TParamsExpr));
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
+  AssertEquals('1 argument',1,Length(p.params));
+  AssertExpression('param 1',p.params[0],pekNumber,'1');
+
+  B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertExpression('left a',B.left,pekIdent,'a');
+  AssertExpression('right b',B.right,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestAPlusBBracketDotC;
+var
+  B, PlusB: TBinaryExpr;
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','b');
+  ParseExpression('(a+b).c');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
+  AssertEquals('().',eopSubIdent,B.OpCode);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertExpression('right c',B.right,pekIdent,'c');
+
+  PlusB:=TBinaryExpr(AssertExpression('Binary identifier',B.left,pekBinary,TBinaryExpr));
+  TAssert.AssertSame('PlusB.left.parent=PlusB',PlusB,PlusB.left.Parent);
+  TAssert.AssertSame('PlusB.right.parent=PlusB',PlusB,PlusB.right.Parent);
+  AssertExpression('left a',PlusB.left,pekIdent,'a');
+  AssertExpression('right b',PlusB.right,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestADotBDotC;
+var
+  B, SubB: TBinaryExpr;
+begin
+  ParseExpression('a.b.c');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
+  AssertEquals('dot expr',eopSubIdent,B.OpCode);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertExpression('right c',B.right,pekIdent,'c');
+
+  SubB:=TBinaryExpr(AssertExpression('Binary identifier',B.left,pekBinary,TBinaryExpr));
+  TAssert.AssertSame('PlusB.left.parent=PlusB',SubB,SubB.left.Parent);
+  TAssert.AssertSame('PlusB.right.parent=PlusB',SubB,SubB.right.Parent);
+  AssertExpression('left a',SubB.left,pekIdent,'a');
+  AssertExpression('right b',SubB.right,pekIdent,'b');
 end;
 
 initialization

+ 223 - 64
packages/fcl-passrc/tests/tcresolver.pas

@@ -347,7 +347,6 @@ type
     Procedure TestForLoopStartIncompFail;
     Procedure TestForLoopEndIncompFail;
     Procedure TestSimpleStatement_VarFail;
-    Procedure TestRecord_Default;
 
     // units
     Procedure TestUnitForwardOverloads;
@@ -483,6 +482,7 @@ type
     Procedure TestRecord_Const_UntypedFail;
     Procedure TestRecord_Const_NestedRecord;
     Procedure TestRecord_Const_Variant;
+    Procedure TestRecord_Default;
     Procedure TestRecord_VarExternal;
     Procedure TestRecord_VarSelfFail;
 
@@ -585,7 +585,6 @@ type
     Procedure TestClass_StrictPrivateInMainBeginFail;
     Procedure TestClass_StrictProtectedInMainBeginFail;
     Procedure TestClass_Constructor_NewInstance;
-    Procedure TestClass_Constructor_InstanceCallResultFail;
     Procedure TestClass_Destructor_FreeInstance;
     Procedure TestClass_ConDestructor_CallInherited;
     Procedure TestClass_Constructor_Inherited;
@@ -861,6 +860,16 @@ type
     Procedure TestHint_ElementHints_WarnOff_SymbolDeprecated;
     Procedure TestHint_Garbage;
 
+    // helpers
+    Procedure ClassHelper;
+    Procedure ClassHelper_AncestorIsNotHelperForDescendantFail;
+    Procedure ClassHelper_ForInterfaceFail;
+    Procedure ClassHelper_FieldFail;
+    Procedure ClassHelper_AbstractFail;
+    Procedure ClassHelper_VirtualObjFPCFail;
+    Procedure RecordHelper;
+    Procedure TypeHelper;
+
     // attributes
     Procedure TestAttributes_Ignore;
   end;
@@ -5241,23 +5250,6 @@ begin
   CheckResolverException('Illegal expression',nIllegalExpression);
 end;
 
-procedure TTestResolver.TestRecord_Default;
-begin
-  StartProgram(false);
-  Add([
-  'type',
-  '  TPoint = record x, y: longint; end;',
-  'var',
-  '  i: longint;',
-  '  r: TPoint;',
-  'begin',
-  '  i:=Default(longint);',
-  '  r:=Default(r);',
-  '  r:=Default(TPoint);',
-  '']);
-  ParseProgram;
-end;
-
 procedure TTestResolver.TestUnitForwardOverloads;
 begin
   StartUnit(false);
@@ -7802,6 +7794,23 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestRecord_Default;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TPoint = record x, y: longint; end;',
+  'var',
+  '  i: longint;',
+  '  r: TPoint;',
+  'begin',
+  '  i:=Default(longint);',
+  '  r:=Default(r);',
+  '  r:=Default(TPoint);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestRecord_VarExternal;
 begin
   StartProgram(false);
@@ -8019,6 +8028,7 @@ begin
   '  TRec.{#p}Create(4); // new object',
   '  r:=TRec.{#q}Create(5); // new object',
   '  r.{#r}Create(6); // normal call',
+  '  r:=r.{#s}Create(7); // normal call',
   '']);
   ParseProgram;
   aMarker:=FirstSrcMarker;
@@ -8043,7 +8053,7 @@ begin
         break;
         end;
       case aMarker^.Identifier of
-      'a','r':// should be normal call
+      'a','r','s':// should be normal call
         if ActualNewInstance then
           RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
       else // should be newinstance
@@ -10040,7 +10050,9 @@ begin
   'begin',
   '  TObject.{#p}Create; // new object',
   '  o:=TObject.{#q}Create; // new object',
-  '  o.{#r}Create; // normal call']);
+  '  o.{#r}Create; // normal call',
+  '  o:=o.{#s}Create; // normal call',
+  '']);
   ParseProgram;
   aMarker:=FirstSrcMarker;
   while aMarker<>nil do
@@ -10066,7 +10078,7 @@ begin
       if not ActualImplicitCallWithoutParams then
         RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+', but got function ref"',aMarker);
       case aMarker^.Identifier of
-      'a','r':// should be normal call
+      'a','r','s':// should be normal call
         if ActualNewInstance then
           RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
       else // should be newinstance
@@ -10080,24 +10092,6 @@ begin
     end;
 end;
 
-procedure TTestResolver.TestClass_Constructor_InstanceCallResultFail;
-begin
-  StartProgram(false);
-  Add('type');
-  Add('  TObject = class');
-  Add('    constructor Create;');
-  Add('  end;');
-  Add('constructor TObject.Create;');
-  Add('begin');
-  Add('end;');
-  Add('var');
-  Add('  o: TObject;');
-  Add('begin');
-  Add('  o:=o.Create; // normal call has no result -> fail');
-  CheckResolverException('Incompatible types: got "Procedure/Function" expected "TObject"',
-    nIncompatibleTypesGotExpected);
-end;
-
 procedure TTestResolver.TestClass_Destructor_FreeInstance;
 var
   aMarker: PSrcMarker;
@@ -12164,7 +12158,7 @@ begin
   '    i: longint;',
   '  end;',
   'begin']);
-  CheckParserException(SParserNoFieldsAllowed,nParserNoFieldsAllowed);
+  CheckParserException('Fields are not allowed in interface',nParserNoFieldsAllowed);
 end;
 
 procedure TTestResolver.TestClassInterfaceConstFail;
@@ -12265,7 +12259,7 @@ begin
   '    procedure DoIt; virtual;',
   '  end;',
   'begin']);
-  CheckParserException(sParserNoFieldsAllowed,nParserNoFieldsAllowed);
+  CheckParserException('Fields are not allowed in interface',nParserNoFieldsAllowed);
 end;
 
 procedure TTestResolver.TestClassInterface_Overloads;
@@ -14853,28 +14847,37 @@ end;
 procedure TTestResolver.TestProcType_Property;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class end;');
-  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
-  Add('  TControl = class');
-  Add('    FOnClick: TNotifyEvent;');
-  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
-  Add('    procedure Click(Sender: TObject);');
-  Add('  end;');
-  Add('procedure TControl.Click(Sender: TObject);');
-  Add('begin');
-  Add('  if Assigned(OnClick) then ;');
-  Add('  OnClick:=@Click;');
-  Add('  OnClick(Sender);');
-  Add('  Self.OnClick(Sender);');
-  Add('  with Self do OnClick(Sender);');
-  Add('end;');
-  Add('var Btn: TControl;');
-  Add('begin');
-  Add('  if Assigned(Btn.OnClick) then ;');
-  Add('  Btn.OnClick(Btn);');
-  Add('  Btn.OnClick(Btn);');
-  Add('  with Btn do OnClick(Btn);');
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TNotifyEvent = procedure(Sender: TObject) of object;',
+  '  TControl = class',
+  '    FOnClick: TNotifyEvent;',
+  '    property OnClick: TNotifyEvent read FOnClick write FOnClick;',
+  '    procedure Click(Sender: TObject);',
+  '  end;',
+  '  TButton = class(TControl)',
+  '    property OnClick;',
+  '  end;',
+  'procedure TControl.Click(Sender: TObject);',
+  'begin',
+  '  if Assigned(OnClick) then ;',
+  '  OnClick:=@Click;',
+  '  OnClick(Sender);',
+  '  Self.OnClick(Sender);',
+  '  with Self do OnClick(Sender);',
+  'end;',
+  'var',
+  '  Ctrl: TControl;',
+  '  Btn: TButton;',
+  'begin',
+  '  if Assigned(Ctrl.OnClick) then ;',
+  '  Ctrl.OnClick(Ctrl);',
+  '  with Ctrl do OnClick(Ctrl);',
+  '  if Assigned(Btn.OnClick) then ;',
+  '  Btn.OnClick(Btn);',
+  '  with Btn do OnClick(Btn);',
+  '']);
   ParseProgram;
 end;
 
@@ -15493,6 +15496,162 @@ begin
   CheckResolverUnexpectedHints(true);
 end;
 
+procedure TTestResolver.ClassHelper;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjectHelper = class helper for TObject',
+  '  type T = word;',
+  '  const',
+  '    c: T = 3;',
+  '    k: T = 4;',
+  '  class var',
+  '    v: T;',
+  '    w: T;',
+  '  end;',
+  '  TBird = class(TObject)',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '  end;',
+  '  TExtObjHelper = class helper(TObjectHelper) for TBird',
+  '  end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.ClassHelper_AncestorIsNotHelperForDescendantFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird = class(TObject)',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '  end;',
+  '  TFish = class(TObject)',
+  '  end;',
+  '  THelper = class helper(TBirdHelper) for TFish',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Derived class helper must extend a subclass of "TBird" or the class itself',
+    nDerivedXMustExtendASubClassY);
+end;
+
+procedure TTestResolver.ClassHelper_ForInterfaceFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  IUnknown = interface',
+  '    procedure DoIt;',
+  '  end;',
+  '  TBirdHelper = class helper for IUnknown',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('class type expected, but IUnknown found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolver.ClassHelper_FieldFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    F: word;',
+  '  end;',
+  'begin',
+  '']);
+  CheckParserException('Fields are not allowed in class helper',
+    nParserNoFieldsAllowed);
+end;
+
+procedure TTestResolver.ClassHelper_AbstractFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    procedure DoIt; virtual; abstract;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Invalid class helper procedure modifier abstract',
+    nInvalidXModifierY);
+end;
+
+procedure TTestResolver.ClassHelper_VirtualObjFPCFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    procedure DoIt; virtual;',
+  '  end;',
+  'procedure TObjHelper.DoIt;',
+  'begin end;',
+  'begin',
+  '']);
+  CheckResolverException('Invalid class helper procedure modifier virtual',
+    nInvalidXModifierY);
+end;
+
+procedure TTestResolver.RecordHelper;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TRec = record',
+  '  end;',
+  '  TRecHelper = record helper for TRec',
+  '  type T = word;',
+  '  const',
+  '    c: T = 3;',
+  '    k: T = 4;',
+  '  class var',
+  '    v: T;',
+  '    w: T;',
+  '  end;',
+  '  TAnt = word;',
+  '  TAntHelper = record helper for TAnt',
+  '  end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TypeHelper;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TStringHelper = type helper for string',
+  '  end;',
+  '  TCaption = string;',
+  '  TCapHelper = type helper(TStringHelper) for TCaption',
+  '  end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestAttributes_Ignore;
 begin
   StartProgram(false);

+ 8 - 0
packages/fcl-passrc/tests/tctypeparser.pas

@@ -165,6 +165,7 @@ type
     Procedure TestReferencePointer;
     Procedure TestInvalidColon;
     Procedure TestTypeHelper;
+    Procedure TestTypeHelperWithParent;
     procedure TestPointerReference;
     Procedure TestPointerKeyWord;
   end;
@@ -3562,9 +3563,16 @@ end;
 
 procedure TTestTypeParser.TestTypeHelper;
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msTypeHelpers];
   ParseType('Type Helper for AnsiString end',TPasClassType,'');
 end;
 
+procedure TTestTypeParser.TestTypeHelperWithParent;
+begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msTypeHelpers];
+  ParseType('Type Helper(TOtherHelper) for AnsiString end',TPasClassType,'');
+end;
+
 procedure TTestTypeParser.TestPointerReference;
 begin
   Add('Type');

+ 9 - 2
packages/fcl-web/examples/httpclient/httpget.pas

@@ -1,9 +1,16 @@
 program httpget;
 
 {$mode objfpc}{$H+}
+{$DEFINE USEGNUTLS}
 
 uses
-  SysUtils, Classes, fphttpclient, sslsockets, fpopenssl, opensslsockets;
+  SysUtils, Classes, fphttpclient,
+{$IFNDEF USEGNUTLS}
+  fpopenssl, opensslsockets,
+{$else}
+  gnutls, gnutlssockets,
+{$endif}
+  sslsockets;
 
 Type
 
@@ -82,7 +89,7 @@ procedure TTestApp.Run;
 begin
   if (ParamCount<>2) then
     begin
-    writeln('Usage : ',ExtractFileName(ParamStr(0)), 'URL filename');
+    writeln('Usage : ',ExtractFileName(ParamStr(0)), ' URL filename');
     Halt(1);
     end;
   With TFPHTTPClient.Create(Nil) do

+ 9 - 1
packages/fcl-web/examples/simpleserver/simpleserver.pas

@@ -1,8 +1,16 @@
 {$mode objfpc}
 {$h+}
+{ $define USEGNUTLS}
 program simpleserver;
 
-uses sysutils, custhttpapp, fpwebfile, sslbase, opensslsockets;
+uses
+  sysutils,
+{$ifdef USEGNUTLS}
+  gnutlssockets,
+{$else}
+  opensslsockets,
+{$endif}
+  sslbase,custhttpapp, fpwebfile;
 
 Type
 

+ 178 - 178
packages/openssl/src/openssl.pas

@@ -42,7 +42,7 @@ unit openssl;
 |==============================================================================|
 | FreePascal basic cleanup (original worked too): Ales Katona                  |
 | WARNING: due to reliance on some units, I have removed the ThreadLocks init  |
-|          if need be, it should be re-added, or handled by the                | 
+|          if need be, it should be re-added, or handled by the                |
 |           OS threading init somehow                                          |
 |                                                                              |
 | 2010 - Felipe Monteiro de Carvalho - Added RAND functios                     |
@@ -105,7 +105,7 @@ var
    {$ELSE OS2}
   DLLSSLName: string = 'libssl';
   DLLUtilName: string = 'libcrypto';
-  
+
   { ADD NEW ONES WHEN THEY APPEAR!
     Always make .so/dylib first, then versions, in descending order!
     Add "." .before the version, first is always just "" }
@@ -134,7 +134,7 @@ type
   PSSL_METHOD = SslPtr;
 {  PX509 = SslPtr;}
 {  PX509_NAME = SslPtr;}
-  PEVP_MD	= SslPtr;
+  PEVP_MD = SslPtr;
   PBIO_METHOD = SslPtr;
   PBIO = SslPtr;
 {  EVP_PKEY = SslPtr;}
@@ -155,20 +155,20 @@ type
   PDN = ^X509_NAME;
 
   ASN1_STRING = record
-	length: integer;
-	asn1_type: integer;
-	data: pointer;
-	flags: longint;
+  length: integer;
+  asn1_type: integer;
+  data: pointer;
+  flags: longint;
   end;
   PASN1_STRING = ^ASN1_STRING;
   PASN1_TIME = PASN1_STRING;
 
   X509_VAL = record
-	notBefore: PASN1_TIME;
+  notBefore: PASN1_TIME;
     notAfter: PASN1_TIME;
   end;
   PX509_VAL = ^X509_VAL;
-  
+
   X509_CINF = record
     version: pointer;
     serialNumber: pointer;
@@ -182,7 +182,7 @@ type
     extensions: pointer;
   end;
   PX509_CINF = ^X509_CINF;
-  
+
   CRYPTO_EX_DATA = record
     sk: pointer;
     dummy: integer;
@@ -208,26 +208,26 @@ type
   end;
   pX509 = ^X509;
   PPX509 = ^PX509;
-  
+
   DSA = record
-	pad: integer;
-	version: integer;
-	write_params: integer;
-	p: pointer;
-	q: pointer;
-	g: pointer;
-	pub_key: pointer;
-	priv_key: pointer;
-	kinv: pointer;
-	r: pointer;
-	flags: integer;
-	method_mont_p: PChar;
-	references: integer;
-	ex_data: record
+  pad: integer;
+  version: integer;
+  write_params: integer;
+  p: pointer;
+  q: pointer;
+  g: pointer;
+  pub_key: pointer;
+  priv_key: pointer;
+  kinv: pointer;
+  r: pointer;
+  flags: integer;
+  method_mont_p: PChar;
+  references: integer;
+  ex_data: record
       sk: pointer;
       dummy: integer;
     end;
-	meth: pointer;
+  meth: pointer;
   end;
   pDSA = ^DSA;
 
@@ -238,7 +238,7 @@ type
       2: (dsa: pDSA);
       3: (dh: pDH);
    end;
-  
+
   EVP_PKEY = record
     ktype: integer;
     save_type: integer;
@@ -249,7 +249,7 @@ type
   end;
   PEVP_PKEY = ^EVP_PKEY;
   PPEVP_PKEY = ^PEVP_PKEY;
-  
+
   PPRSA = ^PRSA;
   PASN1_cInt = SslPtr;
   PPasswdCb = SslPtr;
@@ -403,14 +403,14 @@ type
     key_len: cint;  //* Default value for variable length ciphers */
     iv_len: cint;
     flags: culong; //* Various flags */
-    init: EVP_CIPHER_INIT_FUNC;	//* init key */
+    init: EVP_CIPHER_INIT_FUNC; //* init key */
     do_cipher: EVP_CIPHER_DO_CIPHER_FUNC;//* encrypt/decrypt data */
     cleanup: EVP_CIPHER_CLEANUP_FUNC; //* cleanup ctx */
-    ctx_size: cint;		//* how big ctx->cipher_data needs to be */
+    ctx_size: cint;   //* how big ctx->cipher_data needs to be */
     set_asn1_parameters: EVP_CIPHER_SET_ASN1_PARAMETERS_FUNC; //* Populate a ASN1_TYPE with parameters */
     get_asn1_parameters: EVP_CIPHER_GET_ASN1_PARAMETERS_FUNC; //* Get parameters from a ASN1_TYPE */
     ctrl: EVP_CIPHER_CTRL_FUNC; //* Miscellaneous operations */
-    app_data: Pointer;	//* Application data */
+    app_data: Pointer;  //* Application data */
   end;
   PEVP_CIPHER = ^EVP_CIPHER;
 
@@ -427,7 +427,7 @@ type
 
     app_data: Pointer;   //* application stuff */
     key_len: cint;    //* May change for variable length cipher */
-    flags: culong;	//* Various flags */
+    flags: culong;  //* Various flags */
     cipher_data: Pointer; //* per EVP data */
     final_used: cint;
     block_mask: cint;
@@ -685,12 +685,12 @@ const
   SSL_CTRL_SET_CHANNEL_ID                     = 119;
 
 
-  DTLS_CTRL_GET_TIMEOUT	           = 73;
+  DTLS_CTRL_GET_TIMEOUT            = 73;
   DTLS_CTRL_HANDLE_TIMEOUT         = 74;
-  DTLS_CTRL_LISTEN		   = 75;
-  SSL_CTRL_GET_RI_SUPPORT	   = 76;
-  SSL_CTRL_CLEAR_OPTIONS	   = 77;
-  SSL_CTRL_CLEAR_MODE		   = 78;
+  DTLS_CTRL_LISTEN       = 75;
+  SSL_CTRL_GET_RI_SUPPORT    = 76;
+  SSL_CTRL_CLEAR_OPTIONS     = 77;
+  SSL_CTRL_CLEAR_MODE      = 78;
 
   TLSEXT_TYPE_server_name = 0;
   TLSEXT_TYPE_max_fragment_length = 1;
@@ -788,7 +788,7 @@ const
   OPENSSL_DES_DECRYPT = 0;
   OPENSSL_DES_ENCRYPT = 1;
 
-  X509_V_OK =	0;
+  X509_V_OK = 0;
   X509_V_ILLEGAL = 1;
   X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2;
   X509_V_ERR_UNABLE_TO_GET_CRL = 3;
@@ -827,7 +827,7 @@ const
   //The application is not happy
   X509_V_ERR_APPLICATION_VERIFICATION = 50;
 
-  SSL_FILETYPE_ASN1	= 2;
+  SSL_FILETYPE_ASN1 = 2;
   SSL_FILETYPE_PEM = 1;
   EVP_PKEY_RSA = 6;
 
@@ -891,73 +891,73 @@ const
 
   // BIO
 
-  BIO_NOCLOSE	        = $00;
-  BIO_CLOSE 	        = $01;
+  BIO_NOCLOSE         = $00;
+  BIO_CLOSE           = $01;
 
   //* modifiers */
-  BIO_FP_READ		= $02;
-  BIO_FP_WRITE		= $04;
-  BIO_FP_APPEND		= $08;
-  BIO_FP_TEXT		= $10;
+  BIO_FP_READ   = $02;
+  BIO_FP_WRITE    = $04;
+  BIO_FP_APPEND   = $08;
+  BIO_FP_TEXT   = $10;
 
   BIO_C_SET_CONNECT                 = 100;
   BIO_C_DO_STATE_MACHINE            = 101;
-  BIO_C_SET_NBIO	            = 102;
-  BIO_C_SET_PROXY_PARAM	            = 103;
-  BIO_C_SET_FD	                    = 104;
-  BIO_C_GET_FD		            = 105;
-  BIO_C_SET_FILE_PTR	            = 106;
-  BIO_C_GET_FILE_PTR	            = 107;
-  BIO_C_SET_FILENAME	            = 108;
-  BIO_C_SET_SSL		            = 109;
-  BIO_C_GET_SSL		            = 110;
-  BIO_C_SET_MD		            = 111;
-  BIO_C_GET_MD	                    = 112;
+  BIO_C_SET_NBIO              = 102;
+  BIO_C_SET_PROXY_PARAM             = 103;
+  BIO_C_SET_FD                      = 104;
+  BIO_C_GET_FD                = 105;
+  BIO_C_SET_FILE_PTR              = 106;
+  BIO_C_GET_FILE_PTR              = 107;
+  BIO_C_SET_FILENAME              = 108;
+  BIO_C_SET_SSL               = 109;
+  BIO_C_GET_SSL               = 110;
+  BIO_C_SET_MD                = 111;
+  BIO_C_GET_MD                      = 112;
   BIO_C_GET_CIPHER_STATUS           = 113;
-  BIO_C_SET_BUF_MEM 	            = 114;
-  BIO_C_GET_BUF_MEM_PTR  	    = 115;
+  BIO_C_SET_BUF_MEM               = 114;
+  BIO_C_GET_BUF_MEM_PTR       = 115;
   BIO_C_GET_BUFF_NUM_LINES          = 116;
-  BIO_C_SET_BUFF_SIZE	            = 117;
-  BIO_C_SET_ACCEPT 	            = 118;
-  BIO_C_SSL_MODE 	            = 119;
-  BIO_C_GET_MD_CTX	            = 120;
-  BIO_C_GET_PROXY_PARAM	            = 121;
-  BIO_C_SET_BUFF_READ_DATA 	    = 122; // data to read first */
-  BIO_C_GET_CONNECT	 	    = 123;
-  BIO_C_GET_ACCEPT		    = 124;
+  BIO_C_SET_BUFF_SIZE             = 117;
+  BIO_C_SET_ACCEPT              = 118;
+  BIO_C_SSL_MODE              = 119;
+  BIO_C_GET_MD_CTX              = 120;
+  BIO_C_GET_PROXY_PARAM             = 121;
+  BIO_C_SET_BUFF_READ_DATA      = 122; // data to read first */
+  BIO_C_GET_CONNECT       = 123;
+  BIO_C_GET_ACCEPT        = 124;
   BIO_C_SET_SSL_RENEGOTIATE_BYTES   = 125;
   BIO_C_GET_SSL_NUM_RENEGOTIATES    = 126;
   BIO_C_SET_SSL_RENEGOTIATE_TIMEOUT = 127;
-  BIO_C_FILE_SEEK		    = 128;
-  BIO_C_GET_CIPHER_CTX		    = 129;
-  BIO_C_SET_BUF_MEM_EOF_RETURN	= 130;//*return end of input value*/
-  BIO_C_SET_BIND_MODE		= 131;
-  BIO_C_GET_BIND_MODE		= 132;
-  BIO_C_FILE_TELL		= 133;
-  BIO_C_GET_SOCKS		= 134;
-  BIO_C_SET_SOCKS		= 135;
-
-  BIO_C_SET_WRITE_BUF_SIZE	= 136;//* for BIO_s_bio */
-  BIO_C_GET_WRITE_BUF_SIZE	= 137;
-  BIO_C_MAKE_BIO_PAIR		= 138;
-  BIO_C_DESTROY_BIO_PAIR	= 139;
-  BIO_C_GET_WRITE_GUARANTEE	= 140;
-  BIO_C_GET_READ_REQUEST	= 141;
-  BIO_C_SHUTDOWN_WR		= 142;
-  BIO_C_NREAD0		        = 143;
-  BIO_C_NREAD			= 144;
-  BIO_C_NWRITE0			= 145;
-  BIO_C_NWRITE			= 146;
-  BIO_C_RESET_READ_REQUEST	= 147;
-  BIO_C_SET_MD_CTX		= 148;
-
-  BIO_C_SET_PREFIX		= 149;
-  BIO_C_GET_PREFIX		= 150;
-  BIO_C_SET_SUFFIX		= 151;
-  BIO_C_GET_SUFFIX		= 152;
-
-  BIO_C_SET_EX_ARG		= 153;
-  BIO_C_GET_EX_ARG		= 154;
+  BIO_C_FILE_SEEK       = 128;
+  BIO_C_GET_CIPHER_CTX        = 129;
+  BIO_C_SET_BUF_MEM_EOF_RETURN  = 130;//*return end of input value*/
+  BIO_C_SET_BIND_MODE   = 131;
+  BIO_C_GET_BIND_MODE   = 132;
+  BIO_C_FILE_TELL   = 133;
+  BIO_C_GET_SOCKS   = 134;
+  BIO_C_SET_SOCKS   = 135;
+
+  BIO_C_SET_WRITE_BUF_SIZE  = 136;//* for BIO_s_bio */
+  BIO_C_GET_WRITE_BUF_SIZE  = 137;
+  BIO_C_MAKE_BIO_PAIR   = 138;
+  BIO_C_DESTROY_BIO_PAIR  = 139;
+  BIO_C_GET_WRITE_GUARANTEE = 140;
+  BIO_C_GET_READ_REQUEST  = 141;
+  BIO_C_SHUTDOWN_WR   = 142;
+  BIO_C_NREAD0            = 143;
+  BIO_C_NREAD     = 144;
+  BIO_C_NWRITE0     = 145;
+  BIO_C_NWRITE      = 146;
+  BIO_C_RESET_READ_REQUEST  = 147;
+  BIO_C_SET_MD_CTX    = 148;
+
+  BIO_C_SET_PREFIX    = 149;
+  BIO_C_GET_PREFIX    = 150;
+  BIO_C_SET_SUFFIX    = 151;
+  BIO_C_GET_SUFFIX    = 152;
+
+  BIO_C_SET_EX_ARG    = 153;
+  BIO_C_GET_EX_ARG    = 154;
 
   BIO_CTRL_RESET  =    1  ; { opt - rewind/zero etc }
   BIO_CTRL_EOF    =    2  ; { opt - are we at the eof }
@@ -1032,7 +1032,7 @@ var
   function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
   procedure SslCtxFree(arg0: PSSL_CTX);
   function SslSetFd(s: PSSL; fd: cInt):cInt;
-  
+
   function SslCtrl(ssl: PSSL; cmd: cInt; larg: clong; parg: Pointer): cLong;
   function SslCTXCtrl(ctx: PSSL_CTX; cmd: cInt; larg: clong; parg: Pointer): cLong;
 
@@ -1040,7 +1040,7 @@ var
   function SSLSetMode(s: PSSL; mode: cLong): cLong;
   function SSLCTXGetMode(ctx: PSSL_CTX): cLong;
   function SSLGetMode(s: PSSL): cLong;
-  
+
   function SslMethodV2:PSSL_METHOD;
   function SslMethodV3:PSSL_METHOD;
   function SslMethodTLSV1:PSSL_METHOD;
@@ -1273,12 +1273,12 @@ var
   // PEM Functions - pem.h
   //
   function PEM_read_bio_PrivateKey(bp: PBIO; X: PPEVP_PKEY;
-           cb: Ppem_password_cb; u: Pointer): PEVP_PKEY;  	   
+           cb: Ppem_password_cb; u: Pointer): PEVP_PKEY;
   function PEM_read_bio_PUBKEY(bp: pBIO; var x: pEVP_PKEY;
                cb: Ppem_password_cb; u: pointer): pEVP_PKEY;
   function PEM_write_bio_PrivateKey(bp: pBIO; x: pEVP_PKEY;
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
-               u: pointer): integer;	
+               u: pointer): integer;
   function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer;
   function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
   function PEM_write_bio_X509(bp: pBIO;  x: px509): integer;
@@ -1294,7 +1294,7 @@ var
   function BioWrite(b: PBIO; Buf: TBytes; Len: cInt): cInt; overload;
   function BIO_ctrl(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong;
   function BIO_read_filename(b: PBIO; const name: PChar): cint;
-  
+
   function BIO_s_file: pBIO_METHOD;
   function BIO_new_file(const filename: PChar; const mode: PChar): pBIO;
   function BIO_new_mem_buf(buf: pointer; len: integer): pBIO;
@@ -1681,7 +1681,7 @@ type
   TEVP_DigestInit = function(ctx: PEVP_MD_CTX; type_: PEVP_MD): cint; cdecl;
   TEVP_DigestUpdate = function(ctx: PEVP_MD_CTX; const data: Pointer; cnt: csize_t): cint; cdecl;
   TEVP_DigestFinal = function(ctx: PEVP_MD_CTX; md: PByte; s: pcuint): cint; cdecl;
-  
+
   TEVP_SignFinal = function(ctx: pEVP_MD_CTX; sig: pointer; var s: cardinal;
     key: pEVP_PKEY): integer; cdecl;
   TEVP_PKEY_size = function(key: pEVP_PKEY): integer; cdecl;
@@ -1719,12 +1719,12 @@ type
 
   TPEM_read_bio_PrivateKey = function(bp: PBIO; X: PPEVP_PKEY;
            cb: Ppem_password_cb; u: Pointer): PEVP_PKEY; cdecl;
-   
+
   TPEM_read_bio_PUBKEY = function(bp: pBIO; var x: pEVP_PKEY;
                cb: Ppem_password_cb; u: pointer): pEVP_PKEY; cdecl;
   TPEM_write_bio_PrivateKey = function(bp: pBIO; x: pEVP_PKEY;
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
-               u: pointer): integer; cdecl;	
+               u: pointer): integer; cdecl;
   TPEM_write_bio_PUBKEY = function(bp: pBIO; x: pEVP_PKEY): integer; cdecl;
   TPEM_read_bio_X509 = function(bp: pBIO; x: PPX509; cb: Ppem_password_cb; u: pointer): px509; cdecl;
   TPEM_write_bio_X509 = function(bp: pBIO; x: PX509): integer; cdecl;
@@ -1733,7 +1733,7 @@ type
   // BIO Functions
 
   TBIO_ctrl = function(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong; cdecl;
-  
+
   TBIO_s_file = function: pBIO_METHOD; cdecl;
   TBIO_new_file = function(const filename: PChar; const mode: PChar): pBIO; cdecl;
   TBIO_new_mem_buf = function(buf: pointer; len: integer): pBIO; cdecl;
@@ -1857,7 +1857,7 @@ var
 
   // 3DES functions
   _DESsetoddparity: TDESsetoddparity = nil;
-  _DESsetkey	   : TDESsetkey = nil;
+  _DESsetkey     : TDESsetkey = nil;
   _DESsetkeychecked: TDESsetkeychecked = nil;
   _DESecbencrypt: TDESecbencrypt = nil;
   //thread lock functions
@@ -1958,9 +1958,9 @@ var
   _EVP_DigestVerifyFinal: TEVP_DigestVerifyFinal = nil;
   // PEM
   _PEM_read_bio_PrivateKey: TPEM_read_bio_PrivateKey = nil;
-  	   
-  _PEM_read_bio_PUBKEY: TPEM_read_bio_PUBKEY = nil; 
-  _PEM_write_bio_PrivateKey: TPEM_write_bio_PrivateKey = nil;	
+
+  _PEM_read_bio_PUBKEY: TPEM_read_bio_PUBKEY = nil;
+  _PEM_write_bio_PrivateKey: TPEM_write_bio_PrivateKey = nil;
   _PEM_write_bio_PUBKEY: TPEM_write_bio_PUBKEY = nil;
   _PEM_read_bio_X509: TPEM_read_bio_X509 = nil;
   _PEM_write_bio_X509: TPEM_write_bio_X509 = nil;
@@ -1968,7 +1968,7 @@ var
   // BIO Functions
 
   _BIO_ctrl: TBIO_ctrl = nil;
-  
+
   _BIO_s_file: TBIO_s_file = nil;
   _BIO_new_file: TBIO_new_file = nil;
   _BIO_new_mem_buf: TBIO_new_mem_buf = nil;
@@ -1987,68 +1987,68 @@ var
   PKCS7_ATTR_SIGN_it : ASN1_ITEM;cvar;external;
   PKCS7_ATTR_VERIFY_it : ASN1_ITEM;cvar;external;
 }
-  _PKCS7_ISSUER_AND_SERIAL_new : function: PPKCS7_ISSUER_AND_SERIAL;
-  _PKCS7_ISSUER_AND_SERIAL_free : procedure(a:PPKCS7_ISSUER_AND_SERIAL);
-  _PKCS7_ISSUER_AND_SERIAL_digest : function(data:PPKCS7_ISSUER_AND_SERIAL; _type:PEVP_MD; md:Pbyte; len:Pdword):longint;
-  _PKCS7_dup : function(p7:PPKCS7):PPKCS7;
-  _PEM_write_bio_PKCS7_stream : function(_out:PBIO; p7:PPKCS7; _in:PBIO; flags:longint):longint;
-  _PKCS7_SIGNER_INFO_new : function:PPKCS7_SIGNER_INFO;
-  _PKCS7_SIGNER_INFO_free : procedure(a:PPKCS7_SIGNER_INFO);
-  _PKCS7_RECIP_INFO_new : function:PPKCS7_RECIP_INFO;
-  _PKCS7_RECIP_INFO_free : procedure(a:PPKCS7_RECIP_INFO);
-  _PKCS7_SIGNED_new : function:PPKCS7_SIGNED;
-  _PKCS7_SIGNED_free : procedure(a:PPKCS7_SIGNED);
-  _PKCS7_ENC_CONTENT_new : function:PPKCS7_ENC_CONTENT;
-  _PKCS7_ENC_CONTENT_free : procedure(a:PPKCS7_ENC_CONTENT);
-  _PKCS7_ENVELOPE_new : function:PPKCS7_ENVELOPE;
-  _PKCS7_ENVELOPE_free : procedure(a:PPKCS7_ENVELOPE);
-  _PKCS7_SIGN_ENVELOPE_new : function:PPKCS7_SIGN_ENVELOPE;
-  _PKCS7_SIGN_ENVELOPE_free : procedure(a:PPKCS7_SIGN_ENVELOPE);
-  _PKCS7_DIGEST_new : function:PPKCS7_DIGEST;
-  _PKCS7_DIGEST_free : procedure(a:PPKCS7_DIGEST);
-  _PKCS7_ENCRYPT_new : function:PPKCS7_ENCRYPT;
-  _PKCS7_ENCRYPT_free : procedure(a:PPKCS7_ENCRYPT);
-  _PKCS7_new : function:PPKCS7;
-  _PKCS7_free : procedure(a:PPKCS7);
-  _PKCS7_print_ctx : function(_out:PBIO; x:PPKCS7; indent:longint; pctx:Pointer):longint;
-  _PKCS7_ctrl : function(p7:PPKCS7; cmd:longint; larg:longint; parg:Pchar):longint;
-  _PKCS7_set_type : function(p7:PPKCS7; _type:longint):longint;
-  _PKCS7_set0_type_other : function(p7:PPKCS7; _type:longint; other:PASN1_TYPE):longint;
-  _PKCS7_set_content : function(p7:PPKCS7; p7_data:PPKCS7):longint;
-  _PKCS7_SIGNER_INFO_set : function(p7i:PPKCS7_SIGNER_INFO; x509:PX509; pkey:PEVP_PKEY; dgst:PEVP_MD):longint;
-  _PKCS7_SIGNER_INFO_sign : function(si:PPKCS7_SIGNER_INFO):longint;
-  _PKCS7_add_signer : function(p7:PPKCS7; p7i:PPKCS7_SIGNER_INFO):longint;
-  _PKCS7_add_certificate : function(p7:PPKCS7; x509:PX509):longint;
-  _PKCS7_add_crl : function(p7:PPKCS7; x509: Pointer):longint;
-  _PKCS7_content_new : function(p7:PPKCS7; nid:longint):longint;
-  _PKCS7_add_signature : function(p7:PPKCS7; x509:PX509; pkey:PEVP_PKEY; dgst:PEVP_MD):PPKCS7_SIGNER_INFO;
-  _PKCS7_cert_from_signer_info : function(p7:PPKCS7; si:PPKCS7_SIGNER_INFO):PX509;
-  _PKCS7_set_digest : function(p7:PPKCS7; md:PEVP_MD):longint;
-  _PKCS7_add_recipient : function(p7:PPKCS7; x509:PX509):PPKCS7_RECIP_INFO;
-  _PKCS7_add_recipient_info : function(p7:PPKCS7; ri:PPKCS7_RECIP_INFO):longint;
-  _PKCS7_RECIP_INFO_set : function(p7i:PPKCS7_RECIP_INFO; x509:PX509):longint;
-  _PKCS7_set_cipher : function(p7:PPKCS7; cipher:PEVP_CIPHER):longint;
-  _PKCS7_get_issuer_and_serial : function(p7:PPKCS7; idx:longint):PPKCS7_ISSUER_AND_SERIAL;
-  _PKCS7_digest_from_attributes : function(sk:Pstack_st_X509_ATTRIBUTE):Pointer;
-  _PKCS7_add_signed_attribute : function(p7si:PPKCS7_SIGNER_INFO; nid:longint; _type:longint; data:pointer):longint;
-  _PKCS7_add_attribute : function(p7si:PPKCS7_SIGNER_INFO; nid:longint; atrtype:longint; value:pointer):longint;
-  _PKCS7_get_attribute : function(si:PPKCS7_SIGNER_INFO; nid:longint):PASN1_TYPE;
-  _PKCS7_get_signed_attribute : function(si:PPKCS7_SIGNER_INFO; nid:longint):PASN1_TYPE;
-  _PKCS7_set_signed_attributes : function(p7si:PPKCS7_SIGNER_INFO; sk:Pstack_st_X509_ATTRIBUTE):longint;
-  _PKCS7_set_attributes : function(p7si:PPKCS7_SIGNER_INFO; sk:Pstack_st_X509_ATTRIBUTE):longint;
-  _PKCS7_sign : function(signcert:PX509; pkey:PEVP_PKEY; certs:Pstack_st_X509; data:PBIO; flags:longint):PPKCS7;
-  _PKCS7_sign_add_signer : function(p7:PPKCS7; signcert:PX509; pkey:PEVP_PKEY; md:PEVP_MD; flags:longint):PPKCS7_SIGNER_INFO;
-  _PKCS7_final : function(p7:PPKCS7; data:PBIO; flags:longint):longint;
-  _PKCS7_verify : function(p7:PPKCS7; certs:Pstack_st_X509; store: Pointer; indata:PBIO; _out:PBIO;  flags:longint):longint;
-  _PKCS7_encrypt : function(certs:Pstack_st_X509; _in:PBIO; cipher:PEVP_CIPHER; flags:longint):PPKCS7;
-  _PKCS7_decrypt : function(p7:PPKCS7; pkey:PEVP_PKEY; cert:PX509; data:PBIO; flags:longint):longint;
-  _PKCS7_add_attrib_smimecap : function(si:PPKCS7_SIGNER_INFO; cap:Pstack_st_X509_ALGOR):longint;
-  _PKCS7_simple_smimecap : function(sk:Pstack_st_X509_ALGOR; nid:longint; arg:longint):longint;
-  _PKCS7_add_attrib_content_type : function(si:PPKCS7_SIGNER_INFO; coid:Pointer):longint;
-  _PKCS7_add0_attrib_signing_time : function(si:PPKCS7_SIGNER_INFO; t:PASN1_TIME):longint;
-  _PKCS7_add1_attrib_digest : function(si:PPKCS7_SIGNER_INFO; md:Pbyte; mdlen:longint):longint;
-  _BIO_new_PKCS7 : function(_out:PBIO; p7:PPKCS7):PBIO;
-  _ERR_load_PKCS7_strings : procedure;
+  _PKCS7_ISSUER_AND_SERIAL_new : function: PPKCS7_ISSUER_AND_SERIAL;cdecl;
+  _PKCS7_ISSUER_AND_SERIAL_free : procedure(a:PPKCS7_ISSUER_AND_SERIAL);cdecl;
+  _PKCS7_ISSUER_AND_SERIAL_digest : function(data:PPKCS7_ISSUER_AND_SERIAL; _type:PEVP_MD; md:Pbyte; len:Pdword):longint;cdecl;
+  _PKCS7_dup : function(p7:PPKCS7):PPKCS7;cdecl;
+  _PEM_write_bio_PKCS7_stream : function(_out:PBIO; p7:PPKCS7; _in:PBIO; flags:longint):longint;cdecl;
+  _PKCS7_SIGNER_INFO_new : function:PPKCS7_SIGNER_INFO;cdecl;
+  _PKCS7_SIGNER_INFO_free : procedure(a:PPKCS7_SIGNER_INFO);cdecl;
+  _PKCS7_RECIP_INFO_new : function:PPKCS7_RECIP_INFO;cdecl;
+  _PKCS7_RECIP_INFO_free : procedure(a:PPKCS7_RECIP_INFO);cdecl;
+  _PKCS7_SIGNED_new : function:PPKCS7_SIGNED;cdecl;
+  _PKCS7_SIGNED_free : procedure(a:PPKCS7_SIGNED);cdecl;
+  _PKCS7_ENC_CONTENT_new : function:PPKCS7_ENC_CONTENT;cdecl;
+  _PKCS7_ENC_CONTENT_free : procedure(a:PPKCS7_ENC_CONTENT);cdecl;
+  _PKCS7_ENVELOPE_new : function:PPKCS7_ENVELOPE;cdecl;
+  _PKCS7_ENVELOPE_free : procedure(a:PPKCS7_ENVELOPE);cdecl;
+  _PKCS7_SIGN_ENVELOPE_new : function:PPKCS7_SIGN_ENVELOPE;cdecl;
+  _PKCS7_SIGN_ENVELOPE_free : procedure(a:PPKCS7_SIGN_ENVELOPE);cdecl;
+  _PKCS7_DIGEST_new : function:PPKCS7_DIGEST;cdecl;
+  _PKCS7_DIGEST_free : procedure(a:PPKCS7_DIGEST);cdecl;
+  _PKCS7_ENCRYPT_new : function:PPKCS7_ENCRYPT;cdecl;
+  _PKCS7_ENCRYPT_free : procedure(a:PPKCS7_ENCRYPT);cdecl;
+  _PKCS7_new : function:PPKCS7;cdecl;
+  _PKCS7_free : procedure(a:PPKCS7);cdecl;
+  _PKCS7_print_ctx : function(_out:PBIO; x:PPKCS7; indent:longint; pctx:Pointer):longint;cdecl;
+  _PKCS7_ctrl : function(p7:PPKCS7; cmd:longint; larg:longint; parg:Pchar):longint;cdecl;
+  _PKCS7_set_type : function(p7:PPKCS7; _type:longint):longint;cdecl;
+  _PKCS7_set0_type_other : function(p7:PPKCS7; _type:longint; other:PASN1_TYPE):longint;cdecl;
+  _PKCS7_set_content : function(p7:PPKCS7; p7_data:PPKCS7):longint;cdecl;
+  _PKCS7_SIGNER_INFO_set : function(p7i:PPKCS7_SIGNER_INFO; x509:PX509; pkey:PEVP_PKEY; dgst:PEVP_MD):longint;cdecl;
+  _PKCS7_SIGNER_INFO_sign : function(si:PPKCS7_SIGNER_INFO):longint;cdecl;
+  _PKCS7_add_signer : function(p7:PPKCS7; p7i:PPKCS7_SIGNER_INFO):longint;cdecl;
+  _PKCS7_add_certificate : function(p7:PPKCS7; x509:PX509):longint;cdecl;
+  _PKCS7_add_crl : function(p7:PPKCS7; x509: Pointer):longint;cdecl;
+  _PKCS7_content_new : function(p7:PPKCS7; nid:longint):longint;cdecl;
+  _PKCS7_add_signature : function(p7:PPKCS7; x509:PX509; pkey:PEVP_PKEY; dgst:PEVP_MD):PPKCS7_SIGNER_INFO;cdecl;
+  _PKCS7_cert_from_signer_info : function(p7:PPKCS7; si:PPKCS7_SIGNER_INFO):PX509;cdecl;
+  _PKCS7_set_digest : function(p7:PPKCS7; md:PEVP_MD):longint;cdecl;
+  _PKCS7_add_recipient : function(p7:PPKCS7; x509:PX509):PPKCS7_RECIP_INFO;cdecl;
+  _PKCS7_add_recipient_info : function(p7:PPKCS7; ri:PPKCS7_RECIP_INFO):longint;cdecl;
+  _PKCS7_RECIP_INFO_set : function(p7i:PPKCS7_RECIP_INFO; x509:PX509):longint;cdecl;
+  _PKCS7_set_cipher : function(p7:PPKCS7; cipher:PEVP_CIPHER):longint;cdecl;
+  _PKCS7_get_issuer_and_serial : function(p7:PPKCS7; idx:longint):PPKCS7_ISSUER_AND_SERIAL;cdecl;
+  _PKCS7_digest_from_attributes : function(sk:Pstack_st_X509_ATTRIBUTE):Pointer;cdecl;
+  _PKCS7_add_signed_attribute : function(p7si:PPKCS7_SIGNER_INFO; nid:longint; _type:longint; data:pointer):longint;cdecl;
+  _PKCS7_add_attribute : function(p7si:PPKCS7_SIGNER_INFO; nid:longint; atrtype:longint; value:pointer):longint;cdecl;
+  _PKCS7_get_attribute : function(si:PPKCS7_SIGNER_INFO; nid:longint):PASN1_TYPE;cdecl;
+  _PKCS7_get_signed_attribute : function(si:PPKCS7_SIGNER_INFO; nid:longint):PASN1_TYPE;cdecl;
+  _PKCS7_set_signed_attributes : function(p7si:PPKCS7_SIGNER_INFO; sk:Pstack_st_X509_ATTRIBUTE):longint;cdecl;
+  _PKCS7_set_attributes : function(p7si:PPKCS7_SIGNER_INFO; sk:Pstack_st_X509_ATTRIBUTE):longint;cdecl;
+  _PKCS7_sign : function(signcert:PX509; pkey:PEVP_PKEY; certs:Pstack_st_X509; data:PBIO; flags:longint):PPKCS7;cdecl;
+  _PKCS7_sign_add_signer : function(p7:PPKCS7; signcert:PX509; pkey:PEVP_PKEY; md:PEVP_MD; flags:longint):PPKCS7_SIGNER_INFO;cdecl;
+  _PKCS7_final : function(p7:PPKCS7; data:PBIO; flags:longint):longint;cdecl;
+  _PKCS7_verify : function(p7:PPKCS7; certs:Pstack_st_X509; store: Pointer; indata:PBIO; _out:PBIO;  flags:longint):longint;cdecl;
+  _PKCS7_encrypt : function(certs:Pstack_st_X509; _in:PBIO; cipher:PEVP_CIPHER; flags:longint):PPKCS7;cdecl;
+  _PKCS7_decrypt : function(p7:PPKCS7; pkey:PEVP_PKEY; cert:PX509; data:PBIO; flags:longint):longint;cdecl;
+  _PKCS7_add_attrib_smimecap : function(si:PPKCS7_SIGNER_INFO; cap:Pstack_st_X509_ALGOR):longint;cdecl;
+  _PKCS7_simple_smimecap : function(sk:Pstack_st_X509_ALGOR; nid:longint; arg:longint):longint;cdecl;
+  _PKCS7_add_attrib_content_type : function(si:PPKCS7_SIGNER_INFO; coid:Pointer):longint;cdecl;
+  _PKCS7_add0_attrib_signing_time : function(si:PPKCS7_SIGNER_INFO; t:PASN1_TIME):longint;cdecl;
+  _PKCS7_add1_attrib_digest : function(si:PPKCS7_SIGNER_INFO; md:Pbyte; mdlen:longint):longint;cdecl;
+  _BIO_new_PKCS7 : function(_out:PBIO; p7:PPKCS7):PBIO;cdecl;
+  _ERR_load_PKCS7_strings : procedure;cdecl;
 
   // BN
   _BN_new : function():PBIGNUM; cdecl;
@@ -3647,21 +3647,21 @@ end;
 
 function PEM_write_bio_PrivateKey(bp: pBIO; x: pEVP_PKEY;
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
-               u: pointer): integer; 
+               u: pointer): integer;
 Begin
    if InitSSLInterface and Assigned(_PEM_write_bio_PrivateKey) then
     Result := _PEM_write_bio_PrivateKey(bp, x, enc ,kstr ,klen ,cb, u)
   else
     Result := -1;
-end;   
+end;
 
-function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer; 
+function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer;
 Begin
    if InitSSLInterface and Assigned(_PEM_write_bio_PUBKEY) then
     Result := _PEM_write_bio_PUBKEY(bp, x)
   else
     Result := -1;
-end; 
+end;
 
 function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
 begin
@@ -4624,14 +4624,14 @@ var
   i: cInt;
 begin
   Result := NilHandle;
-  
+
   for i := Low(DLLVersions) to High(DLLVersions) do begin
     {$IFDEF DARWIN}
     Result := LoadLibrary(Value + DLLVersions[i] + '.dylib');
     {$ELSE}
     Result := LoadLibrary(Value + '.so' + DLLVersions[i]);
     {$ENDIF}
-    
+
     if Result <> NilHandle then
       Break;
   end;

File diff suppressed because it is too large
+ 303 - 153
packages/pastojs/src/fppas2js.pp


+ 2 - 2
packages/pastojs/src/pas2jscompiler.pp

@@ -4253,8 +4253,8 @@ begin
   w('    m    : Enables macro replacements');
   w('    2    : Same as -Mobjfpc (default)');
   w('  -SI<x>  : Set interface style to <x>');
-  w('    -SIcom  : COM compatible interface (default)');
-  w('    -SIcorba: CORBA compatible interface');
+  w('    -SIcom  : COM, reference counted interface (default)');
+  w('    -SIcorba: CORBA interface');
   w('  -T<x>  : Set target platform');
   w('    -Tbrowser: default');
   w('    -Tnodejs : add pas.run(), includes -Jc');

+ 5 - 1
packages/pastojs/src/pas2jsfiler.pp

@@ -71,12 +71,13 @@ uses
 
 const
   PCUMagic = 'Pas2JSCache';
-  PCUVersion = 2;
+  PCUVersion = 3;
   { Version Changes:
     1: initial version
     2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
        - pcsfAncestorResolved
        - removed msIgnoreInterfaces
+    3: changed records from function to objects
   }
 
   BuiltInNodeName = 'BuiltIn';
@@ -6635,6 +6636,9 @@ var
   Id: Integer;
   Scope: TPasRecordScope;
 begin
+  if FileVersion<3 then
+    RaiseMsg(20190109214718,El,'record format changed');
+
   Scope:=TPasRecordScope(Resolver.CreateScope(El,TPasRecordScope));
   El.CustomData:=Scope;
 

+ 139 - 50
packages/pastojs/tests/tcmodules.pas

@@ -460,8 +460,7 @@ type
     Procedure TestAdvRecord_SubRecord;
     Procedure TestAdvRecord_SubClass;
     Procedure TestAdvRecord_SubInterfaceFail;
-    // ToDo: pcu: record default property
-    // ToDo: constructor
+    Procedure TestAdvRecord_Constructor;
     // ToDo: class constructor
 
     // classes
@@ -5664,7 +5663,7 @@ begin
     // this.$init
     '$impl.aRec.i = 3;',
     LinesToStr([ // implementation
-    'rtl.createTRecord($impl, "TMyRecord", function () {',
+    'rtl.recNewT($impl, "TMyRecord", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return this.i === b.i;',
@@ -7404,6 +7403,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '});',
     'this.b = false;',
@@ -8019,7 +8019,7 @@ begin
   ConvertProgram;
   CheckSource('TestArrayOfRecord',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.Int = 0;',
     '  this.$eq = function (b) {',
     '    return this.Int === b.Int;',
@@ -8065,7 +8065,7 @@ begin
   ConvertProgram;
   CheckSource('TestArray_StaticRecord',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.Int = 0;',
     '  this.$eq = function (b) {',
     '    return this.Int === b.Int;',
@@ -8592,7 +8592,7 @@ begin
     '  "1": "small",',
     '  small: 1',
     '};',
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return this.i === b.i;',
@@ -8672,7 +8672,7 @@ begin
     '  "1": "small",',
     '  small: 1',
     '};',
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return this.i === b.i;',
@@ -8747,7 +8747,7 @@ begin
     '  "1": "small",',
     '  small: 1',
     '};',
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return this.i === b.i;',
@@ -9185,7 +9185,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecord_Empty',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRecA", function () {',
+    'rtl.recNewT($mod, "TRecA", function () {',
     '  this.$eq = function (b) {',
     '    return true;',
     '  };',
@@ -9214,7 +9214,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecord_Var',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRecA", function () {',
+    'rtl.recNewT($mod, "TRecA", function () {',
     '  this.Bold = 0;',
     '  this.$eq = function (b) {',
     '    return this.Bold === b.Bold;',
@@ -9248,7 +9248,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecord_VarExternal',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRecA", function () {',
+    'rtl.recNewT($mod, "TRecA", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return (this.i === b.i) && (this.length === b.length);',
@@ -9286,7 +9286,7 @@ begin
   ConvertProgram;
   CheckSource('TestWithRecordDo',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.vI = 0;',
     '  this.$eq = function (b) {',
     '    return this.vI === b.vI;',
@@ -9340,7 +9340,7 @@ begin
     '  "1": "green",',
     '  green: 1',
     '};',
-    'rtl.createTRecord($mod, "TSmallRec", function () {',
+    'rtl.recNewT($mod, "TSmallRec", function () {',
     '  this.N = 0;',
     '  this.$eq = function (b) {',
     '    return this.N === b.N;',
@@ -9350,7 +9350,7 @@ begin
     '    return this;',
     '  };',
     '});',
-    'rtl.createTRecord($mod, "TBigRec", function () {',
+    'rtl.recNewT($mod, "TBigRec", function () {',
     '  this.Int = 0;',
     '  this.D = 0.0;',
     '  this.Arr = [];',
@@ -9416,7 +9416,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecord_AsParams',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRecord", function () {',
+    'rtl.recNewT($mod, "TRecord", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return this.i === b.i;',
@@ -9504,7 +9504,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecordElement_AsParams',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRecord", function () {',
+    'rtl.recNewT($mod, "TRecord", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return this.i === b.i;',
@@ -9562,7 +9562,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecordElementFromFuncResult_AsParams',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRecord", function () {',
+    'rtl.recNewT($mod, "TRecord", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return this.i === b.i;',
@@ -9604,7 +9604,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecordElementFromWith_AsParams',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRecord", function () {',
+    'rtl.recNewT($mod, "TRecord", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return this.i === b.i;',
@@ -9663,7 +9663,7 @@ begin
     '  "1": "blue",',
     '  blue: 1',
     '};',
-    'rtl.createTRecord($mod, "TRecord", function () {',
+    'rtl.recNewT($mod, "TRecord", function () {',
     '  this.i = 0;',
     '  this.Event = null;',
     '  this.$new = function () {',
@@ -9681,7 +9681,7 @@ begin
     '    return this;',
     '  };',
     '});',
-    'rtl.createTRecord($mod, "TNested", function () {',
+    'rtl.recNewT($mod, "TNested", function () {',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
     '    r.r = $mod.TRecord.$new();',
@@ -9720,7 +9720,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecord_TypeCastJSValueToRecord',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRecord", function () {',
+    'rtl.recNewT($mod, "TRecord", function () {',
     '  this.i = 0;',
     '  this.$eq = function (b) {',
     '    return this.i === b.i;',
@@ -9771,7 +9771,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecord_FieldArray',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.a = [];',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
@@ -9824,7 +9824,7 @@ begin
   ConvertProgram;
   CheckSource('TestRecord_Const',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TPoint", function () {',
+    'rtl.recNewT($mod, "TPoint", function () {',
     '  this.x = 0;',
     '  this.y = 0;',
     '  this.$eq = function (b) {',
@@ -9836,7 +9836,7 @@ begin
     '    return this;',
     '  };',
     '});',
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.i = 0;',
     '  this.a = [];',
     '  this.$new = function () {',
@@ -9915,7 +9915,7 @@ begin
   CheckSource('TestRecord_InFunction',
     LinesToStr([ // statements
     'this.TPoint = 3;',
-    'var TPoint$1 = rtl.createTRecord(null, "", function () {',
+    'var TPoint$1 = rtl.recNewT(null, "", function () {',
     '  this.x = 0;',
     '  this.y = 0;',
     '  this.$eq = function (b) {',
@@ -9964,7 +9964,7 @@ begin
   ConvertProgram;
   CheckSource('TestAdvRecord_Function',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TPoint", function () {',
+    'rtl.recNewT($mod, "TPoint", function () {',
     '  this.x = 0;',
     '  this.y = 0;',
     '  this.$eq = function (b) {',
@@ -10027,7 +10027,7 @@ begin
   ConvertProgram;
   CheckSource('TestAdvRecord_Property',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TPoint", function () {',
+    'rtl.recNewT($mod, "TPoint", function () {',
     '  this.x = 0;',
     '  this.y = 0;',
     '  this.$eq = function (b) {',
@@ -10088,7 +10088,7 @@ begin
   ConvertProgram;
   CheckSource('TestAdvRecord_PropertyDefault',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TPoint", function () {',
+    'rtl.recNewT($mod, "TPoint", function () {',
     '  this.$eq = function (b) {',
     '    return true;',
     '  };',
@@ -10152,7 +10152,7 @@ begin
   ConvertProgram;
   CheckSource('TestAdvRecord_Property_ClassMethod',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.Fx = 0;',
     '  this.Fy = 0;',
     '  this.$eq = function (b) {',
@@ -10219,7 +10219,7 @@ begin
   ConvertProgram;
   CheckSource('TestAdvRecord_Const',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TPoint", function () {',
+    'rtl.recNewT($mod, "TPoint", function () {',
     '  this.x = 0;',
     '  this.y = 0;',
     '  this.Count = 0;',
@@ -10232,7 +10232,7 @@ begin
     '    return this;',
     '  };',
     '}, true);',
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.i = 0;',
     '  this.a = [];',
     '  this.$new = function () {',
@@ -10317,8 +10317,8 @@ begin
   ConvertProgram;
   CheckSource('TestAdvRecord_SubRecord',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
-    '  rtl.createTRecord(this, "TPoint", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
+    '  rtl.recNewT(this, "TPoint", function () {',
     '    this.x = 0;',
     '    this.y = 0;',
     '    this.Count = 0;',
@@ -10412,7 +10412,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '});',
-    'rtl.createTRecord($mod, "TPoint", function () {',
+    'rtl.recNewT($mod, "TPoint", function () {',
     '  rtl.createClass(this, "TBird", $mod.TObject, function () {',
     '    this.DoIt = function () {',
     '      this.DoIt();',
@@ -10459,6 +10459,56 @@ begin
   ParseProgram;
 end;
 
+procedure TTestModule.TestAdvRecord_Constructor;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  TPoint = record',
+  '    x,y: longint;',
+  '    constructor Create(ax: longint; ay: longint = -1);',
+  '  end;',
+  'constructor tpoint.create(ax,ay: longint);',
+  'begin',
+  '  x:=ax;',
+  '  self.y:=ay;',
+  'end;',
+  'var r: TPoint;',
+  'begin',
+  '  r:=TPoint.Create(1,2);',
+  '  r.Create(3);',
+  '  r:=r.Create(4);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAdvRecord_Constructor',
+    LinesToStr([ // statements
+    'rtl.recNewT($mod, "TPoint", function () {',
+    '  this.x = 0;',
+    '  this.y = 0;',
+    '  this.$eq = function (b) {',
+    '    return (this.x === b.x) && (this.y === b.y);',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    this.x = s.x;',
+    '    this.y = s.y;',
+    '    return this;',
+    '  };',
+    '  this.Create = function (ax, ay) {',
+    '    this.x = ax;',
+    '    this.y = ay;',
+    '    return this;',
+    '  };',
+    '}, true);',
+    'this.r = $mod.TPoint.$new();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.r.$assign($mod.TPoint.$create("Create", [1, 2]));',
+    '$mod.r.Create(3, -1);',
+    '$mod.r.$assign($mod.r.Create(4, -1));',
+    '']));
+end;
+
 procedure TTestModule.TestClass_TObjectDefaultConstructor;
 begin
   StartProgram(false);
@@ -10479,6 +10529,7 @@ begin
   '  obj:=tobject.create();',
   '  obj:=tbird.create;',
   '  obj:=tbird.create();',
+  '  obj:=obj.create();',
   '  obj.destroy;',
   '']);
   ConvertProgram;
@@ -10490,6 +10541,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function(){',
+    '    return this;',
     '  };',
     '  this.Destroy = function(){',
     '  };',
@@ -10501,6 +10553,7 @@ begin
     '$mod.Obj = $mod.TObject.$create("Create");',
     '$mod.Obj = $mod.TObject.$create("Create");',
     '$mod.Obj = $mod.TObject.$create("Create");',
+    '$mod.Obj = $mod.Obj.Create();',
     '$mod.Obj.$destroy("Destroy");',
     '']));
 end;
@@ -10527,6 +10580,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function(Par){',
+    '    return this;',
     '  };',
     '});',
     'this.Obj = null;'
@@ -10565,10 +10619,12 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function(){',
+    '    return this;',
     '  };',
     '});',
     'rtl.createClass($mod, "TTest", $mod.TObject, function () {',
     '  this.Create$1 = function (Par) {',
+    '    return this;',
     '  };',
     '});',
     'this.t = null;'
@@ -10608,6 +10664,7 @@ begin
     '  };',
     '  this.Create = function(Par){',
     '    this.vI = Par+3;',
+    '    return this;',
     '  };',
     '});',
     'this.Obj = null;'
@@ -10656,6 +10713,7 @@ begin
     '    this.Sub = undefined;',
     '  };',
     '  this.Create = function(){',
+    '    return this;',
     '  };',
     '  this.GetIt = function(Par){',
     '    var Result = null;',
@@ -10726,6 +10784,7 @@ begin
     '    iC = $impl.TIntClass.$create("Create$1");',
     '    $impl.TIntClass.DoGlob();',
     '    iC.$class.DoGlob();',
+    '    return this;',
     '  };',
     '});',
     '']),
@@ -10738,6 +10797,7 @@ begin
     '    $mod.TObject.Create.apply(this, arguments);',
     '    $mod.TObject.Create.call(this);',
     '    this.$class.DoGlob();',
+    '    return this;',
     '  };',
     '  this.DoGlob = function () {',
     '  };',
@@ -10780,6 +10840,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '});',
     'rtl.createClass($mod,"TClassA",$mod.TObject,function(){',
@@ -11094,9 +11155,11 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '  this.CreateWithB = function (b) {',
     '    this.Create();',
+    '    return this;',
     '  };',
     '});',
     'rtl.createClass($mod, "TA", $mod.TObject, function () {',
@@ -11104,6 +11167,7 @@ begin
     '    $mod.TObject.Create.apply(this, arguments);',
     '    $mod.TObject.Create.call(this);',
     '    $mod.TObject.CreateWithB.call(this, false);',
+    '    return this;',
     '  };',
     '  this.CreateWithC = function (c) {',
     '    $mod.TObject.Create.call(this);',
@@ -11111,6 +11175,7 @@ begin
     '    this.DoIt();',
     '    this.DoIt();',
     '    this.$class.DoSome();',
+    '    return this;',
     '  };',
     '  this.DoIt = function () {',
     '    this.Create();',
@@ -11178,6 +11243,7 @@ begin
     '    $mod.TObject.vI = this.vI+1;',
     '    $mod.TObject.vI = this.vI+1;',
     '    $mod.TObject.vI += 1;',
+    '    return this;',
     '  };',
     '  this.GetIt = function(Par){',
     '    var Result = null;',
@@ -11257,6 +11323,7 @@ begin
     '    $mod.TObject.vI = this.GetMore(4);',
     '    $mod.TObject.Sub = this.$class.GetIt(5);',
     '    $mod.TObject.vI = this.GetMore(6);',
+    '    return this;',
     '  };',
     '  this.GetMore = function(Par){',
     '    var Result = 0;',
@@ -11913,6 +11980,7 @@ begin
     '    this.Arr = undefined;',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '});',
     'this.Obj = null;',
@@ -11976,6 +12044,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '  this.GetSize = function () {',
     '    var Result = 0;',
@@ -12035,6 +12104,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '  this.GetItems = function (Index) {',
     '    var Result = 0;',
@@ -12091,6 +12161,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '  this.GetSize = function () {',
     '    var Result = 0;',
@@ -12149,6 +12220,7 @@ begin
     '    this.Next = undefined;',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '});',
     'rtl.createClass($mod, "TControl", $mod.TObject, function () {',
@@ -12393,8 +12465,10 @@ begin
     '  this.Create = function (vA) {',
     '    this.Create(1);',
     '    this.Create$1(1,2);',
+    '    return this;',
     '  };',
     '  this.Create$1 = function (vA, vB) {',
+    '    return this;',
     '  };',
     '});',
     'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
@@ -12403,8 +12477,10 @@ begin
     '    this.Create$3(1, 2);',
     '    $mod.TObject.Create.call(this, 1);',
     '    $mod.TObject.Create$1.call(this, 1, 2);',
+    '    return this;',
     '  };',
     '  this.Create$3 = function (vA, vB) {',
+    '    return this;',
     '  };',
     '});',
     '']),
@@ -12578,6 +12654,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function (Msg) {',
+    '    return this;',
     '  };',
     '});',
     'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
@@ -13269,6 +13346,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '  this.Free = function () {',
     '  };',
@@ -13454,6 +13532,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function () {',
+    '    return this;',
     '  };',
     '});',
     'this.Obj = null;',
@@ -14048,7 +14127,7 @@ begin
   CheckSource('TestNestedClass_Record',
     LinesToStr([ // statements
     'rtl.createClass($mod, "TObject", null, function () {',
-    '  rtl.createTRecord(this, "TPoint", function () {',
+    '  rtl.recNewT(this, "TPoint", function () {',
     '    this.x = 0;',
     '    this.y = 0;',
     '    this.$eq = function (b) {',
@@ -14143,6 +14222,7 @@ begin
     '    };',
     '    this.Create = function () {',
     '      this.FId = 3;',
+    '      return this;',
     '    };',
     '    this.Create$1 = function (i) {',
     '      var Result = null;',
@@ -14932,6 +15012,7 @@ begin
   Add('type');
   Add('  TExtAClass = class of TExtA;');
   Add('  TExtA = class external name ''ExtA''');
+  Add('    C: TExtAClass;');
   Add('    constructor New;');
   Add('  end;');
   Add('var');
@@ -14946,6 +15027,7 @@ begin
   Add('  end;');
   Add('  a:=test1.c.new;');
   Add('  a:=test1.c.new();');
+  Add('  a:=A.c.new();');
   ConvertProgram;
   CheckSource('TestExternalClass_ClassOf_New',
     LinesToStr([ // statements
@@ -14960,6 +15042,7 @@ begin
     '$mod.A = new $with1();',
     '$mod.A = new $mod.C();',
     '$mod.A = new $mod.C();',
+    '$mod.A = new $mod.A.C();',
     '']));
 end;
 
@@ -15432,7 +15515,7 @@ begin
     '});',
     'rtl.createClass($mod, "TChild", $mod.TObject, function () {',
     '});',
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.$eq = function (b) {',
     '    return true;',
     '  };',
@@ -15618,6 +15701,8 @@ begin
   '    v:=GetItems(14);',
   '    setitems(15,16);',
   '  end;',
+  '  v:=test1.arr.items[17];',
+  '  test1.arr.items[18]:=v;',
   '']);
   ConvertProgram;
   CheckSource('TestExternalClass_BracketAccessor',
@@ -15661,6 +15746,8 @@ begin
     'var $with2 = $mod.Arr;',
     '$mod.v = $with2[14];',
     '$with2[15] = 16;',
+    '$mod.v = $mod.Arr[17];',
+    '$mod.Arr[18] = $mod.v;',
     '']));
 end;
 
@@ -17577,7 +17664,7 @@ begin
     '    v.SetItems(6, v);',
     '    v.SetItems(7, $ir.ref(2, v.GetItems(8)));',
     '    $ir.ref(4, $ir.ref(3, v.GetItems(9)).GetBird()).SetBird(v);',
-    '    v = rtl.setIntfL(v, $ir.ref(6, v.$ir.ref(5, GetBird()).GetItems(10)).GetBird(), true);',
+    '    v = rtl.setIntfL(v, $ir.ref(6, $ir.ref(5, v.GetBird()).GetItems(10)).GetBird(), true);',
     '  } finally {',
     '    $ir.free();',
     '    rtl._Release(v);',
@@ -17944,7 +18031,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '});',
-    'rtl.createTRecord($mod, "TGUID", function () {',
+    'rtl.recNewT($mod, "TGUID", function () {',
     '  this.D1 = 0;',
     '  this.D2 = 0;',
     '  this.D3 = 0;',
@@ -18059,7 +18146,7 @@ begin
   CheckSource('TestClassInterface_GUIDProperty',
     LinesToStr([ // statements
     'rtl.createInterface($mod, "IUnknown", "{F31DB68F-3010-D355-4EBA-CDD4EF4A737C}", [], null);',
-    'rtl.createTRecord($mod, "TGUID", function () {',
+    'rtl.recNewT($mod, "TGUID", function () {',
     '  this.D1 = 0;',
     '  this.D2 = 0;',
     '  this.D3 = 0;',
@@ -19719,7 +19806,7 @@ begin
   ConvertProgram;
   CheckSource('TestPointer_Record',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.x = 0;',
     '  this.$eq = function (b) {',
     '    return this.x === b.x;',
@@ -19784,7 +19871,7 @@ begin
   ConvertProgram;
   CheckSource('TestPointer_Record',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.x = 0;',
     '  this.$eq = function (b) {',
     '    return this.x === b.x;',
@@ -22486,7 +22573,7 @@ begin
   ConvertProgram;
   CheckSource('TestRTTI_Record',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TPoint", function () {',
+    'rtl.recNewT($mod, "TPoint", function () {',
     '  this.x = 0;',
     '  this.y = 0;',
     '  this.$eq = function (b) {',
@@ -22529,7 +22616,7 @@ begin
   ConvertProgram;
   CheckSource('TestRTTI_Record',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TFloatRec", function () {',
+    'rtl.recNewT($mod, "TFloatRec", function () {',
     '  this.d = [];',
     '  this.$eq = function (b) {',
     '    return this.d === b.d;',
@@ -22572,7 +22659,7 @@ begin
   ConvertProgram;
   CheckSource('TestRTTI_LocalTypes',
     LinesToStr([ // statements
-    'var TPoint = rtl.createTRecord(null, "", function () {',
+    'var TPoint = rtl.recNewT(null, "", function () {',
     '  this.x = 0;',
     '  this.y = 0;',
     '  this.$eq = function (b) {',
@@ -22935,7 +23022,7 @@ begin
   ConvertProgram;
   CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses3',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.$eq = function (b) {',
     '    return true;',
     '  };',
@@ -23221,7 +23308,7 @@ begin
   ConvertProgram;
   CheckSource('TestRTTI_Interface_COM',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TGuid", function () {',
+    'rtl.recNewT($mod, "TGuid", function () {',
     '  this.$eq = function (b) {',
     '    return true;',
     '  };',
@@ -23890,7 +23977,7 @@ begin
     '  rtl.rcArrW(ArrChar, c.charCodeAt() - 48, rtl.rcArrR(ArrChar, c.charCodeAt() - 48));',
     '  ArrByteChar[7][7] = rtl.rc(ArrByteChar[7][7], 1, 10);',
     '  rtl.rcArrW(ArrByteChar, i, c.charCodeAt() - 48, rtl.rcArrR(ArrByteChar, i, c.charCodeAt() - 48));',
-    '  o.A[i] = rtl.rc(o.A[i], 1, 10);',
+    '  rtl.rcArrW(o.A, i, rtl.rcArrR(o.A, i));',
     '};',
     '']),
     LinesToStr([ // $mod.$main
@@ -23926,7 +24013,7 @@ begin
   ConvertProgram;
   CheckSource('TestRangeChecks_ArrayOfRecIndex',
     LinesToStr([ // statements
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.x = 0;',
     '  this.$eq = function (b) {',
     '    return this.x === b.x;',
@@ -23951,7 +24038,7 @@ begin
     '  var o = null;',
     '  Arr[1].$assign(Arr[1]);',
     '  rtl.rcArrR(Arr, i).$assign(rtl.rcArrR(Arr, i + 1));',
-    '  o.A[i].$assign(o.A[i + 2]);',
+    '  rtl.rcArrR(o.A, i).$assign(rtl.rcArrR(o.A, i + 2));',
     '};',
     '']),
     LinesToStr([ // $mod.$main
@@ -23978,6 +24065,7 @@ begin
   '  s[i]:=s[i];',
   '  h[i]:=h[i];',
   '  c:=o.s[i];',
+  '  o.s[i]:=c;',
   'end;',
   'begin',
   '']);
@@ -23999,7 +24087,8 @@ begin
     '  c = rtl.rcc(rtl.rcCharAt(s, 0), 0, 65535);',
     '  s = rtl.rcSetCharAt(s, i - 1, rtl.rcCharAt(s, i - 1));',
     '  h.set(rtl.rcSetCharAt(h.get(), i - 1, rtl.rcCharAt(h.get(), i - 1)));',
-    '  c = rtl.rcc(o.S.charAt(i - 1), 0, 65535);',
+    '  c = rtl.rcc(rtl.rcCharAt(o.S, i - 1), 0, 65535);',
+    '  o.S = rtl.rcSetCharAt(o.S, i - 1, c);',
     '};',
     '']),
     LinesToStr([ // $mod.$main

+ 2 - 1
packages/pastojs/tests/tcoptimizations.pas

@@ -387,7 +387,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitRecordMember',
     LinesToStr([
-    'rtl.createTRecord($mod, "TRec", function () {',
+    'rtl.recNewT($mod, "TRec", function () {',
     '  this.a = 0;',
     '  this.$eq = function (b) {',
     '    return this.a === b.a;',
@@ -936,6 +936,7 @@ begin
   '    };',
   '    this.Create = function (AColor) {',
   '      this.FColor = AColor;',
+  '      return this;',
   '    };',
   '  });',
   '  this.T = null;',

+ 1 - 1
utils/pas2js/dist/rtl.js

@@ -350,7 +350,7 @@ var rtl = {
     return null;
   },
 
-  createTRecord: function(parent,name,initfn,full){
+  recNewT: function(parent,name,initfn,full){
     var t = {};
     if (parent) parent[name] = t;
     function hide(prop){

+ 19 - 7
utils/pas2js/docs/translation.html

@@ -199,8 +199,8 @@ Put + after a boolean switch option to enable it, - to disable it
     m     : Enables macro replacements
     2     : Same as -Mobjfpc (default)
   -SI&lt;x&gt;   : Set interface style to &lt;x&gt;
-    -SIcom   : COM compatible interface (default)
-    -SIcorba : CORBA compatible interface
+    -SIcom   : COM, reference counted interface (default)
+    -SIcorba : CORBA interface
   -T&lt;x&gt;   : Set target platform, case insensitive.
     -Tbrowser : default
     -Tnodejs  : add pas.run(), includes -Jc
@@ -667,7 +667,8 @@ function(){
       this.d = 0.0;
     };
     this.$equal = function (b) {
-      return (this.i == b.i) && (this.s == b.i) && (this.d == b.d);
+      return (this.i == b.i) &&
+        (this.s == b.i) && (this.d == b.d);
     };
   };
   this.r = new this.TMyRecord();
@@ -685,12 +686,13 @@ function(){
 ["System"],
 function(){
   var $mod = this;
-  rtl.createTRecord($mod, "TMyRecord", function() {
+  rtl.recNewT($mod, "TMyRecord", function() {
     this.i = 0;
     this.s = "";
     this.d = 0.0;
     this.$eq = function (b) {
-      return (this.i == b.i) && (this.s == b.i) && (this.d == b.d);
+      return (this.i == b.i) &&
+         (this.s == b.i) && (this.d == b.d);
     };
     this.$assign = function (s) {
       this.i = s.i;
@@ -723,10 +725,20 @@ function(){
           <li>methods, class methods (must be static like in Delphi/FPC)</li>
           <li>class vars</li>
           <li>const fields</li>
-          <li>property, class property, array property, default property</li>
+          <li>property, class property, array property, default array property</li>
+          <li>sub types</li>
+          <li>constructor</li>
+        </ul>
+      </li>
+      <li>Not yet implemented:
+        <ul>
+          <li>operator overloading</li>
+          <li>class constructor</li>
+          <li>reference counted interfaces as fields</li>
+          <li>Interfaces as nested types</li>
+          <li>default non array property</li>
         </ul>
       </li>
-      <li>Not yet implemented: constructors, operators.</li>
       <li>Until Pas2js 1.2 when assigning a record it is cloned, creating a new
         JS object. Since Pas2js 1.3 only values are copied,
         keeping the object, so pointer of record is compatible.</li>

Some files were not shown because too many files changed in this diff