+ several widestring/pwidechar related stuff added

compiler/defbase.pas

@@ -203,7 +203,8 @@ interface
           tc_class_2_intf,
           tc_char_2_char,
           tc_normal_2_smallset,
-          tc_dynarray_2_openarray
+          tc_dynarray_2_openarray,
+          tc_pwchar_2_string
        );
 
     function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
@@ -1509,19 +1510,32 @@ implementation
                    begin
                    { pchar can be assigned to short/ansistrings,
                      but not in tp7 compatible mode }
-                     if is_pchar(def_from) and not(m_tp7 in aktmodeswitches) then
+                     if not(m_tp7 in aktmodeswitches) then
-                      begin
+                       begin
-                        doconv:=tc_pchar_2_string;
+                          if is_pchar(def_from) then
-                        { trefer ansistrings because pchars can overflow shortstrings, }
+                           begin
-                        { but only if ansistrings are the default (JM)                 }
+                             doconv:=tc_pchar_2_string;
-                        if (is_shortstring(def_to) and
+                             { trefer ansistrings because pchars can overflow shortstrings, }
-                            not(cs_ansistrings in aktlocalswitches)) or
+                             { but only if ansistrings are the default (JM)                 }
-                           (is_ansistring(def_to) and
+                             if (is_shortstring(def_to) and
-                            (cs_ansistrings in aktlocalswitches)) then
+                                 not(cs_ansistrings in aktlocalswitches)) or
-                          b:=1
+                                (is_ansistring(def_to) and
-                        else
+                                 (cs_ansistrings in aktlocalswitches)) then
-                          b:=2;
+                               b:=1
-                      end;
+                             else
+                               b:=2;
+                           end
+                          else if is_pwidechar(def_from) then
+                           begin
+                             doconv:=tc_pwchar_2_string;
+                             { trefer ansistrings because pchars can overflow shortstrings, }
+                             { but only if ansistrings are the default (JM)                 }
+                             if is_widestring(def_to) then
+                               b:=1
+                             else
+                               b:=2;
+                           end;
+                       end;
                    end;
                end;
              end;
@@ -2012,7 +2026,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  2002-10-09 21:01:41  florian
+  Revision 1.22  2002-10-10 16:07:57  florian
+    + several widestring/pwidechar related stuff added
+
+  Revision 1.21  2002/10/09 21:01:41  florian
     * variants aren't compatible with nil
 
   Revision 1.20  2002/10/07 09:49:42  florian

compiler/ncnv.pas

@@ -67,6 +67,7 @@ interface
           function resulttype_pchar_to_string : tnode;
           function resulttype_interface_to_guid : tnode;
           function resulttype_dynarray_to_openarray : tnode;
+          function resulttype_pwchar_to_string : tnode;
           function resulttype_call_helper(c : tconverttype) : tnode;
        protected
           function first_int_to_int : tnode;virtual;
@@ -132,7 +133,6 @@ interface
           procedure second_bool_to_bool;virtual;abstract;
           procedure second_load_smallset;virtual;abstract;
           procedure second_ansistring_to_pchar;virtual;abstract;
-          procedure second_pchar_to_string;virtual;abstract;
           procedure second_class_to_intf;virtual;abstract;
           procedure second_char_to_char;virtual;abstract;
           procedure second_nothing; virtual;abstract;
@@ -876,6 +876,15 @@ implementation
         result.resulttype := resulttype;
       end;
 
+    function ttypeconvnode.resulttype_pwchar_to_string : tnode;
+
+      begin
+        result := ccallnode.createinternres(
+          'fpc_pwidechar_to_'+tstringdef(resulttype.def).stringtypname,
+          ccallparanode.create(left,nil),resulttype);
+        left := nil;
+      end;
+
 
     function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
 {$ifdef fpc}
@@ -909,7 +918,8 @@ implementation
           { class_2_intf } nil,
           { char_2_char } @ttypeconvnode.resulttype_char_to_char,
           { normal_2_smallset} nil,
-          { dynarray_2_openarray} @resulttype_dynarray_to_openarray
+          { dynarray_2_openarray} @resulttype_dynarray_to_openarray,
+          { pwchar_2_string} @resulttype_pwchar_to_string
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -945,6 +955,7 @@ implementation
           tc_intf_2_guid : resulttype_interface_to_guid;
           tc_char_2_char : resulttype_char_to_char;
           tc_dynarray_2_openarray : resulttype_dynarray_to_openarray;
+          tc_pwchar_2_string : resulttype_pwchar_to_string;
         end;
       end;
 {$Endif fpc}
@@ -1764,7 +1775,8 @@ implementation
            @ttypeconvnode._first_class_to_intf,
            @ttypeconvnode._first_char_to_char,
            @ttypeconvnode._first_nothing,
-           @ttypeconvnode._first_nothing
+           @ttypeconvnode._first_nothing,
+           nil
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -2086,7 +2098,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.86  2002-10-06 16:10:23  florian
+  Revision 1.87  2002-10-10 16:07:57  florian
+    + several widestring/pwidechar related stuff added
+
+  Revision 1.86  2002/10/06 16:10:23  florian
     * when compiling <interface> as <interface> we can't assume
       anything about relation
 

compiler/ninl.pas

@@ -1511,6 +1511,15 @@ implementation
                             left:=nil;
                             goto myexit;
                          end
+                        else if is_pwidechar(left.resulttype.def) then
+                         begin
+                            hp := ccallparanode.create(left,nil);
+                            result := ccallnode.createintern('fpc_pwidechar_length',hp);
+                            { make sure the left node doesn't get disposed, since it's }
+                            { reused in the new node (JM)                              }
+                            left:=nil;
+                            goto myexit;
+                         end
                         else
                          CGMessage(type_e_mismatch);
                       end;
@@ -2396,7 +2405,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.91  2002-10-05 14:21:08  peter
+  Revision 1.92  2002-10-10 16:07:57  florian
+    + several widestring/pwidechar related stuff added
+
+  Revision 1.91  2002/10/05 14:21:08  peter
     * Length(PChar) supported
 
   Revision 1.90  2002/09/13 19:12:09  carl