* mark class and interface parameters as pfAddress (further fix for

mantis #12038) + test

git-svn-id: trunk@12913 -

compiler/ncgrtti.pas

@@ -630,6 +630,11 @@ implementation
                  }
                  if is_open_array(parasym.vardef) then
                    paraspec:=paraspec or pfArray or pfReference;
+                 { and these for classes and interfaces (maybe because they
+                   are themselves addresses?)
+                 }
+                 if is_class_or_interface(parasym.vardef) then
+                   paraspec:=paraspec or pfAddress;
                  { set bits run from the highest to the lowest bit on
                    big endian systems
                  }

tests/webtbs/tw12038.pp

@@ -14,16 +14,28 @@ uses
   Classes;
 
 type
-
+  TMyObject = class;
   TBatch = Procedure (Var S:String) of Object; stdcall;
   TProcess = function (Var S:String; const A:integer):int64 of Object; stdcall;
   TArray = function (Var Array1:Array of String; const P:Pointer; Out Out1:int64):int64 of Object; stdcall;
+  TOnFour = function (A: array of byte; const B: array of byte;
+    var C: array of byte; out D: array of byte): TComponent  of object;
+  TOnFive = procedure (Component1: TComponent;
+    var Component2: TComponent;
+    out Component3: TComponent;
+    const Component4: TComponent) of object;
+  TOnSix = function (const A: string; var Two: integer;
+    out Three: TMyObject; Four: PInteger; Five: array of Byte;
+    Six: integer): string of object;
   
   TMyObject=Class(TObject)
    private
     FFieldOne : Integer;
     FFieldTwo  : String;
     FOnBatch :TBatch;
+    FOnFour: TOnFour;
+    FOnFive: TOnFive;
+    FOnSix: TOnSix;
   FOnProcess : TProcess;
   FOnArray: TArray;
   
@@ -37,7 +49,18 @@ type
     Property OnTraitement:TBatch read FOnBatch Write FOnBatch;
     Property OnProcess:TProcess read FOnProcess Write FOnProcess;
     Property OnArray:TArray read FOnArray Write FOnArray;
-	
+    function FourthPublished(A: array of byte; const B: array of byte;
+      var C: array of byte; out D: array of byte): TComponent;
+    procedure FifthPublished(Component1: TComponent;
+      var Component2: TComponent;
+      out Component3: TComponent;
+      const Component4: TComponent);
+    function SixthPublished(const A: string; var Two: integer;
+      out Three: TMyObject; Four: PInteger;
+      Five: array of Byte; Six: integer): string;
+    property OnFour: TOnFour read FOnFour write FOnFour;
+    property OnFive: TOnFive read FOnFive write FOnFive;
+    property OnSix: TOnSix read FOnSix write FOnSix;
   end;
 
   PShortString=^ShortString;
@@ -77,6 +100,25 @@ Begin
  S:='The Batch execute the procedure TMyObject.ProcNo2';
 end;
 
+function TMyObject.FourthPublished(A: array of byte; const B: array of byte;
+      var C: array of byte; out D: array of byte): TComponent;
+begin
+  Result := nil;
+end;
+
+procedure TMyObject.FifthPublished(Component1: TComponent;
+      var Component2: TComponent;
+      out Component3: TComponent;
+      const Component4: TComponent);
+begin
+end;
+
+function TMyObject.SixthPublished(const A: string; var Two: integer;
+      out Three: TMyObject; Four: PInteger;
+      Five: array of Byte; Six: integer): string;
+begin
+end;
+
 Function BuildMethodDefinition(Liste: ParametersMethod1;NumI :Integer):String;
 //Build the definition of  method
 var
@@ -197,7 +239,8 @@ begin
     tkInteger : writeln('<tkinteger>');
     tkLString : writeln('<tklstring>');
     //tkString  : writeln('Longueur max ='); string pascal max 255?
-    tkMethod  : Begin
+    tkMethod  :
+      Begin
         writeln('>>> Methode Type >>>');
         //Information for the method type : tkmethod
         //  TPropInfo.PropType= PPTypeInfo;
@@ -276,13 +319,12 @@ begin
           begin
             ParamNameLength := ord( DTypeData^.ParamList[CurrentParamPosition]);
             Fu_ResultType := '';
-	                      for j := CurrentParamPosition + 1 to
+            for j := CurrentParamPosition + 1 to CurrentParamPosition + ParamNameLength do
-	                            CurrentParamPosition + ParamNameLength do
+              Fu_ResultType  := Fu_ResultType + DTypeData^.ParamList[j];
-	                                  Fu_ResultType  := Fu_ResultType +
-	                                               DTypeData^.ParamList[j];
           end 
-		           else Fu_ResultType:='';
+        else
-// 			  end;
+          Fu_ResultType:='';
+  //         end;
         Definition := Definition + ')';
         if Fu_ResultType<>''  then 
           Definition := Format('%s: %s', [Definition, Fu_ResultType]);
@@ -292,7 +334,10 @@ begin
                    // Build  the definion of  method 
         Writeln(PropTypeZ+' '+Definition);
         if ((PropTypeZ+' '+Definition) <> expectedresult) then
+          begin
+            writeln(expectedresult);
             halt(1);
+          end;
 {$ENDIF}
 {$IFDEF delphibuiltin}
         Writeln(PropTypeZ+' '+BuildMethodDefinition(List_of_Param,DTypeData^.ParamCount));
@@ -310,10 +355,13 @@ begin
 end;
 
 const
-  expectedresults: array[0..3] of ansistring = (
+  expectedresults: array[0..6] of ansistring = (
     '',
     'function (out Out1: Int64; const P: Pointer; var array of reference ?Array1: AnsiString): Int64 of object;',
+    'procedure (adresse ?Component1: TComponent; var adresse ?Component2: TComponent; adresse ?out Component3: TComponent; const adresse ?Component4: TComponent) of object;',
+    'function (array of reference ?A: Byte; const array of reference ?B: Byte; var array of reference ?C: Byte; array of reference ?out D: Byte): TComponent of object;',
     'function (const A: LongInt; var S: AnsiString): Int64 of object;',
+    'function (const A: AnsiString; var Two: LongInt; adresse ?out Three: TMyObject; Four: PInteger; array of reference ?Five: Byte; Six: LongInt): AnsiString of object;',
     'procedure (var S: AnsiString) of object;'
     );
 begin
@@ -327,6 +375,9 @@ begin
 {$ENDIF}
  // Get list properties
  NumI := GetPropList(TMyObject.ClassInfo, tkAny, @List_of_Prop);
+ writeln('numi: ',numi);
+ if (numi<>length(expectedresults)) then
+   halt(44);
  for I := 0 to NumI-1 do
   begin
    Writeln('Propriete ',I+1,' = ',List_of_Prop[I]^.Name);