Procházet zdrojové kódy

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

git-svn-id: trunk@42405 -

svenbarth před 6 roky
rodič
revize
404b465c33
4 změnil soubory, kde provedl 107 přidání a 4 odebrání
  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/tcustomattr15.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/tcustomattr3.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;
                       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
                       name set. We only check this now, because message names can be set
                       during the protocol (interface) mapping. At the same time, set the
@@ -1056,6 +1052,11 @@ implementation
                     consume(_SEMICOLON);
                   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;
 
            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.