* throw an error if raise is called in a noreturn subroutine outside of any exception frame, resolves #39514

compiler/cclasses.pas

@@ -86,14 +86,14 @@ type
     procedure Put(Index: Integer; Item: Pointer);
     procedure SetCapacity(NewCapacity: Integer);
     procedure SetCount(NewCount: Integer);
-    Procedure RaiseIndexError(Index : Integer);noreturn;
+    Procedure RaiseIndexError(Index : Integer);
     property List: PPointerList read FList;
   public
     destructor Destroy; override;
     function Add(Item: Pointer): Integer;
     procedure Clear;
     procedure Delete(Index: Integer);
-    class procedure Error(const Msg: string; Data: PtrInt);noreturn;
+    class procedure Error(const Msg: string; Data: PtrInt);
     procedure Exchange(Index1, Index2: Integer);
     function Expand: TFPList;
     function Extract(item: Pointer): Pointer;
@@ -225,7 +225,7 @@ type
     function HashOfIndex(Index: Integer): LongWord;
     function GetNextCollision(Index: Integer): Integer;
     procedure Delete(Index: Integer);
-    class procedure Error(const Msg: string; Data: PtrInt);noreturn;
+    class procedure Error(const Msg: string; Data: PtrInt);
     function Expand: TFPHashList;
     function Extract(item: Pointer): Pointer;
     function IndexOf(Item: Pointer): Integer;
@@ -716,7 +716,7 @@ implementation
                TFPObjectList (Copied from rtl/objpas/classes/lists.inc)
 *****************************************************************************}
 
-procedure TFPList.RaiseIndexError(Index : Integer);noreturn;
+procedure TFPList.RaiseIndexError(Index : Integer);
 begin
   Error(SListIndexError, Index);
 end;
@@ -812,7 +812,7 @@ begin
   end;
 end;
 
-class procedure TFPList.Error(const Msg: string; Data: PtrInt);noreturn;
+class procedure TFPList.Error(const Msg: string; Data: PtrInt);
 begin
   Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame), get_caller_frame(get_frame);
 end;
@@ -1568,7 +1568,7 @@ begin
     Self.Delete(Result);
 end;
 
-class procedure TFPHashList.Error(const Msg: string; Data: PtrInt);noreturn;
+class procedure TFPHashList.Error(const Msg: string; Data: PtrInt);
 begin
   Raise EListError.CreateFmt(Msg,[Data])  at get_caller_addr(get_frame), get_caller_frame(get_frame);
 end;

compiler/msg/errore.msg

@@ -445,7 +445,7 @@ scan_e_unexpected_endif=02108_E_$ENDIF directive found without a matching $IF(N)
 #
 # Parser
 #
-# 03355 is the last used one
+# 03361 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1632,6 +1632,9 @@ parser_e_location_regpair_only_consecutive=03359_E_Only consecutive registers ar
 % MorphOS syscall specific: only consecutive (f.e.: d1-d2) registers are supported for 64bit register pairs
 parser_e_constructurs_cannot_take_type_parameters=03360_E_Constructors cannot take type parameters
 % The use of type parameters in constructors is not allowed.
+parser_e_raise_with_noreturn_not_allowed=03361_E_Raise in subroutines declared as noreturn is not allowed
+% \var{noreturn} tells the compiler that the activation scope of the subroutine is never left. This includes exceptions
+% goto or any other mean. While the compiler cannot detect all such cases some are trivial and the compiler gives an error.
 %
 % \end{description}
 %

compiler/msgidx.inc

@@ -474,6 +474,7 @@ const
   parser_e_location_regpair_only_data=03358;
   parser_e_location_regpair_only_consecutive=03359;
   parser_e_constructurs_cannot_take_type_parameters=03360;
+  parser_e_raise_with_noreturn_not_allowed=03361;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -1147,9 +1148,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 89063;
+  MsgTxtSize = 89128;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,109,361,131,99,63,148,37,223,69,
+    28,109,362,131,99,63,148,37,223,69,
     65,20,30,1,1,1,1,1,1,1
   );

compiler/pstatmnt.pas

@@ -855,6 +855,8 @@ implementation
               if (block_type<>bt_except) then
                 Message(parser_e_no_reraise_possible);
            end;
+         if (po_noreturn in current_procinfo.procdef.procoptions) and (exceptblockcounter=0) then
+           Message(parser_e_raise_with_noreturn_not_allowed);
          p:=craisenode.create(pobj,paddr,pframe);
          raise_statement:=p;
       end;

compiler/verbose.pas

@@ -584,14 +584,17 @@ implementation
 
 
     procedure internalerror(i : longint);noreturn;
+      procedure doraise;
+        begin
+          raise ECompilerAbort.Create;
+        end;
       begin
         UpdateStatus;
         do_internalerror(i);
         GenerateError;
-        raise ECompilerAbort.Create;
+        doraise;
       end;
 
-
     procedure Comment(l:longint;s:ansistring);
       var
         dostop : boolean;

tests/tbf/tw39514.pp

@@ -0,0 +1,20 @@
+{ %fail }
+{$mode objfpc} {$longstrings on}
+procedure ThrowException; noreturn;
+begin
+	raise TObject.Create;
+end;
+
+procedure DoSomethingWithString;
+begin
+	writeln(Copy('hey', 1, 2));
+	ThrowException;
+end;
+
+begin
+	try
+		DoSomethingWithString;
+	except
+		writeln('catch');
+	end;
+end.