+ extend test framework with ability to specify certain expected compiler messages using their ids

tests/readme.txt

@@ -112,6 +112,10 @@ KNOWNCOMPILEERROR..Known bug, which manifest itself at compile time. To
                    the right of the equal sign is the expected exit code
                    from compiler, followed by an optional note. Will not
                    be logged as a bug.
+EXPECTMSGS.........A comma separated list of message IDs (see -vq) which the
+                   compiler is expected to print during execution. If at least
+                   one is not printed then this is considered an error.
+                   Note: implicitly adds the -vq option for compilation.
 QUICKTEST..........If set, only tests without package dependencies are executed
 WPOPARAS...........Parameters to be added after -OW/-Ow to perform whole
                    program optimization tests

tests/utils/dotest.pp

@@ -737,6 +737,47 @@ begin
 end;
 
 
+function CheckForMessages(const OutName:string;Msgs:array of longint;var Found:array of boolean):boolean;
+var
+  t : text;
+  s,id : string;
+  fnd,i : longint;
+begin
+  CheckForMessages:=false;
+  for i:=0 to high(Found) do
+    Found[i]:=False;
+  if length(Msgs)<>length(Found) then
+    exit;
+  assign(t,Outname);
+  {$I-}
+  reset(t);
+  {$I+}
+  if ioresult<>0 then
+    exit;
+  fnd:=0;
+  for i:=0 to high(Found) do
+    Found[i]:=False;
+  while not eof(t) do
+    begin
+      readln(t,s);
+      for i:=0 to high(Msgs) do
+        begin
+          str(Msgs[i],id);
+          id:='('+id+')';
+          if copy(s,1,length(id))=id then
+            begin
+              if not Found[i] then
+                inc(fnd);
+              Found[i]:=True;
+              { there can only be a single message per line }
+              break;
+            end;
+        end;
+    end;
+  close(t);
+  CheckForMessages:=fnd=Length(Msgs);
+end;
+
 { Takes each option from AddOptions list
   considered as a space separated list
   and adds the option to args
@@ -859,13 +900,15 @@ end;
 
 function RunCompiler(const ExtraPara: string):boolean;
 var
-  args,LocalExtraArgs,
+  args,LocalExtraArgs,msgid,
   wpoargs,wposuffix : string;
+  i,
   passnr,
   passes  : longint;
   execres : boolean;
   EndTicks,
   StartTicks : int64;
+  fndmsgs : array of boolean;
 begin
   RunCompiler:=false;
   args:='-n -T'+CompilerTarget+' -Fu'+RTLUnitsDir;
@@ -900,6 +943,12 @@ begin
     end;
   if Config.NeedOptions<>'' then
    AppendOptions(Config.NeedOptions,args);
+  { we need to check for message IDs, so request them }
+  if Length(Config.ExpectMsgs) <> 0 then
+    begin
+      AppendOptions('-vq',args);
+      SetLength(fndmsgs,Length(Config.ExpectMsgs));
+    end;
   wpoargs:='';
   wposuffix:='';
   if (Config.WpoPasses=0) or
@@ -971,6 +1020,34 @@ begin
          Verbose(V_Warning,'Internal error in compiler');
          exit;
        end;
+
+      if length(Config.ExpectMsgs)<>0 then
+        begin
+          Verbose(V_Debug,'Checking for messages: '+ToStr(Length(Config.ExpectMsgs)));
+          if not CheckForMessages(CompilerLogFile,Config.ExpectMsgs,fndmsgs) then
+            begin
+              AddLog(FailLogFile,TestName);
+              if Config.Note<>'' then
+                AddLog(FailLogFile,Config.Note);
+              AddLog(ResLogFile,message_missing+PPFileInfo[current]);
+              AddLog(LongLogFile,line_separation);
+              AddLog(LongLogFile,message_missing+PPFileInfo[current]);
+              if Config.Note<>'' then
+                AddLog(LongLogFile,Config.Note);
+              for i:=0 to length(Config.ExpectMsgs) do
+                if not fndmsgs[i] then
+                  begin
+                    str(Config.ExpectMsgs[i],msgid);
+                    AddLog(LongLogFile,message_missing+msgid);
+                  end;
+              CopyFile(CompilerLogFile,LongLogFile,true);
+              { avoid to try again }
+              AddLog(ExeLogFile,message_missing+PPFileInfo[current]);
+              exit;
+            end
+          else
+            Verbose(V_Debug,'All messages found');
+        end;
     end;
 
   { Should the compile fail ? }

tests/utils/teststr.pp

@@ -36,6 +36,7 @@ const
   skipping_run_unit = 'Skipping test run because it is a unit ';
   skipping_run_test = 'Skipping run test ';
   known_problem = ' known problem: ';
+  message_missing = 'Missing compiler message: ';
   line_separation = '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>';
 
   ResLogfile  : string = 'log';

tests/utils/testu.pp

@@ -50,6 +50,7 @@ type
     WpoParas      : string;
     WpoPasses     : longint;
     DelFiles      : string;
+    ExpectMsgs    : array of longint;
   end;
 
 Const
@@ -278,7 +279,8 @@ var
   t : text;
   part,code : integer;
   l : longint;
-  s,res : string;
+  p : sizeint;
+  s,res,tmp : string;
 
   function GetEntry(const entry:string):boolean;
   var
@@ -470,6 +472,24 @@ begin
               else
                 if GetEntry('DELFILES') then
                   r.DelFiles:=res
+              else
+                if GetEntry('EXPECTMSGS') then
+                  begin
+                    p:=Pos(',',res);
+                    while p>0 do
+                      begin
+                        Val(Copy(res,1,p-1),l,code);
+                        if code<>0 then
+                          Verbose(V_Error,'Invalid value in EXPECTMSGS list: '+Copy(res,1,p-1));
+                        Insert(l,r.ExpectMsgs,Length(r.ExpectMsgs));
+                        Delete(res,1,p);
+                        p:=Pos(',',res);
+                      end;
+                    Val(res,l,code);
+                    if code<>0 then
+                      Verbose(V_Error,'Invalid value in EXPECTMSGS list: '+res);
+                    Insert(l,r.ExpectMsgs,Length(r.ExpectMsgs));
+                  end
               else
                Verbose(V_Error,'Unknown entry: '+s);
             end;