From 3378979f2b90062dbe06b1e788645d87da830d14 Mon Sep 17 00:00:00 2001
From: pierre <pierre@freepascal.org>
Date: Wed, 9 Mar 2011 14:25:11 +0000
Subject: [PATCH] * Test for bug report 18702
git-svn-id: trunk@17096 -
---
.gitattributes | 1 +
tests/webtbs/tw18702.pp | 38 ++++++++++++++++++++++++++++++++++++++
2 files changed, 39 insertions(+)
create mode 100644 tests/webtbs/tw18702.pp
diff --git a/.gitattributes b/.gitattributes
index 195a83f3d3..d478bb9965 100644
--- a/.gitattributes
+++ b/.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
diff --git a/tests/webtbs/tw18702.pp b/tests/webtbs/tw18702.pp
new file mode 100644
index 0000000000..69a54be3bc
--- /dev/null
+++ b/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.