* array of char support for Str()

compiler/ncnv.pas

@@ -1232,7 +1232,8 @@ implementation
                 begin
                   if not(
                      (left.resulttype.def.deftype=formaldef) or
-                     (left.resulttype.def.size=resulttype.def.size) or
+                     (not(is_open_array(left.resulttype.def)) and
+                      (left.resulttype.def.size=resulttype.def.size)) or
                      (is_void(left.resulttype.def)  and
                       (left.nodetype=derefn))
                      ) then
@@ -2026,7 +2027,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.74  2002-09-01 08:01:16  daniel
+  Revision 1.75  2002-09-02 19:24:42  peter
+    * array of char support for Str()
+
+  Revision 1.74  2002/09/01 08:01:16  daniel
    * Removed sets from Tcallnode.det_resulttype
    + Added read/write notifications of variables. These will be usefull
      for providing information for several optimizations. For example

compiler/ninl.pas

@@ -154,7 +154,8 @@ implementation
         is_real := source.resulttype.def.deftype = floatdef;
 
         if not assigned(dest) or
-           (dest.left.resulttype.def.deftype<>stringdef) or
+           ((dest.left.resulttype.def.deftype<>stringdef) and
+            not(is_chararray(dest.left.resulttype.def))) or
            not(is_real or
                (source.left.resulttype.def.deftype = orddef)) then
           begin
@@ -230,7 +231,10 @@ implementation
         left := nil;
 
         { create procedure name }
-        procname := 'fpc_' + tstringdef(dest.resulttype.def).stringtypname+'_';
+        if is_chararray(dest.resulttype.def) then
+          procname:='fpc_chararray_'
+        else
+          procname := 'fpc_' + tstringdef(dest.resulttype.def).stringtypname+'_';
         if is_real then
           procname := procname + 'float'
         else
@@ -2362,7 +2366,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.84  2002-08-19 19:36:43  peter
+  Revision 1.85  2002-09-02 19:24:42  peter
+    * array of char support for Str()
+
+  Revision 1.84  2002/08/19 19:36:43  peter
     * More fixes for cross unit inlining, all tnodes are now implemented
     * Moved pocall_internconst to po_internconst because it is not a
       calling type at all and it conflicted when inlining of these small

rtl/inc/compproc.inc

@@ -61,6 +61,9 @@ function fpc_dynarray_copy(var p : pointer;ti : pointer;
 procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : longint;var s : shortstring); compilerproc;
 procedure fpc_ShortStr_Longint(v : longint;len : longint;var s : shortstring); compilerproc;
 procedure fpc_shortstr_cardinal(v : cardinal;len : longint;var s : shortstring); compilerproc;
+procedure fpc_chararray_Float(d : ValReal;len,fr,rt : longint;var a : array of char); compilerproc;
+procedure fpc_chararray_Longint(v : longint;len : longint;var a : array of char); compilerproc;
+procedure fpc_chararray_cardinal(v : cardinal;len : longint;var a : array of char); compilerproc;
 Function fpc_Val_SInt_ShortStr(DestSize: longint; Const S: ShortString; var Code: ValSInt): ValSInt; compilerproc;
 Function fpc_Val_UInt_Shortstr(Const S: ShortString; var Code: ValSInt): ValUInt; compilerproc;
 Function fpc_Val_Real_ShortStr(const s : shortstring; var code : ValSInt): ValReal; compilerproc;
@@ -262,7 +265,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
 
 {
   $Log$
-  Revision 1.19  2002-08-20 18:24:05  jonas
+  Revision 1.20  2002-09-02 19:24:41  peter
+    * array of char support for Str()
+
+  Revision 1.19  2002/08/20 18:24:05  jonas
     * interface "as" helpers converted from procedures to functions
 
   Revision 1.18  2002/07/31 16:58:12  jonas

rtl/inc/sstrings.inc

@@ -361,6 +361,55 @@ begin
 end;
 
 
+{
+   Array Of Char Str() helpers
+}
+
+procedure fpc_chararray_longint(v : longint;len : longint;var a:array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
+var
+  ss : shortstring;
+  maxlen : longint;
+begin
+  int_str(v,ss);
+  if length(ss)<len then
+    ss:=space(len-length(ss))+ss;
+  if length(ss)<high(a)+1 then
+    maxlen:=length(ss)
+  else
+    maxlen:=high(a)+1;
+  move(ss[1],pchar(@a)^,maxlen);
+end;
+
+
+procedure fpc_chararray_cardinal(v : cardinal;len : longint;var a : array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
+var
+  ss : shortstring;
+  maxlen : longint;
+begin
+  int_str(v,ss);
+  if length(ss)<len then
+    ss:=space(len-length(ss))+ss;
+  if length(ss)<high(a)+1 then
+    maxlen:=length(ss)
+  else
+    maxlen:=high(a)+1;
+  move(ss[1],pchar(@a)^,maxlen);
+end;
+
+
+procedure fpc_chararray_Float(d : ValReal;len,fr,rt : longint;var a : array of char);{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+var
+  ss : shortstring;
+  maxlen : longint;
+begin
+  str_real(len,fr,d,treal_type(rt),ss);
+  if length(ss)<high(a)+1 then
+    maxlen:=length(ss)
+  else
+    maxlen:=high(a)+1;
+  move(ss[1],pchar(@a)^,maxlen);
+end;
+
 
 {*****************************************************************************
                            Val() Functions
@@ -403,7 +452,7 @@ begin
               repeat
                 inc(code);
               until (code>=length(s)) or (s[code]<>'0');
-            end;      
+            end;
      end;
   end;
   InitVal:=code;
@@ -611,7 +660,10 @@ end;
 
 {
   $Log$
-  Revision 1.19  2002-08-06 20:53:38  michael
+  Revision 1.20  2002-09-02 19:24:41  peter
+    * array of char support for Str()
+
+  Revision 1.19  2002/08/06 20:53:38  michael
     + Added support for octal strings (using &)
 
   Revision 1.18  2002/01/24 18:27:06  peter