mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 04:39:22 +02:00
+ type cast variant<->enum
* cnv. node second pass uses now as well helper wrappers
This commit is contained in:
parent
573315745d
commit
8b337fb5ef
@ -53,7 +53,6 @@ interface
|
|||||||
{ procedure second_pchar_to_string;override; }
|
{ procedure second_pchar_to_string;override; }
|
||||||
{ procedure second_class_to_intf;override; }
|
{ procedure second_class_to_intf;override; }
|
||||||
{ procedure second_char_to_char;override; }
|
{ procedure second_char_to_char;override; }
|
||||||
procedure second_call_helper(c : tconverttype); override;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -124,67 +123,16 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure tarmtypeconvnode.second_call_helper(c : tconverttype);
|
|
||||||
|
|
||||||
const
|
|
||||||
secondconvert : array[tconverttype] of pointer = (
|
|
||||||
@second_nothing, {equal}
|
|
||||||
@second_nothing, {not_possible}
|
|
||||||
@second_nothing, {second_string_to_string, handled in resulttype pass }
|
|
||||||
@second_char_to_string,
|
|
||||||
@second_nothing, {char_to_charray}
|
|
||||||
@second_nothing, { pchar_to_string, handled in resulttype pass }
|
|
||||||
@second_nothing, {cchar_to_pchar}
|
|
||||||
@second_cstring_to_pchar,
|
|
||||||
@second_ansistring_to_pchar,
|
|
||||||
@second_string_to_chararray,
|
|
||||||
@second_nothing, { chararray_to_string, handled in resulttype pass }
|
|
||||||
@second_array_to_pointer,
|
|
||||||
@second_pointer_to_array,
|
|
||||||
@second_int_to_int,
|
|
||||||
@second_int_to_bool,
|
|
||||||
@second_bool_to_int, { bool_to_bool }
|
|
||||||
@second_bool_to_int,
|
|
||||||
@second_real_to_real,
|
|
||||||
@second_int_to_real,
|
|
||||||
@second_nothing, { real_to_currency, handled in resulttype pass }
|
|
||||||
@second_proc_to_procvar,
|
|
||||||
@second_nothing, { arrayconstructor_to_set }
|
|
||||||
@second_nothing, { second_load_smallset, handled in first pass }
|
|
||||||
@second_cord_to_pointer,
|
|
||||||
@second_nothing, { interface 2 string }
|
|
||||||
@second_nothing, { interface 2 guid }
|
|
||||||
@second_class_to_intf,
|
|
||||||
@second_char_to_char,
|
|
||||||
@second_nothing, { normal_2_smallset }
|
|
||||||
@second_nothing, { dynarray_2_openarray }
|
|
||||||
@second_nothing,
|
|
||||||
@second_nothing, { variant_2_dynarray }
|
|
||||||
@second_nothing { dynarray_2_variant}
|
|
||||||
);
|
|
||||||
type
|
|
||||||
tprocedureofobject = procedure of object;
|
|
||||||
|
|
||||||
var
|
|
||||||
r : packed record
|
|
||||||
proc : pointer;
|
|
||||||
obj : pointer;
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
|
||||||
{ this is a little bit dirty but it works }
|
|
||||||
{ and should be quite portable too }
|
|
||||||
r.proc:=secondconvert[c];
|
|
||||||
r.obj:=self;
|
|
||||||
tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
ctypeconvnode:=tarmtypeconvnode;
|
ctypeconvnode:=tarmtypeconvnode;
|
||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.5 2003-11-02 14:30:03 florian
|
Revision 1.6 2003-11-04 22:30:15 florian
|
||||||
|
+ type cast variant<->enum
|
||||||
|
* cnv. node second pass uses now as well helper wrappers
|
||||||
|
|
||||||
|
Revision 1.5 2003/11/02 14:30:03 florian
|
||||||
* fixed ARM for new reg. allocation scheme
|
* fixed ARM for new reg. allocation scheme
|
||||||
|
|
||||||
Revision 1.4 2003/09/01 15:11:16 florian
|
Revision 1.4 2003/09/01 15:11:16 florian
|
||||||
|
@ -72,7 +72,9 @@ interface
|
|||||||
tc_dynarray_2_openarray,
|
tc_dynarray_2_openarray,
|
||||||
tc_pwchar_2_string,
|
tc_pwchar_2_string,
|
||||||
tc_variant_2_dynarray,
|
tc_variant_2_dynarray,
|
||||||
tc_dynarray_2_variant
|
tc_dynarray_2_variant,
|
||||||
|
tc_variant_2_enum,
|
||||||
|
tc_enum_2_variant
|
||||||
);
|
);
|
||||||
|
|
||||||
function compare_defs_ext(def_from,def_to : tdef;
|
function compare_defs_ext(def_from,def_to : tdef;
|
||||||
@ -442,6 +444,11 @@ implementation
|
|||||||
doconv:=tc_int_2_int;
|
doconv:=tc_int_2_int;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
variantdef :
|
||||||
|
begin
|
||||||
|
eq:=te_convert_l1;
|
||||||
|
doconv:=tc_variant_2_enum;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -606,6 +613,24 @@ implementation
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
variantdef :
|
||||||
|
begin
|
||||||
|
case def_from.deftype of
|
||||||
|
enumdef :
|
||||||
|
begin
|
||||||
|
doconv:=tc_enum_2_variant;
|
||||||
|
eq:=te_convert_l1;
|
||||||
|
end;
|
||||||
|
arraydef :
|
||||||
|
begin
|
||||||
|
if is_dynamic_array(def_from) then
|
||||||
|
begin
|
||||||
|
doconv:=tc_dynarray_2_variant;
|
||||||
|
eq:=te_convert_l1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
pointerdef :
|
pointerdef :
|
||||||
begin
|
begin
|
||||||
@ -983,8 +1008,8 @@ implementation
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ if we didn't find an appropriate type conversion yet and
|
{ if we didn't find an appropriate type conversion yet
|
||||||
there is a variant involved then we search also the := operator }
|
then we search also the := operator }
|
||||||
if (eq=te_incompatible) and
|
if (eq=te_incompatible) and
|
||||||
check_operator and
|
check_operator and
|
||||||
((def_from.deftype in [objectdef,recorddef,arraydef,stringdef,variantdef]) or
|
((def_from.deftype in [objectdef,recorddef,arraydef,stringdef,variantdef]) or
|
||||||
@ -1223,7 +1248,11 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.35 2003-10-30 16:23:13 peter
|
Revision 1.36 2003-11-04 22:30:15 florian
|
||||||
|
+ type cast variant<->enum
|
||||||
|
* cnv. node second pass uses now as well helper wrappers
|
||||||
|
|
||||||
|
Revision 1.35 2003/10/30 16:23:13 peter
|
||||||
* don't search for overloads in parents for constructors
|
* don't search for overloads in parents for constructors
|
||||||
|
|
||||||
Revision 1.34 2003/10/26 14:11:35 florian
|
Revision 1.34 2003/10/26 14:11:35 florian
|
||||||
|
@ -55,7 +55,6 @@ interface
|
|||||||
{$ifdef TESTOBJEXT2}
|
{$ifdef TESTOBJEXT2}
|
||||||
procedure checkobject;override;
|
procedure checkobject;override;
|
||||||
{$endif TESTOBJEXT2}
|
{$endif TESTOBJEXT2}
|
||||||
procedure second_call_helper(c : tconverttype);override;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -232,107 +231,16 @@ implementation
|
|||||||
{$endif TESTOBJEXT2}
|
{$endif TESTOBJEXT2}
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_call_helper(c : tconverttype);
|
|
||||||
{$ifdef fpc}
|
|
||||||
const
|
|
||||||
secondconvert : array[tconverttype] of pointer = (
|
|
||||||
@second_nothing, {equal}
|
|
||||||
@second_nothing, {not_possible}
|
|
||||||
@second_nothing, {second_string_to_string, handled in resulttype pass }
|
|
||||||
@second_char_to_string,
|
|
||||||
@second_nothing, {char_to_charray}
|
|
||||||
@second_nothing, { pchar_to_string, handled in resulttype pass }
|
|
||||||
@second_nothing, {cchar_to_pchar}
|
|
||||||
@second_cstring_to_pchar,
|
|
||||||
@second_ansistring_to_pchar,
|
|
||||||
@second_string_to_chararray,
|
|
||||||
@second_nothing, { chararray_to_string, handled in resulttype pass }
|
|
||||||
@second_array_to_pointer,
|
|
||||||
@second_pointer_to_array,
|
|
||||||
@second_int_to_int,
|
|
||||||
@second_int_to_bool,
|
|
||||||
@second_bool_to_bool,
|
|
||||||
@second_bool_to_int,
|
|
||||||
@second_real_to_real,
|
|
||||||
@second_int_to_real,
|
|
||||||
@second_nothing, { real_to_currency, handled in resulttype pass }
|
|
||||||
@second_proc_to_procvar,
|
|
||||||
@second_nothing, { arrayconstructor_to_set }
|
|
||||||
@second_nothing, { second_load_smallset, handled in first pass }
|
|
||||||
@second_cord_to_pointer,
|
|
||||||
@second_nothing, { interface 2 string }
|
|
||||||
@second_nothing, { interface 2 guid }
|
|
||||||
@second_class_to_intf,
|
|
||||||
@second_char_to_char,
|
|
||||||
@second_nothing, { normal_2_smallset }
|
|
||||||
@second_nothing, { dynarray_2_openarray }
|
|
||||||
@second_nothing, { pwchar_2_string }
|
|
||||||
@second_nothing, { variant_2_dynarray }
|
|
||||||
@second_nothing { dynarray_2_variant}
|
|
||||||
);
|
|
||||||
type
|
|
||||||
tprocedureofobject = procedure of object;
|
|
||||||
|
|
||||||
var
|
|
||||||
r : packed record
|
|
||||||
proc : pointer;
|
|
||||||
obj : pointer;
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
|
||||||
{ this is a little bit dirty but it works }
|
|
||||||
{ and should be quite portable too }
|
|
||||||
r.proc:=secondconvert[c];
|
|
||||||
r.obj:=self;
|
|
||||||
tprocedureofobject(r)();
|
|
||||||
end;
|
|
||||||
{$else fpc}
|
|
||||||
begin
|
|
||||||
case c of
|
|
||||||
tc_equal,
|
|
||||||
tc_not_possible,
|
|
||||||
tc_string_2_string : second_nothing;
|
|
||||||
tc_char_2_string : second_char_to_string;
|
|
||||||
tc_char_2_chararray : second_nothing;
|
|
||||||
tc_pchar_2_string : second_nothing;
|
|
||||||
tc_cchar_2_pchar : second_nothing;
|
|
||||||
tc_cstring_2_pchar : second_cstring_to_pchar;
|
|
||||||
tc_ansistring_2_pchar : second_ansistring_to_pchar;
|
|
||||||
tc_string_2_chararray : second_string_to_chararray;
|
|
||||||
tc_chararray_2_string : second_nothing;
|
|
||||||
tc_array_2_pointer : second_array_to_pointer;
|
|
||||||
tc_pointer_2_array : second_pointer_to_array;
|
|
||||||
tc_int_2_int : second_int_to_int;
|
|
||||||
tc_int_2_bool : second_int_to_bool;
|
|
||||||
tc_bool_2_bool : second_bool_to_bool;
|
|
||||||
tc_bool_2_int : second_bool_to_int;
|
|
||||||
tc_real_2_real : second_real_to_real;
|
|
||||||
tc_int_2_real : second_int_to_real;
|
|
||||||
tc_real_2_currency : second_nothing;
|
|
||||||
tc_proc_2_procvar : second_proc_to_procvar;
|
|
||||||
tc_arrayconstructor_2_set : second_nothing;
|
|
||||||
tc_load_smallset : second_nothing;
|
|
||||||
tc_cord_2_pointer : second_cord_to_pointer;
|
|
||||||
tc_intf_2_string : second_nothing;
|
|
||||||
tc_intf_2_guid : second_nothing;
|
|
||||||
tc_class_2_intf : second_class_to_intf;
|
|
||||||
tc_char_2_char : second_char_to_char;
|
|
||||||
tc_normal_2_smallset : second_nothing;
|
|
||||||
tc_dynarray_2_openarray : second_nothing;
|
|
||||||
tc_pwchar_2_string : second_nothing;
|
|
||||||
tc_variant_2_dynarray : second_nothing;
|
|
||||||
tc_dynarray_2_variant : second_nothing;
|
|
||||||
else internalerror(2002101101);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{$endif fpc}
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
ctypeconvnode:=ti386typeconvnode;
|
ctypeconvnode:=ti386typeconvnode;
|
||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.67 2003-10-10 17:48:14 peter
|
Revision 1.68 2003-11-04 22:30:15 florian
|
||||||
|
+ type cast variant<->enum
|
||||||
|
* cnv. node second pass uses now as well helper wrappers
|
||||||
|
|
||||||
|
Revision 1.67 2003/10/10 17:48:14 peter
|
||||||
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
|
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
|
||||||
* tregisteralloctor renamed to trgobj
|
* tregisteralloctor renamed to trgobj
|
||||||
* removed rgobj from a lot of units
|
* removed rgobj from a lot of units
|
||||||
|
@ -50,7 +50,6 @@ interface
|
|||||||
{$ifdef TESTOBJEXT2}
|
{$ifdef TESTOBJEXT2}
|
||||||
procedure checkobject;virtual;
|
procedure checkobject;virtual;
|
||||||
{$endif TESTOBJEXT2}
|
{$endif TESTOBJEXT2}
|
||||||
procedure second_call_helper(c : tconverttype);virtual;abstract;
|
|
||||||
procedure pass_2;override;
|
procedure pass_2;override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -515,7 +514,11 @@ end.
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.49 2003-10-10 17:48:13 peter
|
Revision 1.50 2003-11-04 22:30:15 florian
|
||||||
|
+ type cast variant<->enum
|
||||||
|
* cnv. node second pass uses now as well helper wrappers
|
||||||
|
|
||||||
|
Revision 1.49 2003/10/10 17:48:13 peter
|
||||||
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
|
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
|
||||||
* tregisteralloctor renamed to trgobj
|
* tregisteralloctor renamed to trgobj
|
||||||
* removed rgobj from a lot of units
|
* removed rgobj from a lot of units
|
||||||
|
@ -51,6 +51,7 @@ interface
|
|||||||
function det_resulttype:tnode;override;
|
function det_resulttype:tnode;override;
|
||||||
procedure mark_write;override;
|
procedure mark_write;override;
|
||||||
function docompare(p: tnode) : boolean; override;
|
function docompare(p: tnode) : boolean; override;
|
||||||
|
procedure second_call_helper(c : tconverttype);
|
||||||
private
|
private
|
||||||
function resulttype_int_to_int : tnode;
|
function resulttype_int_to_int : tnode;
|
||||||
function resulttype_cord_to_pointer : tnode;
|
function resulttype_cord_to_pointer : tnode;
|
||||||
@ -73,6 +74,8 @@ interface
|
|||||||
function resulttype_variant_to_dynarray : tnode;
|
function resulttype_variant_to_dynarray : tnode;
|
||||||
function resulttype_dynarray_to_variant : tnode;
|
function resulttype_dynarray_to_variant : tnode;
|
||||||
function resulttype_call_helper(c : tconverttype) : tnode;
|
function resulttype_call_helper(c : tconverttype) : tnode;
|
||||||
|
function resulttype_variant_to_enum : tnode;
|
||||||
|
function resulttype_enum_to_variant : tnode;
|
||||||
protected
|
protected
|
||||||
function first_int_to_int : tnode;virtual;
|
function first_int_to_int : tnode;virtual;
|
||||||
function first_cstring_to_pchar : tnode;virtual;
|
function first_cstring_to_pchar : tnode;virtual;
|
||||||
@ -120,6 +123,27 @@ interface
|
|||||||
function _first_class_to_intf : tnode;
|
function _first_class_to_intf : tnode;
|
||||||
function _first_char_to_char : tnode;
|
function _first_char_to_char : tnode;
|
||||||
|
|
||||||
|
procedure _second_int_to_int;virtual;
|
||||||
|
procedure _second_string_to_string;virtual;
|
||||||
|
procedure _second_cstring_to_pchar;virtual;
|
||||||
|
procedure _second_string_to_chararray;virtual;
|
||||||
|
procedure _second_array_to_pointer;virtual;
|
||||||
|
procedure _second_pointer_to_array;virtual;
|
||||||
|
procedure _second_chararray_to_string;virtual;
|
||||||
|
procedure _second_char_to_string;virtual;
|
||||||
|
procedure _second_int_to_real;virtual;
|
||||||
|
procedure _second_real_to_real;virtual;
|
||||||
|
procedure _second_cord_to_pointer;virtual;
|
||||||
|
procedure _second_proc_to_procvar;virtual;
|
||||||
|
procedure _second_bool_to_int;virtual;
|
||||||
|
procedure _second_int_to_bool;virtual;
|
||||||
|
procedure _second_bool_to_bool;virtual;
|
||||||
|
procedure _second_load_smallset;virtual;
|
||||||
|
procedure _second_ansistring_to_pchar;virtual;
|
||||||
|
procedure _second_class_to_intf;virtual;
|
||||||
|
procedure _second_char_to_char;virtual;
|
||||||
|
procedure _second_nothing; virtual;
|
||||||
|
|
||||||
procedure second_int_to_int;virtual;abstract;
|
procedure second_int_to_int;virtual;abstract;
|
||||||
procedure second_string_to_string;virtual;abstract;
|
procedure second_string_to_string;virtual;abstract;
|
||||||
procedure second_cstring_to_pchar;virtual;abstract;
|
procedure second_cstring_to_pchar;virtual;abstract;
|
||||||
@ -984,6 +1008,28 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function ttypeconvnode.resulttype_variant_to_enum : tnode;
|
||||||
|
|
||||||
|
begin
|
||||||
|
result := ctypeconvnode.create_explicit(left,defaultordconsttype);
|
||||||
|
result := ctypeconvnode.create_explicit(result,resulttype);
|
||||||
|
resulttypepass(result);
|
||||||
|
{ left is reused }
|
||||||
|
left := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function ttypeconvnode.resulttype_enum_to_variant : tnode;
|
||||||
|
|
||||||
|
begin
|
||||||
|
result := ctypeconvnode.create_explicit(left,defaultordconsttype);
|
||||||
|
result := ctypeconvnode.create_explicit(result,cvarianttype);
|
||||||
|
resulttypepass(result);
|
||||||
|
{ left is reused }
|
||||||
|
left := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
|
function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
|
||||||
{$ifdef fpc}
|
{$ifdef fpc}
|
||||||
const
|
const
|
||||||
@ -1020,7 +1066,9 @@ implementation
|
|||||||
{ dynarray_2_openarray} @resulttype_dynarray_to_openarray,
|
{ dynarray_2_openarray} @resulttype_dynarray_to_openarray,
|
||||||
{ pwchar_2_string} @resulttype_pwchar_to_string,
|
{ pwchar_2_string} @resulttype_pwchar_to_string,
|
||||||
{ variant_2_dynarray} @resulttype_variant_to_dynarray,
|
{ variant_2_dynarray} @resulttype_variant_to_dynarray,
|
||||||
{ dynarray_2_variant} @resulttype_dynarray_to_variant
|
{ dynarray_2_variant} @resulttype_dynarray_to_variant,
|
||||||
|
{ variant_2_enum} @resulttype_variant_to_enum,
|
||||||
|
{ enum_2_variant} @resulttype_enum_to_variant
|
||||||
);
|
);
|
||||||
type
|
type
|
||||||
tprocedureofobject = function : tnode of object;
|
tprocedureofobject = function : tnode of object;
|
||||||
@ -1801,6 +1849,8 @@ implementation
|
|||||||
@ttypeconvnode._first_nothing,
|
@ttypeconvnode._first_nothing,
|
||||||
nil,
|
nil,
|
||||||
nil,
|
nil,
|
||||||
|
nil,
|
||||||
|
nil,
|
||||||
nil
|
nil
|
||||||
);
|
);
|
||||||
type
|
type
|
||||||
@ -1857,6 +1907,222 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_int_to_int;
|
||||||
|
begin
|
||||||
|
second_int_to_int;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_string_to_string;
|
||||||
|
begin
|
||||||
|
second_string_to_string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_cstring_to_pchar;
|
||||||
|
begin
|
||||||
|
second_cstring_to_pchar;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_string_to_chararray;
|
||||||
|
begin
|
||||||
|
second_string_to_chararray;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_array_to_pointer;
|
||||||
|
begin
|
||||||
|
second_array_to_pointer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_pointer_to_array;
|
||||||
|
begin
|
||||||
|
second_pointer_to_array;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_chararray_to_string;
|
||||||
|
begin
|
||||||
|
second_chararray_to_string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_char_to_string;
|
||||||
|
begin
|
||||||
|
second_char_to_string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_int_to_real;
|
||||||
|
begin
|
||||||
|
second_int_to_real;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_real_to_real;
|
||||||
|
begin
|
||||||
|
second_real_to_real;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_cord_to_pointer;
|
||||||
|
begin
|
||||||
|
second_cord_to_pointer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_proc_to_procvar;
|
||||||
|
begin
|
||||||
|
second_proc_to_procvar;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_bool_to_int;
|
||||||
|
begin
|
||||||
|
second_bool_to_int;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_int_to_bool;
|
||||||
|
begin
|
||||||
|
second_int_to_bool;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_bool_to_bool;
|
||||||
|
begin
|
||||||
|
second_bool_to_bool;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_load_smallset;
|
||||||
|
begin
|
||||||
|
second_load_smallset;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_ansistring_to_pchar;
|
||||||
|
begin
|
||||||
|
second_ansistring_to_pchar;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_class_to_intf;
|
||||||
|
begin
|
||||||
|
second_class_to_intf;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_char_to_char;
|
||||||
|
begin
|
||||||
|
second_char_to_char;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode._second_nothing;
|
||||||
|
begin
|
||||||
|
second_nothing;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode.second_call_helper(c : tconverttype);
|
||||||
|
{$ifdef fpc}
|
||||||
|
const
|
||||||
|
secondconvert : array[tconverttype] of pointer = (
|
||||||
|
@_second_nothing, {equal}
|
||||||
|
@_second_nothing, {not_possible}
|
||||||
|
@_second_nothing, {second_string_to_string, handled in resulttype pass }
|
||||||
|
@_second_char_to_string,
|
||||||
|
@_second_nothing, {char_to_charray}
|
||||||
|
@_second_nothing, { pchar_to_string, handled in resulttype pass }
|
||||||
|
@_second_nothing, {cchar_to_pchar}
|
||||||
|
@_second_cstring_to_pchar,
|
||||||
|
@_second_ansistring_to_pchar,
|
||||||
|
@_second_string_to_chararray,
|
||||||
|
@_second_nothing, { chararray_to_string, handled in resulttype pass }
|
||||||
|
@_second_array_to_pointer,
|
||||||
|
@_second_pointer_to_array,
|
||||||
|
@_second_int_to_int,
|
||||||
|
@_second_int_to_bool,
|
||||||
|
@_second_bool_to_bool,
|
||||||
|
@_second_bool_to_int,
|
||||||
|
@_second_real_to_real,
|
||||||
|
@_second_int_to_real,
|
||||||
|
@_second_nothing, { real_to_currency, handled in resulttype pass }
|
||||||
|
@_second_proc_to_procvar,
|
||||||
|
@_second_nothing, { arrayconstructor_to_set }
|
||||||
|
@_second_nothing, { second_load_smallset, handled in first pass }
|
||||||
|
@_second_cord_to_pointer,
|
||||||
|
@_second_nothing, { interface 2 string }
|
||||||
|
@_second_nothing, { interface 2 guid }
|
||||||
|
@_second_class_to_intf,
|
||||||
|
@_second_char_to_char,
|
||||||
|
@_second_nothing, { normal_2_smallset }
|
||||||
|
@_second_nothing, { dynarray_2_openarray }
|
||||||
|
@_second_nothing, { pwchar_2_string }
|
||||||
|
@_second_nothing, { variant_2_dynarray }
|
||||||
|
@_second_nothing, { dynarray_2_variant}
|
||||||
|
@_second_nothing, { variant_2_enum }
|
||||||
|
@_second_nothing { enum_2_variant }
|
||||||
|
);
|
||||||
|
type
|
||||||
|
tprocedureofobject = procedure of object;
|
||||||
|
|
||||||
|
var
|
||||||
|
r : packed record
|
||||||
|
proc : pointer;
|
||||||
|
obj : pointer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
{ this is a little bit dirty but it works }
|
||||||
|
{ and should be quite portable too }
|
||||||
|
r.proc:=secondconvert[c];
|
||||||
|
r.obj:=self;
|
||||||
|
tprocedureofobject(r)();
|
||||||
|
end;
|
||||||
|
{$else fpc}
|
||||||
|
begin
|
||||||
|
case c of
|
||||||
|
tc_equal,
|
||||||
|
tc_not_possible,
|
||||||
|
tc_string_2_string : second_nothing;
|
||||||
|
tc_char_2_string : second_char_to_string;
|
||||||
|
tc_char_2_chararray : second_nothing;
|
||||||
|
tc_pchar_2_string : second_nothing;
|
||||||
|
tc_cchar_2_pchar : second_nothing;
|
||||||
|
tc_cstring_2_pchar : second_cstring_to_pchar;
|
||||||
|
tc_ansistring_2_pchar : second_ansistring_to_pchar;
|
||||||
|
tc_string_2_chararray : second_string_to_chararray;
|
||||||
|
tc_chararray_2_string : second_nothing;
|
||||||
|
tc_array_2_pointer : second_array_to_pointer;
|
||||||
|
tc_pointer_2_array : second_pointer_to_array;
|
||||||
|
tc_int_2_int : second_int_to_int;
|
||||||
|
tc_int_2_bool : second_int_to_bool;
|
||||||
|
tc_bool_2_bool : second_bool_to_bool;
|
||||||
|
tc_bool_2_int : second_bool_to_int;
|
||||||
|
tc_real_2_real : second_real_to_real;
|
||||||
|
tc_int_2_real : second_int_to_real;
|
||||||
|
tc_real_2_currency : second_nothing;
|
||||||
|
tc_proc_2_procvar : second_proc_to_procvar;
|
||||||
|
tc_arrayconstructor_2_set : second_nothing;
|
||||||
|
tc_load_smallset : second_nothing;
|
||||||
|
tc_cord_2_pointer : second_cord_to_pointer;
|
||||||
|
tc_intf_2_string : second_nothing;
|
||||||
|
tc_intf_2_guid : second_nothing;
|
||||||
|
tc_class_2_intf : second_class_to_intf;
|
||||||
|
tc_char_2_char : second_char_to_char;
|
||||||
|
tc_normal_2_smallset : second_nothing;
|
||||||
|
tc_dynarray_2_openarray : second_nothing;
|
||||||
|
tc_pwchar_2_string : second_nothing;
|
||||||
|
tc_variant_2_dynarray : second_nothing;
|
||||||
|
tc_dynarray_2_variant : second_nothing;
|
||||||
|
else internalerror(2002101101);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif fpc}
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
TISNODE
|
TISNODE
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
@ -2122,7 +2388,11 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.129 2003-10-31 18:42:03 peter
|
Revision 1.130 2003-11-04 22:30:15 florian
|
||||||
|
+ type cast variant<->enum
|
||||||
|
* cnv. node second pass uses now as well helper wrappers
|
||||||
|
|
||||||
|
Revision 1.129 2003/10/31 18:42:03 peter
|
||||||
* don't call proc_to_procvar for explicit typecasts
|
* don't call proc_to_procvar for explicit typecasts
|
||||||
|
|
||||||
Revision 1.128 2003/10/29 22:01:20 florian
|
Revision 1.128 2003/10/29 22:01:20 florian
|
||||||
|
@ -53,7 +53,6 @@ interface
|
|||||||
{ procedure second_class_to_intf;override; }
|
{ procedure second_class_to_intf;override; }
|
||||||
{ procedure second_char_to_char;override; }
|
{ procedure second_char_to_char;override; }
|
||||||
procedure pass_2;override;
|
procedure pass_2;override;
|
||||||
procedure second_call_helper(c : tconverttype); override;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -349,62 +348,6 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure tppctypeconvnode.second_call_helper(c : tconverttype);
|
|
||||||
|
|
||||||
const
|
|
||||||
secondconvert : array[tconverttype] of pointer = (
|
|
||||||
@second_nothing, {equal}
|
|
||||||
@second_nothing, {not_possible}
|
|
||||||
@second_nothing, {second_string_to_string, handled in resulttype pass }
|
|
||||||
@second_char_to_string,
|
|
||||||
@second_nothing, {char_to_charray}
|
|
||||||
@second_nothing, { pchar_to_string, handled in resulttype pass }
|
|
||||||
@second_nothing, {cchar_to_pchar}
|
|
||||||
@second_cstring_to_pchar,
|
|
||||||
@second_ansistring_to_pchar,
|
|
||||||
@second_string_to_chararray,
|
|
||||||
@second_nothing, { chararray_to_string, handled in resulttype pass }
|
|
||||||
@second_array_to_pointer,
|
|
||||||
@second_pointer_to_array,
|
|
||||||
@second_int_to_int,
|
|
||||||
@second_int_to_bool,
|
|
||||||
@second_bool_to_int, { bool_to_bool }
|
|
||||||
@second_bool_to_int,
|
|
||||||
@second_real_to_real,
|
|
||||||
@second_int_to_real,
|
|
||||||
@second_nothing, { real_to_currency, handled in resulttype pass }
|
|
||||||
@second_proc_to_procvar,
|
|
||||||
@second_nothing, { arrayconstructor_to_set }
|
|
||||||
@second_nothing, { second_load_smallset, handled in first pass }
|
|
||||||
@second_cord_to_pointer,
|
|
||||||
@second_nothing, { interface 2 string }
|
|
||||||
@second_nothing, { interface 2 guid }
|
|
||||||
@second_class_to_intf,
|
|
||||||
@second_char_to_char,
|
|
||||||
@second_nothing, { normal_2_smallset }
|
|
||||||
@second_nothing, { dynarray_2_openarray }
|
|
||||||
@second_nothing,
|
|
||||||
{$ifdef fpc}@{$endif}second_nothing, { variant_2_dynarray }
|
|
||||||
{$ifdef fpc}@{$endif}second_nothing { dynarray_2_variant}
|
|
||||||
);
|
|
||||||
type
|
|
||||||
tprocedureofobject = procedure of object;
|
|
||||||
|
|
||||||
var
|
|
||||||
r : packed record
|
|
||||||
proc : pointer;
|
|
||||||
obj : pointer;
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
|
||||||
{ this is a little bit dirty but it works }
|
|
||||||
{ and should be quite portable too }
|
|
||||||
r.proc:=secondconvert[c];
|
|
||||||
r.obj:=self;
|
|
||||||
tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure tppctypeconvnode.pass_2;
|
procedure tppctypeconvnode.pass_2;
|
||||||
{$ifdef TESTOBJEXT2}
|
{$ifdef TESTOBJEXT2}
|
||||||
var
|
var
|
||||||
@ -431,7 +374,11 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.44 2003-10-17 01:22:08 florian
|
Revision 1.45 2003-11-04 22:30:15 florian
|
||||||
|
+ type cast variant<->enum
|
||||||
|
* cnv. node second pass uses now as well helper wrappers
|
||||||
|
|
||||||
|
Revision 1.44 2003/10/17 01:22:08 florian
|
||||||
* compilation of the powerpc compiler fixed
|
* compilation of the powerpc compiler fixed
|
||||||
|
|
||||||
Revision 1.43 2003/10/01 20:34:49 peter
|
Revision 1.43 2003/10/01 20:34:49 peter
|
||||||
|
@ -51,7 +51,6 @@ interface
|
|||||||
{ procedure second_class_to_intf;override; }
|
{ procedure second_class_to_intf;override; }
|
||||||
{ procedure second_char_to_char;override; }
|
{ procedure second_char_to_char;override; }
|
||||||
procedure pass_2;override;
|
procedure pass_2;override;
|
||||||
procedure second_call_helper(c : tconverttype); override;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -175,57 +174,6 @@ procedure TSparctypeconvnode.second_int_to_bool;
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TSparctypeconvnode.second_call_helper(c : tconverttype);
|
|
||||||
const
|
|
||||||
secondconvert : array[tconverttype] of pointer = (
|
|
||||||
@second_nothing, {equal}
|
|
||||||
@second_nothing, {not_possible}
|
|
||||||
@second_nothing, {second_string_to_string, handled in resulttype pass }
|
|
||||||
@second_char_to_string,
|
|
||||||
@second_nothing, {char_to_charray}
|
|
||||||
@second_nothing, { pchar_to_string, handled in resulttype pass }
|
|
||||||
@second_nothing, {cchar_to_pchar}
|
|
||||||
@second_cstring_to_pchar,
|
|
||||||
@second_ansistring_to_pchar,
|
|
||||||
@second_string_to_chararray,
|
|
||||||
@second_nothing, { chararray_to_string, handled in resulttype pass }
|
|
||||||
@second_array_to_pointer,
|
|
||||||
@second_pointer_to_array,
|
|
||||||
@second_int_to_int,
|
|
||||||
@second_int_to_bool,
|
|
||||||
@second_bool_to_int, { bool_to_bool }
|
|
||||||
@second_bool_to_int,
|
|
||||||
@second_real_to_real,
|
|
||||||
@second_int_to_real,
|
|
||||||
@second_nothing, { currency_to_real, handled in resulttype pass }
|
|
||||||
@second_proc_to_procvar,
|
|
||||||
@second_nothing, { arrayconstructor_to_set }
|
|
||||||
@second_nothing, { second_load_smallset, handled in first pass }
|
|
||||||
@second_cord_to_pointer,
|
|
||||||
@second_nothing, { interface 2 string }
|
|
||||||
@second_nothing, { interface 2 guid }
|
|
||||||
@second_class_to_intf,
|
|
||||||
@second_char_to_char,
|
|
||||||
@second_nothing, { normal_2_smallset }
|
|
||||||
@second_nothing, { dynarray_2_openarray }
|
|
||||||
@second_nothing,
|
|
||||||
{$ifdef fpc}@{$endif}second_nothing, { variant_2_dynarray }
|
|
||||||
{$ifdef fpc}@{$endif}second_nothing { dynarray_2_variant}
|
|
||||||
);
|
|
||||||
type
|
|
||||||
tprocedureofobject = procedure of object;
|
|
||||||
var
|
|
||||||
r:packed record
|
|
||||||
proc : pointer;
|
|
||||||
obj : pointer;
|
|
||||||
end;
|
|
||||||
begin
|
|
||||||
{ this is a little bit dirty but it works }
|
|
||||||
{ and should be quite portable too }
|
|
||||||
r.proc:=secondconvert[c];
|
|
||||||
r.obj:=self;
|
|
||||||
tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
|
|
||||||
end;
|
|
||||||
procedure TSparctypeconvnode.pass_2;
|
procedure TSparctypeconvnode.pass_2;
|
||||||
{$ifdef TESTOBJEXT2}
|
{$ifdef TESTOBJEXT2}
|
||||||
var
|
var
|
||||||
@ -251,7 +199,11 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.20 2003-10-24 11:31:43 mazen
|
Revision 1.21 2003-11-04 22:30:15 florian
|
||||||
|
+ type cast variant<->enum
|
||||||
|
* cnv. node second pass uses now as well helper wrappers
|
||||||
|
|
||||||
|
Revision 1.20 2003/10/24 11:31:43 mazen
|
||||||
*fixes related to removal of rg
|
*fixes related to removal of rg
|
||||||
|
|
||||||
Revision 1.19 2003/10/01 20:34:50 peter
|
Revision 1.19 2003/10/01 20:34:50 peter
|
||||||
|
Loading…
Reference in New Issue
Block a user