浏览代码

* procvar types checks for strings args should be stricter

pierre 23 年之前
父节点
当前提交
010beefd28
共有 1 个文件被更改,包括 78 次插入0 次删除
  1. 78 0
      tests/test/tstprocv.pp

+ 78 - 0
tests/test/tstprocv.pp

@@ -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.
+