浏览代码

* synchronize with trunk

git-svn-id: branches/unicodekvm@41481 -
nickysn 6 年之前
父节点
当前提交
0a1f89a063

+ 2 - 0
.gitattributes

@@ -14840,6 +14840,7 @@ tests/webtbf/tw34821.pp svneol=native#text/plain
 tests/webtbf/tw3488.pp svneol=native#text/plain
 tests/webtbf/tw3495.pp svneol=native#text/plain
 tests/webtbf/tw3502.pp svneol=native#text/plain
+tests/webtbf/tw35149a.pp svneol=native#text/plain
 tests/webtbf/tw3553.pp svneol=native#text/plain
 tests/webtbf/tw3562.pp svneol=native#text/plain
 tests/webtbf/tw3583.pp svneol=native#text/plain
@@ -16571,6 +16572,7 @@ tests/webtbs/tw3504.pp svneol=native#text/plain
 tests/webtbs/tw3506.pp svneol=native#text/plain
 tests/webtbs/tw35139.pp svneol=native#text/plain
 tests/webtbs/tw35139a.pp svneol=native#text/plain
+tests/webtbs/tw35149.pp svneol=native#text/plain
 tests/webtbs/tw3523.pp svneol=native#text/plain
 tests/webtbs/tw3529.pp svneol=native#text/plain
 tests/webtbs/tw3531.pp svneol=native#text/plain

+ 1 - 3
compiler/pexpr.pas

@@ -1400,9 +1400,7 @@ implementation
                                 (current_procinfo.procdef.struct=structh))) then
                               Message(parser_e_only_class_members)
                             else
-                              Message(parser_e_only_class_members_via_class_ref)
-                          else if isobjecttype then
-                            Message(parser_e_only_static_members_via_object_type);
+                              Message(parser_e_only_class_members_via_class_ref);
                           p1:=csubscriptnode.create(sym,p1);
                         end;
                    end;

+ 2 - 2
compiler/powerpc/cpupara.pas

@@ -650,8 +650,6 @@ unit cpupara;
                   result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true)
                 else
                   internalerror(2019021921);
-                if curfloatreg<>firstfloatreg then
-                  include(varargspara.varargsinfo,va_uses_float_reg);
               end;
             { varargs routines have to reserve at least 32 bytes for the AIX abi }
             if (target_info.abi in [abi_powerpc_aix,abi_powerpc_darwin]) and
@@ -660,6 +658,8 @@ unit cpupara;
            end
         else
           internalerror(2019021710);
+        if curfloatreg<>firstfloatreg then
+          include(varargspara.varargsinfo,va_uses_float_reg);
         create_funcretloc_info(p,side);
       end;
 

+ 2 - 2
compiler/powerpc64/cpupara.pas

@@ -767,8 +767,6 @@ begin
               curfloatreg, curmmreg, cur_stack_offset, true)
           else
             internalerror(2019021920);
-          if curfloatreg <> firstfloatreg then
-            include(varargspara.varargsinfo, va_uses_float_reg);
         end;
       { varargs routines have to reserve at least 64 bytes for the PPC64 ABI }
       if (result < 64) then
@@ -776,6 +774,8 @@ begin
     end
   else
     internalerror(2019021911);
+  if curfloatreg <> firstfloatreg then
+    include(varargspara.varargsinfo, va_uses_float_reg);
   create_funcretloc_info(p, side);
 end;
 

+ 0 - 4
packages/fcl-js/tests/testjs.lpr

@@ -12,10 +12,6 @@ uses
 var
   Application: TTestRunner;
 
-{$IFDEF WINDOWS}{$R testjs.rc}{$ENDIF}
-
-{$R *.res}
-
 begin
   DefaultFormat:=fplain;
   DefaultRunAllTests:=True;

+ 7 - 7
packages/fcl-json/src/fpjson.pp

@@ -2496,7 +2496,7 @@ begin
       vtChar       : Result:=CreateJSON(VChar);
       vtExtended   : Result:=CreateJSON(VExtended^);
       vtString     : Result:=CreateJSON(vString^);
-      vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
+      vtAnsiString : Result:=CreateJSON(UTF8Decode(StrPas(VPChar)));
       vtPChar      : Result:=CreateJSON(StrPas(VPChar));
       vtPointer    : If (VPointer<>Nil) then
                        TJSONData.DoError(SErrPointerNotNil,[SourceType])
@@ -3153,7 +3153,7 @@ constructor TJSONObject.Create(const Elements: array of {$ifdef pas2js}jsvalue{$
 
 Var
   I : integer;
-  AName : String;
+  AName : TJSONUnicodeStringType;
   J : TJSONData;
 
 begin
@@ -3171,10 +3171,10 @@ begin
     {$else}
     With Elements[i] do
       Case VType of
-        vtChar       : AName:=VChar;
-        vtString     : AName:=vString^;
-        vtAnsiString : AName:=(AnsiString(vAnsiString));
-        vtPChar      : AName:=StrPas(VPChar);
+        vtChar       : AName:=TJSONUnicodeStringType(VChar);
+        vtString     : AName:=TJSONUnicodeStringType(vString^);
+        vtAnsiString : AName:=UTF8Decode(StrPas(VPChar));
+        vtPChar      : AName:=TJSONUnicodeStringType(StrPas(VPChar));
       else
         DoError(SErrNameMustBeString,[I+1]);
       end;
@@ -3183,7 +3183,7 @@ begin
       DoError(SErrNameMustBeString,[I+1]);
     Inc(I);
     J:=VarRecToJSON(Elements[i],'Object');
-    Add(AName,J);
+    Add(UTF8Encode(AName),J);
     Inc(I);
     end;
 end;

+ 53 - 0
packages/fcl-json/src/jsonconf.pp

@@ -90,13 +90,21 @@ type
     Procedure EnumValues(Const APath : UnicodeString; List : TStrings);
 
     function  GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; overload;
+    function  GetValue(const APath: RawByteString; const ADefault: RawByteString): UnicodeString; overload;
     function  GetValue(const APath: UnicodeString; ADefault: Integer): Integer; overload;
+    function  GetValue(const APath: RawByteString; ADefault: Integer): Integer; overload;
     function  GetValue(const APath: UnicodeString; ADefault: Int64): Int64; overload;
+    function  GetValue(const APath: RawByteString; ADefault: Int64): Int64; overload;
     function  GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; overload;
+    function  GetValue(const APath: RawByteString; ADefault: Boolean): Boolean; overload;
     function  GetValue(const APath: UnicodeString; ADefault: Double): Double; overload;
+    function  GetValue(const APath: RawByteString; ADefault: Double): Double; overload;
     Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
+    Function GetValue(const APath: RawByteString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
     Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload;
+
     procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload;
+    procedure SetValue(const APath: RawByteString; const AValue: RawByteString); overload;
     procedure SetValue(const APath: UnicodeString; AValue: Integer); overload;
     procedure SetValue(const APath: UnicodeString; AValue: Int64); overload;
     procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload;
@@ -289,6 +297,12 @@ begin
 end;
 
 
+function TJSONConfig.GetValue(const APath: RawByteString; const ADefault: RawByteString): UnicodeString;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),UTF8Decode(ADefault));
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString;
 
 var
@@ -302,6 +316,12 @@ begin
     Result:=ADefault;
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Integer): Integer;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Integer): Integer;
 var
   El : TJSONData;
@@ -316,6 +336,12 @@ begin
     Result:=StrToIntDef(El.AsString,ADefault);
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Int64): Int64;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Int64): Int64;
 var
   El : TJSONData;
@@ -330,6 +356,12 @@ begin
     Result:=StrToInt64Def(El.AsString,ADefault);
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Boolean): Boolean;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean;
 
 var
@@ -345,6 +377,12 @@ begin
     Result:=StrToBoolDef(El.AsString,ADefault);
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Double): Double;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Double): Double;
 
 var
@@ -360,6 +398,14 @@ begin
     Result:=StrToFloatDef(El.AsString,ADefault);
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; AValue: TStrings;
+  const ADefault: String): Boolean;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),AValue, ADefault);
+end;
+
+
 function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
   const ADefault: String): Boolean;
 var
@@ -418,6 +464,13 @@ begin
   FModified:=True;
 end;
 
+
+procedure TJSONConfig.SetValue(const APath: RawByteString;
+  const AValue: RawByteString);
+begin
+  SetValue(UTF8Decode(APath),UTF8Decode(AValue));
+end;
+
 procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString);
 begin
   if AValue = DefValue then

+ 2 - 2
packages/fcl-json/src/jsonreader.pp

@@ -36,7 +36,7 @@ Type
     procedure DoError(const Msg: String);
     Procedure DoParse(AtCurrent,AllowEOF: Boolean);
     function GetNextToken: TJSONToken;
-    function CurrentTokenString: String;
+    function CurrentTokenString: RawByteString;
     function CurrentToken: TJSONToken; inline;
 
     Procedure KeyValue(Const AKey : TJSONStringType); virtual; abstract;
@@ -203,7 +203,7 @@ begin
   Result:=FScanner.CurToken;
 end;
 
-function TBaseJSONReader.CurrentTokenString: String;
+function TBaseJSONReader.CurrentTokenString: RawByteString;
 
 begin
   If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then

+ 4 - 4
packages/fcl-json/src/jsonscanner.pp

@@ -28,7 +28,7 @@ uses SysUtils, Classes;
 resourcestring
   SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s''';
   SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s''';
-  SErrOpenString = 'string exceeds end of line';
+  SErrOpenString = 'string exceeds end of line %d';
 
 type
 
@@ -331,7 +331,7 @@ begin
                       u1:=u2;
                       end
                     end;
-              #0  : Error(SErrOpenString);
+              #0  : Error(SErrOpenString,[FCurRow]);
             else
               Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
             end;
@@ -355,11 +355,11 @@ begin
           else
             MaybeAppendUnicode;
           if FTokenStr[0] = #0 then
-            Error(SErrOpenString);
+            Error(SErrOpenString,[FCurRow]);
           Inc(FTokenStr);
           end;
         if FTokenStr[0] = #0 then
-          Error(SErrOpenString);
+          Error(SErrOpenString,[FCurRow]);
         MaybeAppendUnicode;
         SectionLength := FTokenStr - TokenStart;
         SetLength(FCurTokenString, OldLength + SectionLength);

+ 29 - 0
packages/fcl-json/tests/jsonconftest.pp

@@ -27,6 +27,7 @@ type
     procedure TestKey;
     procedure TestStrings;
     procedure TestUnicodeStrings;
+    procedure TestUnicodeStrings2;
   end;
 
 implementation
@@ -352,6 +353,34 @@ begin
   end;
 end;
 
+procedure TTestJSONConfig.TestUnicodeStrings2;
+
+Const
+  utf8str = 'Größe ÄÜÖ ㎰ す 가';
+  utf8path = 'Größe/す가';
+
+Var
+  Co : TJSONCOnfig;
+
+
+begin
+  Co:=CreateConf('test.json');
+  try
+    Co.SetValue('/проверка',utf8str);
+    Co.SetValue(utf8path,'something');
+    Co.Flush;
+  finally
+    co.Free;
+  end;
+  Co:=CreateConf('test.json');
+  try
+    AssertEquals('UTF8 string read/Write',utf8str,utf8encode(Co.GetValue('/проверка','')));
+    AssertEquals('UTF8 path read/Write','something',Co.GetValue(utf8path,'something'));
+  finally
+    DeleteConf(Co,True);
+  end;
+end;
+
 
 initialization
 

+ 0 - 3
packages/fcl-json/tests/testjsonconf.lpi

@@ -14,9 +14,6 @@
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>

+ 2 - 1
packages/fcl-passrc/src/pasresolver.pp

@@ -9205,7 +9205,8 @@ begin
       end
     else if LTypeEl.ClassType=TPasEnumType then
       begin
-      if LeftResolved.IdentEl is TPasEnumType then
+      if (LeftResolved.IdentEl is TPasType)
+          and (ResolveAliasType(TPasType(LeftResolved.IdentEl)).ClassType=TPasEnumType) then
         begin
         // e.g. TShiftState.ssAlt
         DotScope:=PushEnumDotScope(TPasEnumType(LTypeEl));

+ 24 - 19
packages/fcl-passrc/tests/tcresolver.pas

@@ -3682,25 +3682,30 @@ end;
 procedure TTestResolver.TestEnums;
 begin
   StartProgram(false);
-  Add('type {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue);');
-  Add('var');
-  Add('  {#f}{=TFlag}f: TFlag;');
-  Add('  {#v}{=TFlag}v: TFlag = Green;');
-  Add('  {#i}i: longint;');
-  Add('begin');
-  Add('  {@f}f:={@Red}Red;');
-  Add('  {@f}f:={@v}v;');
-  Add('  if {@f}f={@Red}Red then ;');
-  Add('  if {@f}f={@v}v then ;');
-  Add('  if {@f}f>{@v}v then ;');
-  Add('  if {@f}f<{@v}v then ;');
-  Add('  if {@f}f>={@v}v then ;');
-  Add('  if {@f}f<={@v}v then ;');
-  Add('  if {@f}f<>{@v}v then ;');
-  Add('  if ord({@f}f)<>ord({@Red}Red) then ;');
-  Add('  {@f}f:={@TFlag}TFlag.{@Red}Red;');
-  Add('  {@f}f:={@TFlag}TFlag({@i}i);');
-  Add('  {@i}i:=longint({@f}f);');
+  Add([
+  'type',
+  '  {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue);',
+  '  {#TAlias}TAlias = TFlag;',
+  'var',
+  '  {#f}{=TFlag}f: TFlag;',
+  '  {#v}{=TFlag}v: TFlag = Green;',
+  '  {#i}i: longint;',
+  'begin',
+  '  {@f}f:={@Red}Red;',
+  '  {@f}f:={@v}v;',
+  '  if {@f}f={@Red}Red then ;',
+  '  if {@f}f={@v}v then ;',
+  '  if {@f}f>{@v}v then ;',
+  '  if {@f}f<{@v}v then ;',
+  '  if {@f}f>={@v}v then ;',
+  '  if {@f}f<={@v}v then ;',
+  '  if {@f}f<>{@v}v then ;',
+  '  if ord({@f}f)<>ord({@Red}Red) then ;',
+  '  {@f}f:={@TFlag}TFlag.{@Red}Red;',
+  '  {@f}f:={@TFlag}TFlag({@i}i);',
+  '  {@i}i:=longint({@f}f);',
+  '  {@f}f:={@TAlias}TAlias.{@Green}Green;',
+  '']);
   ParseProgram;
 end;
 

+ 14 - 0
tests/webtbf/tw35149a.pp

@@ -0,0 +1,14 @@
+{ %fail }
+
+program project1;
+
+{$mode objfpc}
+type
+  TestObject = object
+  var
+    TestNested: Integer;
+  end;
+
+begin
+  writeln(TestObject.TestNested);
+end. 

+ 14 - 0
tests/webtbs/tw35149.pp

@@ -0,0 +1,14 @@
+{ %norun }
+
+program project1;
+
+{$mode objfpc}
+type
+  TestObject = object
+  var
+    TestNested: Integer;
+  end;
+
+begin
+  writeln(SizeOf(TestObject.TestNested));
+end.