--- Merging r40654 into '.':

U    compiler/msg/errore.msg
--- Recording mergeinfo for merge of r40654 into '.':
 U   .
--- Merging r40656 into '.':
U    compiler/pdecvar.pas
A    tests/tbf/tb0266a.pp
A    tests/tbf/tb0266b.pp
--- Recording mergeinfo for merge of r40656 into '.':
 G   .
--- Merging r41308 into '.':
U    tests/webtbs/tw35027.pp
--- Recording mergeinfo for merge of r41308 into '.':
 G   .
--- Merging r41829 into '.':
U    compiler/htypechk.pas
U    compiler/ncal.pas
A    tests/tbs/tb0656.pp
--- Recording mergeinfo for merge of r41829 into '.':
 G   .
--- Merging r42511 into '.':
U    packages/rtl-objpas/src/inc/rtti.pp
U    rtl/objpas/typinfo.pp
U    tests/test/trtti19.pp
--- Recording mergeinfo for merge of r42511 into '.':
 G   .

# revisions: 40654,40656,41308,41829,42511

git-svn-id: branches/fixes_3_2@43410 -

.gitattributes

@@ -11058,6 +11058,8 @@ tests/tbf/tb0262.pp svneol=native#text/pascal
 tests/tbf/tb0263.pp svneol=native#text/pascal
 tests/tbf/tb0264.pp svneol=native#text/pascal
 tests/tbf/tb0265.pp svneol=native#text/pascal
+tests/tbf/tb0266a.pp svneol=native#text/pascal
+tests/tbf/tb0266b.pp svneol=native#text/pascal
 tests/tbf/tb0267.pp svneol=native#text/plain
 tests/tbf/tb0588.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
@@ -11719,6 +11721,7 @@ tests/tbs/tb0650.pp svneol=native#text/pascal
 tests/tbs/tb0651.pp svneol=native#text/pascal
 tests/tbs/tb0654.pp svneol=native#text/plain
 tests/tbs/tb0655.pp svneol=native#text/pascal
+tests/tbs/tb0656.pp svneol=native#text/pascal
 tests/tbs/tb0657.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal

compiler/htypechk.pas

@@ -192,6 +192,7 @@ interface
     procedure set_unique(p : tnode);
 
     function  valid_for_formal_var(p : tnode; report_errors: boolean) : boolean;
+    function  valid_for_formal_constref(p : tnode; report_errors: boolean) : boolean;
     function  valid_for_formal_const(p : tnode; report_errors: boolean) : boolean;
     function  valid_for_var(p:tnode; report_errors: boolean):boolean;
     function  valid_for_assignment(p:tnode; report_errors: boolean):boolean;
@@ -1930,6 +1931,13 @@ implementation
       end;
 
 
+    function  valid_for_formal_constref(p : tnode; report_errors: boolean) : boolean;
+      begin
+        valid_for_formal_constref:=(p.resultdef.typ=formaldef) or
+          valid_for_assign(p,[valid_void,valid_range],report_errors);
+      end;
+
+
     function  valid_for_formal_const(p : tnode; report_errors: boolean) : boolean;
       begin
         valid_for_formal_const:=(p.resultdef.typ=formaldef) or

compiler/msg/errore.msg

@@ -2040,7 +2040,7 @@ type_w_empty_constant_range_set=04125_W_The first value of a set constructur ran
 #
 # Symtable
 #
-# 05097 is the last used one
+# 05098 is the last used one
 #
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
@@ -2356,6 +2356,8 @@ sym_e_generic_type_param_mismatch=05096_E_Generic type parameter "$1" does not m
 sym_e_generic_type_param_decl=05097_E_Generic type parameter declared as "$1"
 % Shows what the generic type parameter was originally declared as if a mismatch
 % is found between a declaration and the definition.
+sym_e_type_must_be_rec_or_object=05098_E_Record or object type expected
+% The variable or expression isn't of the type \var{record} or \var{object}.
 % \end{description}
 #
 # Codegenerator

compiler/msgidx.inc

@@ -660,6 +660,7 @@ const
   sym_w_duplicate_id=05095;
   sym_e_generic_type_param_mismatch=05096;
   sym_e_generic_type_param_decl=05097;
+  sym_e_type_must_be_rec_or_object=05098;
   cg_e_parasize_too_big=06009;
   cg_e_file_must_call_by_reference=06012;
   cg_e_cant_use_far_pointer_there=06013;
@@ -1106,9 +1107,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 82631;
+  MsgTxtSize = 82670;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,106,350,126,98,59,142,34,221,67,
+    28,106,350,126,99,59,142,34,221,67,
     62,20,30,1,1,1,1,1,1,1
   );

compiler/ncal.pas

@@ -1334,12 +1334,16 @@ implementation
 
                      case parasym.varspez of
                        vs_var,
-                       vs_constref,
                        vs_out :
                          begin
                            if not valid_for_formal_var(left,true) then
                             CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
                          end;
+                       vs_constref:
+                         begin
+                           if not valid_for_formal_constref(left,true) then
+                            CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list);
+                         end;
                        vs_const :
                          begin
                            if not valid_for_formal_const(left,true) then

compiler/pdecvar.pas

@@ -132,6 +132,8 @@ implementation
                      end;
                    _POINT :
                      begin
+                       if not is_object(def) and not is_record(def) then
+                         message(sym_e_type_must_be_rec_or_object);
                        consume(_POINT);
                        if assigned(def) then
                         begin

packages/rtl-objpas/src/inc/rtti.pp

@@ -3029,7 +3029,8 @@ begin
   if not aWithHidden and (Length(FParams) > 0) then
     Exit(FParams);
 
-  ptr := @FTypeData^.ParamList[0];
+  ptr := AlignTParamFlags(@FTypeData^.ParamList[0]);
+
   visible := 0;
   total := 0;
 
@@ -3045,7 +3046,9 @@ begin
       Inc(ptr, ptr^ + SizeOf(Byte));
       { skip type name }
       Inc(ptr, ptr^ + SizeOf(Byte));
-      { align? }
+      { align }
+      ptr := AlignTParamFlags(ptr);
+
       if not (pfHidden in infos[total].Flags) then
         Inc(visible);
       Inc(total);

rtl/objpas/typinfo.pp

@@ -747,6 +747,8 @@ unit TypInfo;
 // general property handling
 Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 Function AlignTypeData(p : Pointer) : Pointer; inline;
+Function AlignTParamFlags(p : Pointer) : Pointer; inline;
+Function AlignPTypeInfo(p : Pointer) : Pointer; inline;
 
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string): PPropInfo;
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string; AKinds: TTypeKinds): PPropInfo;
@@ -1240,6 +1242,40 @@ begin
 end;
 
 
+Function AlignTParamFlags(p : Pointer) : Pointer; inline;
+{$packrecords c}
+  type
+    TAlignCheck = record
+      b : byte;
+      w : word;
+    end;
+{$packrecords default}
+begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+  Result:=Pointer(align(p,PtrInt(@TAlignCheck(nil^).w)))
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+  Result:=p;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+end;
+
+
+Function AlignPTypeInfo(p : Pointer) : Pointer; inline;
+{$packrecords c}
+  type
+    TAlignCheck = record
+      b : byte;
+      p : pointer;
+    end;
+{$packrecords default}
+begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+  Result:=Pointer(align(p,PtrInt(@TAlignCheck(nil^).p)))
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+  Result:=p;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+end;
+
+
 Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 begin
   GetTypeData:=AlignTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);

tests/tbf/tb0266a.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+unit tb0266a;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  TTest1 = class
+    fTest: String;
+  end;
+
+  TTest2 = class
+  private
+    fTest: TTest1;
+  public
+    property Test: String read fTest.fTest;
+  end;
+
+implementation
+
+end.
+

tests/tbf/tb0266b.pp

@@ -0,0 +1,28 @@
+{ %FAIL }
+
+unit tb0266b;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  TTest1 = class
+    fTest: String;
+  end;
+
+  TTest2 = record
+    fTest: TTest1;
+  end;
+
+  TTest3 = class
+  private
+    fTest: TTest2;
+  public
+    property Test: String read fTest.fTest.fTest;
+  end;
+
+implementation
+
+end.
+

tests/tbs/tb0656.pp

@@ -0,0 +1,27 @@
+{ %NORUN }
+
+program tb0656;
+
+{$mode objfpc}
+
+procedure Test1(const aArg);
+begin
+end;
+
+procedure Test2(const aArg);
+begin
+  Test1(aArg);
+end;
+
+procedure Test3(constref aArg);
+begin
+end;
+
+procedure Test4(constref aArg);
+begin
+  Test3(aArg);
+end;
+
+begin
+
+end.

tests/test/trtti19.pp

@@ -19,6 +19,7 @@ var
   pb: PByte;
   i: SizeInt;
 begin
+  // writeln(SizeOf(TparamFlags));
   ti := PTypeInfo(TypeInfo(TTestProc));
   td := GetTypeData(ti);
   if td^.ProcSig.ParamCount <> 3 then
@@ -38,34 +39,41 @@ begin
     Halt(6);
   if procparam^.ParamFlags * [pfConstRef] <> [pfConstRef] then
     Halt(7);
-
+  
   ti := PTypeInfo(TypeInfo(TTestMethod));
   td := GetTypeData(ti);
   if td^.ParamCount <> 4 then
     Halt(8);
   pb := @td^.ParamList[0];
+  pb := AlignTParamFlags(pb);
   if PParamFlags(pb)^ * [pfHidden, pfSelf] <> [pfHidden, pfSelf] then
     Halt(9);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
+
+  pb := AlignTParamFlags(pb);
   if PParamFlags(pb)^ * [pfVar] <> [pfVar] then
     Halt(10);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
+
+  pb := AlignTParamFlags(pb);
   if PParamFlags(pb)^ * [pfOut] <> [pfOut] then
     Halt(11);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
+
+  pb := AlignTParamFlags(pb);
   if PParamFlags(pb)^ * [pfConstRef] <> [pfConstRef] then
     Halt(12);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
 
-  pb := pb + SizeOf(TCallConv);
+  pb := AlignPTypeInfo(pb + SizeOf(TCallConv));
   for i := 1 to td^.ParamCount - 1 do begin
     if PPPTypeInfo(pb)[i] <> Nil then begin
       Writeln(PPPTypeInfo(pb)[i]^^.Name);

tests/webtbs/tw35027.pp

@@ -1,7 +1,7 @@
 program tw35027;
 {$mode objfpc}{$H+}
 uses
-  {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF}
+  {$IFDEF UNIX}cthreads,{$ENDIF}
   Classes, sysutils, syncobjs;
 
 type