paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 10:20:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* write P'type' instead of ^'type' for function results, resolves #7561

Browse Source 
git-svn-id: trunk@15837 -
This commit is contained in:
florian 2010-08-17 21:09:11 +00:00
parent b050eaf031
commit 636a59e1ae
2 changed files with 51 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
utils/h2pas/h2pas.pas
View File

@ -248,7 +248,6 @@ program h2pas;
end;
function TypeName(const s:string):string;
var
i : longint;
@ -624,6 +623,7 @@ program h2pas;
(* if in args *dname is replaced by pdname *)
in_args : boolean = false;
typedef_level : longint = 0;
old_in_args : boolean = false;
(* writes an argument list, where p is t_arglist *)
@ -756,7 +756,7 @@ program h2pas;
error : integer;
pointerwritten,
constant : boolean;
old_in_args : boolean;
begin
if not(assigned(p)) then
begin
@ -791,7 +791,12 @@ program h2pas;
write_args(outfile,p^.p1^.p2);
write(outfile,':');
flush(outfile);
old_in_args:=in_args;
(* write pointers as P.... instead of ^.... *)
in_args:=true;
write_p_a_def(outfile,p^.p1^.p1,simple_type);
in_args:=old_in_args;
popshift;
end
end
@ -935,10 +940,10 @@ program h2pas;
begin
if in_args then
begin
if UseCTypesUnit and (IsACType(p^.p1^.p)=False) then
write(outfile,'P')
if UseCTypesUnit and IsACType(p^.p1^.p) then
write(outfile,'p')
else
write(outfile,'p');
write(outfile,'P');
pointerprefix:=true;
end
else
@ -1282,6 +1287,7 @@ program h2pas;
writeln(outfile,aktspace,'end;');
end;
const _WHILE = 257;
const _FOR = 258;
const _DO = 259;
@ -1558,7 +1564,11 @@ begin
if assigned(yyv[yysp-1]^.p1^.p1^.p2) then
write_args(outfile,yyv[yysp-1]^.p1^.p1^.p2);
write(outfile,':');
old_in_args:=in_args;
(* write pointers as P.... instead of ^.... *)
in_args:=true;
write_p_a_def(outfile,yyv[yysp-1]^.p1^.p1^.p1,yyv[yysp-3]);
in_args:=old_in_args;
if createdynlib then
begin
loaddynlibproc.add('pointer('+yyv[yysp-1]^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+yyv[yysp-1]^.p1^.p2^.p+''');');
@ -1570,7 +1580,12 @@ begin
if assigned(yyv[yysp-1]^.p1^.p1^.p2) then
write_args(implemfile,yyv[yysp-1]^.p1^.p1^.p2);
write(implemfile,':');
old_in_args:=in_args;
(* write pointers as P.... instead of ^.... *)
in_args:=true;
write_p_a_def(implemfile,yyv[yysp-1]^.p1^.p1^.p1,yyv[yysp-3]);
in_args:=old_in_args;
end;
end;
(* No CDECL in interface for Uselib *)
@ -1753,7 +1768,12 @@ begin
if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
write_args(implemfile,yyv[yysp-2]^.p1^.p1^.p2);
write(implemfile,':');
old_in_args:=in_args;
(* write pointers as P.... instead of ^.... *)
in_args:=true;
write_p_a_def(implemfile,yyv[yysp-2]^.p1^.p1^.p1,yyv[yysp-4]);
in_args:=old_in_args;
end;
end;
if assigned(yyv[yysp-1]) then

32
utils/h2pas/h2pas.y
View File

@ -244,7 +244,6 @@ program h2pas;
end;
function TypeName(const s:string):string;
var
i : longint;
@ -620,6 +619,7 @@ program h2pas;
(* if in args *dname is replaced by pdname *)
in_args : boolean = false;
typedef_level : longint = 0;
old_in_args : boolean = false;
(* writes an argument list, where p is t_arglist *)
@ -752,7 +752,7 @@ program h2pas;
error : integer;
pointerwritten,
constant : boolean;
old_in_args : boolean;
begin
if not(assigned(p)) then
begin
@ -787,7 +787,12 @@ program h2pas;
write_args(outfile,p^.p1^.p2);
write(outfile,':');
flush(outfile);
old_in_args:=in_args;
(* write pointers as P.... instead of ^.... *)
in_args:=true;
write_p_a_def(outfile,p^.p1^.p1,simple_type);
in_args:=old_in_args;
popshift;
end
end
@ -931,10 +936,10 @@ program h2pas;
begin
if in_args then
begin
if UseCTypesUnit and (IsACType(p^.p1^.p)=False) then
write(outfile,'P')
if UseCTypesUnit and IsACType(p^.p1^.p) then
write(outfile,'p')
else
write(outfile,'p');
write(outfile,'P');
pointerprefix:=true;
end
else
@ -1278,6 +1283,7 @@ program h2pas;
writeln(outfile,aktspace,'end;');
end;
%}
%token _WHILE _FOR _DO _GOTO _CONTINUE _BREAK
@ -1480,7 +1486,11 @@ declaration :
if assigned($4^.p1^.p1^.p2) then
write_args(outfile,$4^.p1^.p1^.p2);
write(outfile,':');
old_in_args:=in_args;
(* write pointers as P.... instead of ^.... *)
in_args:=true;
write_p_a_def(outfile,$4^.p1^.p1^.p1,$2);
in_args:=old_in_args;
if createdynlib then
begin
loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
@ -1490,9 +1500,14 @@ declaration :
begin
write(implemfile,'function ',$4^.p1^.p2^.p);
if assigned($4^.p1^.p1^.p2) then
write_args(implemfile,$4^.p1^.p1^.p2);
write_args(implemfile,$4^.p1^.p1^.p2);
write(implemfile,':');
old_in_args:=in_args;
(* write pointers as P.... instead of ^.... *)
in_args:=true;
write_p_a_def(implemfile,$4^.p1^.p1^.p1,$2);
in_args:=old_in_args;
end;
end;
(* No CDECL in interface for Uselib *)
@ -1674,7 +1689,12 @@ declaration :
if assigned($4^.p1^.p1^.p2) then
write_args(implemfile,$4^.p1^.p1^.p2);
write(implemfile,':');
old_in_args:=in_args;
(* write pointers as P.... instead of ^.... *)
in_args:=true;
write_p_a_def(implemfile,$4^.p1^.p1^.p1,$2);
in_args:=old_in_args;
end;
end;
if assigned($5) then