* synchronized with trunk

git-svn-id: branches/z80@45056 -

.gitattributes

@@ -13267,6 +13267,7 @@ tests/tbs/tb0667.pp svneol=native#text/pascal
 tests/tbs/tb0668a.pp svneol=native#text/pascal
 tests/tbs/tb0668b.pp svneol=native#text/pascal
 tests/tbs/tb0669.pp svneol=native#text/pascal
+tests/tbs/tb0670.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain

compiler/defutil.pas

@@ -349,6 +349,10 @@ interface
         signdness, the result will also get that signdness }
     function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
 
+    { # calculates "not v" based on the provided def; returns true if the def
+        was negatable, false otherwise }
+    function calc_not_ordvalue(var v:Tconstexprint; var def:tdef):boolean;
+
     { # returns whether the type is potentially a valid type of/for an "univ" parameter
         (basically: it must have a compile-time size) }
     function is_valid_univ_para_type(def: tdef): boolean;
@@ -1747,6 +1751,59 @@ implementation
       end;
 
 
+    function calc_not_ordvalue(var v:Tconstexprint;var def:tdef):boolean;
+      begin
+        if not assigned(def) or (def.typ<>orddef) then
+          exit(false);
+        result:=true;
+        case torddef(def).ordtype of
+          pasbool1,
+          pasbool8,
+          pasbool16,
+          pasbool32,
+          pasbool64:
+            v:=byte(not(boolean(int64(v))));
+          bool8bit,
+          bool16bit,
+          bool32bit,
+          bool64bit:
+            begin
+              if v=0 then
+                v:=-1
+              else
+                v:=0;
+            end;
+          uchar,
+          uwidechar,
+          u8bit,
+          s8bit,
+          u16bit,
+          s16bit,
+          s32bit,
+          u32bit,
+          s64bit,
+          u64bit:
+            begin
+              { unsigned, equal or bigger than the native int size? }
+              if (torddef(def).ordtype in [u64bit,u32bit,u16bit,u8bit,uchar,uwidechar]) and
+                 (is_nativeord(def) or is_oversizedord(def)) then
+                begin
+                  { Delphi-compatible: not dword = dword (not word = longint) }
+                  { Extension: not qword = qword                              }
+                  v:=qword(not qword(v));
+                  { will be truncated by the ordconstnode for u32bit }
+                end
+              else
+                begin
+                  v:=int64(not int64(v));
+                  def:=get_common_intdef(torddef(def),torddef(sinttype),false);
+                end;
+            end;
+          else
+            result:=false;
+        end;
+      end;
+
     function is_valid_univ_para_type(def: tdef): boolean;
       begin
         result:=

compiler/nmat.pas

@@ -1176,52 +1176,8 @@ implementation
           begin
              v:=tordconstnode(left).value;
              def:=left.resultdef;
-             case torddef(left.resultdef).ordtype of
+             if not calc_not_ordvalue(v,def) then
-               pasbool1,
+               CGMessage(type_e_mismatch);
-               pasbool8,
-               pasbool16,
-               pasbool32,
-               pasbool64:
-                 v:=byte(not(boolean(int64(v))));
-               bool8bit,
-               bool16bit,
-               bool32bit,
-               bool64bit:
-                 begin
-                   if v=0 then
-                     v:=-1
-                   else
-                     v:=0;
-                 end;
-               uchar,
-               uwidechar,
-               u8bit,
-               s8bit,
-               u16bit,
-               s16bit,
-               s32bit,
-               u32bit,
-               s64bit,
-               u64bit:
-                 begin
-                   { unsigned, equal or bigger than the native int size? }
-                   if (torddef(left.resultdef).ordtype in [u64bit,u32bit,u16bit,u8bit,uchar,uwidechar]) and
-                      (is_nativeord(left.resultdef) or is_oversizedord(left.resultdef)) then
-                     begin
-                       { Delphi-compatible: not dword = dword (not word = longint) }
-                       { Extension: not qword = qword                              }
-                       v:=qword(not qword(v));
-                       { will be truncated by the ordconstnode for u32bit }
-                     end
-                   else
-                     begin
-                       v:=int64(not int64(v));
-                       def:=get_common_intdef(torddef(left.resultdef),torddef(sinttype),false);
-                     end;
-                 end;
-               else
-                 CGMessage(type_e_mismatch);
-             end;
              { not-nodes are not range checked by the code generator -> also
                don't range check while inlining; the resultdef is a bit tricky
                though: the node's resultdef gets changed in most cases compared

compiler/scanner.pas

@@ -931,6 +931,7 @@ type
     function isBoolean: Boolean;
     function asBool: Boolean;
     function asInt: Integer;
+    function asInt64: Int64;
     function asStr: String;
     destructor destroy; override;
   end;
@@ -1145,6 +1146,12 @@ type
         begin
           if isBoolean then
             result:=texprvalue.create_bool(not asBool)
+          else if is_ordinal(def) then
+            begin
+              result:=texprvalue.create_ord(value.valueord);
+              result.def:=def;
+              calc_not_ordvalue(result.value.valueord,result.def);
+            end
           else
             begin
               error('Boolean', 'NOT');
@@ -1161,6 +1168,14 @@ type
                 v.error('Boolean','OR');
                 result:=texprvalue.create_error;
               end
+          else if is_ordinal(def) then
+            if is_ordinal(v.def) then
+              result:=texprvalue.create_ord(value.valueord or v.value.valueord)
+            else
+              begin
+                v.error('Ordinal','OR');
+                result:=texprvalue.create_error;
+              end
           else
             begin
               error('Boolean','OR');
@@ -1177,6 +1192,14 @@ type
                 v.error('Boolean','XOR');
                 result:=texprvalue.create_error;
               end
+          else if is_ordinal(def) then
+            if is_ordinal(v.def) then
+              result:=texprvalue.create_ord(value.valueord xor v.value.valueord)
+            else
+              begin
+                v.error('Ordinal','XOR');
+                result:=texprvalue.create_error;
+              end
           else
             begin
               error('Boolean','XOR');
@@ -1193,6 +1216,14 @@ type
                 v.error('Boolean','AND');
                 result:=texprvalue.create_error;
               end
+          else if is_ordinal(def) then
+            if is_ordinal(v.def) then
+              result:=texprvalue.create_ord(value.valueord and v.value.valueord)
+            else
+              begin
+                v.error('Ordinal','AND');
+                result:=texprvalue.create_error;
+              end
           else
             begin
               error('Boolean','AND');
@@ -1328,12 +1359,12 @@ type
 
   function texprvalue.isBoolean: Boolean;
     var
-      i: integer;
+      i: int64;
     begin
       result:=is_boolean(def);
       if not result and is_integer(def) then
         begin
-          i:=asInt;
+          i:=asInt64;
           result:=(i=0)or(i=1);
         end;
     end;
@@ -1348,6 +1379,11 @@ type
       result:=value.valueord.svalue;
     end;
 
+  function texprvalue.asInt64: Int64;
+    begin
+      result:=value.valueord.svalue;
+    end;
+
   function texprvalue.asStr: String;
     var
       b:byte;

packages/fcl-json/src/fpjsonrtti.pp

@@ -54,8 +54,6 @@ Type
     function IsChildStored: boolean;
     function StreamChildren(AComp: TComponent): TJSONArray;
   protected
-    Function GetPropertyList(aObject : TObject) : TPropInfoList; virtual;
-    Procedure StreamProperties(aObject : TObject;aList : TPropInfoList; aParent : TJSONObject); virtual;
     function StreamClassProperty(Const AObject: TObject): TJSONData; virtual;
     Function StreamProperty(Const AObject : TObject; Const PropertyName : String) : TJSONData;
     Function StreamProperty(Const AObject : TObject; PropertyInfo : PPropInfo) : TJSONData;
@@ -757,36 +755,12 @@ begin
   Result:=(GetChildProperty<>'Children');
 end;
 
-Function TJSONStreamer.GetPropertyList(aObject : TObject) : TPropInfoList;
-
-begin
-  result:=TPropInfoList.Create(AObject,tkProperties);
-end;
-
-Procedure TJSONStreamer.StreamProperties(aObject : TObject;aList : TPropInfoList; aParent : TJSONObject);
-
-Var
-  I : Integer;
-  PD : TJSONData;
-
-begin
-  For I:=0 to aList.Count-1 do
-    begin
-    PD:=StreamProperty(AObject,aList.Items[i]);
-    If (PD<>Nil) then 
-      begin
-      if jsoLowerPropertyNames in Options then
-        aParent.Add(LowerCase(aList.Items[I]^.Name),PD)
-      else
-        aParent.Add(aList.Items[I]^.Name,PD);
-      end;
-    end;
-end;
-
 function TJSONStreamer.ObjectToJSON(Const AObject: TObject): TJSONObject;
 
 Var
   PIL : TPropInfoList;
+  PD : TJSONData;
+  I : Integer;
 
 begin
   Result:=Nil;
@@ -806,12 +780,20 @@ begin
       Result.Add('Objects', StreamTList(TList(AObject)))
     else
       begin
-      PIL:=GetPropertyList(aObject);
+      PIL:=TPropInfoList.Create(AObject,tkProperties);
-//      TPropInfoList.Create(AObject,tkProperties);
       try
-        StreamProperties(aObject,PIL,Result);
+        For I:=0 to PIL.Count-1 do
+          begin
+          PD:=StreamProperty(AObject,PIL.Items[i]);
+            If (PD<>Nil) then begin
+              if jsoLowerPropertyNames in Options then
+                Result.Add(LowerCase(PIL.Items[I]^.Name),PD)
+              else
+            Result.Add(PIL.Items[I]^.Name,PD);
+          end;
+          end;
       finally
-        FreeAndNil(Pil);
+        FReeAndNil(Pil);
       end;
       If (jsoStreamChildren in Options) and (AObject is TComponent) then
         Result.Add(ChildProperty,StreamChildren(TComponent(AObject)));

packages/fcl-passrc/src/pasresolver.pp

@@ -5155,6 +5155,7 @@ var
   Proc: TPasProcedure;
   Store, SameScope: Boolean;
   ProcScope: TPasProcedureScope;
+  CurResolver: TPasResolver;
 
   procedure CountProcInSameScope;
   begin
@@ -5188,7 +5189,7 @@ begin
     fpkProc:
       // proc hides a non proc
       if (Data^.Proc.GetModule=El.GetModule) then
-        // forbidden within same module
+        // forbidden within same CurModule
         RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
           [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType)
       else
@@ -5205,8 +5206,15 @@ begin
         end;
     fpkMethod:
       // method hides a non proc
-      RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier,
+      begin
-        [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType);
+      ProcScope:=TPasProcedureScope(Data^.Proc.CustomData);
+      CurResolver:=ProcScope.Owner as TPasResolver;
+      if msDelphi in CurResolver.CurrentParser.CurrentModeswitches then
+        // ok in delphi
+      else
+        RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier,
+          [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType);
+      end;
     end;
     exit;
     end;
@@ -5491,9 +5499,12 @@ var
   i, TypeParamCnt: Integer;
   OtherScope: TPasIdentifierScope;
   ParentScope: TPasScope;
-  IsGeneric: Boolean;
+  IsGeneric, IsDelphi: Boolean;
 begin
   if aName='' then exit(nil);
+
+  IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
+
   if Scope is TPasGroupScope then
     begin
     Group:=TPasGroupScope(Scope);
@@ -5523,7 +5534,8 @@ begin
       RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
     end;
 
-  if (Kind=pikSimple) and (Group<>nil) and (El.ClassType<>TPasProperty) then
+  if (Kind=pikSimple) and (Group<>nil) and (El.ClassType<>TPasProperty)
+      and not IsDelphi then
     begin
     // check duplicate in ancestors and helpers
     for i:=1 to Group.Count-1 do
@@ -5554,7 +5566,7 @@ begin
 
   // check duplicate in current scope
   OlderIdentifier:=Identifier.NextSameIdentifier;
-  if IsGeneric and (msDelphi in CurrentParser.CurrentModeswitches) then
+  if IsGeneric and IsDelphi then
     OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
   if OlderIdentifier<>nil then
     begin

packages/fcl-passrc/tests/tcresolver.pas

@@ -614,7 +614,8 @@ type
     Procedure TestClass_SubObject;
     Procedure TestClass_WithDoClassInstance;
     Procedure TestClass_ProcedureExternal;
-    Procedure TestClass_ReintroducePublicVarFail;
+    Procedure TestClass_ReintroducePublicVarObjFPCFail;
+    Procedure TestClass_ReintroducePublicVarDelphi;
     Procedure TestClass_ReintroducePrivateVar;
     Procedure TestClass_ReintroduceProc;
     Procedure TestClass_UntypedParam_TypeCast;
@@ -11011,22 +11012,59 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestClass_ReintroducePublicVarFail;
+procedure TTestResolver.TestClass_ReintroducePublicVarObjFPCFail;
 begin
   StartProgram(false);
-  Add('type');
+  Add([
-  Add('  TObject = class');
+  'type',
-  Add('  public');
+  '  TObject = class',
-  Add('    Some: longint;');
+  '  public',
-  Add('  end;');
+  '    Some: longint;',
-  Add('  TCar = class(tobject)');
+  '  end;',
-  Add('  public');
+  '  TCar = class(tobject)',
-  Add('    Some: longint;');
+  '  public',
-  Add('  end;');
+  '    Some: longint;',
-  Add('begin');
+  '  end;',
+  'begin']);
   CheckResolverException('Duplicate identifier "Some" at afile.pp(5,5)',nDuplicateIdentifier);
 end;
 
+procedure TTestResolver.TestClass_ReintroducePublicVarDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '  public',
+  '    {#Obj_Some}Some: longint;',
+  '    {#Obj_Foo}Foo: word;',
+  '    function {#Obj_Bar}Bar: string;',
+  '  end;',
+  '  TCar = class(tobject)',
+  '  public',
+  '    {#Car_Some}Some: double;',
+  '    function {#Car_Foo}Foo: boolean;',
+  '    {#Car_Bar}Bar: single;',
+  '  end;',
+  'function TObject.Bar: string;',
+  'begin',
+  'end;',
+  'function TCar.Foo: boolean;',
+  'begin',
+  '  {@Car_Some}Some:=3.3;',
+  '  {@Car_Bar}Bar:=4.3;',
+  '  inherited {@Obj_Bar}Bar;',
+  '  inherited {@Obj_Bar}Bar();',
+  '  inherited {@Obj_Foo}Foo := 4;',
+  '  if inherited {@Obj_Some}Some = 5 then ;',
+  'end;',
+  'var C: TCar;',
+  'begin',
+  '  C.Some:=1.3;']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass_ReintroducePrivateVar;
 begin
   StartProgram(false);

packages/fcl-web/src/jsonrpc/fpjsonrpc.pp

@@ -27,6 +27,8 @@ Type
 { ---------------------------------------------------------------------
   JSON-RPC Handler support
   ---------------------------------------------------------------------}
+  TJSONRPCHandlerDef = Class;
+  TCustomJSONRPCDispatcher = Class;
 
   { TJSONParamDef }
 
@@ -90,6 +92,7 @@ Type
     FOptions: TJSONRPCOptions;
     FParamDefs: TJSONParamDefs;
     FExecParams : TJSONData;
+    FResultType: TJSONtype;
     procedure SetParamDefs(const AValue: TJSONParamDefs);
   Protected
     function CreateParamDefs: TJSONParamDefs; virtual;
@@ -107,7 +110,10 @@ Type
     Procedure CheckParams(Const Params : TJSONData);
     Function ParamByName(Const AName : String) : TJSONData;
     Function Execute(Const Params : TJSONData; AContext : TJSONRPCCallContext = Nil) : TJSONData;
+    // Checked on incoming request
     Property ParamDefs : TJSONParamDefs Read FParamDefs Write SetParamDefs;
+    // Used in parameter descriptions
+    Property ResultType : TJSONtype Read FResultType Write FResultType;
   end;
   TCustomJSONRPCHandlerClass = Class of TCustomJSONRPCHandler;
 
@@ -140,19 +146,60 @@ Type
   JSON-RPC dispatcher support
   ---------------------------------------------------------------------}
 
+  TCreateAPIOption = (caoFormatted,caoFullParams);
+  TCreateAPIOptions = set of TCreateAPIOption;
+
+  { TAPIDescriptionCreator }
+
+  TAPIDescriptionCreator = Class(TPersistent)
+  private
+    FDefaultOptions: TCreateAPIOptions;
+    FDispatcher: TCustomJSONRPCDispatcher;
+    FNameSpace : String;
+    FURL : String;
+    FAPIType : String;
+    function GetNameSpace: String;
+    function isNameSpaceStored: Boolean;
+  Protected
+    Function GetOwner: TPersistent; override;
+    procedure AddParamDefs(O: TJSONObject; Defs: TJSONParamDefs); virtual;
+    function CreateParamDef(aDef: TJSONParamDef): TJSONObject; virtual;
+    function HandlerToAPIMethod(H: TCustomJSONRPCHandler; aOptions: TCreateAPIOptions): TJSONObject; virtual;
+    function HandlerDefToAPIMethod(H: TJSONRPCHandlerDef; aOptions: TCreateAPIOptions): TJSONObject; virtual;
+    function DefaultNameSpace: String; virtual;
+    Function PublishHandler(H: TCustomJSONRPCHandler): Boolean; virtual;
+    function PublishHandlerDef(HD: TJSONRPCHandlerDef): Boolean; virtual;
+  Public
+    Constructor Create(aDispatcher : TCustomJSONRPCDispatcher); virtual;
+    Procedure Assign(Source : TPersistent); override;
+    function CreateAPI(aOptions: TCreateAPIOptions): TJSONObject; overload;
+    function CreateAPI : TJSONObject; overload;
+    Property Dispatcher : TCustomJSONRPCDispatcher Read FDispatcher;
+  Published
+    // Namespace for API description. Must be set. Default 'FPWeb'
+    Property NameSpace : String Read GetNameSpace Write FNameSpace Stored isNameSpaceStored;
+    // URL property for API router. Must be set.
+    Property URL : String Read FURL Write FURL;
+    // "type". By default: 'remoting'
+    Property APIType : String Read FAPIType Write FAPIType;
+    // Default options for creating an API
+    Property DefaultOptions : TCreateAPIOptions Read FDefaultOptions Write FDefaultOptions;
+  end;
+
   TJSONRPCDispatchOption = (jdoSearchRegistry, // Check JSON Handler registry
                             jdoSearchOwner, // Check owner (usually webmodule) for request handler
                             jdoJSONRPC1, // Allow JSON RPC-1
                             jdoJSONRPC2, // Allow JSON RPC-2
                             jdoRequireClass, // Require class name (as in Ext.Direct)
                             jdoNotifications, // Allow JSON Notifications
-                            jdoStrictNotifications // Error if notification returned result. Default is to discard result.
+                            jdoStrictNotifications, // Error if notification returned result. Default is to discard result.
-
+                            jdoAllowAPI, // Allow client to get API description
+                            jdoCacheAPI // Cache the API description
                             );
   TJSONRPCDispatchOptions = set of TJSONRPCDispatchOption;
 
 Const
-  DefaultDispatchOptions =  [jdoSearchOwner,jdoJSONRPC1,jdoJSONRPC2,jdoNotifications];
+  DefaultDispatchOptions =  [jdoSearchOwner,jdoJSONRPC1,jdoJSONRPC2,jdoNotifications,jdoAllowAPI,jdoCacheAPI];
 
 Type
   TDispatchRequestEvent = Procedure(Sender : TObject; Const AClassName,AMethod : TJSONStringType; Const Params : TJSONData) of object;
@@ -160,14 +207,21 @@ Type
 
   { TCustomJSONRPCDispatcher }
 
+
   TCustomJSONRPCDispatcher = Class(TComponent)
   private
+    FAPICreator: TAPIDescriptionCreator;
     FFindHandler: TFindRPCHandlerEvent;
     FOnDispatchRequest: TDispatchRequestEvent;
     FOnEndBatch: TNotifyEvent;
     FOnStartBatch: TNotifyEvent;
     FOptions: TJSONRPCDispatchOptions;
+    FCachedAPI : TJSONObject;
+    FCachedAPIOptions : TCreateAPIOptions;
+    procedure SetAPICreator(AValue: TAPIDescriptionCreator);
   Protected
+    // Create TAPIDescriptionCreator instance. Must have self as owner
+    Function CreateAPICreator : TAPIDescriptionCreator; virtual;
     // Find handler. If none found, nil is returned. Executes OnFindHandler if needed.
     // On return 'DoFree' must be set to indicate that the hand
     Function FindHandler(Const AClassName,AMethodName : TJSONStringType;AContext : TJSONRPCCallContext; Out FreeObject : TComponent) : TCustomJSONRPCHandler; virtual;
@@ -202,8 +256,17 @@ Type
     Class Function ParamsProperty : String; virtual;
   Public
     Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
     Class Function TransactionProperty : String; virtual;
+    // execute request(s) using context
     Function Execute(Requests : TJSONData;AContext : TJSONRPCCallContext = Nil) : TJSONData;
+    // Create an API description. If options are not specified, APICreator.DefaultOptions is used.
+    Function CreateAPI(aOptions : TCreateAPIOptions): TJSONObject; overload;
+    Function CreateAPI : TJSONObject; overload;
+    // Return API Description including namespace, as a string. If options are not specified, APICreator.DefaultOptions is used.
+    Function APIAsString(aOptions : TCreateAPIOptions) : TJSONStringType; virtual;
+    Function APIAsString : TJSONStringType; virtual;
+    Property APICreator : TAPIDescriptionCreator Read FAPICreator Write  SetAPICreator;
   end;
 
   TJSONRPCDispatcher = Class(TCustomJSONRPCDispatcher)
@@ -213,6 +276,7 @@ Type
     Property OnFindHandler;
     Property OnEndBatch;
     Property Options;
+    Property APICreator;
   end;
 
 
@@ -238,6 +302,7 @@ Type
     FDataModuleClass : TDataModuleClass;
     FHandlerMethodName: TJSONStringType;
     FHandlerClassName: TJSONStringType;
+    FResultType: TJSONType;
     procedure CheckNames(const AClassName, AMethodName: TJSONStringType);
     function GetParamDefs: TJSONParamDefs;
     procedure SetFPClass(const AValue: TCustomJSONRPCHandlerClass);
@@ -257,6 +322,7 @@ Type
     Property AfterCreate : TJSONRPCHandlerEvent Read FAfterCreate Write FAfterCreate;
     Property ArgumentCount : Integer Read FArgumentCount Write FArgumentCount;
     Property ParamDefs : TJSONParamDefs Read GetParamDefs Write SetParamDefs;
+    Property ResultType : TJSONType Read FResultType Write FResultType;
   end;
   TJSONRPCHandlerDefClass = Class of TJSONRPCHandlerDef;
 
@@ -490,6 +556,36 @@ begin
   raise EJSONRPC.CreateFmt(SErrParams, [Format(Fmt, Args)]);
 end;
 
+{ TAPIDescriptionCreator }
+
+function TAPIDescriptionCreator.GetOwner: TPersistent;
+begin
+  Result:=FDispatcher;
+end;
+
+constructor TAPIDescriptionCreator.Create(aDispatcher: TCustomJSONRPCDispatcher);
+begin
+  FDispatcher:=aDispatcher;
+  DefaultOptions:=[caoFullParams];
+end;
+
+procedure TAPIDescriptionCreator.Assign(Source: TPersistent);
+
+Var
+  C : TAPIDescriptionCreator absolute Source;
+
+begin
+  if Source is TAPIDescriptionCreator then
+    begin
+    URL:=C.URL;
+    NameSpace:=C.FNameSpace;
+    FAPIType:=C.APIType;
+    DefaultOptions:=C.DefaultOptions;
+    end
+  else
+    inherited Assign(Source);
+end;
+
 
 { TJSONParamDef }
 
@@ -800,6 +896,167 @@ end;
 
 { TCustomJSONRPCDispatcher }
 
+// Create API method description
+
+Function TAPIDescriptionCreator.CreateParamDef(aDef: TJSONParamDef) : TJSONObject;
+
+begin
+  With aDef do
+    Result:=TJSONObject.Create(['name',Name,'type',JSONTypeName(DataType),'required',Required]);
+end;
+
+procedure TAPIDescriptionCreator.AddParamDefs(O: TJSONObject; Defs: TJSONParamDefs);
+
+Var
+  A : TJSONArray;
+  I : Integer;
+
+begin
+  A:=TJSONArray.Create;
+  O.Add('paramdefs',A);
+  For I:=0 to Defs.Count-1 do
+    A.Add(CreateParamDef(Defs[i]));
+end;
+
+Function TAPIDescriptionCreator.HandlerToAPIMethod (H: TCustomJSONRPCHandler; aOptions : TCreateAPIOptions): TJSONObject;
+
+begin
+  Result:=TJSONObject.Create(['name',H.Name,'len',H.ParamDefs.Count]);
+  if Not (caoFullParams in aOptions) then exit;
+  Result.Add('resulttype',JSONTypeName(H.ResultType));
+  if (H.ParamDefs.Count>0) then
+    AddParamDefs(Result,H.ParamDefs);
+end;
+
+Function TAPIDescriptionCreator.HandlerDefToAPIMethod (H: TJSONRPCHandlerDef; aOptions: TCreateAPIOptions): TJSONObject;
+
+begin
+  Result:=TJSONObject.Create(['name',H.HandlerMethodName,'len',H.ArgumentCount]);
+  if Not (caoFullParams in aOptions) then exit;
+  Result.Add('resulttype',JSONTypeName(H.ResultType));
+  if (H.ParamDefs.Count>0) then
+    AddParamDefs(Result,H.ParamDefs);
+end;
+
+function TAPIDescriptionCreator.GetNameSpace: String;
+begin
+  Result:=FNameSpace;
+  If (Result='') then
+    Result:=DefaultNameSpace
+end;
+
+function TAPIDescriptionCreator.isNameSpaceStored: Boolean;
+begin
+  Result:=NameSpace<>DefaultNameSpace;
+end;
+
+function TAPIDescriptionCreator.DefaultNameSpace: String;
+begin
+  Result:='';
+end;
+
+function TAPIDescriptionCreator.PublishHandler(H: TCustomJSONRPCHandler): Boolean;
+begin
+  Result:=(H<>Nil)
+end;
+
+Function TAPIDescriptionCreator.PublishHandlerDef(HD: TJSONRPCHandlerDef): Boolean;
+
+begin
+  Result:=(HD<>Nil)
+end;
+
+function TAPIDescriptionCreator.CreateAPI(aOptions: TCreateAPIOptions): TJSONObject;
+
+Var
+  A,D : TJSONObject;
+  R : TJSONArray;
+  N : TJSONStringType;
+  H : TCustomJSONRPCHandler;
+  I,J : Integer;
+  M : TCustomJSONRPCHandlerManager;
+  HD : TJSONRPCHandlerDef;
+  search : Boolean;
+  C : TComponent;
+
+begin
+  D:=TJSONObject.Create;
+  try
+    D.Add('url',URL);
+    D.Add('type',APIType);
+    A:=TJSONObject.Create;
+    D.Add('actions',A);
+    R:=Nil;
+    N:='';
+    Search:=assigned(Dispatcher) and (jdoSearchOwner in Dispatcher.Options);
+    C:=Dispatcher.Owner;
+    If Search and Assigned(C) then
+      begin
+      for I:=C.ComponentCount-1 downto 0 do
+        If C.Components[i] is TCustomJSONRPCHandler then
+          begin
+          H:=C.Components[i] as TCustomJSONRPCHandler;
+          if PublishHandler(H) then
+            begin
+            If (R=Nil) then
+              begin
+              N:=C.Name;
+              R:=TJSONArray.Create;
+              A.Add(N,R);
+              end;
+            R.Add(HandlerToAPIMethod(H,aOptions));
+            end;
+          end;
+      end;
+    Search:=assigned(Dispatcher) and (jdoSearchRegistry in Dispatcher.Options);
+    If Search then
+      begin
+      M:=JSONRPCHandlerManager;
+      For I:=M.HandlerCount-1 downto 0 do
+        begin
+        HD:=M.HandlerDefs[i];
+        if PublishHandlerDef(HD) then
+          begin
+          If (R=Nil) or (CompareText(N,HD.HandlerClassName)<>0) then
+            begin
+            N:=HD.HandlerClassName;
+            J:=A.IndexOfName(N);
+            If (J=-1) then
+              begin
+              R:=TJSONArray.Create;
+              A.Add(N,R);
+              end
+            else
+              R:=A.Items[J] as TJSONArray;
+            end;
+          R.Add(HandlerDefToAPIMethod(HD,aOptions));
+          end;
+        end;
+      end;
+      Result:=D;
+  except
+    FreeAndNil(D);
+    Raise;
+  end;
+end;
+
+function TAPIDescriptionCreator.CreateAPI: TJSONObject;
+begin
+  Result:=CreateAPI(DefaultOptions);
+end;
+
+procedure TCustomJSONRPCDispatcher.SetAPICreator(AValue: TAPIDescriptionCreator);
+begin
+  if FAPICreator=AValue then Exit;
+  FAPICreator.Assign(AValue);
+end;
+
+function TCustomJSONRPCDispatcher.CreateAPICreator: TAPIDescriptionCreator;
+begin
+  Result:=TAPIDescriptionCreator.Create(Self);
+end;
+
+
 function TCustomJSONRPCDispatcher.FindHandler(const AClassName, AMethodName: TJSONStringType;AContext : TJSONRPCCallContext;Out FreeObject : TComponent): TCustomJSONRPCHandler;
 
 Var
@@ -862,9 +1119,11 @@ function TCustomJSONRPCDispatcher.FormatResult(Const AClassName, AMethodName: TJ
 Const Params,ID, Return : TJSONData) : TJSONData;
 
 begin
-  Result:=TJSONObject.Create(['result',Return,'error',TJSonNull.Create,transactionproperty,ID.Clone]);
+  Result:=TJSONObject.Create(['result',Return,transactionproperty,ID.Clone]);
   if jdoJSONRPC2 in options then
-    TJSONObject(Result).Add('jsonrpc','2.0');
+    TJSONObject(Result).Add('jsonrpc','2.0')
+  else
+    TJSONObject(Result).Add('error',TJSonNull.Create);
 end;
 
 function TCustomJSONRPCDispatcher.CreateJSON2Error(const AMessage: String;
@@ -1101,9 +1360,17 @@ end;
 constructor TCustomJSONRPCDispatcher.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
+  FAPICreator:=CreateAPICreator;
   FOptions:=DefaultDispatchOptions;
 end;
 
+destructor TCustomJSONRPCDispatcher.Destroy;
+begin
+  FreeAndNil(FAPICreator);
+  FreeAndNil(FCachedAPI);
+  inherited Destroy;
+end;
+
 function TCustomJSONRPCDispatcher.Execute(Requests: TJSONData;AContext : TJSONRPCCallContext = Nil): TJSONData;
 begin
   If Assigned(FOnStartBatch) then
@@ -1115,6 +1382,58 @@ begin
     FOnEndBatch(Self);
 end;
 
+function TCustomJSONRPCDispatcher.CreateAPI(aOptions: TCreateAPIOptions): TJSONObject;
+
+Var
+  CAO : TCreateAPIOptions;
+
+begin
+  CAO:=aOptions-[caoFormatted];
+  Result:=Nil;
+  if (jdoCacheAPI in Options)
+     and (FCachedAPI<>Nil)
+     and (CAO=FCachedAPIOptions) then
+    Result:=TJSONObject(FCachedAPI.Clone)
+  else
+    begin
+    Result:=APICreator.CreateAPI(aOptions);
+    if (jdoCacheAPI in Options) then
+      begin
+      FCachedAPI:=TJSONObject(Result.Clone);
+      FCachedAPIOptions:=CAO;
+      end;
+    end;
+end;
+
+function TCustomJSONRPCDispatcher.CreateAPI: TJSONObject;
+begin
+  Result:=CreateAPI(APICreator.DefaultOptions);
+end;
+
+function TCustomJSONRPCDispatcher.APIAsString(aOptions: TCreateAPIOptions): TJSONStringType;
+
+Var
+  S : TJSONObject;
+
+begin
+  S:=CreateAPI(aOptions);
+  try
+    if caoFormatted in aOptions then
+      Result:=S.FormatJSON()
+    else
+      Result:=S.AsJSON;
+    if APICreator.NameSpace<>'' then
+      Result:=APICreator.NameSpace+' = '+Result;
+  finally
+    S.Free;
+  end;
+end;
+
+function TCustomJSONRPCDispatcher.APIAsString: TJSONStringType;
+begin
+  Result:=APIAsString(APICreator.DefaultOptions);
+end;
+
 { TJSONRPCHandlerDef }
 
 procedure TJSONRPCHandlerDef.SetFPClass(const AValue: TCustomJSONRPCHandlerClass
@@ -1351,6 +1670,7 @@ begin
           D:=AddHandlerDef(CN,C.Name);
           D.ArgumentCount:=TCustomJSONRPCHandler(C).ParamDefs.Count;
           D.ParamDefs:=TCustomJSONRPCHandler(C).ParamDefs;
+          D.ResultType:=TCustomJSONRPCHandler(C).ResultType;
           {$ifdef wmdebug}SendDebug('Registering provider '+C.Name);{$endif}
           D.FDataModuleClass:=TDataModuleClass(DM.ClassType);
           end;
@@ -1378,6 +1698,7 @@ Function TCustomJSONRPCHandlerManager.RegisterHandler(Const AClassName,
 Var
   I : Integer;
   B : Boolean;
+  H : TCustomJSONRPCHandler;
 
 begin
   B:=FRegistering;
@@ -1392,6 +1713,13 @@ begin
     Result:=AddHandlerDef(AClassName,AMEthodName);
     Result.HandlerClass:=AClass;
     Result.ArgumentCount:=AArgumentCount;
+    H:=Aclass.Create(Nil);
+    try
+      Result.ParamDefs:=H.ParamDefs;
+      Result.ResultType:=H.ResultType;
+    finally
+      H.Free;
+    end;
   finally
     FRegistering:=B;
   end;

packages/pastojs/tests/tcmodules.pas

@@ -522,6 +522,7 @@ type
     Procedure TestClass_OverloadsAncestor;
     Procedure TestClass_OverloadConstructor;
     Procedure TestClass_OverloadDelphiOverride;
+    Procedure TestClass_ReintroduceVarDelphi;
     Procedure TestClass_ReintroducedVar;
     Procedure TestClass_RaiseDescendant;
     Procedure TestClass_ExternalMethod;
@@ -13889,6 +13890,94 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClass_ReintroduceVarDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TAnimal = class',
+  '  public',
+  '    {#animal_a}A: longint;',
+  '    function {#animal_b}B: longint;',
+  '  end;',
+  '  TBird = class(TAnimal)',
+  '  public',
+  '    {#bird_a}A: double;',
+  '    {#bird_b}B: boolean;',
+  '  end;',
+  '  TEagle = class(TBird)',
+  '  public',
+  '    function {#eagle_a}A: boolean;',
+  '    {#eagle_b}B: double;',
+  '  end;',
+  'function TAnimal.B: longint;',
+  'begin',
+  'end;',
+  'function TEagle.A: boolean;',
+  'begin',
+  '  {@eagle_b}B:=3.3;',
+  '  {@eagle_a}A();',
+  '  TBird(Self).{@bird_b}B:=true;',
+  '  TAnimal(Self).{@animal_a}A:=17;',
+  '  inherited {@bird_b}B:=inherited {bird_a}A>1;', // Delphi allows only inherited <functionname>
+  'end;',
+  'var',
+  '  e: TEagle;',
+  'begin',
+  '  e.{@eagle_b}B:=5.3;',
+  '  if e.{@eagle_a}A then ;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_ReintroduceVarDelphi',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TAnimal", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.A = 0;',
+    '  };',
+    '  this.B = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TAnimal, function () {',
+    '  this.$init = function () {',
+    '    $mod.TAnimal.$init.call(this);',
+    '    this.A$1 = 0.0;',
+    '    this.B$1 = false;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TEagle", $mod.TBird, function () {',
+    '  this.$init = function () {',
+    '    $mod.TBird.$init.call(this);',
+    '    this.B$2 = 0.0;',
+    '  };',
+    '  this.A$2 = function () {',
+    '    var Result = false;',
+    '    this.B$2 = 3.3;',
+    '    this.A$2();',
+    '    this.B$1 = true;',
+    '    this.A = 17;',
+    '    this.B$1 = this.A$1 > 1;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.e = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.e.B$2 = 5.3;',
+    'if ($mod.e.A$2()) ;',
+    '']));
+end;
+
 procedure TTestModule.TestClass_ReintroducedVar;
 begin
   StartProgram(false);

tests/tbs/tb0670.pp

@@ -0,0 +1,92 @@
+{ %NORUN }
+
+program tb0670;
+
+const
+  Value1 = $06;
+  Value2 = $60;
+  Value3 = $6000;
+  Value4 = $60000000;
+  Value5 = $60000000000;
+
+  Value6 = $40;
+  Value7 = $4000;
+  Value8 = $40000000;
+  Value9 = $40000000000;
+
+  ValueNot1 = not Value1;
+  ValueNot2 = not Value2;
+  ValueNot3 = not Value3;
+  ValueNot4 = not Value4;
+  ValueNot5 = not Value5;
+
+  ValueOr1 = Value1 or Value2;
+  ValueOr2 = Value1 or Value3;
+  ValueOr3 = Value1 or Value4;
+  ValueOr4 = Value1 or Value5;
+
+  ValueAnd1 = Value2 and Value6;
+  ValueAnd2 = Value3 and Value7;
+  ValueAnd3 = Value4 and Value8;
+  ValueAnd4 = Value5 and Value9;
+
+{ Test "not X" }
+
+{$if not (not Value1 = ValueNot1)}
+{$error 'not Value1 = ValueNot1'}
+{$endif}
+
+{$if not (not Value2 = ValueNot2)}
+{$error 'not Value2 = ValueNot2'}
+{$endif}
+
+{$if not (not Value3 = ValueNot3)}
+{$error 'not Value3 = ValueNot3'}
+{$endif}
+
+{$if not (not Value4 = ValueNot4)}
+{$error 'not Value4 = ValueNot4'}
+{$endif}
+
+{$if not (not Value5 = ValueNot5)}
+{$error 'not Value5 = ValueNot5'}
+{$endif}
+
+{ Test "X or Y" }
+
+{$if Value1 or Value2 <> ValueOr1}
+{$error 'Value1 or Value2 = ValueOr1'}
+{$endif}
+
+{$if Value1 or Value3 <> ValueOr2}
+{$error 'Value1 or Value3 = ValueOr2'}
+{$endif}
+
+{$if Value1 or Value4 <> ValueOr3}
+{$error 'Value1 or Value4 = ValueOr3'}
+{$endif}
+
+{$if Value1 or Value5 <> ValueOr4}
+{$error 'Value1 or Value5 = ValueOr4'}
+{$endif}
+
+{ Test "X and Y" }
+
+{$if Value2 and Value6 <> ValueAnd1 }
+{$error 'Value2 and Value6 = ValueAnd1' }
+{$endif}
+
+{$if Value3 and Value7 <> ValueAnd2 }
+{$error 'Value3 and Value7 = ValueAnd2' }
+{$endif}
+
+{$if Value4 and Value8 <> ValueAnd3 }
+{$error 'Value4 and Value8 = ValueAnd3' }
+{$endif}
+
+{$if Value5 and Value9 <> ValueAnd4 }
+{$error 'Value5 and Value9 = ValueAnd4' }
+{$endif}
+
+begin
+end.