+ write(ln) support for variants added

compiler/ninl.pas

@@ -631,6 +631,8 @@ implementation
                           end;
                       end;
                     end;
+                  variantdef :
+                    name:=procprefix+'variant';
                   arraydef :
                     begin
                       if is_chararray(para.left.resulttype.def) then
@@ -2405,7 +2407,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.92  2002-10-10 16:07:57  florian
+  Revision 1.93  2002-10-10 19:24:58  florian
+    + write(ln) support for variants added
+
+  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

rtl/inc/compproc.inc

@@ -158,6 +158,11 @@ Procedure fpc_Write_Text_Char(Len : Longint;var t : Text;c : Char); compilerproc
 {$ifdef HASWIDECHAR}
 Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); compilerproc;
 {$endif HASWIDECHAR}
+
+{$ifdef HASVARIANT}
+Procedure fpc_Write_Text_Variant(Len : Longint;var f : Text;const v : variant); compilerproc;
+{$endif HASVARIANT}
+
 Procedure fpc_Read_End(var f:Text); compilerproc;
 Procedure fpc_ReadLn_End(var f : Text); compilerproc;
 Procedure fpc_Read_Text_ShortStr(var f : Text;var s : String); compilerproc;
@@ -275,7 +280,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
 
 {
   $Log$
-  Revision 1.26  2002-10-10 16:08:50  florian
+  Revision 1.27  2002-10-10 19:24:28  florian
+    + write(ln) support for variants added
+
+  Revision 1.26  2002/10/10 16:08:50  florian
     + several widestring/pwidechar related helpers added
 
   Revision 1.25  2002/10/05 14:20:16  peter

rtl/inc/variant.inc

@@ -55,6 +55,18 @@ procedure variant_clear(var v : variant);[Public,Alias:'FPC_VARIANT_CLEAR'];
      variantmanager.varclear(v);
   end;
 
+Procedure fpc_Write_Text_Variant(Len : Longint;var f : Text;const v : variant); iocheck; [Public,Alias:'FPC_WRITE_TEXT_VARIANT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Begin
+  If (InOutRes<>0) then
+   exit;
+  case TextRec(f).mode of
+    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+      variantmanager.writevariant(f,v,len);
+    fmInput: InOutRes:=105
+    else InOutRes:=103;
+  end;
+End;
+
 { ---------------------------------------------------------------------
     Overloaded operators.
   ---------------------------------------------------------------------}
@@ -566,7 +578,10 @@ procedure initvariantmanager;
 
 {
   $Log$
-  Revision 1.11  2002-10-09 20:13:26  florian
+  Revision 1.12  2002-10-10 19:24:28  florian
+    + write(ln) support for variants added
+
+  Revision 1.11  2002/10/09 20:13:26  florian
     * hopefully last fix to get things working :/
 
   Revision 1.10  2002/10/09 19:56:01  florian

rtl/inc/varianth.inc

@@ -163,6 +163,9 @@ type
       varaddref : procedure(var v : variant);
       varcopy : procedure(var dest : variant;const source : variant);
       varcast : procedure(var dest : variant;const source : variant;vartype : longint);
+
+      writevariant : function(var t : text;const v : variant;width : longint) : Pointer;
+      write0Variant : function(var t : text;const v : Variant): Pointer;
    end;
    pvariantmanager = ^tvariantmanager;
 
@@ -279,7 +282,10 @@ operator <=(const op1,op2 : variant) dest : boolean;
 
 {
   $Log$
-  Revision 1.10  2002-10-09 19:08:22  florian
+  Revision 1.11  2002-10-10 19:24:28  florian
+    + write(ln) support for variants added
+
+  Revision 1.10  2002/10/09 19:08:22  florian
     + Variant constants Unassigned and Null added
 
   Revision 1.9  2002/10/07 15:10:45  florian