--- Merging r13548 through r13549 into '.':

U    packages/fcl-xml/src/dom.pp
U    packages/fcl-xml/src/xmlread.pp
--- Merging r13567 into '.':
U    rtl/objpas/classes/writer.inc
--- Merging r13617 into '.':
A    tests/webtbf/tw13971c.pp
A    tests/webtbf/tw13971d.pp
A    tests/webtbf/tw13971e.pp
A    tests/webtbf/tw13971f.pp
A    tests/webtbf/tw13971a.pp
A    tests/webtbf/tw13971b.pp
--- Merging r13644 into '.':
U    rtl/unix/keyboard.pp
--- Merging r13664 into '.':
U    compiler/systems/t_nds.pas
U    compiler/systems/i_gba.pas
U    compiler/systems/t_gba.pas
U    compiler/systems/i_nds.pas
U    packages/libndsfpc/src/fat/filesystem.pp
--- Merging r13707 through r13708 into '.':
U    rtl/win/wininc/defines.inc
U    tests/webtbs/tw12038.pp
U    compiler/ncgrtti.pas

git-svn-id: branches/fixes_2_4@13733 -

.gitattributes

@@ -8624,6 +8624,12 @@ tests/webtbf/tw1365.pp svneol=native#text/plain
 tests/webtbf/tw13815.pp svneol=native#text/plain
 tests/webtbf/tw1395.pp svneol=native#text/plain
 tests/webtbf/tw13956.pp svneol=native#text/plain
+tests/webtbf/tw13971a.pp svneol=native#text/plain
+tests/webtbf/tw13971b.pp svneol=native#text/plain
+tests/webtbf/tw13971c.pp svneol=native#text/plain
+tests/webtbf/tw13971d.pp svneol=native#text/plain
+tests/webtbf/tw13971e.pp svneol=native#text/plain
+tests/webtbf/tw13971f.pp svneol=native#text/plain
 tests/webtbf/tw13992.pp svneol=native#text/plain
 tests/webtbf/tw1407.pp svneol=native#text/plain
 tests/webtbf/tw14104a.pp svneol=native#text/plain

compiler/ncgrtti.pas

@@ -681,18 +681,9 @@ implementation
                { write parameter info. The parameters must be written in reverse order
                  if this method uses right to left parameter pushing! }
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.maxparacount));
-{$ifdef i386}
-               if def.proccalloption in pushleftright_pocalls then
-                 begin
-                   for i:=0 to def.paras.count-1 do
-                     write_para(tparavarsym(def.paras[i]));
-                 end
-               else
-{$endif}
-                 begin
-                   for i:=def.paras.count-1 downto 0 do
-                     write_para(tparavarsym(def.paras[i]));
-                 end;
+
+               for i:=0 to def.paras.count-1 do
+                 write_para(tparavarsym(def.paras[i]));
 
                { write name of result type }
                write_rtti_name(def.returndef);

compiler/systems/i_gba.pas

@@ -34,8 +34,8 @@ unit i_gba;
             system       : system_arm_gba;
             name         : 'GameBoy Advance';
             shortname    : 'gba';
-            flags        : [tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses
-	                          ,tf_smartlink_sections,tf_requires_proper_alignment];
+            flags        : [tf_needs_symbol_size,tf_files_case_sensitive,
+                            tf_use_function_relative_addresses,tf_requires_proper_alignment,tf_smartlink_sections];
             cpu          : cpu_arm;
             unit_env     : '';
             extradefines : '';
@@ -88,7 +88,7 @@ unit i_gba;
               );
             first_parm_offset : 8;
             stacksize    : 16384;
-            abi : abi_default
+            abi : abi_eabi
           );
 
   implementation

compiler/systems/i_nds.pas

@@ -1,5 +1,5 @@
 {
-    This unit implements support information structures for GameBoy Advance
+    This unit implements support information structures for Nintendo DS
 
     Copyright (c) 1998-2002 by Peter Vreman
 
@@ -34,8 +34,8 @@ unit i_nds;
             system       : system_arm_nds;
             name         : 'Nintendo DS';
             shortname    : 'nds';
-            flags        : [tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses
-                           ,tf_requires_proper_alignment,tf_smartlink_sections];
+            flags        : [tf_needs_symbol_size,tf_files_case_sensitive,
+                            tf_use_function_relative_addresses,tf_requires_proper_alignment,tf_smartlink_sections];
             cpu          : cpu_arm;
             unit_env     : '';
             extradefines : '';
@@ -88,7 +88,7 @@ unit i_nds;
               );
             first_parm_offset : 8;
             stacksize    : $3CFF; //15615? or 16384?;
-            abi : abi_default
+            abi : abi_eabi
           );
 
   implementation

compiler/systems/t_gba.pas

@@ -30,6 +30,7 @@ interface
 implementation
 
     uses
+       aasmbase,
        SysUtils,
        cutils,cfileutl,cclasses,
        globtype,globals,systems,verbose,script,fmodule,i_gba,link;
@@ -554,14 +555,22 @@ var
   StaticStr,
   GCSectionsStr,
   DynLinkStr,
+  MapStr,
   StripStr: string;
 begin
   { for future use }
   StaticStr:='';
   StripStr:='';
   DynLinkStr:='';
-
-  GCSectionsStr:='--gc-sections';
+  MapStr:='';
+
+  if (cs_link_strip in current_settings.globalswitches) and
+     not(cs_link_separate_dbg_file in current_settings.globalswitches) then
+   StripStr:='-s';
+  if (cs_link_map in current_settings.globalswitches) then
+   StripStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map'));
+  if create_smartlink_sections then
+   GCSectionsStr:='--gc-sections';
   //if not(cs_link_extern in current_settings.globalswitches) then
   if not(cs_link_nolink in current_settings.globalswitches) then
    Message1(exec_i_linking,current_module.exefilename^);
@@ -572,24 +581,15 @@ begin
 { Call linker }
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  if not(cs_link_on_target in current_settings.globalswitches) then
-   begin
-    Replace(cmdstr,'$EXE',(maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename^,'.elf')))));
-    Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName))));
-    Replace(cmdstr,'$STATIC',StaticStr);
-    Replace(cmdstr,'$STRIP',StripStr);
-    Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
-    Replace(cmdstr,'$DYNLINK',DynLinkStr);
-   end
-  else
-   begin
-    Replace(cmdstr,'$EXE',maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename^,'.elf'))));
-    Replace(cmdstr,'$RES',maybequoted(ScriptFixFileName(outputexedir+Info.ResName)));
-    Replace(cmdstr,'$STATIC',StaticStr);
-    Replace(cmdstr,'$STRIP',StripStr);
-    Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
-    Replace(cmdstr,'$DYNLINK',DynLinkStr);
-   end;
+
+  Replace(cmdstr,'$EXE',(maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename^,'.elf')))));
+  Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName))));
+  Replace(cmdstr,'$STATIC',StaticStr);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
+  Replace(cmdstr,'$MAP',MapStr);
+  Replace(cmdstr,'$DYNLINK',DynLinkStr);
+
   success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);
 
 { Remove ReponseFile }

compiler/systems/t_nds.pas

@@ -1,6 +1,6 @@
 {
     This unit implements support import,export,link routines
-    for the (arm) GameBoy Advance target
+    for the (arm) Nintendo DS target
 
     Copyright (c) 2001-2002 by Peter Vreman
 
@@ -30,6 +30,7 @@ interface
 implementation
 
     uses
+       aasmbase,
        SysUtils,
        cutils,cfileutl,cclasses,
        globtype,globals,systems,verbose,script,fmodule,i_nds,link;
@@ -705,19 +706,27 @@ var
   StaticStr,
   GCSectionsStr,
   DynLinkStr,
+  MapStr,
   StripStr: string;
   preName: string;
 begin
   { for future use }
   StaticStr:='';
   StripStr:='';
+  MapStr:='';
   DynLinkStr:='';
   case apptype of
    app_arm9: preName:='.nef';
    app_arm7: preName:='.nlf';
   end;
 
-  GCSectionsStr:='--gc-sections';
+  if (cs_link_strip in current_settings.globalswitches) and
+     not(cs_link_separate_dbg_file in current_settings.globalswitches) then
+   StripStr:='-s';
+  if (cs_link_map in current_settings.globalswitches) then
+   StripStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map'));
+  if create_smartlink_sections then
+   GCSectionsStr:='--gc-sections';
   if not(cs_link_nolink in current_settings.globalswitches) then
    Message1(exec_i_linking,current_module.exefilename^);
 
@@ -733,6 +742,7 @@ begin
   Replace(cmdstr,'$STATIC',StaticStr);
   Replace(cmdstr,'$STRIP',StripStr);
   Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
+  Replace(cmdstr,'$MAP',MapStr);
   Replace(cmdstr,'$DYNLINK',DynLinkStr);
   
   success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);

packages/fcl-xml/src/dom.pp

@@ -2060,7 +2060,7 @@ constructor TDOMDocument.Create;
 begin
   inherited Create(nil);
   FOwnerDocument := Self;
-  FMaxPoolSize := TDOMAttr.InstanceSize + sizeof(Pointer);
+  FMaxPoolSize := (TDOMAttr.InstanceSize + sizeof(Pointer)-1) and not (sizeof(Pointer)-1) + sizeof(Pointer);
   FPools := AllocMem(FMaxPoolSize);
   FNames := THashTable.Create(256, True);
   SetLength(FNamespaces, 3);

packages/fcl-xml/src/xmlread.pp

@@ -925,17 +925,18 @@ end;
 
 function TXMLDecodingSource.Reload: Boolean;
 var
+  Remainder: PtrInt;
   r, inLeft: Cardinal;
   rslt: Integer;
 begin
   if DTDSubsetType = dsInternal then
     FReader.DTDReloadHook;
-  r := FBufEnd - FBuf;
-  if r > 0 then
-    Move(FBuf^, FBufStart^, r * sizeof(WideChar));
+  Remainder := FBufEnd - FBuf;
+  if Remainder > 0 then
+    Move(FBuf^, FBufStart^, Remainder * sizeof(WideChar));
   Dec(LFPos, FBuf-FBufStart);
   FBuf := FBufStart;
-  FBufEnd := FBufStart + r;
+  FBufEnd := FBufStart + Remainder;
 
   repeat
     inLeft := FCharBufEnd - FCharBuf;
@@ -2724,7 +2725,7 @@ begin
               Inc(IgnoreLevel)
             else if FSource.Matches(']]>') then
               Dec(IgnoreLevel)
-            else
+            else if wc <> #0 then
               FSource.NextChar;
           until (IgnoreLevel=0) or (wc = #0);
 // Since PE's are not recognized in ignore sections, reaching EOF is fatal.

packages/libndsfpc/src/fat/filesystem.pp

@@ -14,6 +14,7 @@ uses
   ctypes, nds9;
 
 {$linklib filesystem}
+{$linklib fat}
 {$linklib nds9}
 
 {$linklib c}

rtl/objpas/classes/writer.inc

@@ -879,6 +879,7 @@ begin
   { Check if the ancestor can be used }
   HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
     (Instance.ClassType = Ancestor.ClassType));
+  //writeln('TWriter.WriteProperty Name=',PropType^.Name,' Kind=',GetEnumName(TypeInfo(TTypeKind),ord(PropType^.Kind)),' HasAncestor=',HasAncestor);
 
   case PropType^.Kind of
     tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
@@ -1035,14 +1036,17 @@ begin
         if HasAncestor then
         begin
           AncestorObj := TObject(GetObjectProp(Ancestor, PropInfo));
-          if Assigned(AncestorObj) then
-            if Assigned(ObjValue) and
-              (TComponent(AncestorObj).Owner = FRootAncestor) and
-              (TComponent(ObjValue).Owner = Root) and
-              (UpperCase(TComponent(AncestorObj).Name) = UpperCase(TComponent(ObjValue).Name)) then
-              AncestorObj := ObjValue
-//            else
-//              AncestorObj := nil;
+          if (AncestorObj is TComponent) and
+             (ObjValue is TComponent) then
+          begin
+            //writeln('TWriter.WriteProperty AncestorObj=',TComponent(AncestorObj).Name,' OwnerFit=',TComponent(AncestorObj).Owner = FRootAncestor,' ',TComponent(ObjValue).Name,' OwnerFit=',TComponent(ObjValue).Owner = Root);
+            if (TComponent(AncestorObj).Owner <> FRootAncestor) or
+             (TComponent(ObjValue).Owner <> Root) or
+             (UpperCase(TComponent(AncestorObj).Name) <> UpperCase(TComponent(ObjValue).Name)) then
+            begin
+              AncestorObj := nil;
+            end;
+          end;
         end else
           AncestorObj := nil;
 

rtl/unix/keyboard.pp

@@ -1013,9 +1013,15 @@ const key_sequences:array[0..276] of key_sequence=(
        (char:0;scan:kbAltDown;st:#27#27'[B'),    {rxvt}
        (char:0;scan:kbAltLeft;st:#27#27'[D'),    {rxvt}
        (char:0;scan:kbAltRight;st:#27#27'[C'),   {rxvt}
+{$ifdef HAIKU}
+       (char:0;scan:kbAltUp;st:#27#27'OA'),
+       (char:0;scan:kbAltDown;st:#27#27'OB'),
+       (char:0;scan:kbAltRight;st:#27#27'OC'),
+{$else}
        (char:0;scan:kbAltUp;st:#27'OA'),
        (char:0;scan:kbAltDown;st:#27'OB'),
        (char:0;scan:kbAltRight;st:#27'OC'),
+{$endif}
        (char:0;scan:kbAltLeft;st:#27#27'OD'),
        (char:0;scan:kbAltPgUp;st:#27#27'[5~'),   {rxvt}
        (char:0;scan:kbAltPgDn;st:#27#27'[6~'),   {rxvt}

rtl/win/wininc/defines.inc

@@ -2830,7 +2830,7 @@ Type
      TPM_VERTICAL    = $40;
      TPM_TOPALIGN    = 0;
      TPM_VCENTERALIGN= $10;
-     TPM_BOOTOMALIGN = $20;
+     TPM_BOTTOMALIGN = $20;
      TPM_NONOTIFY    = $80;
      TPM_RETURNCMD   = $100;
      TPM_RECURSE         = $0001;

tests/webtbf/tw13971a.pp

@@ -0,0 +1,19 @@
+{ %fail }
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+
+type
+  tc = class
+    function getx(i: longint): longint;
+    property prop[i: longint]: longint read getx;
+    default: longint;
+  end;
+
+function tc.getx(i: longint): longint;
+begin
+end;
+
+begin
+end.

tests/webtbf/tw13971b.pp

@@ -0,0 +1,19 @@
+{ %fail }
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+
+type
+  tc = class
+    constructor test;
+    a: longint;
+  end;
+
+constructor tc.test;
+begin
+end;
+
+begin
+end.
+

tests/webtbf/tw13971c.pp

@@ -0,0 +1,19 @@
+{ %fail }
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+
+type
+  tc = class
+    procedure test;
+    register: longint;
+  end;
+
+procedure tc.test;
+begin
+end;
+
+begin
+end.
+

tests/webtbf/tw13971d.pp

@@ -0,0 +1,18 @@
+{ %fail }
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+
+type
+  tc = class
+    function getx(i: longint): longint;
+    default: longint;
+  end;
+
+function tc.getx(i: longint): longint;
+begin
+end;
+
+begin
+end.

tests/webtbf/tw13971e.pp

@@ -0,0 +1,18 @@
+{ %fail }
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+
+type
+  tc = class
+    constructor create;
+    a: longint;
+  end;
+
+constructor tc.create;
+begin
+end;
+
+begin
+end.

tests/webtbf/tw13971f.pp

@@ -0,0 +1,18 @@
+{ %fail }
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+
+type
+  tc = class
+    destructor destroy; override;
+    a: longint;
+  end;
+
+destructor tc.destroy;
+begin
+end;
+
+begin
+end.

tests/webtbs/tw12038.pp

@@ -1,4 +1,4 @@
-{$M+}
+{$M+}
 program RTTI132;
 
 {$IFDEF FPC}
@@ -357,11 +357,11 @@ end;
 const
   expectedresults: array[0..6] of ansistring = (
     '',
-    'function (out Out1: Int64; const P: Pointer; var array of reference ?Array1: AnsiString): Int64 of object;',
-    'procedure (const adresse ?Component4: TComponent; adresse ?out Component3: TComponent; var adresse ?Component2: TComponent; adresse ?Component1: TComponent) of object;',
-    'function (array of reference ?out D: Byte; var array of reference ?C: Byte; const array of reference ?B: Byte; array of reference ?A: Byte): TComponent of object;',
-    'function (const A: LongInt; var S: AnsiString): Int64 of object;',
-    'function (Six: LongInt; array of reference ?Five: Byte; Four: PInteger; adresse ?out Three: TMyObject; var Two: LongInt; const A: AnsiString): AnsiString of object;',
+    'function (var array of reference ?Array1: AnsiString; const P: Pointer; out Out1: Int64): 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 (var S: AnsiString; const A: LongInt): 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