Browse Source

* Return an error if there is a unbound class-attribute at the end of a type-block

git-svn-id: branches/joost/classattributes@22967 -
joost 13 years ago
parent
commit
173622da46
3 changed files with 39 additions and 2 deletions
  1. 1 0
      .gitattributes
  2. 3 2
      compiler/pdecl.pas
  3. 35 0
      tests/test/tclassattribute8.pp

+ 1 - 0
.gitattributes

@@ -10486,6 +10486,7 @@ tests/test/tclassattribute4.pp svneol=native#text/plain
 tests/test/tclassattribute5.pp svneol=native#text/plain
 tests/test/tclassattribute6.pp svneol=native#text/plain
 tests/test/tclassattribute7.pp svneol=native#text/plain
+tests/test/tclassattribute8.pp svneol=native#text/plain
 tests/test/tclassinfo1.pp svneol=native#text/pascal
 tests/test/tclrprop.pp svneol=native#text/plain
 tests/test/tcmov1.pp svneol=native#text/plain

+ 3 - 2
compiler/pdecl.pas

@@ -870,8 +870,9 @@ implementation
                generictypelist.free;
              end;
 
-           if Assigned(current_rtticlassattributesdef) then
-             internalerror(202105250);
+           if assigned(current_rtticlassattributesdef) and (current_rtticlassattributesdef.get_attribute_count>0) then
+             Message1(scan_e_unresolved_attribute,trtti_attribute(current_rtticlassattributesdef.rtti_attributes[0]).typesym.prettyname);
+
          until ((token<>_ID) and (token<>_LECKKLAMMER)) or
                (in_structure and
                 ((idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]) or

+ 35 - 0
tests/test/tclassattribute8.pp

@@ -0,0 +1,35 @@
+program tclassattribute8;
+
+{$mode objfpc}{$H+}
+
+uses
+  typinfo;
+
+type
+
+  { tmyt }
+
+  TMyt = class(TCustomAttribute)
+    constructor create;
+  end;
+
+type
+
+  { TMyObject }
+
+  [TMyt]
+  TMyObject = class(TObject)
+  end;
+  // Attributes for integers are not allowed, so the following should fail, since
+  // there is nothing to bind the attribute to.
+  [TMyt]
+  int = integer;
+
+constructor TMyt.create;
+begin
+
+end;
+
+begin
+end.
+