mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 20:09:25 +02:00
* fixes for ansistrings
This commit is contained in:
peter
parent
d626ddb757
commit
59c75c7410
@ -559,27 +559,19 @@ unit pdecl;
|
||||
consume(RECKKLAMMER);
|
||||
if p^.value>255 then
|
||||
d:=new(pstringdef,longinit(p^.value))
|
||||
else if p^.value<>255 then
|
||||
d:=new(pstringdef,shortinit(p^.value))
|
||||
{$ifndef GDB}
|
||||
else d:=new(pstringdef,shortinit(255));
|
||||
{$else GDB}
|
||||
else d:=globaldef('STRING');
|
||||
{$endif GDB}
|
||||
else
|
||||
if p^.value<>255 then
|
||||
d:=new(pstringdef,shortinit(p^.value))
|
||||
else
|
||||
d:=cshortstringdef;
|
||||
disposetree(p);
|
||||
end
|
||||
{ should string without suffix be an ansistring also
|
||||
in ansistring mode ?? (PM) Yes!!! (FK) }
|
||||
else
|
||||
begin
|
||||
if cs_ansistrings in aktlocalswitches then
|
||||
d:=new(pstringdef,ansiinit(0))
|
||||
d:=cansistringdef
|
||||
else
|
||||
{$ifndef GDB}
|
||||
d:=new(pstringdef,shortinit(255));
|
||||
{$else GDB}
|
||||
d:=globaldef('STRING');
|
||||
{$endif GDB}
|
||||
d:=cshortstringdef;
|
||||
end;
|
||||
stringtype:=d;
|
||||
end;
|
||||
@ -2094,7 +2086,10 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.81 1998-11-13 15:40:22 pierre
|
||||
Revision 1.82 1998-11-16 10:18:07 peter
|
||||
* fixes for ansistrings
|
||||
|
||||
Revision 1.81 1998/11/13 15:40:22 pierre
|
||||
+ added -Se in Makefile cvstest target
|
||||
+ lexlevel cleanup
|
||||
normal_function_level main_program_level and unit_init_level defined
|
||||
|
||||
@ -69,9 +69,8 @@ procedure insert_intern_types(p : psymtable);
|
||||
{
|
||||
all the types inserted into the system unit
|
||||
}
|
||||
var
|
||||
booleandef : pdef;
|
||||
{$ifdef GDB}
|
||||
var
|
||||
{ several defs to simulate more or less C++ objects for GDB }
|
||||
vmtdef : precdef;
|
||||
pvmtdef : ppointerdef;
|
||||
@ -100,9 +99,9 @@ begin
|
||||
p^.insert(new(ptypesym,init('char_pointer',charpointerdef)));
|
||||
p^.insert(new(ptypesym,init('file',cfiledef)));
|
||||
{$ifdef i386}
|
||||
p^.insert(new(ptypesym,init('REAL',new(pfloatdef,init(s64real)))));
|
||||
p^.insert(new(ptypesym,init('REAL',c64floatdef)));
|
||||
p^.insert(new(ptypesym,init('EXTENDED',s80floatdef)));
|
||||
p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bit)))));
|
||||
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real)))));
|
||||
{$endif}
|
||||
{$ifdef m68k}
|
||||
{ internal definitions }
|
||||
@ -112,40 +111,33 @@ begin
|
||||
if (cs_fp_emulation) in aktmoduleswitches then
|
||||
p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s32real)))))
|
||||
else
|
||||
p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s64real)))));
|
||||
p^.insert(new(ptypesym,init('DOUBLE',c64floatdef)));
|
||||
if (cs_fp_emulation) in aktmoduleswitches then
|
||||
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s32real)))))
|
||||
else
|
||||
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real)))));
|
||||
p^.insert(new(ptypesym,init('EXTENDED',s80floatdef)));
|
||||
{ p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s32real)))));}
|
||||
{$endif}
|
||||
p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real)))));
|
||||
p^.insert(new(ptypesym,init('POINTER',new(ppointerdef,init(voiddef)))));
|
||||
p^.insert(new(ptypesym,init('POINTER',voidpointerdef)));
|
||||
p^.insert(new(ptypesym,init('STRING',cshortstringdef)));
|
||||
p^.insert(new(ptypesym,init('SHORTSTRING',cshortstringdef)));
|
||||
p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
|
||||
p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
|
||||
p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
|
||||
booleandef:=new(porddef,init(bool8bit,0,1));
|
||||
p^.insert(new(ptypesym,init('BOOLEAN',booleandef)));
|
||||
p^.insert(new(ptypesym,init('BYTEBOOL',booleandef)));
|
||||
p^.insert(new(ptypesym,init('BOOLEAN',booldef)));
|
||||
p^.insert(new(ptypesym,init('BYTEBOOL',booldef)));
|
||||
p^.insert(new(ptypesym,init('WORDBOOL',new(porddef,init(bool16bit,0,1)))));
|
||||
p^.insert(new(ptypesym,init('LONGBOOL',new(porddef,init(bool32bit,0,1)))));
|
||||
p^.insert(new(ptypesym,init('CHAR',new(porddef,init(uchar,0,255)))));
|
||||
p^.insert(new(ptypesym,init('CHAR',cchardef)));
|
||||
p^.insert(new(ptypesym,init('TEXT',new(pfiledef,init(ft_text,nil)))));
|
||||
p^.insert(new(ptypesym,init('CARDINAL',new(porddef,init(u32bit,0,$ffffffff)))));
|
||||
p^.insert(new(ptypesym,init('CARDINAL',u32bitdef)));
|
||||
p^.insert(new(ptypesym,init('FIXED',new(pfloatdef,init(f32bit)))));
|
||||
p^.insert(new(ptypesym,init('FIXED16',new(pfloatdef,init(f16bit)))));
|
||||
p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef)))));
|
||||
{ !!!!!
|
||||
p^.insert(new(ptypesym,init('COMP',new(porddef,init(s64bit,0,0)))));
|
||||
p^.insert(new(ptypesym,init('SINGLE',new(porddef,init(s32real,0,0)))));
|
||||
p^.insert(new(ptypesym,init('EXTENDED',new(porddef,init(s80real,0,0)))));
|
||||
p^.insert(new(ptypesym,init('FILE',new(pfiledef,init(ft_untyped,nil)))));
|
||||
}
|
||||
{$ifdef GDB}
|
||||
{ Add a type for virtual method tables in lowercase }
|
||||
{ so it isn't reachable! }
|
||||
{$ifdef GDB}
|
||||
vmtsymtable:=new(psymtable,init(recordsymtable));
|
||||
vmtdef:=new(precdef,init(vmtsymtable));
|
||||
pvmtdef:=new(ppointerdef,init(vmtdef));
|
||||
@ -240,7 +232,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1998-11-09 11:44:36 peter
|
||||
Revision 1.11 1998-11-16 10:18:09 peter
|
||||
* fixes for ansistrings
|
||||
|
||||
Revision 1.10 1998/11/09 11:44:36 peter
|
||||
+ va_list for printf support
|
||||
|
||||
Revision 1.9 1998/11/05 12:02:54 peter
|
||||
|
||||
@ -248,32 +248,43 @@ implementation
|
||||
regi : tregister;
|
||||
store_valid, old_count_ref : boolean;
|
||||
|
||||
{ types.is_equal can't handle a formaldef ! }
|
||||
function is_equal(def1,def2 : pdef) : boolean;
|
||||
{ check if the resulttype from tree p is equal with def, needed
|
||||
for stringconstn and formaldef }
|
||||
function is_equal(p:ptree;def:pdef) : boolean;
|
||||
|
||||
begin
|
||||
{ safety check }
|
||||
if not (assigned(def1) or assigned(def2)) then
|
||||
if not (assigned(def) or assigned(p^.resulttype)) then
|
||||
begin
|
||||
is_equal:=false;
|
||||
exit;
|
||||
end;
|
||||
{ all types can be passed to a formaldef }
|
||||
is_equal:=(def1^.deftype=formaldef) or
|
||||
(types.is_equal(def1,def2))
|
||||
is_equal:=(def^.deftype=formaldef) or
|
||||
(types.is_equal(p^.resulttype,def))
|
||||
{ to support ansi/long/wide strings in a proper way }
|
||||
{ string and string[10] are assumed as equal }
|
||||
{ when searching the correct overloaded procedure }
|
||||
or
|
||||
(
|
||||
(def1^.deftype=stringdef) and (def2^.deftype=stringdef) and
|
||||
(pstringdef(def1)^.string_typ=pstringdef(def2)^.string_typ)
|
||||
(def^.deftype=stringdef) and (p^.resulttype^.deftype=stringdef) and
|
||||
(pstringdef(def)^.string_typ=pstringdef(p^.resulttype)^.string_typ)
|
||||
)
|
||||
or
|
||||
(
|
||||
(p^.left^.treetype=stringconstn) and
|
||||
(is_ansistring(p^.resulttype) and is_pchar(def))
|
||||
)
|
||||
or
|
||||
(
|
||||
(p^.left^.treetype=ordconstn) and
|
||||
(is_char(p^.resulttype) and (is_shortstring(def) or is_ansistring(def)))
|
||||
)
|
||||
{ set can also be a not yet converted array constructor }
|
||||
or
|
||||
(
|
||||
(def1^.deftype=setdef) and (def2^.deftype=arraydef) and
|
||||
(parraydef(def2)^.IsConstructor) and not(parraydef(def2)^.IsVariant)
|
||||
(def^.deftype=setdef) and (p^.resulttype^.deftype=arraydef) and
|
||||
(parraydef(p^.resulttype)^.IsConstructor) and not(parraydef(p^.resulttype)^.IsVariant)
|
||||
)
|
||||
;
|
||||
end;
|
||||
@ -483,7 +494,7 @@ implementation
|
||||
hp:=procs;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if is_equal(hp^.nextpara^.data,pt^.resulttype) then
|
||||
if is_equal(pt,hp^.nextpara^.data) then
|
||||
begin
|
||||
if hp^.nextpara^.data=pt^.resulttype then
|
||||
begin
|
||||
@ -503,7 +514,7 @@ implementation
|
||||
if exactmatch then
|
||||
begin
|
||||
{ the first .... }
|
||||
while (assigned(procs)) and not(is_equal(procs^.nextpara^.data,pt^.resulttype)) do
|
||||
while (assigned(procs)) and not(is_equal(pt,procs^.nextpara^.data)) do
|
||||
begin
|
||||
hp:=procs^.next;
|
||||
dispose(procs);
|
||||
@ -513,7 +524,7 @@ implementation
|
||||
hp:=procs;
|
||||
while (assigned(hp)) and assigned(hp^.next) do
|
||||
begin
|
||||
if not(is_equal(hp^.next^.nextpara^.data,pt^.resulttype)) then
|
||||
if not(is_equal(pt,hp^.next^.nextpara^.data)) then
|
||||
begin
|
||||
hp2:=hp^.next^.next;
|
||||
dispose(hp^.next);
|
||||
@ -611,7 +622,7 @@ implementation
|
||||
hp:=procs;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if not is_equal(hp^.nextpara^.data,pt^.resulttype) then
|
||||
if not is_equal(pt,hp^.nextpara^.data) then
|
||||
begin
|
||||
def_to:=hp^.nextpara^.data;
|
||||
if ((def_from^.deftype=orddef) and (def_to^.deftype=orddef)) and
|
||||
@ -673,25 +684,40 @@ implementation
|
||||
pt:=pt^.right;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ reset nextpara for all procs left }
|
||||
hp:=procs;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
hp^.nextpara:=hp^.firstpara;
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
|
||||
{ let's try to eliminate equal is exact is there }
|
||||
{if assigned(procs^.next) then
|
||||
if assigned(procs^.next) then
|
||||
begin
|
||||
pt:=p^.left;
|
||||
while assigned(pt) do
|
||||
begin
|
||||
if pt^.exact_match_found then
|
||||
begin
|
||||
hp:=procs;
|
||||
while (assigned(procs)) and (procs^.nextpara^.data<>pt^.resulttype) do
|
||||
begin
|
||||
hp:=procs^.next;
|
||||
dispose(procs);
|
||||
procs:=hp;
|
||||
end;
|
||||
while assigned(procs) and (procs^.nextpara^.data<>pt^.resulttype) do
|
||||
begin
|
||||
hp:=procs^.next;
|
||||
dispose(procs);
|
||||
procs:=hp;
|
||||
end;
|
||||
end;
|
||||
{ update nextpara for all procedures }
|
||||
hp:=procs;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
hp^.nextpara:=hp^.nextpara^.next;
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
pt:=pt^.right;
|
||||
end;
|
||||
end; }
|
||||
end;
|
||||
|
||||
if assigned(procs^.next) then
|
||||
begin
|
||||
@ -941,7 +967,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1998-11-10 10:09:17 peter
|
||||
Revision 1.12 1998-11-16 10:18:10 peter
|
||||
* fixes for ansistrings
|
||||
|
||||
Revision 1.11 1998/11/10 10:09:17 peter
|
||||
* va_list -> array of const
|
||||
|
||||
Revision 1.10 1998/11/09 11:44:41 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user