* string constants are now array of char until

    they are converted to a specific string type

git-svn-id: trunk@1254 -

.gitattributes

@@ -6310,6 +6310,7 @@ tests/webtbs/tw4308.pp svneol=native#text/plain
 tests/webtbs/tw4336.pp svneol=native#text/plain
 tests/webtbs/tw4350.pp svneol=native#text/plain
 tests/webtbs/tw4388.pp svneol=native#text/plain
+tests/webtbs/tw4390.pp svneol=native#text/plain
 tests/webtbs/tw4398.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

compiler/aasmtai.pas

@@ -270,8 +270,7 @@ interface
           { extra len so the string can contain an \0 }
           len : longint;
           constructor Create(const _str : string);
-          constructor Create_pchar(_str : pchar);
-          constructor Create_length_pchar(_str : pchar;length : longint);
+          constructor Create_pchar(_str : pchar;length : longint);
           destructor Destroy;override;
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -1478,7 +1477,6 @@ implementation
  ****************************************************************************}
 
      constructor tai_string.Create(const _str : string);
-
        begin
           inherited Create;
           typ:=ait_string;
@@ -1487,17 +1485,8 @@ implementation
           strpcopy(str,_str);
        end;
 
-     constructor tai_string.Create_pchar(_str : pchar);
-
-       begin
-          inherited Create;
-          typ:=ait_string;
-          str:=_str;
-          len:=strlen(_str);
-       end;
-
-    constructor tai_string.Create_length_pchar(_str : pchar;length : longint);
 
+    constructor tai_string.Create_pchar(_str : pchar;length : longint);
        begin
           inherited Create;
           typ:=ait_string;
@@ -1505,12 +1494,11 @@ implementation
           len:=length;
        end;
 
-    destructor tai_string.destroy;
 
+    destructor tai_string.destroy;
       begin
-         { you can have #0 inside the strings so }
          if str<>nil then
-           freemem(str,len+1);
+           freemem(str);
          inherited Destroy;
       end;
 
@@ -1519,9 +1507,8 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         len:=ppufile.getlongint;
-        getmem(str,len+1);
+        getmem(str,len);
         ppufile.getdata(str^,len);
-        str[len]:=#0;
       end;
 
 
@@ -1538,8 +1525,8 @@ implementation
         p : tlinkedlistitem;
       begin
         p:=inherited getcopy;
-        getmem(tai_string(p).str,len+1);
-        move(str^,tai_string(p).str^,len+1);
+        getmem(tai_string(p).str,len);
+        move(str^,tai_string(p).str^,len);
         getcopy:=p;
       end;
 

compiler/cresstr.pas

@@ -157,7 +157,7 @@ procedure Tresourcestrings.CreateResourceStringList;
             getmem(s,len+1);
             move(value^,s^,len);
             s[len]:=#0;
-            asmlist[al_const].concat(tai_string.create_length_pchar(s,len));
+            asmlist[al_const].concat(tai_string.create_pchar(s,len));
             asmlist[al_const].concat(tai_const.create_8bit(0));
          end;
        { append Current value (nil) and hash...}
@@ -175,7 +175,7 @@ procedure Tresourcestrings.CreateResourceStringList;
        getmem(s,l+1);
        move(Name[1],s^,l);
        s[l]:=#0;
-       asmlist[al_const].concat(tai_string.create_length_pchar(s,l));
+       asmlist[al_const].concat(tai_string.create_pchar(s,l));
        asmlist[al_const].concat(tai_const.create_8bit(0));
      end;
   end;

compiler/defcmp.pas

@@ -49,6 +49,7 @@ interface
           tc_pchar_2_string,
           tc_cchar_2_pchar,
           tc_cstring_2_pchar,
+          tc_cstring_2_int,
           tc_ansistring_2_pchar,
           tc_string_2_chararray,
           tc_chararray_2_string,
@@ -266,6 +267,15 @@ implementation
                          doconv:=tc_int_2_int;
                       end;
                    end;
+                 arraydef :
+                   begin
+                     if (m_mac in aktmodeswitches) and
+                        (fromtreetype=stringconstn) then
+                       begin
+                         eq:=te_convert_l3;
+                         doconv:=tc_cstring_2_int;
+                       end;
+                   end;
                end;
              end;
 
@@ -277,7 +287,9 @@ implementation
                      { Constant string }
                      if (fromtreetype=stringconstn) then
                       begin
-                        if (tstringdef(def_from).string_typ=tstringdef(def_to).string_typ) then
+                        { we can change the stringconst node }
+                        if (tstringdef(def_from).string_typ=st_conststring) or
+                           (tstringdef(def_from).string_typ=tstringdef(def_to).string_typ) then
                           eq:=te_equal
                         else
                          begin
@@ -285,14 +297,11 @@ implementation
                            { Don't prefer conversions from widestring to a
                              normal string as we can loose information }
                            if tstringdef(def_from).string_typ=st_widestring then
-                             eq:=te_convert_l1
+                             eq:=te_convert_l3
+                           else if tstringdef(def_to).string_typ=st_widestring then
+                             eq:=te_convert_l2
                            else
-                             begin
-                               if tstringdef(def_to).string_typ=st_widestring then
-                                 eq:=te_convert_l1
-                               else
-                                 eq:=te_equal; { we can change the stringconst node }
-                             end;
+                             eq:=te_equal;
                          end;
                       end
                      else
@@ -350,36 +359,55 @@ implementation
                      { array of char to string, the length check is done by the firstpass of this node }
                      if is_chararray(def_from) or is_open_chararray(def_from) then
                       begin
-                        doconv:=tc_chararray_2_string;
-                        if is_open_array(def_from) then
+                        { "Untyped" stringconstn is an array of char }
+                        if fromtreetype=stringconstn then
                           begin
-                            if is_ansistring(def_to) then
-                              eq:=te_convert_l1
-                            else if is_widestring(def_to) then
+                            doconv:=tc_string_2_string;
+                            { prefered string type depends on the $H switch }
+                            if not(cs_ansistrings in aktlocalswitches) and
+                               (tstringdef(def_to).string_typ=st_shortstring) then
+                              eq:=te_equal
+                            else if (cs_ansistrings in aktlocalswitches) and
+                               (tstringdef(def_to).string_typ=st_ansistring) then
+                              eq:=te_equal
+                            else if tstringdef(def_to).string_typ=st_widestring then
                               eq:=te_convert_l3
                             else
-                              eq:=te_convert_l2;
+                              eq:=te_convert_l1;
                           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 if is_widestring(def_to) then
-                              eq:=te_convert_l3
-                            else
-                              eq:=te_convert_l2;
+                          doconv:=tc_chararray_2_string;
+                          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_l3
+                              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 if is_widestring(def_to) then
+                                eq:=te_convert_l3
+                              else
+                                eq:=te_convert_l2;
+                            end;
                           end;
                       end
                      else
@@ -629,6 +657,14 @@ implementation
                                 eq:=te_convert_l1;
                               end;
                           end
+                        else
+                          { to array of char, from "Untyped" stringconstn (array of char) }
+                          if (fromtreetype=stringconstn) and
+                             is_chararray(def_to) then
+                            begin
+                              eq:=te_convert_l1;
+                              doconv:=tc_string_2_chararray;
+                            end
                         else
                          { other arrays }
                           begin
@@ -752,7 +788,7 @@ implementation
                         (is_pchar(def_to) or is_pwidechar(def_to)) then
                       begin
                         doconv:=tc_cstring_2_pchar;
-                        eq:=te_convert_l1;
+                        eq:=te_convert_l2;
                       end
                      else
                       if cdo_explicit in cdoptions then
@@ -811,21 +847,35 @@ implementation
                    end;
                  arraydef :
                    begin
-                     { chararray to pointer }
-                     if (is_zero_based_array(def_from) or
-                         is_open_array(def_from)) and
-                        equal_defs(tarraydef(def_from).elementtype.def,tpointerdef(def_to).pointertype.def) then
+                     { string constant (which can be part of array constructor)
+                       to zero terminated string constant }
+                     if (fromtreetype in [arrayconstructorn,stringconstn]) and
+                        (is_pchar(def_to) or is_pwidechar(def_to)) then
                       begin
-                        doconv:=tc_array_2_pointer;
-                        eq:=te_convert_l1;
+                        doconv:=tc_cstring_2_pchar;
+                        eq:=te_convert_l2;
                       end
                      else
-                      { dynamic array to pointer, delphi only }
-                      if (m_delphi in aktmodeswitches) and
-                         is_dynamic_array(def_from) then
-                       begin
-                         eq:=te_equal;
-                       end;
+                      { chararray to pointer }
+                      if (is_zero_based_array(def_from) or
+                          is_open_array(def_from)) and
+                          equal_defs(tarraydef(def_from).elementtype.def,tpointerdef(def_to).pointertype.def) then
+                        begin
+                          doconv:=tc_array_2_pointer;
+                          { don't prefer the pchar overload when a constant
+                            string was passed }
+                          if fromtreetype=stringconstn then
+                            eq:=te_convert_l2
+                          else
+                            eq:=te_convert_l1;
+                        end
+                     else
+                       { dynamic array to pointer, delphi only }
+                       if (m_delphi in aktmodeswitches) and
+                          is_dynamic_array(def_from) then
+                        begin
+                          eq:=te_equal;
+                        end;
                    end;
                  pointerdef :
                    begin

compiler/nadd.pas

@@ -558,7 +558,7 @@ implementation
           begin
              case nodetype of
                 addn :
-                  t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
+                  t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2,st_conststring);
                 ltn :
                   t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true);
                 lten :
@@ -1086,10 +1086,17 @@ implementation
              end;
           end
          { pointer comparision and subtraction }
-         else if ((rd.deftype=pointerdef) and (ld.deftype=pointerdef)) or
+         else if (
+                  (rd.deftype=pointerdef) and (ld.deftype=pointerdef)
+                 ) or
                  { compare pchar to char arrays by addresses like BP/Delphi }
-                 ((is_pchar(ld) or (lt=niln)) and is_chararray(rd)) or
-                 ((is_pchar(rd) or (rt=niln)) and is_chararray(ld)) then
+                 (
+                  (nodetype in [equaln,unequaln]) and
+                  (
+                   ((is_pchar(ld) or (lt=niln)) and is_chararray(rd)) or
+                   ((is_pchar(rd) or (rt=niln)) and is_chararray(ld))
+                  )
+                 ) then
           begin
             { convert char array to pointer }
             if is_chararray(rd) then
@@ -1325,16 +1332,16 @@ implementation
             if not assigned(hsym) then
               internalerror(200412043);
             { For methodpointers compare only tmethodpointer.proc }
-	    if (rd.deftype=procvardef) and
+            if (rd.deftype=procvardef) and
                (not tprocvardef(rd).is_addressonly) then
-	      begin
+              begin
                 right:=csubscriptnode.create(
                            hsym,
                            ctypeconvnode.create_internal(right,methodpointertype));
-	       end;
-	    if (ld.deftype=procvardef) and
-	       (not tprocvardef(ld).is_addressonly) then
-	      begin
+               end;
+            if (ld.deftype=procvardef) and
+               (not tprocvardef(ld).is_addressonly) then
+              begin
                 left:=csubscriptnode.create(
                           hsym,
                           ctypeconvnode.create_internal(left,methodpointertype));

compiler/ncal.pas

@@ -316,6 +316,14 @@ type
             begin
               if (paradef.deftype<>arraydef) then
                 internalerror(200405241);
+              { passing a string to an array of char }
+                 if (p.nodetype=stringconstn) then
+                   begin
+                     len:=str_length(p);
+                     if len>0 then
+                      dec(len);
+                   end
+              else
               { handle special case of passing an single array to an array of array }
               if compare_defs(tarraydef(paradef).elementtype.def,p.resulttype.def,nothingn)>=te_equal then
                 len:=0

compiler/ncgcnv.pas

@@ -33,6 +33,7 @@ interface
        tcgtypeconvnode = class(ttypeconvnode)
          procedure second_int_to_int;override;
          procedure second_cstring_to_pchar;override;
+         procedure second_cstring_to_int;override;
          procedure second_string_to_chararray;override;
          procedure second_array_to_pointer;override;
          procedure second_pointer_to_array;override;
@@ -136,17 +137,18 @@ interface
       begin
          location_reset(location,LOC_REGISTER,OS_ADDR);
          case tstringdef(left.resulttype.def).string_typ of
+           st_conststring :
+             begin
+               location.register:=cg.getaddressregister(exprasmlist);
+               cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
+             end;
            st_shortstring :
              begin
                inc(left.location.reference.offset);
                location.register:=cg.getaddressregister(exprasmlist);
                cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
              end;
-         {$ifdef ansistring_bits}
-           st_ansistring16,st_ansistring32,st_ansistring64 :
-         {$else}
            st_ansistring :
-         {$endif}
              begin
                if (left.nodetype=stringconstn) and
                   (str_length(left)=0) then
@@ -180,9 +182,6 @@ interface
                else
                 begin
                   location.register:=cg.getintregister(exprasmlist,OS_INT);
-{$ifdef fpc}
-{$warning Todo: convert widestrings to ascii when typecasting them to pchars}
-{$endif}
                   cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_INT,left.location.reference,
                     location.register);
                 end;
@@ -191,26 +190,24 @@ interface
       end;
 
 
-    procedure tcgtypeconvnode.second_string_to_chararray;
+    procedure tcgtypeconvnode.second_cstring_to_int;
+      begin
+        { this can't happen because constants are already processed in
+          pass 1 }
+        internalerror(200510013);
+      end;
 
-      var
-        arrsize: longint;
 
+    procedure tcgtypeconvnode.second_string_to_chararray;
       begin
-         with tarraydef(resulttype.def) do
-           arrsize := highrange-lowrange+1;
-         if (left.nodetype = stringconstn) and
-            { left.length+1 since there's always a terminating #0 character (JM) }
-            (tstringconstnode(left).len+1 >= arrsize) and
-            (tstringdef(left.resulttype.def).string_typ=st_shortstring) then
-           begin
-             location_copy(location,left.location);
-             inc(location.reference.offset);
-             exit;
-           end
-         else
-           { should be handled already in resulttype pass (JM) }
-           internalerror(200108292);
+        if (left.nodetype = stringconstn) and
+           (tstringdef(left.resulttype.def).string_typ=st_conststring) then
+          begin
+            location_copy(location,left.location);
+            exit;
+          end;
+        { should be handled already in resulttype pass (JM) }
+        internalerror(200108292);
       end;
 
 

compiler/ncgcon.pas

@@ -248,11 +248,7 @@ implementation
          i,mylength  : longint;
       begin
          { for empty ansistrings we could return a constant 0 }
-       {$ifdef ansistring_bits}
-         if (st_type in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring]) and (len=0) then
-       {$else}
          if (st_type in [st_ansistring,st_widestring]) and (len=0) then
-       {$endif}
           begin
             location_reset(location,LOC_CONSTANT,OS_ADDR);
             location.value:=0;
@@ -288,58 +284,32 @@ implementation
                                (lastlabel<>nil) and
                                (tai_string(hp1).len=mylength) then
                               begin
-                                 { if shortstring then check the length byte first and
-                                   set the start index to 1 }
                                  case st_type of
-                                   st_shortstring:
+                                   st_conststring:
                                      begin
-                                       if len=ord(tai_string(hp1).str[0]) then
+                                       j:=0;
+                                       same_string:=true;
+                                       if len>0 then
                                          begin
-                                           j:=1;
-                                           same_string:=true;
-                                           if len>0 then
+                                           for i:=0 to len-1 do
                                              begin
-                                               for i:=0 to len-1 do
-                                                begin
-                                                  if tai_string(hp1).str[j]<>value_str[i] then
-                                                   begin
-                                                     same_string:=false;
-                                                     break;
-                                                   end;
-                                                  inc(j);
-                                                end;
+                                               if tai_string(hp1).str[j]<>value_str[i] then
+                                                 begin
+                                                   same_string:=false;
+                                                   break;
+                                                 end;
+                                               inc(j);
                                              end;
                                          end;
                                      end;
-                                 {$ifdef ansistring_bits}
-                                   st_ansistring16:
+                                   st_shortstring:
                                      begin
-                                       { before the string the following sequence must be found:
-                                         <label>
-                                           constsymbol <datalabel>
-                                           const32 <len>
-                                           const32 <len>
-                                           const32 -1
-                                         we must then return <label> to reuse
-                                       }
-                                       hp2:=tai(lastlabelhp.previous);
-                                       if assigned(hp2) and
-                                          (hp2.typ=ait_const_16bit) and
-                                          (tai_const(hp2).value=aword(-1)) and
-                                          assigned(hp2.previous) and
-                                          (tai(hp2.previous).typ=ait_const_16bit) and
-                                          (tai_const(hp2.previous).value=len) and
-                                          assigned(hp2.previous.previous) and
-                                          (tai(hp2.previous.previous).typ=ait_const_16bit) and
-                                          (tai_const(hp2.previous.previous).value=len) and
-                                          assigned(hp2.previous.previous.previous) and
-                                          (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
-                                          assigned(hp2.previous.previous.previous.previous) and
-                                          (tai(hp2.previous.previous.previous.previous).typ=ait_label) then
+                                       { if shortstring then check the length byte first and
+                                         set the start index to 1 }
+                                       if len=ord(tai_string(hp1).str[0]) then
                                          begin
-                                           lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
+                                           j:=1;
                                            same_string:=true;
-                                           j:=0;
                                            if len>0 then
                                              begin
                                                for i:=0 to len-1 do
@@ -354,12 +324,7 @@ implementation
                                              end;
                                          end;
                                      end;
-                                 {$endif}
-                                 {$ifdef ansistring_bits}
-                                   st_ansistring32,
-                                 {$else}
                                    st_ansistring,
-                                 {$endif}
                                    st_widestring :
                                      begin
                                        { before the string the following sequence must be found:
@@ -398,50 +363,6 @@ implementation
                                              end;
                                          end;
                                      end;
-                                 {$ifdef ansistring_bits}
-                                   st_ansistring64:
-                                     begin
-                                       { before the string the following sequence must be found:
-                                         <label>
-                                           constsymbol <datalabel>
-                                           const32 <len>
-                                           const32 <len>
-                                           const32 -1
-                                         we must then return <label> to reuse
-                                       }
-                                       hp2:=tai(lastlabelhp.previous);
-                                       if assigned(hp2) and
-                                          (hp2.typ=ait_const_64bit) and
-                                          (tai_const(hp2).value=aword(-1)) and
-                                          assigned(hp2.previous) and
-                                          (tai(hp2.previous).typ=ait_const_64bit) and
-                                          (tai_const(hp2.previous).value=len) and
-                                          assigned(hp2.previous.previous) and
-                                          (tai(hp2.previous.previous).typ=ait_const_64bit) and
-                                          (tai_const(hp2.previous.previous).value=len) and
-                                          assigned(hp2.previous.previous.previous) and
-                                          (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
-                                          assigned(hp2.previous.previous.previous.previous) and
-                                          (tai(hp2.previous.previous.previous.previous).typ=ait_label) then
-                                         begin
-                                           lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
-                                           same_string:=true;
-                                           j:=0;
-                                           if len>0 then
-                                             begin
-                                               for i:=0 to len-1 do
-                                                begin
-                                                  if tai_string(hp1).str[j]<>value_str[i] then
-                                                   begin
-                                                     same_string:=false;
-                                                     break;
-                                                   end;
-                                                  inc(j);
-                                                end;
-                                             end;
-                                         end;
-                                     end;
-                                 {$endif}
                                  end;
                                  { found ? }
                                  if same_string then
@@ -465,33 +386,7 @@ implementation
                    asmlist[al_typedconsts].concat(Tai_label.Create(lastlabel));
                    { generate an ansi string ? }
                    case st_type of
-                    {$ifdef ansistring_bits}
-                      st_ansistring16:
-                        begin
-                           { an empty ansi string is nil! }
-                           if len=0 then
-                             asmlist[al_typedconsts].concat(Tai_const.Create_ptr(0))
-                           else
-                             begin
-                                objectlibrary.getdatalabel(l1);
-                                objectlibrary.getdatalabel(l2);
-                                Consts.concat(Tai_label.Create(l2));
-                                Consts.concat(Tai_const_symbol.Create(l1));
-                                Consts.concat(Tai_const.Create_32bit(-1));
-                                Consts.concat(Tai_const.Create_32bit(len));
-                                Consts.concat(Tai_label.Create(l1));
-                                getmem(pc,len+2);
-                                move(value_str^,pc^,len);
-                                pc[len]:=#0;
-                                { to overcome this problem we set the length explicitly }
-                                { with the ending null char }
-                                asmlist[al_typedconsts].concat(Tai_string.Create_length_pchar(pc,len+1));
-                                { return the offset of the real string }
-                                lab_str:=l2;
-                             end;
-                        end;
-                    {$endif}
-                      {$ifdef ansistring_bits}st_ansistring32:{$else}st_ansistring:{$endif}
+                      st_ansistring:
                         begin
                            { an empty ansi string is nil! }
                            if len=0 then
@@ -505,42 +400,15 @@ implementation
                                 asmlist[al_typedconsts].concat(Tai_const.Create_aint(-1));
                                 asmlist[al_typedconsts].concat(Tai_const.Create_aint(len));
                                 asmlist[al_typedconsts].concat(Tai_label.Create(l1));
-                                getmem(pc,len+2);
-                                move(value_str^,pc^,len);
-                                pc[len]:=#0;
-                                { to overcome this problem we set the length explicitly }
-                                { with the ending null char }
-                                asmlist[al_typedconsts].concat(Tai_string.Create_length_pchar(pc,len+1));
-                                { return the offset of the real string }
-                                lab_str:=l2;
-                             end;
-                        end;
-                    {$ifdef ansistring_bits}
-                      st_ansistring64:
-                        begin
-                           { an empty ansi string is nil! }
-                           if len=0 then
-                             Consts.concat(Tai_const.Create_ptr(0))
-                           else
-                             begin
-                                objectlibrary.getdatalabel(l1);
-                                objectlibrary.getdatalabel(l2);
-                                asmlist[al_typedconsts].concat(Tai_label.Create(l2));
-                                asmlist[al_typedconsts].concat(Tai_const_symbol.Create(l1));
-                                asmlist[al_typedconsts].concat(Tai_const.Create_32bit(-1));
-                                asmlist[al_typedconsts].concat(Tai_const.Create_32bit(len));
-                                asmlist[al_typedconsts].concat(Tai_label.Create(l1));
-                                getmem(pc,len+2);
+                                { include also terminating zero }
+                                getmem(pc,len+1);
                                 move(value_str^,pc^,len);
                                 pc[len]:=#0;
-                                { to overcome this problem we set the length explicitly }
-                                { with the ending null char }
-                                asmlist[al_typedconsts].concat(Tai_string.Create_length_pchar(pc,len+1));
+                                asmlist[al_typedconsts].concat(Tai_string.Create_pchar(pc,len+1));
                                 { return the offset of the real string }
                                 lab_str:=l2;
                              end;
                         end;
-                    {$endif}
                       st_widestring:
                         begin
                            { an empty wide string is nil! }
@@ -574,14 +442,20 @@ implementation
                            l:=255
                           else
                            l:=len;
-                          { also length and terminating zero }
-                          getmem(pc,l+3);
-                          move(value_str^,pc[1],l+1);
+                          { include length and terminating zero for quick conversion to pchar }
+                          getmem(pc,l+2);
+                          move(value_str^,pc[1],l);
                           pc[0]:=chr(l);
-                          { to overcome this problem we set the length explicitly }
-                          { with the ending null char }
                           pc[l+1]:=#0;
-                          asmlist[al_typedconsts].concat(Tai_string.Create_length_pchar(pc,l+2));
+                          asmlist[al_typedconsts].concat(Tai_string.Create_pchar(pc,l+2));
+                        end;
+                      st_conststring:
+                        begin
+                          { include terminating zero }
+                          getmem(pc,len+1);
+                          move(value_str^,pc[0],len);
+                          pc[len]:=#0;
+                          asmlist[al_typedconsts].concat(Tai_string.Create_pchar(pc,len+1));
                         end;
                    end;
                 end;

compiler/ncnv.pas

@@ -65,6 +65,7 @@ interface
           function resulttype_real_to_currency : tnode;
           function resulttype_cchar_to_pchar : tnode;
           function resulttype_cstring_to_pchar : tnode;
+          function resulttype_cstring_to_int : tnode;
           function resulttype_char_to_char : tnode;
           function resulttype_arrayconstructor_to_set : tnode;
           function resulttype_pchar_to_string : tnode;
@@ -83,6 +84,7 @@ interface
        protected
           function first_int_to_int : tnode;virtual;
           function first_cstring_to_pchar : tnode;virtual;
+          function first_cstring_to_int : tnode;virtual;
           function first_string_to_chararray : tnode;virtual;
           function first_char_to_string : tnode;virtual;
           function first_nothing : tnode;virtual;
@@ -108,6 +110,7 @@ interface
           { any effect                                                       }
           function _first_int_to_int : tnode;
           function _first_cstring_to_pchar : tnode;
+          function _first_cstring_to_int : tnode;
           function _first_string_to_chararray : tnode;
           function _first_char_to_string : tnode;
           function _first_nothing : tnode;
@@ -130,6 +133,7 @@ interface
           procedure _second_int_to_int;virtual;
           procedure _second_string_to_string;virtual;
           procedure _second_cstring_to_pchar;virtual;
+          procedure _second_cstring_to_int;virtual;
           procedure _second_string_to_chararray;virtual;
           procedure _second_array_to_pointer;virtual;
           procedure _second_pointer_to_array;virtual;
@@ -151,6 +155,7 @@ interface
           procedure second_int_to_int;virtual;abstract;
           procedure second_string_to_string;virtual;abstract;
           procedure second_cstring_to_pchar;virtual;abstract;
+          procedure second_cstring_to_int;virtual;abstract;
           procedure second_string_to_chararray;virtual;abstract;
           procedure second_array_to_pointer;virtual;abstract;
           procedure second_pointer_to_array;virtual;abstract;
@@ -610,6 +615,7 @@ implementation
           'tc_pchar_2_string',
           'tc_cchar_2_pchar',
           'tc_cstring_2_pchar',
+          'tc_cstring_2_int',
           'tc_ansistring_2_pchar',
           'tc_string_2_chararray',
           'tc_chararray_2_string',
@@ -700,20 +706,25 @@ implementation
         arrsize  : aint;
         chartype : string[8];
       begin
-         with tarraydef(resulttype.def) do
+        result := nil;
+        with tarraydef(resulttype.def) do
           begin
             if highrange<lowrange then
              internalerror(200501051);
             arrsize := highrange-lowrange+1;
           end;
-         if (left.nodetype = stringconstn) and
-            { left.length+1 since there's always a terminating #0 character (JM) }
-            (tstringconstnode(left).len+1 >= arrsize) and
-            (tstringdef(left.resulttype.def).string_typ=st_shortstring) then
+        if (left.nodetype = stringconstn) and
+           (tstringdef(left.resulttype.def).string_typ=st_conststring) then
            begin
-             { handled separately }
-             result := nil;
-             exit;
+             { if the array is large enough we can use the string
+               constant directly. This is handled in ncgcnv }
+             if arrsize>=tstringconstnode(left).len then
+               exit;
+             { Convert to shortstring/ansistring and call helper }
+             if tstringconstnode(left).len>255 then
+               inserttypeconv(left,cansistringtype)
+             else
+               inserttypeconv(left,cshortstringtype);
            end;
         if is_widechar(tarraydef(resulttype.def).elementtype.def) then
           chartype:='widechar'
@@ -732,47 +743,12 @@ implementation
       var
         procname: string[31];
         stringpara : tcallparanode;
-        pw : pcompilerwidestring;
-        pc : pchar;
 
       begin
          result:=nil;
          if left.nodetype=stringconstn then
           begin
-             { convert ascii 2 unicode }
-           {$ifdef ansistring_bits}
-             if (tstringdef(resulttype.def).string_typ=st_widestring) and
-                (tstringconstnode(left).st_type in [st_ansistring16,st_ansistring32,
-                       st_ansistring64,st_shortstring,st_longstring]) then
-           {$else}
-             if (tstringdef(resulttype.def).string_typ=st_widestring) and
-                (tstringconstnode(left).st_type in [st_ansistring,st_shortstring,st_longstring]) then
-           {$endif}
-              begin
-                initwidestring(pw);
-                ascii2unicode(tstringconstnode(left).value_str,tstringconstnode(left).len,pw);
-                ansistringdispose(tstringconstnode(left).value_str,tstringconstnode(left).len);
-                pcompilerwidestring(tstringconstnode(left).value_str):=pw;
-              end
-             else
-             { convert unicode 2 ascii }
-           {$ifdef ansistring_bits}
-             if (tstringconstnode(left).st_type=st_widestring) and
-                (tstringdef(resulttype.def).string_typ in [st_ansistring16,st_ansistring32,
-                           st_ansistring64,st_shortstring,st_longstring]) then
-           {$else}
-             if (tstringconstnode(left).st_type=st_widestring) and
-                (tstringdef(resulttype.def).string_typ in [st_ansistring,st_shortstring,st_longstring]) then
-           {$endif}
-              begin
-                pw:=pcompilerwidestring(tstringconstnode(left).value_str);
-                getmem(pc,getlengthwidestring(pw)+1);
-                unicode2ascii(pw,pc);
-                donewidestring(pw);
-                tstringconstnode(left).value_str:=pc;
-              end;
-             tstringconstnode(left).st_type:=tstringdef(resulttype.def).string_typ;
-             tstringconstnode(left).resulttype:=resulttype;
+             tstringconstnode(left).changestringtype(resulttype);
              result:=left;
              left:=nil;
           end
@@ -1053,6 +1029,25 @@ implementation
       end;
 
 
+    function ttypeconvnode.resulttype_cstring_to_int : tnode;
+      var
+        fcc : cardinal;
+        pb  : pbyte;
+      begin
+         result:=nil;
+         if left.nodetype<>stringconstn then
+           internalerror(200510012);
+         if tstringconstnode(left).len=4 then
+           begin
+             pb:=pbyte(tstringconstnode(left).value_str);
+             fcc:=(pb[0] shl 24) or (pb[1] shl 16) or (pb[2] shl 8) or pb[3];
+             result:=cordconstnode.create(fcc,u32inttype,false);
+           end
+         else
+           CGMessage2(type_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
+      end;
+
+
     function ttypeconvnode.resulttype_arrayconstructor_to_set : tnode;
 
       var
@@ -1292,7 +1287,6 @@ implementation
 
 
     function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
-{$ifdef fpc}
       const
          resulttypeconvert : array[tconverttype] of pointer = (
           {none} nil,
@@ -1304,6 +1298,7 @@ implementation
           { pchar_2_string } @ttypeconvnode.resulttype_pchar_to_string,
           { cchar_2_pchar } @ttypeconvnode.resulttype_cchar_to_pchar,
           { cstring_2_pchar } @ttypeconvnode.resulttype_cstring_to_pchar,
+          { cstring_2_int } @ttypeconvnode.resulttype_cstring_to_int,
           { ansistring_2_pchar } nil,
           { string_2_chararray } @ttypeconvnode.resulttype_string_to_chararray,
           { chararray_2_string } @ttypeconvnode.resulttype_chararray_to_string,
@@ -1351,38 +1346,13 @@ implementation
          if assigned(r.proc) then
           result:=tprocedureofobject(r)();
       end;
-{$else}
-      begin
-        case c of
-          tc_string_2_string: resulttype_string_to_string;
-          tc_char_2_string : resulttype_char_to_string;
-          tc_char_2_chararray: resulttype_char_to_chararray;
-          tc_pchar_2_string : resulttype_pchar_to_string;
-          tc_cchar_2_pchar : resulttype_cchar_to_pchar;
-          tc_cstring_2_pchar : resulttype_cstring_to_pchar;
-          tc_string_2_chararray : resulttype_string_to_chararray;
-          tc_chararray_2_string : resulttype_chararray_to_string;
-          tc_real_2_real : resulttype_real_to_real;
-          tc_int_2_real : resulttype_int_to_real;
-          tc_real_2_currency : resulttype_real_to_currency;
-          tc_arrayconstructor_2_set : resulttype_arrayconstructor_to_set;
-          tc_cord_2_pointer : resulttype_cord_to_pointer;
-          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;
-          tc_variant_2_dynarray : resulttype_variant_to_dynarray;
-          tc_dynarray_2_variant : resulttype_dynarray_to_variant;
-        end;
-      end;
-{$Endif fpc}
 
 
     function ttypeconvnode.det_resulttype:tnode;
 
       var
         htype : ttype;
-        hp,hp2 : tnode;
+        hp : tnode;
         currprocdef : tabstractprocdef;
         aprocdef : tprocdef;
         eq : tequaltype;
@@ -1775,12 +1745,20 @@ implementation
     function ttypeconvnode.first_cstring_to_pchar : tnode;
 
       begin
-         first_cstring_to_pchar:=nil;
+         result:=nil;
          registersint:=1;
          expectloc:=LOC_REGISTER;
       end;
 
 
+    function ttypeconvnode.first_cstring_to_int : tnode;
+
+      begin
+        result:=nil;
+        internalerror(200510014);
+      end;
+
+
     function ttypeconvnode.first_string_to_chararray : tnode;
 
       begin
@@ -2058,6 +2036,11 @@ implementation
          result:=first_cstring_to_pchar;
       end;
 
+    function ttypeconvnode._first_cstring_to_int : tnode;
+      begin
+         result:=first_cstring_to_int;
+      end;
+
     function ttypeconvnode._first_string_to_chararray : tnode;
       begin
          result:=first_string_to_chararray;
@@ -2161,6 +2144,7 @@ implementation
            nil, { removed in resulttype_chararray_to_string }
            @ttypeconvnode._first_cchar_to_pchar,
            @ttypeconvnode._first_cstring_to_pchar,
+           @ttypeconvnode._first_cstring_to_int,
            @ttypeconvnode._first_ansistring_to_pchar,
            @ttypeconvnode._first_string_to_chararray,
            nil, { removed in resulttype_chararray_to_string }
@@ -2285,6 +2269,12 @@ implementation
       end;
 
 
+    procedure ttypeconvnode._second_cstring_to_int;
+      begin
+        second_cstring_to_int;
+      end;
+
+
     procedure ttypeconvnode._second_string_to_chararray;
       begin
         second_string_to_chararray;
@@ -2398,6 +2388,7 @@ implementation
            @ttypeconvnode._second_nothing, { pchar_to_string, handled in resulttype pass }
            @ttypeconvnode._second_nothing, {cchar_to_pchar}
            @ttypeconvnode._second_cstring_to_pchar,
+           @ttypeconvnode._second_cstring_to_int,
            @ttypeconvnode._second_ansistring_to_pchar,
            @ttypeconvnode._second_string_to_chararray,
            @ttypeconvnode._second_nothing, { chararray_to_string, handled in resulttype pass }

compiler/ncon.pas

@@ -91,7 +91,7 @@ interface
           lab_str : tasmlabel;
           st_type : tstringtype;
           constructor createstr(const s : string;st:tstringtype);virtual;
-          constructor createpchar(s : pchar;l : longint);virtual;
+          constructor createpchar(s : pchar;l : longint;st:tstringtype);virtual;
           constructor createwstr(w : pcompilerwidestring);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -103,6 +103,7 @@ interface
           function det_resulttype:tnode;override;
           function getpcharcopy : pchar;
           function docompare(p: tnode) : boolean; override;
+          procedure changestringtype(const newtype:ttype);
        end;
        tstringconstnodeclass = class of tstringconstnode;
 
@@ -237,12 +238,10 @@ implementation
           conststring :
             begin
               len:=p.value.len;
-              if not(cs_ansistrings in aktlocalswitches) and (len>255) then
-               len:=255;
               getmem(pc,len+1);
               move(pchar(p.value.valueptr)^,pc^,len);
               pc[len]:=#0;
-              p1:=cstringconstnode.createpchar(pc,len);
+              p1:=cstringconstnode.createpchar(pc,len,st_conststring);
             end;
           constreal :
             p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,pbestrealtype^);
@@ -520,10 +519,8 @@ implementation
 *****************************************************************************}
 
     constructor tstringconstnode.createstr(const s : string;st:tstringtype);
-
       var
          l : longint;
-
       begin
          inherited create(stringconstn);
          l:=length(s);
@@ -533,30 +530,11 @@ implementation
          move(s[1],value_str^,l);
          value_str[l]:=#0;
          lab_str:=nil;
-         if st=st_default then
-          begin
-            if cs_ansistrings in aktlocalswitches then
-            {$ifdef ansistring_bits}
-              case aktansistring_bits of
-                sb_16:
-                  st_type:=st_ansistring16;
-                sb_32:
-                  st_type:=st_ansistring32;
-                sb_64:
-                  st_type:=st_ansistring64;
-              end
-            {$else}
-              st_type:=st_ansistring
-            {$endif}
-            else
-              st_type:=st_shortstring;
-          end
-         else
-          st_type:=st;
+         st_type:=st;
       end;
 
-    constructor tstringconstnode.createwstr(w : pcompilerwidestring);
 
+    constructor tstringconstnode.createwstr(w : pcompilerwidestring);
       begin
          inherited create(stringconstn);
          len:=getlengthwidestring(w);
@@ -566,28 +544,13 @@ implementation
          st_type:=st_widestring;
       end;
 
-    constructor tstringconstnode.createpchar(s : pchar;l : longint);
 
+    constructor tstringconstnode.createpchar(s : pchar;l : longint;st:tstringtype);
       begin
          inherited create(stringconstn);
          len:=l;
          value_str:=s;
-         if (cs_ansistrings in aktlocalswitches) or
-            (len>255) then
-          {$ifdef ansistring_bits}
-            case aktansistring_bits of
-              sb_16:
-                st_type:=st_ansistring16;
-              sb_32:
-                st_type:=st_ansistring32;
-              sb_64:
-                st_type:=st_ansistring64;
-            end
-          {$else}
-            st_type:=st_ansistring
-          {$endif}
-         else
-          st_type:=st_shortstring;
+         st_type:=st;
          lab_str:=nil;
       end;
 
@@ -673,22 +636,25 @@ implementation
       end;
 
     function tstringconstnode.det_resulttype:tnode;
+      var
+        l : aint;
       begin
         result:=nil;
         case st_type of
+          st_conststring :
+            begin
+              { handle and store as array[0..len-1] of char }
+              if len>0 then
+                l:=len-1
+              else
+                l:=0;
+              resulttype.setdef(tarraydef.create(0,l,s32inttype));
+              tarraydef(resulttype.def).setelementtype(cchartype);
+            end;
           st_shortstring :
             resulttype:=cshortstringtype;
-        {$ifdef ansistring_bits}
-          st_ansistring16:
-            resulttype:=cansistringtype16;
-          st_ansistring32:
-            resulttype:=cansistringtype32;
-          st_ansistring64:
-            resulttype:=cansistringtype64;
-        {$else}
           st_ansistring :
             resulttype:=cansistringtype;
-        {$endif}
           st_widestring :
             resulttype:=cwidestringtype;
           st_longstring :
@@ -699,17 +665,14 @@ implementation
     function tstringconstnode.pass_1 : tnode;
       begin
         result:=nil;
-      {$ifdef ansistring_bits}
-        if (st_type in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring]) and
-      {$else}
         if (st_type in [st_ansistring,st_widestring]) and
-      {$endif}
            (len=0) then
          expectloc:=LOC_CONSTANT
         else
          expectloc:=LOC_CREFERENCE;
       end;
 
+
     function tstringconstnode.getpcharcopy : pchar;
       var
          pc : pchar;
@@ -733,6 +696,39 @@ implementation
           (lab_str = tstringconstnode(p).lab_str);
       end;
 
+
+    procedure tstringconstnode.changestringtype(const newtype:ttype);
+      var
+        pw : pcompilerwidestring;
+        pc : pchar;
+      begin
+        if newtype.def.deftype<>stringdef then
+          internalerror(200510011);
+        { convert ascii 2 unicode }
+        if (tstringdef(newtype.def).string_typ=st_widestring) and
+           (st_type<>st_widestring) then
+          begin
+            initwidestring(pw);
+            ascii2unicode(value_str,len,pw);
+            ansistringdispose(value_str,len);
+            pcompilerwidestring(value_str):=pw;
+          end
+        else
+          { convert unicode 2 ascii }
+          if (st_type=st_widestring) and
+            (tstringdef(newtype.def).string_typ<>st_widestring) then
+            begin
+              pw:=pcompilerwidestring(value_str);
+              getmem(pc,getlengthwidestring(pw)+1);
+              unicode2ascii(pw,pc);
+              donewidestring(pw);
+              value_str:=pc;
+            end;
+        st_type:=tstringdef(newtype.def).string_typ;
+        resulttype:=newtype;
+      end;
+
+
 {*****************************************************************************
                              TSETCONSTNODE
 *****************************************************************************}

compiler/nobj.pas

@@ -269,7 +269,7 @@ implementation
          asmlist[al_globals].concat(tai_const.create_8bit(len));
          getmem(ca,len+1);
          move(p^.data.messageinf.str^,ca^,len+1);
-         asmlist[al_globals].concat(Tai_string.Create_pchar(ca));
+         asmlist[al_globals].concat(Tai_string.Create_pchar(ca,len));
          if assigned(p^.r) then
            writenames(p^.r);
       end;

compiler/pexpr.pas

@@ -674,18 +674,24 @@ implementation
             begin
               consume(_LKLAMMER);
               in_args:=true;
+              { Translate to x:=x+y[+z]. The addnode will do the
+                type checking }
               p2:=nil;
               repeat
                 p1:=comp_expr(true);
-                set_varstate(p1,vs_used,[vsf_must_be_valid]);
-                if not((p1.resulttype.def.deftype=stringdef) or
-                       ((p1.resulttype.def.deftype=orddef) and
-                        (torddef(p1.resulttype.def).typ=uchar))) then
-                  Message(parser_e_illegal_parameter_list);
                 if p2<>nil then
                   p2:=caddnode.create(addn,p2,p1)
                 else
-                  p2:=p1;
+                  begin
+                    { Force string type if it isn't yet }
+                    if not(
+                           (p1.resulttype.def.deftype=stringdef) or
+                           is_chararray(p1.resulttype.def) or
+                           is_char(p1.resulttype.def)
+                          ) then
+                      inserttypeconv(p1,cshortstringtype);
+                    p2:=p1;
+                  end;
               until not try_to_consume(_COMMA);
               consume(_RKLAMMER);
               statement_syssym:=p2;
@@ -779,7 +785,7 @@ implementation
               else
                begin
                  { then insert an empty string }
-                 p2:=cstringconstnode.createstr('',st_default);
+                 p2:=cstringconstnode.createstr('',st_conststring);
                end;
               statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
               consume(_RKLAMMER);
@@ -1387,7 +1393,7 @@ implementation
                           getmem(pc,len+1);
                           move(pchar(tconstsym(srsym).value.valueptr)^,pc^,len);
                           pc[len]:=#0;
-                          p1:=cstringconstnode.createpchar(pc,len);
+                          p1:=cstringconstnode.createpchar(pc,len,st_conststring);
                         end;
                       constwstring :
                         p1:=cstringconstnode.createwstr(pcompilerwidestring(tconstsym(srsym).value.valueptr));
@@ -2214,7 +2220,7 @@ implementation
 
            _CSTRING :
              begin
-               p1:=cstringconstnode.createstr(pattern,st_default);
+               p1:=cstringconstnode.createstr(pattern,st_conststring);
                consume(_CSTRING);
              end;
 

compiler/ptconst.pas

@@ -353,7 +353,7 @@ implementation
                          len:=255;
                         getmem(ca,len+2);
                         move(tstringconstnode(p).value_str^,ca^,len+1);
-                        asmlist[al_const].concat(Tai_string.Create_length_pchar(ca,len+1));
+                        asmlist[al_const].concat(Tai_string.Create_pchar(ca,len+1));
                       end
                     else
                       if is_constcharnode(p) then
@@ -593,7 +593,7 @@ implementation
                        getmem(ca,strlength+1);
                        move(strval^,ca^,strlength);
                        ca[strlength]:=#0;
-                       asmlist[cural].concat(Tai_string.Create_length_pchar(ca,strlength));
+                       asmlist[cural].concat(Tai_string.Create_pchar(ca,strlength));
                        { fillup with spaces if size is shorter }
                        if t.def.size>strlength then
                         begin
@@ -603,7 +603,7 @@ implementation
                           fillchar(ca[0],t.def.size-strlength-1,' ');
                           ca[t.def.size-strlength-1]:=#0;
                           { this can also handle longer strings }
-                          asmlist[cural].concat(Tai_string.Create_length_pchar(ca,t.def.size-strlength-1));
+                          asmlist[cural].concat(Tai_string.Create_pchar(ca,t.def.size-strlength-1));
                         end;
                      end;
                    st_ansistring:
@@ -619,14 +619,11 @@ implementation
                             asmlist[al_const].concat(Tai_const.Create_aint(-1));
                             asmlist[al_const].concat(Tai_const.Create_aint(strlength));
                             asmlist[al_const].concat(Tai_label.Create(ll));
-                            getmem(ca,strlength+2);
+                            getmem(ca,strlength+1);
                             move(strval^,ca^,strlength);
                             { The terminating #0 to be stored in the .data section (JM) }
                             ca[strlength]:=#0;
-                            { End of the PChar. The memory has to be allocated because in }
-                            { tai_string.done, there is a freemem(len+1) (JM)             }
-                            ca[strlength+1]:=#0;
-                            asmlist[al_const].concat(Tai_string.Create_length_pchar(ca,strlength+1));
+                            asmlist[al_const].concat(Tai_string.Create_pchar(ca,strlength));
                           end;
                      end;
                    st_widestring:

compiler/rautils.pas

@@ -1415,7 +1415,7 @@ end;
    pc: PChar;
   Begin
      getmem(pc,length(s)+1);
-     p.concat(Tai_string.Create_length_pchar(strpcopy(pc,s),length(s)));
+     p.concat(Tai_string.Create_pchar(strpcopy(pc,s),length(s)));
   end;
 
   Procedure ConcatPasString(p : TAAsmoutput;s:string);

compiler/symconst.pas

@@ -188,16 +188,11 @@ type
   );
 
   { string types }
-  tstringtype = (st_default,
+  tstringtype = (
+    st_conststring,
     st_shortstring,
     st_longstring,
-  {$ifndef ansistring_bits}
     st_ansistring,
-  {$else}
-    st_ansistring16,
-    st_ansistring32,
-    st_ansistring64,
-  {$endif}
     st_widestring
   );
 

tests/tbs/tb0429.pp

@@ -10,11 +10,11 @@ end;
 procedure lowercase(c:shortstring);overload;
 begin
   writeln('short');
-  err:=false;
 end;
 procedure lowercase(c:ansistring);overload;
 begin
   writeln('ansi');
+  err:=false;
 end;
 
 var
@@ -23,7 +23,9 @@ var
   i : longint;
 begin
   err:=true;
-  { this should choosse the shortstring version }
+  { this should choosse the ansistring version }
+  w:='';
+  for i:=1 to 300 do w:=w+'.';
   lowercase(w);
   if err then
    begin

tests/test/tmacpas2.pp

@@ -23,7 +23,7 @@ end;
 procedure TestFourCharCode(myFCC: MyFourCharCodeType);
 
 begin
-  Writeln('FPC creator code as number: ', myFCC);
+  Writeln('FPC creator code as number: ', hexstr(myFCC,8));
   if myFCC <> $46506173 then
     success := false;
 end;

tests/webtbs/tw4390.pp

@@ -0,0 +1,23 @@
+{ Source provided for Free Pascal Bug Report 4390 }
+{ Submitted by "Benjamin Rosseaux" on  2005-09-28 }
+{ e-mail: [email protected] }
+PROGRAM Test;
+{$APPTYPE CONSOLE}
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+PROCEDURE WriteToFile(CONST Buf;Size:INTEGER);
+var
+  s : shortstring;
+BEGIN
+  move(Buf,s[1],size);
+  s[0]:=chr(size);
+  writeln('Writing: "',s,'"');
+  if s<>'TEST' then
+    halt(1);
+END;
+
+BEGIN
+ WriteToFile('TEST',4);
+END.