Pārlūkot izejas kodu

* Test for bug report 18702

git-svn-id: trunk@17096 -
pierre 14 gadi atpakaļ
vecāks
revīzija
3378979f2b
2 mainītis faili ar 39 papildinājumiem un 0 dzēšanām
  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.