From 2a897f5b6b36e4817a73b18bc9e2d3c346befd30 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Fri, 18 Dec 2020 13:50:39 +0000
Subject: [PATCH] * apply slightly adjusted patch by Blaise.ru which moves
 parsing of result types to a separate functions thus ensuring that File types
 can't be used for procedure variables (just like they already couldn't be
 used as a result type for normal functions) + added test

git-svn-id: trunk@47810 -
---
 .gitattributes       |  1 +
 compiler/pdecsub.pas |  6 +-----
 compiler/ptype.pas   | 12 +++++++++++-
 tests/tbf/tb0273.pp  |  8 ++++++++
 4 files changed, 21 insertions(+), 6 deletions(-)
 create mode 100644 tests/tbf/tb0273.pp

diff --git a/.gitattributes b/.gitattributes
index 9f67871297..2053806caf 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -12735,6 +12735,7 @@ tests/tbf/tb0269.pp svneol=native#text/pascal
 tests/tbf/tb0270.pp svneol=native#text/pascal
 tests/tbf/tb0271.pp svneol=native#text/pascal
 tests/tbf/tb0272.pp svneol=native#text/plain
+tests/tbf/tb0273.pp svneol=native#text/pascal
 tests/tbf/tb0588.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 4d6506a744..c2ebfb2bc2 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -1344,7 +1344,7 @@ implementation
             parse_generic:=(df_generic in pd.defoptions);
             if pd.is_generic or pd.is_specialization then
               symtablestack.push(pd.parast);
-            single_type(pd.returndef,[stoAllowSpecialization]);
+            pd.returndef:=result_type([stoAllowSpecialization]);
 
             // Issue #24863, enabled only for the main progra commented out for now because it breaks building of RTL and needs extensive
 // testing and/or RTL patching.
@@ -1555,10 +1555,6 @@ implementation
             include(pd.procoptions,po_variadic);
           end;
 
-        { file types can't be function results }
-        if assigned(pd) and
-           (pd.returndef.typ=filedef) then
-          message(parser_e_illegal_function_result);
         { support procedure proc stdcall export; }
         if not(check_proc_directive(false)) then
           begin
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index 4887e759c8..5a5f8c48b3 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -42,6 +42,8 @@ interface
 
     { reads a string, file type or a type identifier }
     procedure single_type(out def:tdef;options:TSingleTypeOptions);
+    { ... but rejects types that cannot be returned from functions }
+    function result_type(options:TSingleTypeOptions):tdef;
 
     { reads any type declaration, where the resulting type will get name as type identifier }
     procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;var hadtypetoken:boolean);
@@ -645,6 +647,14 @@ implementation
       end;
 
 
+    function result_type(options:TSingleTypeOptions):tdef;
+      begin
+        single_type(result,options);
+        { file types cannot be function results }
+        if result.typ=filedef then
+          message(parser_e_illegal_function_result);
+      end;
+
     procedure parse_record_members(recsym:tsym);
 
       function IsAnonOrLocal: Boolean;
@@ -1587,7 +1597,7 @@ implementation
             if is_func then
               begin
                 consume(_COLON);
-                single_type(pd.returndef,[stoAllowSpecialization]);
+                pd.returndef:=result_type([stoAllowSpecialization]);
               end;
             if try_to_consume(_OF) then
               begin
diff --git a/tests/tbf/tb0273.pp b/tests/tbf/tb0273.pp
new file mode 100644
index 0000000000..a997f3072c
--- /dev/null
+++ b/tests/tbf/tb0273.pp
@@ -0,0 +1,8 @@
+{ %FAIL }
+
+// EXPECTED: 'Error: Illegal function result type'
+// ACTUAL: gets compiled
+type M = function : file;
+
+begin
+end.