mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 20:19:29 +01:00
* fixed constant char to unicodestring conversion
git-svn-id: trunk@11779 -
This commit is contained in:
parent
4971e432de
commit
cd6b57c733
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -7116,6 +7116,7 @@ tests/tbs/tb0552.pp svneol=native#text/plain
|
|||||||
tests/tbs/tb0553.pp svneol=native#text/plain
|
tests/tbs/tb0553.pp svneol=native#text/plain
|
||||||
tests/tbs/tb0554.pp svneol=native#text/plain
|
tests/tbs/tb0554.pp svneol=native#text/plain
|
||||||
tests/tbs/tb0555.pp svneol=native#text/plain
|
tests/tbs/tb0555.pp svneol=native#text/plain
|
||||||
|
tests/tbs/tb0556.pp svneol=native#text/plain
|
||||||
tests/tbs/tb205.pp svneol=native#text/plain
|
tests/tbs/tb205.pp svneol=native#text/plain
|
||||||
tests/tbs/ub0060.pp svneol=native#text/plain
|
tests/tbs/ub0060.pp svneol=native#text/plain
|
||||||
tests/tbs/ub0069.pp svneol=native#text/plain
|
tests/tbs/ub0069.pp svneol=native#text/plain
|
||||||
|
|||||||
@ -902,7 +902,6 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.typecheck_char_to_string : tnode;
|
function ttypeconvnode.typecheck_char_to_string : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
procname: string[31];
|
procname: string[31];
|
||||||
para : tcallparanode;
|
para : tcallparanode;
|
||||||
@ -911,7 +910,6 @@ implementation
|
|||||||
newblock : tblocknode;
|
newblock : tblocknode;
|
||||||
newstat : tstatementnode;
|
newstat : tstatementnode;
|
||||||
restemp : ttempcreatenode;
|
restemp : ttempcreatenode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
{ we can't do widechar to ansichar conversions at compile time, since }
|
{ we can't do widechar to ansichar conversions at compile time, since }
|
||||||
@ -930,6 +928,7 @@ implementation
|
|||||||
else
|
else
|
||||||
concatwidestringchar(ws,tcompilerwidechar(chr(tordconstnode(left).value.uvalue)));
|
concatwidestringchar(ws,tcompilerwidechar(chr(tordconstnode(left).value.uvalue)));
|
||||||
hp:=cstringconstnode.createwstr(ws);
|
hp:=cstringconstnode.createwstr(ws);
|
||||||
|
hp.changestringtype(resultdef);
|
||||||
donewidestring(ws);
|
donewidestring(ws);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
@ -994,7 +993,6 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.typecheck_char_to_chararray : tnode;
|
function ttypeconvnode.typecheck_char_to_chararray : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if resultdef.size <> 1 then
|
if resultdef.size <> 1 then
|
||||||
begin
|
begin
|
||||||
@ -1010,10 +1008,8 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.typecheck_char_to_char : tnode;
|
function ttypeconvnode.typecheck_char_to_char : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
hp : tordconstnode;
|
hp : tordconstnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if (left.nodetype=ordconstn) and
|
if (left.nodetype=ordconstn) and
|
||||||
|
|||||||
75
tests/tbs/tb0556.pp
Normal file
75
tests/tbs/tb0556.pp
Normal file
@ -0,0 +1,75 @@
|
|||||||
|
program decrefcrash;
|
||||||
|
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
|
||||||
|
{$ifdef mswindows}{$apptype console}{$endif}
|
||||||
|
uses
|
||||||
|
{$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif}
|
||||||
|
sysutils;
|
||||||
|
|
||||||
|
const
|
||||||
|
maxdatasize = $7fffffff;
|
||||||
|
type
|
||||||
|
{$ifdef VER2_2}
|
||||||
|
msechar = widechar;
|
||||||
|
msestring = widestring;
|
||||||
|
{$else VER2_2}
|
||||||
|
msechar = unicodechar;
|
||||||
|
msestring = unicodestring;
|
||||||
|
{$endif VER2_2}
|
||||||
|
msecharaty = array[0..maxdatasize div sizeof(msechar)-1] of msechar;
|
||||||
|
pmsecharaty = ^msecharaty;
|
||||||
|
|
||||||
|
procedure replacechar1(var dest: msestring; a,b: msechar);
|
||||||
|
//replaces a by b
|
||||||
|
var
|
||||||
|
int1: integer;
|
||||||
|
begin
|
||||||
|
uniquestring(dest);
|
||||||
|
for int1:= 0 to length(dest)-1 do begin
|
||||||
|
if pmsecharaty(dest)^[int1] = a then begin
|
||||||
|
pmsecharaty(dest)^[int1]:= b;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function winfilepath(dirname,filename: msestring): msestring;
|
||||||
|
begin
|
||||||
|
writeln((pptrint(pointer(dirname))-2)^);
|
||||||
|
flush(output);
|
||||||
|
writeln((pptrint(pointer(filename))-2)^);
|
||||||
|
flush(output);
|
||||||
|
replacechar1(dirname,msechar('/'),msechar('\'));
|
||||||
|
replacechar1(filename,msechar('/'),msechar('\'));
|
||||||
|
if (length(dirname) >= 3) and (dirname[1] = '\') and (dirname[3] = ':') then begin
|
||||||
|
dirname[1]:= dirname[2]; // '/c:' -> 'c:\'
|
||||||
|
dirname[2]:= ':';
|
||||||
|
dirname[3]:= '\';
|
||||||
|
if (dirname[4] = '\') and (length(dirname) > 4) then begin
|
||||||
|
move(dirname[5],dirname[4],(length(dirname) - 4)*sizeof(msechar));
|
||||||
|
setlength(dirname,length(dirname) - 1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if filename <> '' then begin
|
||||||
|
if dirname = '' then begin
|
||||||
|
result:= '.\'+filename;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
if dirname[length(dirname)] <> '\' then begin
|
||||||
|
result:= dirname + '\' + filename;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
result:= dirname + filename;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
result:= dirname;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
mstr1,mstr2: msestring;
|
||||||
|
begin
|
||||||
|
mstr2:= 'C:\Dokumente und Einstellungen\mseca\Anwendungsdaten\.mseide';
|
||||||
|
mstr1:= winfilepath(mstr2,'*');
|
||||||
|
end.
|
||||||
Loading…
Reference in New Issue
Block a user