Browse Source

* Test for bug report 18702

git-svn-id: trunk@17096 -
pierre 14 years ago
parent
commit
3378979f2b
2 changed files with 39 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 38 0
      tests/webtbs/tw18702.pp

+ 1 - 0
.gitattributes

@@ -11201,6 +11201,7 @@ tests/webtbs/tw18620.pp svneol=native#text/pascal
 tests/webtbs/tw1863.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw18690.pp svneol=native#text/plain
+tests/webtbs/tw18702.pp svneol=native#text/pascal
 tests/webtbs/tw1873.pp svneol=native#text/plain
 tests/webtbs/tw1883.pp svneol=native#text/plain
 tests/webtbs/tw18859.pp svneol=native#text/plain

+ 38 - 0
tests/webtbs/tw18702.pp

@@ -0,0 +1,38 @@
+program project1;
+
+{$mode objfpc}{$H+}
+{$modeswitch nestedprocvars}
+
+type
+  TGetSQLTextProc = function() : string is nested;
+
+procedure TestSQLFieldType(AGetSQLTextProc: TGetSQLTextProc);
+var
+  i          : byte;
+  s: string;
+begin
+  for i := 0 to 9 do
+    begin
+    s := AGetSQLTextProc();
+    if s<>'hello' then
+      begin
+      writeln('Failed');
+      halt(i+1);
+      end;
+    end;
+end;
+
+procedure TestSQLClob;
+
+  function GetSQLText() : string;
+  begin
+    result := 'hello';
+  end;
+
+begin
+  TestSQLFieldType(@GetSQLText);
+end;
+
+begin
+  TestSQLClob;
+end.