mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 00:42:06 +02:00
* procvar types checks for strings args should be stricter
This commit is contained in:
parent
b71c1492a9
commit
010beefd28
78
tests/test/tstprocv.pp
Normal file
78
tests/test/tstprocv.pp
Normal file
@ -0,0 +1,78 @@
|
||||
{ %FAIL }
|
||||
{ this compilation should fail
|
||||
because an ansitring should not be allowed
|
||||
as equivalent to a normal short string
|
||||
for procvars PM }
|
||||
|
||||
{$mode fpc}
|
||||
{$H-}
|
||||
|
||||
uses
|
||||
strings;
|
||||
|
||||
Type
|
||||
type_error_proc = procedure (Const St : String);
|
||||
|
||||
Const
|
||||
error_proc : type_error_proc = nil;
|
||||
has_errors : boolean = false;
|
||||
var
|
||||
st : string;
|
||||
ast : ansistring;
|
||||
pst : pchar;
|
||||
|
||||
|
||||
|
||||
procedure string_error_proc(const err : string);
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
writeln('String error proc: ',err);
|
||||
{$endif DEBUG}
|
||||
if err<>st then
|
||||
has_errors:=true;
|
||||
end;
|
||||
|
||||
procedure ansistring_error_proc(const err : ansistring);
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
writeln('Ansistring error proc: ',err);
|
||||
{$endif DEBUG}
|
||||
if err<>ast then
|
||||
has_errors:=true;
|
||||
end;
|
||||
|
||||
procedure pchar_error_proc(const err : pchar);
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
writeln('Pchar error proc: ',err);
|
||||
{$endif DEBUG}
|
||||
if strcomp(err,pst)<>0 then
|
||||
has_errors:=true;
|
||||
end;
|
||||
|
||||
begin
|
||||
st:='direct short string';
|
||||
string_error_proc(st);
|
||||
ast:='direct ansistring';
|
||||
ansistring_error_proc(ast);
|
||||
pst:='direct short string';
|
||||
pchar_error_proc(pst);
|
||||
|
||||
error_proc:=@string_error_proc;
|
||||
st:='short string via procvar';
|
||||
error_proc(st);
|
||||
|
||||
error_proc:=@ansistring_error_proc;
|
||||
ast:='ansistring via procvar';
|
||||
error_proc(ast);
|
||||
|
||||
error_proc:=@pchar_error_proc;
|
||||
pst:='pchar via procvar';
|
||||
error_proc(pst);
|
||||
if has_errors then
|
||||
begin
|
||||
Writeln('Wrong code is generated');
|
||||
halt(1);
|
||||
end;
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user