Pārlūkot izejas kodu

* synchronized with trunk

git-svn-id: branches/wasm@48225 -
nickysn 4 gadi atpakaļ
vecāks
revīzija
780ded903a

+ 1 - 1
.gitattributes

@@ -4015,7 +4015,6 @@ packages/fcl-registry/tests/Makefile.fpc -text
 packages/fcl-registry/tests/regtestframework.pp -text
 packages/fcl-registry/tests/tcxmlreg.pp svneol=native#text/plain
 packages/fcl-registry/tests/testbasics.pp svneol=native#text/plain
-packages/fcl-registry/tests/tregistry2.pp svneol=native#text/plain
 packages/fcl-report/Makefile svneol=native#text/plain
 packages/fcl-report/Makefile.fpc svneol=native#text/plain
 packages/fcl-report/demos/company-logo.png -text svneol=unset#image/png
@@ -14481,6 +14480,7 @@ tests/test/packages/fcl-db/tdb5.pp svneol=native#text/plain
 tests/test/packages/fcl-db/tdb6.pp svneol=native#text/plain
 tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tregistry2.pp svneol=native#text/plain
 tests/test/packages/fcl-registry/tw35060a.pp svneol=native#text/plain
 tests/test/packages/fcl-registry/tw35060b.pp svneol=native#text/plain
 tests/test/packages/fcl-registry/tw35060c.pp svneol=native#text/plain

+ 13 - 6
compiler/hlcgobj.pas

@@ -4901,6 +4901,7 @@ implementation
   procedure thlcgobj.initialize_regvars(p: TObject; arg: pointer);
     var
       href : treference;
+      mmreg : tregister;
     begin
       if (tsym(p).typ=staticvarsym) and not(tstaticvarsym(p).noregvarinitneeded) then
        begin
@@ -4922,12 +4923,18 @@ implementation
                      tstaticvarsym(p).initialloc.register);
              end;
            LOC_CMMREGISTER :
-             { clear the whole register }
-             a_opmm_reg_reg(TAsmList(arg),OP_XOR,tstaticvarsym(p).vardef,
-               { as we pass shuffle=nil, we have to pass a full register }
-               newreg(R_MMREGISTER,getsupreg(tstaticvarsym(p).initialloc.register),R_SUBMMWHOLE),
-               newreg(R_MMREGISTER,getsupreg(tstaticvarsym(p).initialloc.register),R_SUBMMWHOLE),
-               nil);
+             begin
+{$ifdef ARM}
+               { Do not pass d0 (which uses f0 and f1) for arm single type variable }
+               mmreg:=tstaticvarsym(p).initialloc.register;
+{$else}
+               { clear the whole register }
+               mmreg:=newreg(R_MMREGISTER,getsupreg(tstaticvarsym(p).initialloc.register),R_SUBMMWHOLE);
+{$endif}             
+               a_opmm_reg_reg(TAsmList(arg),OP_XOR,tstaticvarsym(p).vardef, mmreg, mmreg,
+                 { as we pass shuffle=nil, we have to pass a full register }
+                 nil);
+             end;
            LOC_CFPUREGISTER :
              begin
                { initialize fpu regvar by loading from memory }

+ 13 - 8
compiler/m68k/n68kadd.pas

@@ -26,7 +26,7 @@ unit n68kadd;
 interface
 
     uses
-       node,nadd,ncgadd,cpubase,cgbase;
+       symtype,node,nadd,ncgadd,cpubase,cgbase;
 
 
     type
@@ -34,7 +34,7 @@ interface
        private
           function getresflags(unsigned: boolean) : tresflags;
           function getfloatresflags: tresflags;
-          function inlineable_realconstnode(const n: tnode): boolean;
+          function inlineable_realconstnode(const n: tnode; fpu_type : tdef): boolean;
           procedure second_mul64bit;
        protected
           function use_generic_mul64bit: boolean; override;
@@ -55,7 +55,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,paramgr,symtype,
+      symconst,symdef,paramgr,
       aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk,
       cpuinfo,pass_1,pass_2,
       cpupara,cgutils,procinfo,
@@ -146,9 +146,14 @@ implementation
       end;
 
 
-    function t68kaddnode.inlineable_realconstnode(const n: tnode): boolean;
+    function t68kaddnode.inlineable_realconstnode(const n: tnode; fpu_type : tdef): boolean;
       begin
-        result:=(n.nodetype = realconstn) and
+        if assigned(fpu_type) and
+	   ((FPUM68K_HAS_EXTENDED in fpu_capabilities[current_settings.fputype])
+            or (fpu_type.size < sizeof(bestreal))) then
+          result:=false
+        else
+          result:=(n.nodetype = realconstn) and
             not ((trealconstnode(n).value_real=MathInf.Value) or
                  (trealconstnode(n).value_real=MathNegInf.Value) or
                  (trealconstnode(n).value_real=MathQNaN.value));
@@ -191,7 +196,7 @@ implementation
 
         { have left in the register, right can be a memory location }
         if (FPUM68K_HAS_FLOATIMMEDIATE in fpu_capabilities[current_settings.fputype]) and
-           inlineable_realconstnode(left) then
+           inlineable_realconstnode(left,resultdef) then
           begin
             location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
             current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(A_FMOVE,tcgsize2opsize[left.location.size],trealconstnode(left).value_real,location.register))
@@ -211,7 +216,7 @@ implementation
           LOC_REFERENCE,LOC_CREFERENCE:
               begin
                 if (FPUM68K_HAS_FLOATIMMEDIATE in fpu_capabilities[current_settings.fputype]) and
-                   inlineable_realconstnode(right) then
+                   inlineable_realconstnode(right,resultdef) then
                   current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(op,tcgsize2opsize[right.location.size],trealconstnode(right).value_real,location.register))
                 else
                   begin
@@ -284,7 +289,7 @@ implementation
                   begin
                     hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
                     if not (current_settings.fputype = fpu_coldfire) and
-                       inlineable_realconstnode(right) then
+                       inlineable_realconstnode(right,left.resultdef) then
                       current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(A_FCMP,tcgsize2opsize[right.location.size],trealconstnode(right).value_real,left.location.register))
                     else
                       begin

+ 1 - 1
compiler/nbas.pas

@@ -1023,8 +1023,8 @@ implementation
                   if segment <> NR_NO then
                     Result := gas_regname(segment) + ':'
                   else
-                    Result := '';
 {$endif defined(x86)}
+                    Result := '';
 
                   if Assigned(symbol) then
                     begin

+ 11 - 3
packages/fcl-passrc/src/pasresolver.pp

@@ -3937,10 +3937,16 @@ end;
 { EPasResolve }
 
 procedure EPasResolve.SetPasElement(AValue: TPasElement);
+var
+  Old: TPasElement;
 begin
   if FPasElement=AValue then Exit;
-  if PasElement<>nil then
+  Old:=FPasElement;
+  if Old<>nil then
+    begin
+    Old:=nil;
     PasElement.Release{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
+    end;
   FPasElement:=AValue;
   if PasElement<>nil then
     PasElement.AddRef{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
@@ -7526,11 +7532,13 @@ procedure TPasResolver.FinishExceptOnExpr;
 var
   El: TPasImplExceptOn;
   ResolvedType: TPasResolverResult;
+  TypeEl: TPasType;
 begin
   CheckTopScope(TPasExceptOnScope);
   El:=TPasImplExceptOn(FTopScope.Element);
-  ComputeElement(El.TypeEl,ResolvedType,[rcType]);
-  CheckIsClass(El.TypeEl,ResolvedType);
+  TypeEl:=El.TypeEl;
+  ComputeElement(TypeEl,ResolvedType,[rcType]);
+  CheckIsClass(TypeEl,ResolvedType);
 end;
 
 procedure TPasResolver.FinishExceptOnStatement;

+ 28 - 10
packages/fcl-passrc/src/pparser.pp

@@ -6001,10 +6001,23 @@ var
 
   function CloseBlock: boolean; // true if parent reached
   var C: TPasImplBlockClass;
+    NeedUnget: Boolean;
   begin
     C:=TPasImplBlockClass(CurBlock.ClassType);
     if C=TPasImplExceptOn then
-      Engine.FinishScope(stExceptOnStatement,CurBlock)
+      begin
+      Engine.FinishScope(stExceptOnStatement,CurBlock);
+      NeedUnget:=CurToken=tkSemicolon;
+      if NeedUnget then
+        NextToken;
+      if (CurToken in [tkend,tkelse])
+          or ((CurToken=tkIdentifier) and (lowercase(CurTokenString)='on')) then
+        // ok
+      else
+        ParseExcExpectedAorB('end','on');
+      if NeedUnget then
+        UngetToken;
+      end
     else if C=TPasImplWithDo then
       Engine.FinishScope(stWithExpr,CurBlock);
     CurBlock:=CurBlock.Parent as TPasImplBlock;
@@ -6063,6 +6076,7 @@ var
   TypeEl: TPasType;
   ImplRaise: TPasImplRaise;
   VarEl: TPasVariable;
+  ImplExceptOn: TPasImplExceptOn;
 
 begin
   NewImplElement:=nil;
@@ -6486,6 +6500,8 @@ begin
         //        ParseExc;
         CheckStatementCanStart;
 
+        //writeln('TPasParser.ParseStatement ',CurToken,' ',CurTokenString);
+
         // On is usable as an identifier
         if lowerCase(CurTokenText)='on' then
           begin
@@ -6496,31 +6512,33 @@ begin
             begin
               SrcPos:=CurTokenPos;
               ExpectIdentifier;
-              El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock,SrcPos));
+              ImplExceptOn:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock,SrcPos));
+              El:=ImplExceptOn;
               SrcPos:=CurSourcePos;
               Name:=CurTokenString;
               NextToken;
+              //writeln('TPasParser.ParseStatement ',CurToken,' ',CurTokenString);
               //writeln('ON t=',Name,' Token=',CurTokenText);
               if CurToken=tkColon then
                 begin
                 // the first expression was the variable name
                 NextToken;
-                TypeEl:=ParseSimpleType(El,SrcPos,'');
-                TPasImplExceptOn(El).TypeEl:=TypeEl;
-                VarEl:=TPasVariable(CreateElement(TPasVariable,Name,El,SrcPos));
-                TPasImplExceptOn(El).VarEl:=VarEl;
+                TypeEl:=ParseSimpleType(ImplExceptOn,SrcPos,'');
+                ImplExceptOn.TypeEl:=TypeEl;
+                VarEl:=TPasVariable(CreateElement(TPasVariable,Name,ImplExceptOn,SrcPos));
+                ImplExceptOn.VarEl:=VarEl;
                 VarEl.VarType:=TypeEl;
                 TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF};
-                if TypeEl.Parent=El then
+                if TypeEl.Parent=ImplExceptOn then
                   TypeEl.Parent:=VarEl;
                 end
               else
                 begin
                 UngetToken;
-                TPasImplExceptOn(El).TypeEl:=ParseSimpleType(El,SrcPos,'');
+                ImplExceptOn.TypeEl:=ParseSimpleType(ImplExceptOn,SrcPos,'');
                 end;
-              Engine.FinishScope(stExceptOnExpr,El);
-              CreateBlock(TPasImplExceptOn(El));
+              Engine.FinishScope(stExceptOnExpr,ImplExceptOn);
+              CreateBlock(ImplExceptOn);
               El:=nil;
               ExpectToken(tkDo);
             end else

+ 22 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -345,6 +345,7 @@ type
     Procedure TestTryStatement;
     Procedure TestTryExceptOnNonTypeFail;
     Procedure TestTryExceptOnNonClassFail;
+    Procedure TestTryStatementMissingOnFail;
     Procedure TestRaiseNonVarFail;
     Procedure TestRaiseNonClassFail;
     Procedure TestRaiseDescendant;
@@ -1736,6 +1737,8 @@ begin
         end;
       ok:=true;
       end;
+    on E: Exception do
+      Fail('Expected EPasResolve but got '+E.ClassName);
   end;
   AssertEquals('Missing resolver error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
 end;
@@ -1756,6 +1759,8 @@ begin
         MsgNumber,Parser.LastMsgNumber);
       ok:=true;
       end;
+    on E: Exception do
+      Fail('Expected EParserError but got '+E.ClassName);
   end;
   AssertEquals('Missing parser error '+Msg+' ('+IntToStr(MsgNumber)+')',true,ok);
 end;
@@ -5414,6 +5419,23 @@ begin
   CheckResolverException('class expected, but Longint found',nXExpectedButYFound);
 end;
 
+procedure TTestResolver.TestTryStatementMissingOnFail;
+begin
+  StartProgram(true,[supTObject]);
+  Add([
+  'procedure Run;',
+  'begin',
+  '  try',
+  '  except',
+  '    on TObject do ;',
+  '    Run;',
+  '  end;',
+  'end;',
+  'begin',
+  '']);
+  CheckParserException('Expected "end" or "on"',nParserExpectToken2Error);
+end;
+
 procedure TTestResolver.TestRaiseNonVarFail;
 begin
   StartProgram(false);

+ 25 - 20
packages/fcl-registry/src/regini.inc

@@ -293,31 +293,36 @@ end;
 
 function TRegIniFile.OpenSection(const Section: string; CreateSection : Boolean = false): boolean;
 var
-  k: HKEY;
-  S : String;
-
+  s: string;
 begin
-  S:=Section;
-  If (S<>'') and (S[1] = '\') then
-    Delete(S,1,1);
-  if CreateSection and (S<>'') then
-    CreateKey('\'+CurrentPath+'\'+S);
-  if S <> '' then
-    k:=GetKey('\'+CurrentPath+'\'+S)
-  else
-    k:=GetKey('\'+CurrentPath);
-  if k = 0 then
-    begin
-    Result:=False;
-    exit;
+  ASSERT(fOldCurKey = 0);
+  if Section <> '' then begin
+    fOldCurKey:=CurrentKey;
+    fOldCurPath:=CurrentPath;
+    // Detach the current key to prevent its closing in OpenKey()
+    SetCurrentKey(0);
+    if Section[1] = '\' then
+      s:=Section
+    else
+      s:='\' + string(fOldCurPath) + '\' + Section;
+    Result:=OpenKey(s, CreateSection);
+    if not Result then begin
+      // Restore on error
+      SetCurrentKey(fOldCurKey);
+      fOldCurKey:=0;
+      fOldCurPath:='';
     end;
-  SetCurrentKey(k);
-  Result:=True;
+  end
+  else
+    Result:=True;
 end;
 
 procedure TRegIniFile.CloseSection;
 begin
-  CloseKey(CurrentKey);
-  fCurrentKey:=0;
+  if fOldCurKey <> 0 then begin
+    ChangeKey(fOldCurKey, fOldCurPath);
+    fOldCurKey:=0;
+    fOldCurPath:='';
+  end;
 end;
 

+ 15 - 7
packages/fcl-registry/src/registry.pp

@@ -202,6 +202,8 @@ type
     fFileName          : String;
     fPath              : String;
     fPreferStringValues: Boolean;
+    fOldCurKey         : HKEY;
+    fOldCurPath        : UnicodeString;
     function OpenSection(const Section: string; CreateSection : Boolean = false): boolean;
     procedure CloseSection;
   public
@@ -266,6 +268,7 @@ type
     procedure DeleteKey(const Section, Name: String); override;
     procedure UpdateFile; override;
     function ValueExists(const Section, Ident: string): Boolean; override;
+    function SectionExists(const Section: string): Boolean; override;
     property RegIniFile: TRegIniFile read FRegIniFile;
   end{$ifdef XMLREG}deprecated 'Use TRegistry instead. Will be removed in 4.0'{$endif} platform; 
 
@@ -1125,13 +1128,18 @@ end;
 
 function TRegistryIniFile.ValueExists(const Section, Ident: string): Boolean;
 begin
-  with FRegInifile do
-    if OpenSection(Section) then
-      try
-        Result:=FRegInifile.ValueExists(Ident);
-      finally
-        CloseSection;
-      end;
+  Result:=FRegInifile.OpenSection(Section);
+  if Result then
+    try
+      Result:=FRegInifile.ValueExists(Ident);
+    finally
+      FRegInifile.CloseSection;
+    end;
+end;
+
+function TRegistryIniFile.SectionExists(const Section: string): Boolean;
+begin
+  Result:=FRegIniFile.KeyExists(Section);
 end;
 
 {$ifdef XMLREG}

+ 21 - 0
packages/fcl-registry/src/winreg.inc

@@ -81,7 +81,28 @@ function TRegistry.DeleteKey(const Key: UnicodeString): Boolean;
 
 Var
   u: UnicodeString;
+  subkeys: TUnicodeStringArray;
+  k, old: HKEY;
+  i: integer;
 begin
+  old:=fCurrentKey;
+  k:=GetKey(Key);
+  if k <> 0 then
+    begin
+      fCurrentKey:=k;
+      try
+        subkeys:=GetKeyNames;
+        for i:=0 to High(subkeys) do
+          begin
+            Result:=DeleteKey(subkeys[i]);
+            if not Result then
+              exit;
+          end;
+      finally
+        fCurrentKey:=old;
+        CloseKey(k);
+      end;
+    end;
   u:=PRepKey(Key);
   FLastError:=RegDeleteKeyW(GetBaseKey(RelativeKey(Key)),PWideChar(u));
   Result:=FLastError=ERROR_SUCCESS;

+ 5 - 11
packages/fcl-registry/src/xmlreg.pp

@@ -235,23 +235,13 @@ end;
 Function TXmlRegistry.DeleteKey(KeyPath : UnicodeString) : Boolean;
 
 Var
-  N, Curr : TDomElement;
-  Node: TDOMNode;
+  N : TDomElement;
 
 begin
  N:=FindKey(KeyPath);
  Result:=(N<>Nil);
  If Result then
    begin
-   //if a key has subkeys, result shall be false and nothing shall be deleted
-   Curr:=N;
-   Node:=Curr.FirstChild;
-   While Assigned(Node) do
-     begin
-     If (Node.NodeType=ELEMENT_NODE) and (Node.NodeName=SKey) then
-       Exit(False);
-     Node:=Node.NextSibling;
-     end;
    (N.ParentNode as TDomElement).RemoveChild(N);
    FDirty:=True;
    MaybeFlush;
@@ -269,6 +259,8 @@ begin
   Result:=(Length(KeyPath)>0);
   If Not Result then
     Exit;
+  If (KeyPath[1] in ['/','\']) then
+    FCurrentElement:=Nil;
   KeyPath:=NormalizeKey(KeyPath);
   If (FCurrentElement<>nil) then
   begin
@@ -917,6 +909,8 @@ begin
   Result:=Nil;
   If (Length(S)=0) then
     Exit;
+  if S[1] in ['/','\'] then
+    FCurrentElement:=nil;
   S:=NormalizeKey(S);
   If (FCurrentElement<>nil) then
   begin

+ 1 - 13
packages/fcl-registry/tests/testbasics.pp

@@ -21,7 +21,6 @@ type
     procedure TestSimpleWinRegistry;
     procedure TestDoubleWrite;
     procedure bug16395;
-    procedure TestAdv;
     procedure TestStringList;
     Procedure TestInt64;
     Procedure TestDeleteSubkey;
@@ -30,11 +29,7 @@ type
 implementation
 
 uses
-  registry
-{$ifdef windows}
-  , tregistry2
-{$endif windows}
-  ;
+  registry;
 
 { TTestBasics }
 
@@ -167,13 +162,6 @@ begin
   DeleteUserXmlFile;
 end;
 
-procedure TTestBasics.TestAdv;
-begin
-{$ifdef windows}
-  DoRegTest2;
-{$endif windows}
-end;
-
 Procedure TTestBasics.TestStringList;
 
 Var

+ 0 - 113
packages/fcl-registry/tests/tregistry2.pp

@@ -1,113 +0,0 @@
-{$ifdef FPC} {$mode delphi}  {$endif}
-unit tregistry2;
-
-interface
-
-procedure DoRegTest2;
-
-implementation
-
-uses Windows, SysUtils, Classes, registry;
-
-const
-  STestRegPath = 'Software\FPC-RegTest';
-  
-procedure TestFailed(ErrCode: integer);
-begin
-  raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode));
-end;
-
-procedure ClearReg;
-begin
-  with TRegistry.Create do
-    try
-      DeleteKey(STestRegPath + '\1');
-      DeleteKey(STestRegPath);
-    finally
-      Free;
-    end;
-end;
-
-procedure DoRegTest2;
-var
-  reg: TRegistry;
-  ri: TRegIniFile;
-  rini: TRegistryIniFile;
-  sl: TStringList;
-begin
-  ClearReg;
-  reg:=TRegistry.Create;
-  try
-    if not reg.OpenKey(STestRegPath, True) then
-      TestFailed(1);
-    if reg.CurrentPath <> STestRegPath then
-      TestFailed(2);
-    reg.WriteString('Item1', '1');
-    if not reg.OpenKey('\' + STestRegPath + '\1', True) then
-      TestFailed(3);
-    reg.WriteString('Item2', '2');
-    if reg.CurrentPath <> STestRegPath + '\1' then
-      TestFailed(5);
-    reg.CloseKey;
-    if reg.CurrentPath <> '' then
-      TestFailed(6);
-
-    ri:=TRegIniFile.Create(STestRegPath);
-    with ri do
-    try
-      if ReadString('', 'Item1', '') <> '1' then
-        TestFailed(10);
-      if ReadString('1', 'Item2', '') <> '2' then
-        TestFailed(11);
-      if ReadString('', 'Item1', '') <> '1' then
-        TestFailed(12);
-      if not ValueExists('Item1') then
-        TestFailed(13);
-
-      WriteInteger('1', 'Item3', 3);
-
-      sl:=TStringList.Create;
-      try
-        ReadSectionValues('1', sl);
-        if sl.Count <> 2 then
-          TestFailed(14);
-        if sl.Values['Item2'] <> '2' then
-          TestFailed(15);
-        if sl.Values['Item3'] <> '3' then
-          TestFailed(16);
-      finally
-        sl.Free;
-      end;
-
-      WriteInteger('', 'Item4', 4);
-      if  GetDataType('Item4') <> rdString then
-        TestFailed(17);
-    finally
-      Free;
-    end;
-
-    rini:=TRegistryIniFile.Create(STestRegPath);
-    with rini do
-    try
-      if ReadString('', 'Item1', '') <> '1' then
-        TestFailed(20);
-      if ReadString('1', 'Item2', '') <> '2' then
-        TestFailed(21);
-      if ReadString('', 'Item1', '') <> '1' then
-        TestFailed(22);
-      if not ValueExists('', 'Item4') then
-        TestFailed(23);
-      if not ValueExists('1', 'Item2') then
-        TestFailed(24);
-    finally
-      Free;
-    end;
-
-  finally
-    reg.Free;
-    ClearReg;
-  end;
-end;
-
-end.
-

+ 1 - 0
rtl/linux/m68k/cprt0.as

@@ -38,6 +38,7 @@ __entry:
         lea.l    8(%sp,%d0.l*4),%a0
         move.l   %a0,operatingsystem_parameter_envp
         move.l   %sp,%a0       /* argv */
+        move.l   %sp,__stkptr
 
         pea      (%sp)         /* highest available stack address */
         pea      (%a1)         /* termination function provided by kernel */

+ 1 - 0
rtl/linux/m68k/dllprt0.as

@@ -24,6 +24,7 @@ _startlib:
 # This is a normal C function with args (argc,argv,envp)
 FPC_SHARED_LIB_START:
         link.w   %a6,#0
+        move.l   %sp,__stkptr
         move.l   8(%fp),%d0
         move.l   %d0,operatingsystem_parameter_argc
         move.l   12(%fp),%d0

+ 5 - 0
rtl/linux/mips/cprt0.as

@@ -128,6 +128,11 @@ _start:
         .globl  main_stub
         .type   main_stub,@function
 main_stub:
+        /* load fp */
+        move    $s8,$sp
+        /* set __stkptr value to $s8 */
+        lui     $v0,%hi(__stkptr)
+        sw      $s8,%lo(__stkptr)($v0)
         lui     $v0,%hi(__fpc_ret_sp)
         sw      $sp,%lo(__fpc_ret_sp)($v0)
         lui     $v0,%hi(__fpc_ret_ra)

+ 1 - 0
rtl/linux/mips/prt0.as

@@ -52,6 +52,7 @@ _dynamic_start:
 _start:
         /* load fp */
         move    $s8,$sp
+        /* set __stkptr value to $s8 */
         lui     $at,%hi(__stkptr)
         sw      $s8,%lo(__stkptr)($at)
 

+ 224 - 0
tests/test/packages/fcl-registry/tregistry2.pp

@@ -0,0 +1,224 @@
+{
+  This unit tests mostly TRegIniFile to work properly and be Delphi compatible.
+  This test also runs on non-Windows platforms where XML registry is used.
+  Please keep this test Delphi compatible.
+}
+
+{$ifdef FPC} {$mode delphi}  {$endif}
+uses Windows, SysUtils, Classes, registry;
+
+{$ifdef FPC}
+  {$WARN implicit_string_cast_loss off}
+  {$WARN symbol_deprecated off}
+{$endif FPC}
+
+const
+  STestRegPath = 'Software\FPC-RegTest';
+  
+procedure TestFailed(ErrCode: integer);
+begin
+  writeln('Test FAILED. Error code: ' + IntToStr(ErrCode));
+  Halt(ErrCode);
+end;
+
+procedure ClearReg(const KeyName: string = '');
+begin
+  with TRegistry.Create do
+    try
+      DeleteKey(STestRegPath);
+    finally
+      Free;
+    end;
+end;
+
+function NormPath(const s: string): string;
+begin
+  Result:=StringReplace(s, '/', '\', [rfReplaceAll]);
+end;
+
+procedure DoRegTest2;
+var
+  reg: TRegistry;
+  ri: TRegIniFile;
+  rini: TRegistryIniFile;
+  sl: TStringList;
+begin
+  ClearReg;
+  try
+    reg:=TRegistry.Create;
+    try
+      { The test key must be deleted by ClearReg() }
+      if reg.KeyExists(STestRegPath) then
+        TestFailed(1);
+      if reg.OpenKey(STestRegPath, False) then
+        TestFailed(2);
+
+      if not reg.OpenKey(STestRegPath, True) then
+        TestFailed(5);
+      if NormPath(reg.CurrentPath) <> STestRegPath then
+        TestFailed(6);
+      reg.WriteString('Item1', '1');
+      if not reg.OpenKey('\' + STestRegPath + '\1', True) then
+        TestFailed(10);
+      reg.WriteString('Item2', '2');
+      if NormPath(reg.CurrentPath) <> STestRegPath + '\1' then
+        TestFailed(15);
+      reg.CloseKey;
+      if NormPath(reg.CurrentPath) <> '' then
+        TestFailed(20);
+      if reg.KeyExists(STestRegPath + '\' + STestRegPath) then
+        TestFailed(21);
+    finally
+      reg.Free;
+    end;
+
+    ri:=TRegIniFile.Create(STestRegPath);
+    with ri do
+    try
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(101);
+      if ReadString('1', 'Item2', '') <> '2' then
+        TestFailed(105);
+      if NormPath(ri.CurrentPath) <> STestRegPath then
+        TestFailed(110);
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(115);
+      if not ValueExists('Item1') then
+        TestFailed(120);
+
+      WriteInteger('1', 'Item3', 3);
+
+      sl:=TStringList.Create;
+      try
+        ReadSectionValues('1', sl);
+        if sl.Count <> 2 then
+          TestFailed(125);
+        if sl.Values['Item2'] <> '2' then
+          TestFailed(130);
+        if sl.Values['Item3'] <> '3' then
+          TestFailed(135);
+      finally
+        sl.Free;
+      end;
+
+      WriteInteger('', 'Item4', 4);
+      WriteInteger('', 'Item41', 41);
+      WriteInteger('', 'Item42', 42);
+      if GetDataType('Item4') <> rdString then
+        TestFailed(140);
+      if ReadString('', 'Item41', '') <> '41' then
+        TestFailed(141);
+      if ReadString('', 'Item42', '') <> '42' then
+        TestFailed(142);
+    finally
+      Free;
+    end;
+
+    { \ at the beginning of the path must be accepted }
+    ri:=TRegIniFile.Create('\' + STestRegPath);
+    with ri do
+    try
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(145);
+    finally
+      Free;
+    end;
+
+    { Write to non-existing key must work }
+    ri:=TRegIniFile.Create(STestRegPath + '\2\3\4');
+    with ri do
+    try
+      if FileName <> NormPath(CurrentPath) then
+        TestFailed(147);
+      if CurrentKey = 0 then
+        TestFailed(148);
+      WriteInteger('', 'Item5', 5);
+      WriteInteger('5', 'Item6', 6);
+      if ReadInteger('', 'Item5', 0) <> 5 then
+        TestFailed(150);
+      if ReadInteger('5', 'Item6', 0) <> 6 then
+        TestFailed(160);
+    finally
+      Free;
+    end;
+
+
+    rini:=TRegistryIniFile.Create(STestRegPath);
+    with rini do
+    try
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(201);
+      { \ is not allowed as a section name }
+      if ReadString('\', 'Item1', '') = '1' then
+        TestFailed(202);
+      if ReadString('1', 'Item2', '') <> '2' then
+        TestFailed(205);
+      { Trailing \ is allowed }
+      if ReadString('1\', 'Item2', '') <> '2' then
+        TestFailed(206);
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(210);
+      if not ValueExists('', 'Item4') then
+        TestFailed(215);
+      if not ValueExists('1', 'Item2') then
+        TestFailed(220);
+      if ReadInteger('2\3\4\5', 'Item6', 0) <> 6 then
+        TestFailed(225);
+      if ReadInteger('2\3\4', 'Item5', 0) <> 5 then
+        TestFailed(230);
+
+      EraseSection('2');
+      if SectionExists('2\3') then
+        TestFailed(245);
+      if ValueExists('2\3\4', 'Item5') then
+        TestFailed(240);
+
+      WriteString('2\3\4', 'Item10', '10');
+      if ReadInteger('2\3\4', 'Item10', 0) <> 10 then
+        TestFailed(245);
+
+      { Check access via a full path }
+      if not SectionExists('\' + STestRegPath) then
+        TestFailed(250);
+      if ReadInteger('\2\3\4', 'Item10', 0) = 10 then
+        TestFailed(255);
+      if ReadInteger('\' + STestRegPath + '\2\3\4', 'Item10', 0) <> 10 then
+        TestFailed(260);
+    finally
+      Free;
+    end;
+
+  finally
+    ClearReg;
+  end;
+
+  { Test if all test keys have been deleted by ClearReg() }
+  reg:=TRegistry.Create;
+  try
+    if reg.KeyExists(STestRegPath) then
+      TestFailed(501);
+    if reg.OpenKey(STestRegPath, False) then
+      TestFailed(502);
+    if reg.OpenKey(STestRegPath + '\2', False) then
+      TestFailed(503);
+  finally
+    reg.Free;
+  end;
+end;
+
+procedure DeleteUserXmlFile;
+begin
+{$ifdef FPC}
+  DeleteFile(Includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml');
+  RemoveDir(GetAppConfigDir(False));
+{$endif FPC}
+end;
+
+begin
+  try
+    DoRegTest2;
+  finally
+    DeleteUserXmlFile;
+  end;
+end.
+

+ 3 - 4
utils/pas2js/dist/rtl.js

@@ -707,10 +707,9 @@ var rtl = {
   },
 
   intfAsIntfT: function (intf,intftype){
-    if (intf){
-      var i = rtl.getIntfG(intf.$o,intftype.$guid);
-      if (i!==null) return i;
-    }
+    if (!intf) return null;
+    var i = rtl.getIntfG(intf.$o,intftype.$guid);
+    if (i) return i;
     rtl.raiseEInvalidCast();
   },