【IC script】perl 脚本 调用 多个线程 进行回归测试

一般perl脚本回归：

sub regress_run{
    open LIST, "<$tc_list";##传入回归tc list
    while(<LIST>){
        &run_tc($_); ##依次运行仿真每个tc
    }
}

这样perl脚本调用一个线程，占用一个license依次按照tc_list进行回归。也可以将tc_list分成若干份，单独回归。但这样需要打开多个terminal窗口，同时每个分割的每个list仿真时间无法掌控，有个时间短，有的时间长。

如何起多个线程，调用多个license，对一个tc_list进行回归？

大致思路：fork产生多个perl子进程，子进程访问同一个tc_list,将tc取出后，从tc_list中删除该tc.

use Fcntl qw(:flock); 
use POSIX qw(WNOHANG);
use POSIX qw(strftime);

sub cur_time{ strftime "%H:%M:%S",localtime;}

for(my $i=0;$i<$mult_proc;++i){ ##创建mult_proc个子进程
    	$child_proc = fork(); ##通过fork函数产生子进程
	die "fork child_proc fail $!\n" if (!defined($child_proc));
    	if ($child_proc == 0){ ##进入子进程 
		while(1){
			open(FH,"<$tc_list") or die "$!\n"; #选择任意文件上锁，这样只有等待解锁后，其他子进程才能继续往下运行。起到block其他子进程的作用，以防多个进程同时方位$tmp_tc_list造成竞争
			flock(FH,LOCK_EX) or die "can't lock file:$!\n";
			sleep(1);
			@test_tmp = `sed -n 1p $tmp_tc_list`; ##取出list第一个tc,需要保存到数组变量中，否则出错？
			chomp($test = @test_tmp[0]);
			if(!defined($test)){ ##如果list遍历完，结束子进程
				print 'child_pro pid:'.$$.'exit time:'.&cur_time."\n"; ## $$显示子进程pid
				exit(0);
			}
			if($test =~ /^$/){ ##如果为空白行，跳过
				system('sed', '-i', '1d', $tmp_tc_list)； ##从list中删除空白行
				next;
			}
			system('sed', '-i', '1d', $tmp_tc_list); ##在list中删除使用过的第一行tc
			sleep(1);
			close（FH); ##解锁lock
			&print_result(); ##打印回归结果，tatal tc,pass tc,fail tc etc
			&run_tc($test); ## 仿真tc 在仿真的命令后面加上 ">&null" 就会屏蔽掉eda工具的打印信息，exp: make run >&null 
		        	
		}
    	} else {
 		print "parent_pro pid:$$\n"; ##打印父进程pid
		print "child pid:$child_proc\n"; ##打印子进程pid
    	}
	until(waitpid(-1,WNOHANG) == -1){ ##每个20s检测一次，等待所有子进程结束后，杀死僵尸进程
		sleep(20);
	}
	print "END time:&cur_time \n";
	`rm -rf $tmp_tc_list`; ##删除list
	`rm -rf null`; ## 不打印 make xxx >&null  或者  >/dev/null 2>&1 不需要删除null
}

大致代码如上

waitpid使用方法见链接：https://blog.csdn.net/Holden_Liu/article/details/100174792