blob: d50d3299e8ec55ec8312d5ab530864ab1a503434 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
{ %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.
|
