Bläddra i källkod

compiler: change overload search for char constants (for delphi compatibility):
- for AnsiChar prefer ShortString, AnsiString, UnicodeString, WideString, ... (LongString?)
- for WideChar prefer UnicodeString, WideString, AnsiString, ShortString, ... (LongString?)
- remove old code from htypechk which made AnsiChar const = AnsiString,ShortString and WideChar const = WideString,UnicodeString - it is no longer needed since defcmp performs the required comparisons
+ test

git-svn-id: trunk@20348 -

paul 13 år sedan
förälder
incheckning
2499b5514f
4 ändrade filer med 133 tillägg och 16 borttagningar
  1. 1 0
      .gitattributes
  2. 22 3
      compiler/defcmp.pas
  3. 0 13
      compiler/htypechk.pas
  4. 110 0
      tests/test/tcpstr20.pp

+ 1 - 0
.gitattributes

@@ -10180,6 +10180,7 @@ tests/test/tcpstr17.pp svneol=native#text/pascal
 tests/test/tcpstr18.pp svneol=native#text/pascal
 tests/test/tcpstr19.pp svneol=native#text/pascal
 tests/test/tcpstr2.pp svneol=native#text/plain
+tests/test/tcpstr20.pp svneol=native#text/pascal
 tests/test/tcpstr2a.pp svneol=native#text/plain
 tests/test/tcpstr3.pp svneol=native#text/plain
 tests/test/tcpstr4.pp svneol=native#text/plain

+ 22 - 3
compiler/defcmp.pas

@@ -481,11 +481,30 @@ implementation
                  orddef :
                    begin
                    { char to string}
-                     if is_char(def_from) or
-                        is_widechar(def_from) then
+                     if is_char(def_from) then
+                       begin
+                         doconv:=tc_char_2_string;
+                         case tstringdef(def_to).stringtype of
+                           st_shortstring: eq:=te_convert_l1;
+                           st_ansistring: eq:=te_convert_l2;
+                           st_unicodestring: eq:=te_convert_l3;
+                           st_widestring: eq:=te_convert_l4;
+                         else
+                           eq:=te_convert_l5;
+                         end;
+                       end
+                     else
+                     if is_widechar(def_from) then
                       begin
                         doconv:=tc_char_2_string;
-                        eq:=te_convert_l1;
+                        case tstringdef(def_to).stringtype of
+                          st_unicodestring: eq:=te_convert_l1;
+                          st_widestring: eq:=te_convert_l2;
+                          st_ansistring: eq:=te_convert_l3;
+                          st_shortstring: eq:=te_convert_l4;
+                        else
+                          eq:=te_convert_l5;
+                        end;
                       end;
                    end;
                  arraydef :

+ 0 - 13
compiler/htypechk.pas

@@ -1677,19 +1677,6 @@ implementation
               if (p.resultdef.typ=stringdef) and
                  (tstringdef(def_to).stringtype=tstringdef(p.resultdef).stringtype) then
                 eq:=te_equal
-              else
-              { Passing a constant char to ansistring or shortstring or
-                a widechar to widestring then handle it as equal. }
-               if (p.left.nodetype=ordconstn) and
-                  (
-                   is_char(p.resultdef) and
-                   (is_shortstring(def_to) or is_ansistring(def_to))
-                  ) or
-                  (
-                   is_widechar(p.resultdef) and
-                   (is_widestring(def_to) or is_unicodestring(def_to))
-                  ) then
-                eq:=te_equal
             end;
           setdef :
             begin

+ 110 - 0
tests/test/tcpstr20.pp

@@ -0,0 +1,110 @@
+program tcpstr20;
+
+{$APPTYPE CONSOLE}
+{$MODE Delphi}
+
+// Test checks that preferred string type arguments 
+// for AnsiChar are: ShortString, AnsiString, UnicodeString, WideString
+// for WideChar are: UnicodeString, WideString, AnsiString, ShortString
+
+const
+  AC = AnsiChar(13);
+  WC = WideChar(13);
+
+procedure Test(const I, Compare, ExitCode: Integer);
+begin
+  if I <> Compare then
+  begin
+    WriteLn(I, ' <> ', Compare);
+    halt(ExitCode);
+  end;
+end;
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+function OverAll(const S: WideString): Integer; overload;
+begin
+  Result := 1;
+end;
+{$endif}
+
+function OverAll(const S: UnicodeString): Integer; overload;
+begin
+  Result := 2;
+end;
+
+function OverAll(const S: RawByteString): Integer; overload;
+begin
+  Result := 3;
+end;
+
+function OverAll(const S: ShortString): Integer; overload;
+begin
+  Result := 4;
+end;
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+function OverWide(const S: WideString): Integer; overload;
+begin
+  Result := 1;
+end;
+{$endif}
+
+function OverWide(const S: UnicodeString): Integer; overload;
+begin
+  Result := 2;
+end;
+
+function OverNonWide(const S: RawByteString): Integer; overload;
+begin
+  Result := 3;
+end;
+
+function OverNonWide(const S: ShortString): Integer; overload;
+begin
+  Result := 4;
+end;
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+function OverAllNoUni(const S: WideString): Integer; overload;
+begin
+  Result := 1;
+end;
+
+function OverAllNoUni(const S: RawByteString): Integer; overload;
+begin
+  Result := 3;
+end;
+
+function OverAllNoUni(const S: ShortString): Integer; overload;
+begin
+  Result := 4;
+end;
+{$endif}
+
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+function OverAllNoShort(const S: WideString): Integer; overload;
+begin
+  Result := 1;
+end;
+{$endif}
+
+function OverAllNoShort(const S: UnicodeString): Integer; overload;
+begin
+  Result := 2;
+end;
+
+function OverAllNoShort(const S: RawByteString): Integer; overload;
+begin
+  Result := 3;
+end;
+
+begin
+  Test(OverAll(AC), 4, 1);
+  Test(OverAll(WC), 2, 2);
+  Test(OverWide(AC), 2, 3);
+  Test(OverNonWide(WC), 3, 4);
+  {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+  Test(OverAllNoUni(WC), 1, 5);
+  {$endif}
+  Test(OverAllNoShort(AC), 3, 6);
+end.