* tests with Delphi showed that an attribute class must explicitely declare a parameterless constructor if it should be used, cause TCustomAttribute.Create is private

Note: this also means that TCustomAttribute itself can not be used as an attribute
* adjusted existing tests
+ added test

git-svn-id: trunk@42471 -

.gitattributes

@@ -13220,6 +13220,7 @@ tests/test/tcustomattr19.pp svneol=native#text/pascal
 tests/test/tcustomattr2.pp svneol=native#text/pascal
 tests/test/tcustomattr20.pp svneol=native#text/pascal
 tests/test/tcustomattr21.pp svneol=native#text/pascal
+tests/test/tcustomattr22.pp svneol=native#text/pascal
 tests/test/tcustomattr3.pp svneol=native#text/pascal
 tests/test/tcustomattr4.pp svneol=native#text/pascal
 tests/test/tcustomattr5.pp svneol=native#text/pascal

rtl/inc/objpas.inc

@@ -1143,6 +1143,17 @@
         result:=longint(E_NOINTERFACE);
     end;
 
+{****************************************************************************
+                               TCustomAttribute
+****************************************************************************}
+
+
+    constructor TCustomAttribute.Create;
+    begin
+      inherited;
+    end;
+
+
 {****************************************************************************
                              Exception Support
 ****************************************************************************}

rtl/inc/objpash.inc

@@ -428,8 +428,16 @@
 {$endif FPC_USE_PSABIEH}
        end;
 
+       {$PUSH}
+       { disable the warning that the constructor should be public }
+       {$WARN 3018 OFF}
        TCustomAttribute = class(TObject)
+       private
+         { if the user wants to use a parameterless constructor they need to
+           explicitely declare it in their type }
+         constructor Create;
        end;
+       {$POP}
 
     Const
        ExceptProc : TExceptProc = Nil;

tests/test/tcustomattr10.pp

@@ -9,6 +9,7 @@ uses
 type
   { TMyAttr }
   TMyAttrAttribute = class(TCustomAttribute)
+    constructor Create;
   end;
 
 type
@@ -17,6 +18,11 @@ type
   TMyObject = class(TObject)
   end;
 
+constructor TMyAttrAttribute.Create;
+begin
+
+end;
+
 var
   at: PAttributeTable;
   AClassAttribute: TCustomAttribute;

tests/test/tcustomattr11.pp

@@ -8,11 +8,11 @@ uses
 
 type
   TTest = class(TCustomAttribute)
-
+    constructor Create;
   end;
 
   TTestAttribute = class(TCustomAttribute)
-
+    constructor Create;
   end;
 
   { the attribute with the Attribute suffix is preferred }
@@ -21,9 +21,20 @@ type
 
   end;
 
+constructor TTestAttribute.Create;
+begin
+
+end;
+
+constructor TTest.Create;
+begin
+
+end;
+
 var
   at: PAttributeTable;
   attr: TCustomAttribute;
+
 begin
   at := GetAttributeTable(TypeInfo(TTestObj));
   if not Assigned(at) then

tests/test/tcustomattr17.pp

@@ -6,8 +6,17 @@ program tcustomattr17;
 {$modeswitch prefixedattributes}
 
 type
-  [TCustomAttribute]
+  TTest = class(TCustomAttribute)
+    constructor Create;
+  end;
+
+  [TTest]
   Int = Integer;
 
+constructor TTest.Create;
+begin
+
+end;
+
 begin
 end.

tests/test/tcustomattr18.pp

@@ -7,53 +7,63 @@ uses
   TypInfo;
 
 type
-  [TCustomAttribute]
+  TAttr = class(TCustomAttribute)
+    constructor Create;
+  end;
+
+  [TAttr]
   TTestRec = record
 
   end;
 
-  [TCustomAttribute]
+  [TAttr]
   TEnum = (
     eOne
   );
 
-  [TCustomAttribute]
+  [TAttr]
   TSet = set of TEnum;
 
-  [TCustomAttribute]
+  [TAttr]
   TPtr = ^LongInt;
 
-  [TCustomAttribute]
+  [TAttr]
   TLongInt = type LongInt;
 
-  [TCustomAttribute]
+  [TAttr]
   TMyMethod = procedure of object;
 
-  [TCustomAttribute]
+  [TAttr]
   TMyProc = procedure;
 
-  [TCustomAttribute]
+  [TAttr]
   TMyStaticArray = array[0..3] of Integer;
 
-  [TCustomAttribute]
+  [TAttr]
   TMyDynArray = array of Integer;
 
-  [TCustomAttribute]
+  [TAttr]
   IMyIntf = interface
 
   end;
 
-  [TCustomAttribute]
+  [TAttr]
   TString8 = String[8];
 
-  [TCustomAttribute]
+  [TAttr]
   TStringCP = type AnsiString(1234);
 
+constructor TAttr.Create;
+begin
+
+end;
+
 var
   typeinfos: array of PTypeInfo;
   i: SizeInt;
   at: PAttributeTable;
   attr: TCustomAttribute;
+
 begin
   typeinfos := [
     TypeInfo(TTestRec),
@@ -79,7 +89,7 @@ begin
     attr := GetAttribute(at, 0);
     if not Assigned(attr) then
       Halt(i * 10 + 2);
-    if attr.ClassType <> TCustomAttribute then
+    if attr.ClassType <> TAttr then
       Halt(i * 20 + 3);
   end;
 

tests/test/tcustomattr22.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+program tcustomattr22;
+
+{$mode objfpc}
+{$modeswitch prefixedattributes}
+
+type
+  TTestAttribute = class(TCustomAttribute)
+    constructor Create(aArg: LongInt);
+  end;
+
+  [TTestAttribute(42), TTestAttribute]
+  TMyTest = class
+
+  end;
+
+constructor TTestAttribute.Create(aArg: LongInt);
+begin
+
+end;
+
+begin
+end.

tests/test/tcustomattr9.pp

@@ -1,3 +1,5 @@
+{ %FAIL }
+
 program tcustomattr9;
 
 {$mode objfpc}{$H+}
@@ -8,7 +10,7 @@ uses
 
 type
   { tmyt }
-  // TCustomAttribute without constructor
+  // TCustomAttribute's constructor is private!
   tmyt = class(TCustomAttribute);
 
 type
@@ -16,20 +18,6 @@ type
   TMyObject = class(TObject)
   end;
 
-var
-  at: PAttributeTable;
-  AClassAttribute: TCustomAttribute;
-
 begin
-  at := GetAttributeTable(TMyObject.ClassInfo);
-  if not Assigned(at) then
-    halt(1);
-  if at^.AttributeCount<>1 then
-    halt(2);
-
-  AClassAttribute := GetAttribute(at,0);
-  if AClassAttribute = nil then
-    halt(3);
-  writeln('ok');
 end.
 

tests/test/ucustomattr14a.pp

@@ -6,6 +6,7 @@ interface
 
 type
   TTestAttribute = class(TCustomAttribute)
+    constructor Create;
   end;
 
   TTest2Attribute = class(TCustomAttribute)
@@ -14,6 +15,11 @@ type
 
 implementation
 
+constructor TTestAttribute.Create;
+begin
+
+end;
+
 constructor TTest2Attribute.Create(const aStr: String);
 begin