2
0
Эх сурвалжийг харах

compiler: fix parsing and handling of typed constants declared inside classes/objects + tests

git-svn-id: trunk@15094 -
paul 15 жил өмнө
parent
commit
c879230f08

+ 2 - 0
.gitattributes

@@ -8943,6 +8943,7 @@ tests/test/tclass11b.pp svneol=native#text/pascal
 tests/test/tclass12a.pp svneol=native#text/pascal
 tests/test/tclass12b.pp svneol=native#text/pascal
 tests/test/tclass12c.pp svneol=native#text/pascal
+tests/test/tclass12d.pp svneol=native#text/plain
 tests/test/tclass13.pp svneol=native#text/pascal
 tests/test/tclass14a.pp svneol=native#text/pascal
 tests/test/tclass14b.pp svneol=native#text/pascal
@@ -9183,6 +9184,7 @@ tests/test/tobject3.pp svneol=native#text/plain
 tests/test/tobject4.pp svneol=native#text/plain
 tests/test/tobject5.pp svneol=native#text/pascal
 tests/test/tobject6.pp svneol=native#text/plain
+tests/test/tobject7.pp svneol=native#text/plain
 tests/test/toperator1.pp svneol=native#text/plain
 tests/test/toperator2.pp svneol=native#text/plain
 tests/test/toperator3.pp svneol=native#text/plain

+ 1 - 1
compiler/pdecl.pas

@@ -254,7 +254,7 @@ implementation
                         tclist:=current_asmdata.asmlists[al_rotypedconsts]
                       else
                         tclist:=current_asmdata.asmlists[al_typedconsts];
-                      read_typed_const(tclist,tstaticvarsym(sym));
+                      read_typed_const(tclist,tstaticvarsym(sym),in_class);
                     end;
                 end;
 

+ 2 - 2
compiler/pdecvar.pas

@@ -999,11 +999,11 @@ implementation
                 include(tcsym.symoptions,sp_internal);
                 vs.defaultconstsym:=tcsym;
                 symtablestack.top.insert(tcsym);
-                read_typed_const(current_asmdata.asmlists[al_typedconsts],tcsym);
+                read_typed_const(current_asmdata.asmlists[al_typedconsts],tcsym,false);
               end;
             staticvarsym :
               begin
-                read_typed_const(current_asmdata.asmlists[al_typedconsts],tstaticvarsym(vs));
+                read_typed_const(current_asmdata.asmlists[al_typedconsts],tstaticvarsym(vs),false);
               end;
             else
               internalerror(200611051);

+ 7 - 1
compiler/pexpr.pas

@@ -1285,6 +1285,12 @@ implementation
                    begin
                      p1.free;
                      p1:=genconstsymtree(tconstsym(sym));
+                   end;
+                 staticvarsym:
+                   begin
+                     // typed constant is a staticvarsym
+                     p1.free;
+                     p1:=cloadnode.create(sym,sym.Owner);
                    end
                  else
                    internalerror(16);
@@ -1531,7 +1537,7 @@ implementation
                                 begin
                                   check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
                                   if not(getaddr) and
-                                     not((sp_static in srsym.symoptions) or (srsym.typ=constsym)) then
+                                     not((sp_static in srsym.symoptions) or (srsym.typ in [constsym,staticvarsym])) then
                                     Message(sym_e_only_static_in_static)
                                   else
                                     begin

+ 4 - 3
compiler/ptconst.pas

@@ -27,7 +27,7 @@ interface
 
    uses symtype,symsym,aasmdata;
 
-    procedure read_typed_const(list:tasmlist;sym:tstaticvarsym);
+    procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean);
 
 
 implementation
@@ -1375,7 +1375,7 @@ implementation
 
 {$maxfpuregisters default}
 
-    procedure read_typed_const(list:tasmlist;sym:tstaticvarsym);
+    procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean);
       var
         storefilepos : tfileposinfo;
         cursectype   : TAsmSectionType;
@@ -1407,7 +1407,8 @@ implementation
         consume(_SEMICOLON);
 
         { parse public/external/export/... }
-        if (
+        if not in_class and
+           (
             (
              (token = _ID) and
              (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and

+ 30 - 0
tests/test/tclass12d.pp

@@ -0,0 +1,30 @@
+program tclass12d;
+{$APPTYPE console}
+{$ifdef fpc}
+  {$mode delphi}{$H+}
+{$endif}
+
+type
+  TR = class
+  private
+    type
+      TSomeType = integer;
+    const
+      SomeValue: TSomeType = 1;
+    class function GetSomeProp: TSomeType; static;
+  public
+    class property SomeProp: TSomeType read GetSomeProp;
+  end;
+
+class function TR.GetSomeProp: TSomeType;
+begin
+  Result := SomeValue;
+end;
+
+begin
+  if TR.SomeValue <> 1 then
+    halt(1);
+  if TR.SomeProp <> 1 then
+    halt(1);
+  WriteLn('ok');
+end.

+ 30 - 0
tests/test/tobject7.pp

@@ -0,0 +1,30 @@
+program tclass12d;
+{$APPTYPE console}
+{$ifdef fpc}
+  {$mode delphi}{$H+}
+{$endif}
+
+type
+  TR = object
+  private
+    type
+      TSomeType = integer;
+    const
+      SomeValue: TSomeType = 1;
+    class function GetSomeProp: TSomeType; static;
+  public
+    class property SomeProp: TSomeType read GetSomeProp;
+  end;
+
+class function TR.GetSomeProp: TSomeType;
+begin
+  Result := SomeValue;
+end;
+
+begin
+  if TR.SomeValue <> 1 then
+    halt(1);
+  if TR.SomeProp <> 1 then
+    halt(1);
+  WriteLn('ok');
+end.