Просмотр исходного кода

* allow custom attributes for all type declarations that are not a simple alias
+ added tests

git-svn-id: trunk@42405 -

svenbarth 6 лет назад
Родитель
Сommit
404b465c33
4 измененных файлов с 107 добавлено и 4 удалено
  1. 2 0
      .gitattributes
  2. 5 4
      compiler/pdecl.pas
  3. 13 0
      tests/test/tcustomattr17.pp
  4. 87 0
      tests/test/tcustomattr18.pp

+ 2 - 0
.gitattributes

@@ -13213,6 +13213,8 @@ tests/test/tcustomattr13.pp svneol=native#text/pascal
 tests/test/tcustomattr14.pp svneol=native#text/pascal
 tests/test/tcustomattr14.pp svneol=native#text/pascal
 tests/test/tcustomattr15.pp svneol=native#text/pascal
 tests/test/tcustomattr15.pp svneol=native#text/pascal
 tests/test/tcustomattr16.pp svneol=native#text/pascal
 tests/test/tcustomattr16.pp svneol=native#text/pascal
+tests/test/tcustomattr17.pp svneol=native#text/pascal
+tests/test/tcustomattr18.pp svneol=native#text/pascal
 tests/test/tcustomattr2.pp svneol=native#text/pascal
 tests/test/tcustomattr2.pp svneol=native#text/pascal
 tests/test/tcustomattr3.pp svneol=native#text/pascal
 tests/test/tcustomattr3.pp svneol=native#text/pascal
 tests/test/tcustomattr4.pp svneol=native#text/pascal
 tests/test/tcustomattr4.pp svneol=native#text/pascal

+ 5 - 4
compiler/pdecl.pas

@@ -1025,10 +1025,6 @@ implementation
                         vmtbuilder.free;
                         vmtbuilder.free;
                       end;
                       end;
 
 
-                    { If there are attribute-properties available, bind them to
-                      this object }
-                    trtti_attribute_list.bind(rtti_attrs_def,tobjectdef(hdef).rtti_attribute_list);
-
                     { In case of an objcclass, verify that all methods have a message
                     { In case of an objcclass, verify that all methods have a message
                       name set. We only check this now, because message names can be set
                       name set. We only check this now, because message names can be set
                       during the protocol (interface) mapping. At the same time, set the
                       during the protocol (interface) mapping. At the same time, set the
@@ -1056,6 +1052,11 @@ implementation
                     consume(_SEMICOLON);
                     consume(_SEMICOLON);
                   end;
                   end;
               end;
               end;
+
+              { if we have a real type definition or a unique type we may bind
+                attributes to this def }
+              if not istyperenaming or isunique then
+                trtti_attribute_list.bind(rtti_attrs_def,tobjectdef(hdef).rtti_attribute_list);
             end;
             end;
 
 
            if isgeneric and (not(hdef.typ in [objectdef,recorddef,arraydef,procvardef])
            if isgeneric and (not(hdef.typ in [objectdef,recorddef,arraydef,procvardef])

+ 13 - 0
tests/test/tcustomattr17.pp

@@ -0,0 +1,13 @@
+{ %FAIL }
+
+program tcustomattr17;
+
+{$mode objfpc}
+{$modeswitch prefixedattributes}
+
+type
+  [TCustomAttribute]
+  Int = Integer;
+
+begin
+end.

+ 87 - 0
tests/test/tcustomattr18.pp

@@ -0,0 +1,87 @@
+program tcustomattr18;
+
+{$mode objfpc}
+{$modeswitch prefixedattributes}
+
+uses
+  TypInfo;
+
+type
+  [TCustomAttribute]
+  TTestRec = record
+
+  end;
+
+  [TCustomAttribute]
+  TEnum = (
+    eOne
+  );
+
+  [TCustomAttribute]
+  TSet = set of TEnum;
+
+  [TCustomAttribute]
+  TPtr = ^LongInt;
+
+  [TCustomAttribute]
+  TLongInt = type LongInt;
+
+  [TCustomAttribute]
+  TMyMethod = procedure of object;
+
+  [TCustomAttribute]
+  TMyProc = procedure;
+
+  [TCustomAttribute]
+  TMyStaticArray = array[0..3] of Integer;
+
+  [TCustomAttribute]
+  TMyDynArray = array of Integer;
+
+  [TCustomAttribute]
+  IMyIntf = interface
+
+  end;
+
+  [TCustomAttribute]
+  TString8 = String[8];
+
+  [TCustomAttribute]
+  TStringCP = type AnsiString(1234);
+
+var
+  typeinfos: array of PTypeInfo;
+  i: SizeInt;
+  at: PAttributeTable;
+  attr: TCustomAttribute;
+begin
+  typeinfos := [
+    TypeInfo(TTestRec),
+    TypeInfo(TEnum),
+    TypeInfo(TSet),
+    TypeInfo(TPtr),
+    TypeInfo(TLongInt),
+    TypeInfo(TMyMethod),
+    TypeInfo(TMyProc),
+    TypeInfo(TMyStaticArray),
+    TypeInfo(TMyDynArray),
+    TypeInfo(IMyIntf),
+    TypeInfo(TString8),
+    TypeInfo(TStringCP)
+  ];
+
+  for i := 0 to High(typeinfos) do begin
+    at := GetAttributeTable(typeinfos[i]);
+    if not Assigned(at) then
+      Halt(i * 10);
+    if at^.AttributeCount <> 1 then
+      Halt(i * 10 + 1);
+    attr := GetAttribute(at, 0);
+    if not Assigned(attr) then
+      Halt(i * 10 + 2);
+    if attr.ClassType <> TCustomAttribute then
+      Halt(i * 20 + 3);
+  end;
+
+  Writeln('ok');
+end.