* widestring patches from Alexey Barkovoy

compiler/defcmp.pas

@@ -166,7 +166,6 @@ implementation
          hct : tconverttype;
          hd3 : tobjectdef;
          hpd : tprocdef;
-         hpe : tenumsym;
       begin
          eq:=te_incompatible;
          doconv:=tc_not_possible;
@@ -326,31 +325,49 @@ implementation
                  arraydef :
                    begin
                      { array of char to string, the length check is done by the firstpass of this node }
-                     if is_chararray(def_from) or
-                        (is_char(tarraydef(def_from).elementtype.def) and
-                         is_open_array(def_from)) then
+                     if is_chararray(def_from) or is_open_chararray(def_from) then
                       begin
                         doconv:=tc_chararray_2_string;
-                        if is_open_array(def_from) or
-                           (is_shortstring(def_to) and
-                            (def_from.size <= 255)) or
-                           (is_ansistring(def_to) and
-                            (def_from.size > 255)) then
-                         eq:=te_convert_l1
-                        else
-                         eq:=te_convert_l2;
+                        if is_open_array(def_from) then
+                          begin
+                            if is_ansistring(def_to) then
+  			      eq:=te_convert_l1
+                            else if is_widestring(def_to) then
+			      eq:=te_convert_l2
+                            else
+			      eq:=te_convert_l2;
+                          end
+			else
+                          begin
+                            if is_shortstring(def_to) then
+                              begin
+                                { Only compatible with arrays that fit
+                                  smaller than 255 chars }
+                                if (def_from.size <= 255) then
+                                  eq:=te_convert_l1;
+                              end
+                            else if is_ansistring(def_to) then
+                              begin
+                                if (def_from.size > 255) then
+                                  eq:=te_convert_l1
+                                else
+                                  eq:=te_convert_l2;
+                              end
+                            else
+                              eq:=te_convert_l2;
+                          end;
                       end
                      else
                      { array of widechar to string, the length check is done by the firstpass of this node }
-                      if is_widechararray(def_from) or
-                         (is_widechar(tarraydef(def_from).elementtype.def) and
-                          is_open_array(def_from)) then
+                      if is_widechararray(def_from) or is_open_widechararray(def_from) then
                        begin
                          doconv:=tc_chararray_2_string;
                          if is_widestring(def_to) then
-                          eq:=te_convert_l1
+                           eq:=te_convert_l1
                          else
-                          eq:=te_convert_l3;
+                           { size of widechar array is double due the sizeof a widechar }
+                           if not(is_shortstring(def_to) and (def_from.size>255*sizeof(widechar))) then
+                             eq:=te_convert_l3;
                        end;
                    end;
                  pointerdef :
@@ -1349,7 +1366,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.65  2005-01-07 21:14:21  florian
+  Revision 1.66  2005-01-10 22:10:26  peter
+    * widestring patches from Alexey Barkovoy
+
+  Revision 1.65  2005/01/07 21:14:21  florian
     + compiler side of variant<->interface implemented
 
   Revision 1.64  2005/01/06 13:30:40  florian

compiler/defutil.pas

@@ -127,6 +127,12 @@ interface
     {# Returns true if p is a wide char array def }
     function is_widechararray(p : tdef) : boolean;
 
+    {# Returns true if p is a open char array def }
+    function is_open_chararray(p : tdef) : boolean;
+
+    {# Returns true if p is a open wide char array def }
+    function is_open_widechararray(p : tdef) : boolean;
+
 {*****************************************************************************
                           String helper functions
  *****************************************************************************}
@@ -565,6 +571,20 @@ implementation
       end;
 
 
+    { true if p is a open char array def }
+    function is_open_chararray(p : tdef) : boolean;
+      begin
+        is_open_chararray:= is_open_array(p) and
+                            is_char(tarraydef(p).elementtype.def);
+      end;
+
+    { true if p is a open wide char array def }
+    function is_open_widechararray(p : tdef) : boolean;
+      begin
+        is_open_widechararray:= is_open_array(p) and
+                                is_widechar(tarraydef(p).elementtype.def);
+      end;
+
     { true if p is a pchar def }
     function is_pchar(p : tdef) : boolean;
       begin
@@ -888,7 +908,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  2004-11-01 23:30:11  peter
+  Revision 1.22  2005-01-10 22:10:26  peter
+    * widestring patches from Alexey Barkovoy
+
+  Revision 1.21  2004/11/01 23:30:11  peter
     * support > 32bit accesses for x86_64
     * rewrote array size checking to support 64bit
 

compiler/htypechk.pas

@@ -230,13 +230,15 @@ implementation
                  end;
                 { not chararray+[(wide)char,(wide)string,(wide)chararray] }
                 if (is_chararray(ld) or is_widechararray(ld) or
-                    (is_open_array(ld) and (is_char(tarraydef(ld).elementtype.def) or is_widechar(tarraydef(ld).elementtype.def)))
-                   ) and
+                    is_open_chararray(ld) or is_open_widechararray(ld))
+                   and
                    ((rd.deftype in [stringdef,orddef,enumdef]) or
                     is_pchar(rd) or
                     is_pwidechar(rd) or
                     is_chararray(rd) or
                     is_widechararray(rd) or
+                    is_open_chararray(rd) or
+                    is_open_widechararray(rd) or
                     (rt=niln)) then
                  begin
                    allowed:=false;
@@ -267,12 +269,13 @@ implementation
               end;
             stringdef :
               begin
-                if ((rd.deftype in [orddef,enumdef,stringdef]) or
-                    is_pchar(rd) or
-                    is_pwidechar(rd) or
-                    is_chararray(rd) or
-                    is_widechararray(rd) or
-                    (is_open_array(rd) and (is_char(tarraydef(rd).elementtype.def) or is_widechar(tarraydef(rd).elementtype.def)))) then
+                if (rd.deftype in [orddef,enumdef,stringdef]) or
+                   is_pchar(rd) or
+                   is_pwidechar(rd) or
+                   is_chararray(rd) or
+                   is_widechararray(rd) or
+                   is_open_chararray(rd) or
+                   is_open_widechararray(rd) then
                  begin
                    allowed:=false;
                    exit;
@@ -1974,7 +1977,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.107  2005-01-07 16:22:47  peter
+  Revision 1.108  2005-01-10 22:10:26  peter
+    * widestring patches from Alexey Barkovoy
+
+  Revision 1.107  2005/01/07 16:22:47  peter
     * handle string-open array of (wide)char without variants
 
   Revision 1.106  2004/12/05 12:28:10  peter

compiler/nadd.pas

@@ -114,6 +114,7 @@ implementation
          rv,lv   : tconstexprint;
          rvd,lvd : bestreal;
          resultrealtype : ttype;
+         strtype: tstringtype;
 {$ifdef state_tracking}
      factval : Tnode;
      change  : boolean;
@@ -1061,67 +1062,77 @@ implementation
            care of chararray+chararray and chararray+char.
            Note: Must be done after pointerdef+pointerdef has been checked, else
            pchar is converted to string }
-         else if (rd.deftype=stringdef) or (ld.deftype=stringdef) or
-                 ((is_pchar(rd) or is_chararray(rd) or is_char(rd)) and
-                  (is_pchar(ld) or is_chararray(ld) or is_char(ld))) then
+         else if (rd.deftype=stringdef) or
+	         (ld.deftype=stringdef) or
+                 ((is_pchar(rd) or is_chararray(rd) or is_char(rd) or is_open_chararray(rd) or
+                   is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd)) and
+                  (is_pchar(ld) or is_chararray(ld) or is_char(ld) or is_open_chararray(ld) or
+                   is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld))) then
           begin
             if (nodetype in [addn,equaln,unequaln,lten,gten,ltn,gtn]) then
               begin
-                if is_widestring(rd) or is_widestring(ld) then
-                  begin
-                     if not(is_widestring(rd)) then
-                       inserttypeconv(right,cwidestringtype);
-                     if not(is_widestring(ld)) then
-                       inserttypeconv(left,cwidestringtype);
-                  end
-                else if is_ansistring(rd) or is_ansistring(ld) then
-                  begin
-                     if not(is_ansistring(rd)) then
-                       begin
-                       {$ifdef ansistring_bits}
-                         case Tstringdef(ld).string_typ of
-                           st_ansistring16:
-                             inserttypeconv(right,cansistringtype16);
-                           st_ansistring32:
-                             inserttypeconv(right,cansistringtype32);
-                           st_ansistring64:
-                             inserttypeconv(right,cansistringtype64);
-                         end;
-                       {$else}
-                         inserttypeconv(right,cansistringtype);
-                       {$endif}
-                       end;
-                     if not(is_ansistring(ld)) then
-                       begin
-                       {$ifdef ansistring_bits}
-                         case Tstringdef(rd).string_typ of
-                           st_ansistring16:
-                             inserttypeconv(left,cansistringtype16);
-                           st_ansistring32:
-                             inserttypeconv(left,cansistringtype32);
-                           st_ansistring64:
-                             inserttypeconv(left,cansistringtype64);
-                         end;
-                       {$else}
-                         inserttypeconv(left,cansistringtype);
-                       {$endif}
-                       end;
-                  end
-                else if is_longstring(rd) or is_longstring(ld) then
-                  begin
-                     if not(is_longstring(rd)) then
-                       inserttypeconv(right,clongstringtype);
-                     if not(is_longstring(ld)) then
-                       inserttypeconv(left,clongstringtype);
-                  end
+                { Is there a widestring? }
+                if is_widestring(rd) or is_widestring(ld) or
+                   is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd) or
+                   is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld) then
+                  strtype:= st_widestring
                 else
-                  begin
-                     if not(is_shortstring(ld)) then
-                       inserttypeconv(left,cshortstringtype);
-                     { don't convert char, that can be handled by the optimized node }
-                     if not(is_shortstring(rd) or is_char(rd)) then
-                       inserttypeconv(right,cshortstringtype);
-                  end;
+		  if is_ansistring(rd) or is_ansistring(ld) or
+                     ((cs_ansistrings in aktlocalswitches) and
+                     //todo: Move some of this to longstring's then they are implemented?
+                      (
+		       is_pchar(rd) or (is_chararray(rd) and (rd.size > 255)) or is_open_chararray(rd) or
+                       is_pchar(ld) or (is_chararray(ld) and (ld.size > 255)) or is_open_chararray(ld)
+                      )
+                     ) then
+                    strtype:= st_ansistring
+                else
+		  if is_longstring(rd) or is_longstring(ld) then
+                    strtype:= st_longstring
+                else
+		  begin
+                    {$warning todo: add a warning/hint here if one converting a too large array}
+                    { nodes is PChar, array [with size > 255] or OpenArrayOfChar.
+                      Note: Delphi halts with error if "array [0..xx] of char"
+                           is assigned to ShortString and string length is less
+                           then array size }
+                    strtype:= st_shortstring;
+		  end;
+
+                // Now convert nodes to common string type
+		case strtype of
+		  st_widestring :
+                    begin
+                      if not(is_widestring(rd)) then
+                        inserttypeconv(right,cwidestringtype);
+                      if not(is_widestring(ld)) then
+                        inserttypeconv(left,cwidestringtype);
+                    end;
+                  st_ansistring :
+                    begin
+                      if not(is_ansistring(rd)) then
+                        inserttypeconv(right,cansistringtype);
+                      if not(is_ansistring(ld)) then
+                        inserttypeconv(left,cansistringtype);
+                    end;
+                  st_longstring :
+                    begin
+                      if not(is_longstring(rd)) then
+                        inserttypeconv(right,clongstringtype);
+                      if not(is_longstring(ld)) then
+                        inserttypeconv(left,clongstringtype);
+                     end;
+                   st_shortstring :
+                     begin
+                       if not(is_shortstring(ld)) then
+                         inserttypeconv(left,cshortstringtype);
+                       { don't convert char, that can be handled by the optimized node }
+                       if not(is_shortstring(rd) or is_char(rd)) then
+                         inserttypeconv(right,cshortstringtype);
+                     end;
+                   else
+                     internalerror(2005101);
+                end;
               end
             else
               CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
@@ -2058,7 +2069,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.133  2005-01-02 17:31:07  peter
+  Revision 1.134  2005-01-10 22:10:26  peter
+    * widestring patches from Alexey Barkovoy
+
+  Revision 1.133  2005/01/02 17:31:07  peter
   unsigned*unsigned will also have unsigned result.
 
   Revision 1.132  2004/12/06 15:57:22  peter