do not publish enums with jumps

compiler/msg/errore.msg

@@ -445,7 +445,7 @@ scan_e_unexpected_endif=02108_E_$ENDIF directive found without a matching $IF(N)
 #
 # Parser
 #
-# 03364 is the last used one
+# 03365 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1639,6 +1639,8 @@ parser_e_section_directive_not_allowed_for_target=03362_E_Directive section not
 % Only some targets (e.g. Embedded and FreeRTOS) support the section directive.
 parser_e_absolute_sym_cannot_reference_itself=03363_E_Absolute variable cannot reference itself
 parser_e_syscall_format_not_support=03364_E_Syntax of syscall directive not supported by current target
+% Published property is ignored
+parser_w_ignoring_published_property=03365_W_This property will not be published
 % On a certain target, not all syntax variants of the syscall directive make sense and thus those making
 % no sense are not supported
 % Declarations like \var{var i: Integer absolute i;} are not allowed

compiler/msgidx.inc

@@ -478,6 +478,7 @@ const
   parser_e_section_directive_not_allowed_for_target=03362;
   parser_e_absolute_sym_cannot_reference_itself=03363;
   parser_e_syscall_format_not_support=03364;
+  parser_w_ignoring_published_property=03365;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -1156,9 +1157,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 90505;
+  MsgTxtSize = 90549;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,109,365,132,100,63,148,38,223,71,
+    28,109,366,132,100,63,148,38,223,71,
     65,20,30,1,1,1,1,1,1,1
   );

compiler/pdecvar.pas

@@ -519,10 +519,13 @@ implementation
            $M has effect on visibility of default section for classes. 
            Interface has always only public section (fix for problem in tb0631.pp) }
          if ((p.visibility=vis_published) or is_dispinterface(astruct)) and
-            ((not(p.propdef.is_publishable) and not is_interface(astruct)) or
+            ((not(p.propdef.is_publishable=pp_publish) and not is_interface(astruct)) or
              (sp_static in p.symoptions)) then
            begin
-             Message(parser_e_cant_publish_that_property);
+             if p.propdef.is_publishable=pp_error then
+               Message(parser_e_cant_publish_that_property)
+             else
+               Message(parser_w_ignoring_published_property);
              p.visibility:=vis_public;
            end;
 

compiler/symdef.pas

@@ -154,7 +154,7 @@ interface
           function  size:asizeint;override;
           function  getvardef:longint;override;
           function  alignment:shortint;override;
-          function  is_publishable : boolean;override;
+          function  is_publishable : tpublishproperty;override;
           function  needs_inittable : boolean;override;
           function  has_non_trivial_init_child(check_parent:boolean):boolean;override;
           function  rtti_mangledname(rt:trttitype):TSymStr;override;
@@ -223,7 +223,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;
           function  getvardef:longint;override;
           procedure setsize;
-          function is_publishable : boolean;override;
+          function is_publishable : tpublishproperty;override;
           function needs_inittable : boolean;override;
        end;
        tvariantdefclass = class of tvariantdef;
@@ -522,7 +522,7 @@ interface
           function  members_need_inittable : boolean;
           { this should be called when this class implements an interface }
           procedure prepareguid;
-          function  is_publishable : boolean;override;
+          function  is_publishable : tpublishproperty;override;
           function  needs_inittable : boolean;override;
           function  needs_separate_initrtti : boolean;override;
           function  has_non_trivial_init_child(check_parent:boolean):boolean;override;
@@ -564,7 +564,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;
           function getcopy:tstoreddef;override;
           function GetTypeName:string;override;
-          function is_publishable : boolean;override;
+          function is_publishable : tpublishproperty;override;
           function rtti_mangledname(rt:trttitype):TSymStr;override;
           procedure register_created_object_type;override;
        end;
@@ -614,7 +614,7 @@ interface
           function needs_inittable : boolean;override;
           function needs_separate_initrtti : boolean;override;
           property elementdef : tdef read _elementdef write setelementdef;
-          function is_publishable : boolean;override;
+          function is_publishable : tpublishproperty;override;
           function is_hwvector: boolean;
        end;
        tarraydefclass = class of tarraydef;
@@ -628,7 +628,7 @@ interface
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;
-          function  is_publishable : boolean;override;
+          function  is_publishable : tpublishproperty;override;
           function  GetTypeName:string;override;
           function alignment:shortint;override;
           procedure setsize;
@@ -646,7 +646,7 @@ interface
             override ppuwrite_platform instead }
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;
           function  GetTypeName:string;override;
-          function  is_publishable : boolean;override;
+          function  is_publishable : tpublishproperty;override;
           function alignment:shortint;override;
           function structalignment: shortint;override;
           procedure setsize;
@@ -750,7 +750,7 @@ interface
           function  GetSymtable(t:tGetSymtable):TSymtable;override;
           function  size : asizeint;override;
           function  GetTypeName:string;override;
-          function  is_publishable : boolean;override;
+          function  is_publishable : tpublishproperty;override;
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           function  getmangledparaname:TSymStr;override;
@@ -1016,7 +1016,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;
           function  GetTypeName:string;override;
           function  getmangledparaname:TSymStr;override;
-          function  is_publishable : boolean;override;
+          function  is_publishable : tpublishproperty;override;
           function  size:asizeint;override;
           function alignment : shortint;override;
           function  needs_inittable : boolean;override;
@@ -1048,7 +1048,7 @@ interface
           procedure buildderef;override;
           procedure deref;override;
           function  GetTypeName:string;override;
-          function  is_publishable : boolean;override;
+          function  is_publishable : tpublishproperty;override;
           procedure calcsavesize(packenum: shortint);
           function  packedbitsize: asizeint; override;
           procedure setmax(_max:asizeint);
@@ -1076,7 +1076,7 @@ interface
           procedure buildderef;override;
           procedure deref;override;
           function  GetTypeName:string;override;
-          function  is_publishable : boolean;override;
+          function  is_publishable : tpublishproperty;override;
           function alignment: shortint; override;
        end;
        tsetdefclass = class of tsetdef;
@@ -2417,9 +2417,9 @@ implementation
 
 
     { returns true, if the definition can be published }
-    function tstoreddef.is_publishable : boolean;
+    function tstoreddef.is_publishable : tpublishproperty;
       begin
-         is_publishable:=false;
+         is_publishable:=pp_error;
       end;
 
 
@@ -2897,9 +2897,9 @@ implementation
       end;
 
 
-    function tstringdef.is_publishable : boolean;
+    function tstringdef.is_publishable : tpublishproperty;
       begin
-         is_publishable:=true;
+         is_publishable:=pp_publish;
       end;
 
 
@@ -3148,9 +3148,15 @@ implementation
       end;
 
 
-    function tenumdef.is_publishable : boolean;
+    function tenumdef.is_publishable : tpublishproperty;
       begin
-         is_publishable:=true;
+         if not has_jumps then
+           is_publishable:=pp_publish
+         else
+         if m_delphi in current_settings.modeswitches then
+           is_publishable:=pp_ignore
+         else
+           is_publishable:=pp_error;
       end;
 
 
@@ -3497,9 +3503,12 @@ implementation
       end;
 
 
-    function torddef.is_publishable : boolean;
+    function torddef.is_publishable : tpublishproperty;
       begin
-         is_publishable:=(ordtype<>uvoid);
+         if ordtype<>uvoid then
+           is_publishable:=pp_publish
+         else
+           is_publishable:=pp_error;
       end;
 
 
@@ -3626,9 +3635,9 @@ implementation
       end;
 
 
-    function tfloatdef.is_publishable : boolean;
+    function tfloatdef.is_publishable : tpublishproperty;
       begin
-         is_publishable:=true;
+         is_publishable:=pp_publish;
       end;
 
 
@@ -3859,9 +3868,9 @@ implementation
       end;
 
 
-    function tvariantdef.is_publishable : boolean;
+    function tvariantdef.is_publishable : tpublishproperty;
       begin
-         is_publishable:=true;
+         is_publishable:=pp_publish;
       end;
 
 
@@ -4100,9 +4109,9 @@ implementation
       end;
 
 
-    function tclassrefdef.is_publishable : boolean;
+    function tclassrefdef.is_publishable : tpublishproperty;
       begin
-         result:=true;
+         is_publishable:=pp_publish;
       end;
 
 
@@ -4207,9 +4216,12 @@ implementation
       end;
 
 
-    function tsetdef.is_publishable : boolean;
+    function tsetdef.is_publishable : tpublishproperty;
       begin
-         is_publishable:=savesize in [1,2,4];
+         if savesize in [1,2,4] then
+           is_publishable:=pp_publish
+         else
+           is_publishable:=pp_error;
       end;
 
     function tsetdef.alignment: shortint;
@@ -4637,9 +4649,12 @@ implementation
       end;
 
 
-    function tarraydef.is_publishable : boolean;
+    function tarraydef.is_publishable : tpublishproperty;
       begin
-        Result:=ado_IsDynamicArray in arrayoptions;
+         if ado_IsDynamicArray in arrayoptions then
+           is_publishable:=pp_publish
+         else
+           is_publishable:=pp_error;
       end;
 
 
@@ -7600,9 +7615,12 @@ implementation
       end;
 
 
-    function tprocvardef.is_publishable : boolean;
+    function tprocvardef.is_publishable : tpublishproperty;
       begin
-         is_publishable:=(po_methodpointer in procoptions);
+         if po_methodpointer in procoptions then
+           is_publishable:=pp_publish
+         else
+           is_publishable:=pp_error;
       end;
 
 
@@ -8472,9 +8490,12 @@ implementation
       end;
 
 
-    function tobjectdef.is_publishable : boolean;
+    function tobjectdef.is_publishable : tpublishproperty;
       begin
-         is_publishable:=objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface];
+         if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
+           is_publishable:=pp_publish
+         else
+           is_publishable:=pp_error;
       end;
 
 

compiler/symtype.pas

@@ -51,6 +51,7 @@ interface
 ************************************************}
 
       tgetsymtable = (gs_none,gs_record,gs_local,gs_para);
+      tpublishproperty = (pp_ignore, pp_error, pp_publish);
 
       tdef = class(TDefEntry)
         protected
@@ -98,7 +99,7 @@ interface
          function  getvardef:longint;virtual;abstract;
          function  getparentdef:tdef;virtual;
          function  getsymtable(t:tgetsymtable):TSymtable;virtual;
-         function  is_publishable:boolean;virtual;abstract;
+         function  is_publishable:tpublishproperty;virtual;abstract;
          function  needs_inittable:boolean;virtual;abstract;
          { contains a (managed) child that is not initialized to 0/Nil }
          function  has_non_trivial_init_child(check_parent:boolean):boolean;virtual;abstract;

tests/webtbf/tw39866.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+program RTTITest;
+
+{$mode objfpc}{$h+}
+
+uses
+  SysUtils, Classes, TypInfo;
+
+type
+  TMyEnum = (meOne=1, meThree=3, meFive=5, meSix);
+
+  TMyClass = class(TPersistent)
+  private
+    FEnum: TMyEnum;
+  Published
+    property Enum: TMyEnum read FEnum write FEnum;
+  end;
+
+begin
+end.

tests/webtbs/tw39866.pp

@@ -0,0 +1,32 @@
+program RTTITest;
+
+{$mode delphi}{$h+}
+
+uses
+  SysUtils, Classes, TypInfo;
+
+type
+  TMyEnum = (meOne=1, meThree=3, meFive=5, meSix);
+
+  TMyClass = class(TPersistent)
+  private
+    FEnum: TMyEnum;
+  Published
+    property Enum: TMyEnum read FEnum write FEnum;
+  end;
+
+var
+  PI: PPropInfo;
+  aClass: TMyClass;
+  TypeData: PTypeData;
+begin
+  aClass:=TMyClass.Create;
+  TypeData:=GetTypeData(aClass.ClassInfo);
+  if TypeData^.PropCount<>0 then
+    Halt(1);
+
+  PI:=GetPropInfo(aClass,'Enum',tkAny);
+  if Assigned(PI) then
+    Halt(2);
+  aClass.Free;
+end.