Преглед изворни кода

--- Merging r40284 into '.':
U compiler/pdecvar.pas
--- Recording mergeinfo for merge of r40284 into '.':
U .
--- Merging r40285 into '.':
D tests/webtbs/tw27880.pp
A tests/webtbf/tw27880.pp
A tests/tbf/tb0261.pp
A tests/tbf/tb0262.pp
A tests/tbf/tb0263.pp
A tests/tbf/tb0264.pp
A tests/tbf/tb0265.pp
U compiler/pdecl.pas
--- Recording mergeinfo for merge of r40285 into '.':
G .

# revisions: 40284,40285

git-svn-id: branches/fixes_3_2@40289 -

marco пре 6 година
родитељ
комит
6574f0974a
9 измењених фајлова са 155 додато и 33 уклоњено
  1. 6 1
      .gitattributes
  2. 3 0
      compiler/pdecl.pas
  3. 48 31
      compiler/pdecvar.pas
  4. 18 0
      tests/tbf/tb0261.pp
  5. 18 0
      tests/tbf/tb0262.pp
  6. 20 0
      tests/tbf/tb0263.pp
  7. 21 0
      tests/tbf/tb0264.pp
  8. 20 0
      tests/tbf/tb0265.pp
  9. 1 1
      tests/webtbf/tw27880.pp

+ 6 - 1
.gitattributes

@@ -10941,6 +10941,11 @@ tests/tbf/tb0256.pp svneol=native#text/pascal
 tests/tbf/tb0257a.pp svneol=native#text/pascal
 tests/tbf/tb0257a.pp svneol=native#text/pascal
 tests/tbf/tb0257b.pp svneol=native#text/pascal
 tests/tbf/tb0257b.pp svneol=native#text/pascal
 tests/tbf/tb0258.pp svneol=native#text/pascal
 tests/tbf/tb0258.pp svneol=native#text/pascal
+tests/tbf/tb0261.pp svneol=native#text/pascal
+tests/tbf/tb0262.pp svneol=native#text/pascal
+tests/tbf/tb0263.pp svneol=native#text/pascal
+tests/tbf/tb0264.pp svneol=native#text/pascal
+tests/tbf/tb0265.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -14508,6 +14513,7 @@ tests/webtbf/tw2739.pp svneol=native#text/plain
 tests/webtbf/tw2751.pp svneol=native#text/plain
 tests/webtbf/tw2751.pp svneol=native#text/plain
 tests/webtbf/tw2752.pp svneol=native#text/plain
 tests/webtbf/tw2752.pp svneol=native#text/plain
 tests/webtbf/tw2787.pp svneol=native#text/plain
 tests/webtbf/tw2787.pp svneol=native#text/plain
+tests/webtbf/tw27880.pp svneol=native#text/pascal
 tests/webtbf/tw2795.pp svneol=native#text/plain
 tests/webtbf/tw2795.pp svneol=native#text/plain
 tests/webtbf/tw28338.pp svneol=native#text/plain
 tests/webtbf/tw28338.pp svneol=native#text/plain
 tests/webtbf/tw28355.pp svneol=native#text/plain
 tests/webtbf/tw28355.pp svneol=native#text/plain
@@ -15882,7 +15888,6 @@ tests/webtbs/tw2780.pp svneol=native#text/plain
 tests/webtbs/tw27811.pp svneol=native#text/plain
 tests/webtbs/tw27811.pp svneol=native#text/plain
 tests/webtbs/tw27832.pp svneol=native#text/plain
 tests/webtbs/tw27832.pp svneol=native#text/plain
 tests/webtbs/tw2788.pp svneol=native#text/plain
 tests/webtbs/tw2788.pp svneol=native#text/plain
-tests/webtbs/tw27880.pp svneol=native#text/plain
 tests/webtbs/tw2789.pp svneol=native#text/plain
 tests/webtbs/tw2789.pp svneol=native#text/plain
 tests/webtbs/tw2794.pp svneol=native#text/plain
 tests/webtbs/tw2794.pp svneol=native#text/plain
 tests/webtbs/tw27998.pp svneol=native#text/plain
 tests/webtbs/tw27998.pp svneol=native#text/plain

+ 3 - 0
compiler/pdecl.pas

@@ -274,6 +274,9 @@ implementation
                      to it from the structure or linking will fail }
                      to it from the structure or linking will fail }
                    if symtablestack.top.symtabletype in [recordsymtable,ObjectSymtable] then
                    if symtablestack.top.symtabletype in [recordsymtable,ObjectSymtable] then
                      begin
                      begin
+                       { note: we keep hdef so that we might at least read the
+                               constant data correctly for error recovery }
+                       check_allowed_for_var_or_const(hdef,false);
                        sym:=cfieldvarsym.create(orgname,varspez,hdef,[],true);
                        sym:=cfieldvarsym.create(orgname,varspez,hdef,[],true);
                        symtablestack.top.insert(sym);
                        symtablestack.top.insert(sym);
                        sym:=make_field_static(symtablestack.top,tfieldvarsym(sym));
                        sym:=make_field_static(symtablestack.top,tfieldvarsym(sym));

+ 48 - 31
compiler/pdecvar.pas

@@ -28,7 +28,7 @@ interface
 
 
     uses
     uses
       cclasses,
       cclasses,
-      symtable,symsym,symdef;
+      symtable,symsym,symdef,symtype;
 
 
     type
     type
       tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final,vd_canreorder,vd_check_generic);
       tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final,vd_canreorder,vd_check_generic);
@@ -44,6 +44,8 @@ interface
 
 
     procedure try_consume_sectiondirective(var asection: ansistring);
     procedure try_consume_sectiondirective(var asection: ansistring);
 
 
+    function check_allowed_for_var_or_const(def:tdef;allowdynarray:boolean):boolean;
+
 implementation
 implementation
 
 
     uses
     uses
@@ -54,7 +56,7 @@ implementation
        globtype,globals,tokens,verbose,constexp,
        globtype,globals,tokens,verbose,constexp,
        systems,
        systems,
        { symtable }
        { symtable }
-       symconst,symbase,symtype,defutil,defcmp,symcreat,
+       symconst,symbase,defutil,defcmp,symcreat,
 {$if defined(i386) or defined(i8086)}
 {$if defined(i386) or defined(i8086)}
        symcpu,
        symcpu,
 {$endif}
 {$endif}
@@ -1541,6 +1543,47 @@ implementation
       end;
       end;
 
 
 
 
+    function check_allowed_for_var_or_const(def:tdef;allowdynarray:boolean):boolean;
+      var
+        stowner,tmpdef : tdef;
+        st : tsymtable;
+      begin
+        result:=true;
+        st:=symtablestack.top;
+        if not (st.symtabletype in [recordsymtable,objectsymtable]) then
+          exit;
+        stowner:=tdef(st.defowner);
+        while assigned(stowner) and (stowner.typ in [objectdef,recorddef]) do
+          begin
+            if def.typ=arraydef then
+              begin
+                tmpdef:=def;
+                while (tmpdef.typ=arraydef) do
+                  begin
+                    { dynamic arrays are allowed in certain cases }
+                    if allowdynarray and (ado_IsDynamicArray in tarraydef(tmpdef).arrayoptions) then
+                      begin
+                        tmpdef:=nil;
+                        break;
+                      end;
+                    tmpdef:=tarraydef(tmpdef).elementdef;
+                  end;
+              end
+            else
+              tmpdef:=def;
+            if assigned(tmpdef) and
+                (is_object(tmpdef) or is_record(tmpdef)) and
+                is_owned_by(tabstractrecorddef(stowner),tabstractrecorddef(tmpdef)) then
+              begin
+                Message1(type_e_type_is_not_completly_defined,tabstractrecorddef(tmpdef).RttiName);
+                result:=false;
+                break;
+              end;
+            stowner:=tdef(stowner.owner.defowner);
+          end;
+      end;
+
+
     procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList; variantdesc : ppvariantrecdesc;out had_generic:boolean);
     procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList; variantdesc : ppvariantrecdesc;out had_generic:boolean);
       var
       var
          sc : TFPObjectList;
          sc : TFPObjectList;
@@ -1644,35 +1687,9 @@ implementation
              { allow only static fields reference to struct where they are declared }
              { allow only static fields reference to struct where they are declared }
              if not (vd_class in options) then
              if not (vd_class in options) then
                begin
                begin
-                 stowner:=tdef(recst.defowner);
-                 while assigned(stowner) and (stowner.typ in [objectdef,recorddef]) do
-                   begin
-                     if hdef.typ=arraydef then
-                       begin
-                         tmpdef:=hdef;
-                         while (tmpdef.typ=arraydef) do
-                           begin
-                             { dynamic arrays are allowed }
-                             if ado_IsDynamicArray in tarraydef(tmpdef).arrayoptions then
-                               begin
-                                 tmpdef:=nil;
-                                 break;
-                               end;
-                             tmpdef:=tarraydef(tmpdef).elementdef;
-                           end;
-                       end
-                     else
-                       tmpdef:=hdef;
-                     if assigned(tmpdef) and
-                         (is_object(tmpdef) or is_record(tmpdef)) and
-                         is_owned_by(tabstractrecorddef(stowner),tabstractrecorddef(tmpdef)) then
-                       begin
-                         Message1(type_e_type_is_not_completly_defined, tabstractrecorddef(tmpdef).RttiName);
-                         { for error recovery or compiler will crash later }
-                         hdef:=generrordef;
-                       end;
-                     stowner:=tdef(stowner.owner.defowner);
-                   end;
+                 if not check_allowed_for_var_or_const(hdef,true) then
+                   { for error recovery or compiler will crash later }
+                   hdef:=generrordef;
                end;
                end;
 
 
              { Process procvar directives }
              { Process procvar directives }

+ 18 - 0
tests/tbf/tb0261.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+program tb0261;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  public
+    a, b: LongInt;
+  public const
+    Test: TTest = (a: 42; b: 21);
+  end;
+
+begin
+
+end.

+ 18 - 0
tests/tbf/tb0262.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+program tb0262;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  public
+    a, b: LongInt;
+  public const
+    Test: array[0..1] of TTest = ((a: 42; b: 21), (a: 21; b: 42));
+  end;
+
+begin
+
+end.

+ 20 - 0
tests/tbf/tb0263.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+program tb0263;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  public
+    a, b: LongInt;
+  public const
+    Test: array[0..1] of record
+      t: TTest;
+    end = ((t: (a: 42; b: 21)), (t: (a: 21; b: 42)));
+  end;
+
+begin
+
+end.

+ 21 - 0
tests/tbf/tb0264.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+program tb0264;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  public
+    a, b: LongInt;
+  public type
+    TSubType = record
+    public const
+      Test: TTest = (a: 42; b: 21);
+    end;
+  end;
+
+begin
+
+end.

+ 20 - 0
tests/tbf/tb0265.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+program tb0265;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  public
+    a, b: LongInt;
+  public const
+    Test: array of record
+      t: TTest;
+    end = ((t: (a: 42; b: 21)), (t: (a: 21; b: 42)));
+  end;
+
+begin
+
+end.

+ 1 - 1
tests/webtbs/tw27880.pp → tests/webtbf/tw27880.pp

@@ -1,4 +1,4 @@
-{ %norun }
+{ %FAIL }
 
 
 program project1;
 program project1;