* Inherit extended RTTI settings from parent object

compiler/pdecobj.pas

@@ -1703,8 +1703,13 @@ implementation
             else
               olddef:=nil;
               
-            { apply $RTTI directive to current object }
-            current_structdef.apply_rtti_directive(current_module.rtti_directive);
+            { if set explicitly, apply $RTTI directive to current object }
+            if current_module.rtti_directive.clause<>rtc_none then
+              current_structdef.apply_rtti_directive(current_module.rtti_directive)
+            else
+              { if not set, and class has a parent, take parent object settings }
+              if (objectType = odt_class) and assigned(current_objectdef.childof) then
+                current_structdef.apply_rtti_directive(current_objectdef.childof.rtti);
 
             { generate TObject VMT space }
             { We must insert the VMT at the start for system.tobject, and class_tobject was already set.

rtl/inc/rttih.inc

@@ -41,14 +41,32 @@ type
 const
 {$IFNDEF SMALLRTTI}
   DefaultFieldRttiVisibility = [vcPrivate..vcPublished];
-  DefaultMethodRttiVisibility = [vcPublic..vcPublished];
-  DefaultPropertyRttiVisibility = [vcPublic..vcPublished];
+  DefaultMethodRttiVisibility = [vcPublic,vcPublished];
+  DefaultPropertyRttiVisibility = [vcPublic,vcPublished];
 {$ELSE SMALLRTTI}
   DefaultFieldRttiVisibility = [];
   DefaultMethodRttiVisibility = [];
   DefaultPropertyRttiVisibility = [];
 {$ENDIF SMALLRTTI}
 
+ { Default RTTI settings }
+
+{$IFDEF FPC_HAS_FEATURE_RTTI}
+{$IFDEF ENABLE_DELPHI_RTTI}
+
+{$Message WARN 'Delphi RTTI enabled'}
+
+{$RTTI INHERIT
+   METHODS(DefaultMethodRttiVisibility)
+   FIELDS(DefaultFieldRttiVisibility)
+   PROPERTIES(DefaultPropertyRttiVisibility)
+}
+
+{$ENDIF ENABLE_DELPHI_RTTI}
+
+{$ENDIF FPC_HAS_FEATURE_RTTI}
+
+ 
 
 {$POP}
 
@@ -61,7 +79,7 @@ const
   tkWideString = tkWString;
   tkUnicodeString = tkUString;
 
-{$ifdef FPC_HAS_FEATURE_RTTI}
+{$IFDEF FPC_HAS_FEATURE_RTTI}
 procedure InitializeArray(p, typeInfo: Pointer; count: SizeInt);
 procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);
 procedure CopyArray(dest, source, typeInfo: Pointer; count: SizeInt);

tests/test/texrtti16.pp

@@ -0,0 +1,50 @@
+{$MODE OBJFPC}
+{$M+}
+
+{ 
+  test that TMethodClassRTTI inherits RTTI settings of TBase 
+  Note that the system unit must be compiled without extended RTTI generation TObject
+}
+
+
+program texrtti16;
+
+uses typinfo, sysutils, uexrtti16, uexrttiutil;
+
+Type
+  { TMethodClassRTTI }
+
+  TMethodClassRTTI = Class (TBase)
+  Private
+    FY : Boolean;
+  public
+    Procedure PublicMethod;
+    Property Y : Boolean Read FY Write FY;
+  end;
+
+procedure TMethodClassRTTI.PublicMethod;
+begin
+  Writeln('hiero')
+end;
+
+procedure TestClassMethods;
+
+Var
+  A : PExtendedMethodInfoTable;
+  aCount : Integer;
+  AInstance : TMethodClassRTTI;
+  P: PPropListEx;
+
+begin
+  aCount:=GetMethodList(TMethodClassRTTI,A,[]);
+  AssertEquals('Public method has extended RTTI',1,aCount);
+  CheckMethod('Full',0, A^[0],'PublicMethod',vcPublic);
+  aCount:=GetPropListEx(TMethodClassRTTI,P);  
+  AssertEquals('Public property has RTTI',1,aCount);
+  CheckProperty(0, P^[0]^,'Y',tkBool,vcPublic,false);
+end;
+
+begin
+  TestClassMethods;
+end.
+

tests/test/uexrtti16.pp

@@ -0,0 +1,18 @@
+unit uexrtti16;
+
+{$mode objfpc}
+
+interface
+
+Type
+  {$RTTI EXPLICIT
+     PROPERTIES([vcPublic])
+     FIELDS([vcPublic])
+     METHODS([vcPublic])}
+     
+  TBase = Class(TObject)
+  end;
+
+implementation
+
+end.