compiler:

  - warn if compiler finds implicit or explicit string type conversion from a form of ansi string to a form of unicode string and vice versa
  - mark explicit warnings as OFF by default
  - warn if compiler finds an assignment of an unicode char const to ansi string or char type (warn for assignment of unicode string const to be implemented)
  - revert a piece of code from r19457 regards shortstring handling because shortstring handling should not differ from ansistring in this paticular case

git-svn-id: trunk@19574 -

compiler/msg/errore.msg

@@ -41,6 +41,9 @@
 #   x_   executable informations
 #   o_   normal (e.g., "press enter to continue")
 #
+# <type> can contain a minus sign at the beginning to mark that
+# the message is off by default. Look at type_w_explicit_string_cast
+# for example.
 
 #
 # General
@@ -1406,7 +1409,7 @@ parser_e_invalid_codepage=03314_E_Invalid codepage
 % \end{description}
 # Type Checking
 #
-# 04100 is the last used one
+# 04108 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1770,6 +1773,24 @@ type_e_procedures_return_no_value=04103_E_Invalid assignment, procedures return
 % This error occurs when one tries to assign the result of a procedure or destructor call.
 % A procedure or destructor returns no value so this is not
 % possible.
+type_w_implicit_string_cast=04104_W_Implicit string type conversion from "$1" to "$2"
+% An implicit type conversion from an ansi string type to an unicode string type is
+% encountered. To avoid this warning perform an explicit type conversion.
+type_w_implicit_string_cast_loss=04105_W_Implicit string type conversion with potential data loss from "$1" to "$2"
+% An implicit type conversion from an unicode string type to an ansi string type is
+% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of
+% destination string type.
+type_w_explicit_string_cast=04106_-W_Explicit string typecast from "$1" to "$2"
+% An explicit typecast from an ansi string type to an unicode string type is
+% encountered. This warning is off by default. You can turn it on to see all suspicious string conversions.
+type_w_explicit_string_cast_loss=04107_-W_Explicit string typecast with potential data loss from "$1" to "$2"
+% An explicit typecast from an unicode string type to an ansi string type is
+% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of
+% destination string type. This warning is off by default. You can turn it on to see all the places with lossy string
+% conversions.
+type_w_unicode_data_loss=04108_W_Unicode constant cast with potential data loss
+% Conversion from a WideChar to AnsiChar can lose data since now all unicode characters may be represented in the current
+% system codepage
 % \end{description}
 #
 # Symtable
@@ -2940,10 +2961,10 @@ option_read_config_file=11034_D_Reading config file "$1"
 option_found_file=11035_D_found source file name "$1"
 % Additional information about options.
 % Displayed when you have the debug option turned on.
-option_code_page_not_available=11039_E_Unknown code page
-% An unknown code page for the source files was requested.
-% The compiler is compiled with support for several code pages built-in.
-% The requested code page is not in that list. You will need to recompile
+option_code_page_not_available=11039_E_Unknown codepage
+% An unknown codepage for the source files was requested.
+% The compiler is compiled with support for several codepages built-in.
+% The requested codepage is not in that list. You will need to recompile
 % the compiler with support for the codepage you need.
 option_config_is_dir=11040_F_Config file $1 is a directory
 % Directories cannot be used as configuration files.

compiler/msgidx.inc

@@ -500,6 +500,11 @@ const
   type_e_class_helper_must_extend_subclass=04101;
   type_e_record_helper_must_extend_same_record=04102;
   type_e_procedures_return_no_value=04103;
+  type_w_implicit_string_cast=04104;
+  type_w_implicit_string_cast_loss=04105;
+  type_w_explicit_string_cast=04106;
+  type_w_explicit_string_cast_loss=04107;
+  type_w_unicode_data_loss=04108;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -912,9 +917,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 61726;
+  MsgTxtSize = 62020;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,89,315,104,85,55,116,26,202,63,
+    26,89,315,109,85,55,116,26,202,63,
     50,20,1,1,1,1,1,1,1,1
   );

compiler/ncnv.pas

@@ -1031,17 +1031,13 @@ implementation
         newstat  : tstatementnode;
         restemp  : ttempcreatenode;
         sa : ansistring;
-        cw : WideChar;
+        cw : tcompilerwidechar;
         l : SizeUInt;
       begin
          result:=nil;
          if (left.nodetype=ordconstn) and
             ((tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring,st_ansistring]) or
-             (torddef(left.resultdef).ordtype=uchar) or
-             ((torddef(left.resultdef).ordtype=uwidechar) and
-              (tstringdef(resultdef).stringtype<>st_shortstring)
-             )
-            ) then
+             (torddef(left.resultdef).ordtype in [uchar,uwidechar])) then
            begin
               if (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then
                begin
@@ -1057,18 +1053,22 @@ implementation
               else
                 begin
                   if (torddef(left.resultdef).ordtype=uwidechar) then
-                   begin
-                    if (current_settings.sourcecodepage<>CP_UTF8) then
-                      hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue)))
-                    else
-                     begin
-                       Word(cw):=tcompilerwidechar(tordconstnode(left).value.uvalue);
-                       SetLength(sa,5);
-                       l:=UnicodeToUtf8(@(sa[1]),Length(sa),@cw,1);
-                       SetLength(sa,l-1);
-                       hp:=cstringconstnode.createstr(sa);
-                     end
-                   end
+                    begin
+                      if (current_settings.sourcecodepage<>CP_UTF8) then
+                        begin
+                          if tordconstnode(left).value.uvalue>127 then
+                            Message(type_w_unicode_data_loss);
+                          hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue)));
+                        end
+                      else
+                        begin
+                          cw:=tcompilerwidechar(tordconstnode(left).value.uvalue);
+                          SetLength(sa,5);
+                          l:=UnicodeToUtf8(@(sa[1]),Length(sa),@cw,1);
+                          SetLength(sa,l-1);
+                          hp:=cstringconstnode.createstr(sa);
+                        end
+                    end
                   else
                     hp:=cstringconstnode.createstr(chr(tordconstnode(left).value.uvalue));
                   { output string consts in local ansistring encoding }
@@ -1080,19 +1080,6 @@ implementation
               result:=hp;
            end
          else
-           if (tstringdef(resultdef).stringtype=st_shortstring) and
-              (torddef(left.resultdef).ordtype=uwidechar) and
-              (left.nodetype=ordconstn) and
-              (tcompilerwidechar(tordconstnode(left).value.uvalue) <= 127)
-           then
-             begin
-               SetLength(sa,1);
-               Byte(sa[1]):= tordconstnode(left).value.uvalue;
-               hp:=cstringconstnode.createstr(sa);
-               tstringconstnode(hp).changestringtype(resultdef);
-               result:=hp;
-             end
-           else
            { shortstrings are handled 'inline' (except for widechars) }
            if (tstringdef(resultdef).stringtype<>st_shortstring) or
               (torddef(left.resultdef).ordtype=uwidechar) then
@@ -1107,9 +1094,23 @@ implementation
 
                    { create the procname }
                    if torddef(left.resultdef).ordtype<>uwidechar then
-                     procname:='fpc_char_to_'
+                     begin
+                       procname:='fpc_char_to_';
+                       if tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring] then
+                         if nf_explicit in flags then
+                           Message2(type_w_explicit_string_cast,left.resultdef.typename,resultdef.typename)
+                         else
+                           Message2(type_w_implicit_string_cast,left.resultdef.typename,resultdef.typename);
+                     end
                    else
-                     procname:='fpc_uchar_to_';
+                     begin
+                       procname:='fpc_uchar_to_';
+                       if not (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then
+                         if nf_explicit in flags then
+                           Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
+                         else
+                           Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
+                     end;
                    procname:=procname+tstringdef(resultdef).stringtypname;
 
                    { and finally the call }
@@ -1117,6 +1118,10 @@ implementation
                  end
                else
                  begin
+                   if nf_explicit in flags then
+                     Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
+                   else
+                     Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
                    newblock:=internalstatements(newstat);
                    restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
                    addstatement(newstat,restemp);
@@ -1188,6 +1193,22 @@ implementation
                 left:=nil;
               end;
           end
+        else if (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and
+                not (tstringdef(resultdef).stringtype in [st_unicodestring,st_widestring]) then
+          begin
+            if nf_explicit in flags then
+              Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
+            else
+              Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
+          end
+        else if not (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and
+                (tstringdef(resultdef).stringtype in [st_unicodestring,st_widestring]) then
+          begin
+            if nf_explicit in flags then
+              Message2(type_w_explicit_string_cast,left.resultdef.typename,resultdef.typename)
+            else
+              Message2(type_w_implicit_string_cast,left.resultdef.typename,resultdef.typename);
+          end
       end;
 
     function ttypeconvnode.typecheck_char_to_chararray : tnode;
@@ -1220,6 +1241,8 @@ implementation
                 (torddef(left.resultdef).ordtype=uwidechar) and
                 (current_settings.sourcecodepage<>CP_UTF8) then
               begin
+                if tordconstnode(left).value.uvalue>127 then
+                  Message(type_w_unicode_data_loss);
                 hp:=cordconstnode.create(
                       ord(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue))),
                       cchartype,true);

compiler/nld.pas

@@ -608,7 +608,9 @@ implementation
                   if (right.nodetype=stringconstn) and
                      (tstringconstnode(right).len=0) then
                     useshelper:=false;
-                end;
+                end
+              else if (tstringdef(right.resultdef).stringtype in [st_unicodestring,st_widestring]) then
+                Message2(type_w_implicit_string_cast_loss,right.resultdef.typename,left.resultdef.typename);
              { rest is done in pass 1 (JM) }
              if useshelper then
                exit;

compiler/scandir.pas

@@ -1298,6 +1298,21 @@ unit scandir;
         else
         if ident='ZERO_NIL_COMPAT' then
           recordpendingmessagestate(type_w_zero_to_nil, msgstate)
+        else
+        if ident='IMPLICIT_STRING_CAST' then
+          recordpendingmessagestate(type_w_implicit_string_cast, msgstate)
+        else
+        if ident='IMPLICIT_STRING_CAST_LOSS' then
+          recordpendingmessagestate(type_w_implicit_string_cast_loss, msgstate)
+        else
+        if ident='EXPLICIT_STRING_CAST' then
+          recordpendingmessagestate(type_w_explicit_string_cast, msgstate)
+        else
+        if ident='EXPLICIT_STRING_CAST_LOSS' then
+          recordpendingmessagestate(type_w_explicit_string_cast_loss, msgstate)
+        else
+        if ident='CVT_NARROWING_STRING_LOST' then
+          recordpendingmessagestate(type_w_unicode_data_loss, msgstate)
         else
           begin
             i:=0;