mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 01:29:29 +02:00
+ several widestring/pwidechar related stuff added
This commit is contained in:
florian
parent
6c725f11e7
commit
161d1b923e
@ -203,7 +203,8 @@ interface
|
||||
tc_class_2_intf,
|
||||
tc_char_2_char,
|
||||
tc_normal_2_smallset,
|
||||
tc_dynarray_2_openarray
|
||||
tc_dynarray_2_openarray,
|
||||
tc_pwchar_2_string
|
||||
);
|
||||
|
||||
function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
|
||||
@ -1509,19 +1510,32 @@ implementation
|
||||
begin
|
||||
{ pchar can be assigned to short/ansistrings,
|
||||
but not in tp7 compatible mode }
|
||||
if is_pchar(def_from) and not(m_tp7 in aktmodeswitches) then
|
||||
begin
|
||||
doconv:=tc_pchar_2_string;
|
||||
{ trefer ansistrings because pchars can overflow shortstrings, }
|
||||
{ but only if ansistrings are the default (JM) }
|
||||
if (is_shortstring(def_to) and
|
||||
not(cs_ansistrings in aktlocalswitches)) or
|
||||
(is_ansistring(def_to) and
|
||||
(cs_ansistrings in aktlocalswitches)) then
|
||||
b:=1
|
||||
else
|
||||
b:=2;
|
||||
end;
|
||||
if not(m_tp7 in aktmodeswitches) then
|
||||
begin
|
||||
if is_pchar(def_from) then
|
||||
begin
|
||||
doconv:=tc_pchar_2_string;
|
||||
{ trefer ansistrings because pchars can overflow shortstrings, }
|
||||
{ but only if ansistrings are the default (JM) }
|
||||
if (is_shortstring(def_to) and
|
||||
not(cs_ansistrings in aktlocalswitches)) or
|
||||
(is_ansistring(def_to) and
|
||||
(cs_ansistrings in aktlocalswitches)) then
|
||||
b:=1
|
||||
else
|
||||
b:=2;
|
||||
end
|
||||
else if is_pwidechar(def_from) then
|
||||
begin
|
||||
doconv:=tc_pwchar_2_string;
|
||||
{ trefer ansistrings because pchars can overflow shortstrings, }
|
||||
{ but only if ansistrings are the default (JM) }
|
||||
if is_widestring(def_to) then
|
||||
b:=1
|
||||
else
|
||||
b:=2;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -2012,7 +2026,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.21 2002-10-09 21:01:41 florian
|
||||
Revision 1.22 2002-10-10 16:07:57 florian
|
||||
+ several widestring/pwidechar related stuff added
|
||||
|
||||
Revision 1.21 2002/10/09 21:01:41 florian
|
||||
* variants aren't compatible with nil
|
||||
|
||||
Revision 1.20 2002/10/07 09:49:42 florian
|
||||
|
||||
@ -67,6 +67,7 @@ interface
|
||||
function resulttype_pchar_to_string : tnode;
|
||||
function resulttype_interface_to_guid : tnode;
|
||||
function resulttype_dynarray_to_openarray : tnode;
|
||||
function resulttype_pwchar_to_string : tnode;
|
||||
function resulttype_call_helper(c : tconverttype) : tnode;
|
||||
protected
|
||||
function first_int_to_int : tnode;virtual;
|
||||
@ -132,7 +133,6 @@ interface
|
||||
procedure second_bool_to_bool;virtual;abstract;
|
||||
procedure second_load_smallset;virtual;abstract;
|
||||
procedure second_ansistring_to_pchar;virtual;abstract;
|
||||
procedure second_pchar_to_string;virtual;abstract;
|
||||
procedure second_class_to_intf;virtual;abstract;
|
||||
procedure second_char_to_char;virtual;abstract;
|
||||
procedure second_nothing; virtual;abstract;
|
||||
@ -876,6 +876,15 @@ implementation
|
||||
result.resulttype := resulttype;
|
||||
end;
|
||||
|
||||
function ttypeconvnode.resulttype_pwchar_to_string : tnode;
|
||||
|
||||
begin
|
||||
result := ccallnode.createinternres(
|
||||
'fpc_pwidechar_to_'+tstringdef(resulttype.def).stringtypname,
|
||||
ccallparanode.create(left,nil),resulttype);
|
||||
left := nil;
|
||||
end;
|
||||
|
||||
|
||||
function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
|
||||
{$ifdef fpc}
|
||||
@ -909,7 +918,8 @@ implementation
|
||||
{ class_2_intf } nil,
|
||||
{ char_2_char } @ttypeconvnode.resulttype_char_to_char,
|
||||
{ normal_2_smallset} nil,
|
||||
{ dynarray_2_openarray} @resulttype_dynarray_to_openarray
|
||||
{ dynarray_2_openarray} @resulttype_dynarray_to_openarray,
|
||||
{ pwchar_2_string} @resulttype_pwchar_to_string
|
||||
);
|
||||
type
|
||||
tprocedureofobject = function : tnode of object;
|
||||
@ -945,6 +955,7 @@ implementation
|
||||
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;
|
||||
end;
|
||||
end;
|
||||
{$Endif fpc}
|
||||
@ -1764,7 +1775,8 @@ implementation
|
||||
@ttypeconvnode._first_class_to_intf,
|
||||
@ttypeconvnode._first_char_to_char,
|
||||
@ttypeconvnode._first_nothing,
|
||||
@ttypeconvnode._first_nothing
|
||||
@ttypeconvnode._first_nothing,
|
||||
nil
|
||||
);
|
||||
type
|
||||
tprocedureofobject = function : tnode of object;
|
||||
@ -2086,7 +2098,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.86 2002-10-06 16:10:23 florian
|
||||
Revision 1.87 2002-10-10 16:07:57 florian
|
||||
+ several widestring/pwidechar related stuff added
|
||||
|
||||
Revision 1.86 2002/10/06 16:10:23 florian
|
||||
* when compiling <interface> as <interface> we can't assume
|
||||
anything about relation
|
||||
|
||||
|
||||
@ -1511,6 +1511,15 @@ implementation
|
||||
left:=nil;
|
||||
goto myexit;
|
||||
end
|
||||
else if is_pwidechar(left.resulttype.def) then
|
||||
begin
|
||||
hp := ccallparanode.create(left,nil);
|
||||
result := ccallnode.createintern('fpc_pwidechar_length',hp);
|
||||
{ make sure the left node doesn't get disposed, since it's }
|
||||
{ reused in the new node (JM) }
|
||||
left:=nil;
|
||||
goto myexit;
|
||||
end
|
||||
else
|
||||
CGMessage(type_e_mismatch);
|
||||
end;
|
||||
@ -2396,7 +2405,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.91 2002-10-05 14:21:08 peter
|
||||
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
|
||||
* Length(PChar) supported
|
||||
|
||||
Revision 1.90 2002/09/13 19:12:09 carl
|
||||
|
||||
Loading…
Reference in New Issue
Block a user