[fpc-devel] Procedural types returning file types

[Blaise at blaise.ru]

The patch http://hg.blaise.ru/public/fpc/rev/698389953e49 (attached) fixes the following:
-------8<-------
// EXPECTED: 'Error: Illegal function result type'
// ACTUAL: gets compiled
type M = function : file;

begin
end.
-------8<-------

-- 
βþ
-------------- next part --------------
# HG changeset patch
# User Blaise.ru
# Date 1608281477 -10800
! procvar_dec: reject file types as result types of procedural types

diff -r a4ade871efd2 -r ac2ef7649638 pdecsub.pas
--- a/pdecsub.pas	Thu Dec 17 10:58:01 2020 +0300
+++ b/pdecsub.pas	Fri Dec 18 11:51:17 2020 +0300
@@ -1344,7 +1344,7 @@
             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 @@
             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 -r a4ade871efd2 -r ac2ef7649638 ptype.pas
--- a/ptype.pas	Thu Dec 17 10:58:01 2020 +0300
+++ b/ptype.pas	Fri Dec 18 11:51:17 2020 +0300
@@ -41,7 +41,9 @@
     procedure resolve_forward_types;
 
     { reads a string, file type or a type identifier }
-    procedure single_type(var def:tdef;options:TSingleTypeOptions);
+    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);
@@ -454,7 +456,7 @@
       end;
 
 
-    procedure single_type(var def:tdef;options:TSingleTypeOptions);
+    procedure single_type(out def:tdef;options:TSingleTypeOptions);
        var
          t2 : tdef;
          isspecialize,
@@ -645,6 +647,14 @@
       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 @@
             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