File: txt2example.pl

package info (click to toggle)
yacas 1.3.6-2
  • links: PTS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 7,176 kB
  • ctags: 3,520
  • sloc: cpp: 13,960; java: 12,602; sh: 11,401; makefile: 552; perl: 517; ansic: 381
file content (138 lines) | stat: -rw-r--r-- 3,552 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#!/usr/bin/perl -w

# Extract In>/Out> examples from txt documentation, create ys test scripts using Verify().
# Usage: perl txt2example.pl file.chapt.txt > file.yts

$in_EG = 0;	# within an example block
$have_in = 0; # within an In> line
$have_out = 0; # within an Out> line
$in_text = "";	# text after In>
$out_text = ""; # text after Out>

$filename = $ARGV[0];
open(INFILE, "$filename") || die "txt2example.pl: Error: cannot open file '$filename'\n";

$line = 0;	# line number

while(<INFILE>) {
	$line++;
	chomp;
	# Only care about certain lines: start with *EG or *E.G., finish with a * label, each example line must be either In> or Out> and TAB-indented
	# The lines labeled "test" or not labeled are selected for export, all other lines are not (e.g. we can write "*E.G. notest" and it will not be tested)
	if ($in_EG == 1)
	{
		if (/^\*/)
		{	# finish *EG block
			&print_test($in_text, $out_text);
			$in_EG = 0;
			&finish_eg();
			$out_text = $in_text = "";
			$have_in = $have_out = 0;
		}
		if ($have_in == 1)
		{
			if (m/^\tIn\>\s*(.*)$/)
			{	# continuation In>, need to trim the preceding backslash
				$piece = $1;
				$in_text =~ s/\\$//;
				$in_text .= $piece;
			}
			elsif (m/^\tOut\>\s*(.*)$/)
			{	# Out> line started
				$out_text = $1;
				$have_in = 0;
				$have_out = 1;
			}
			elsif (m/^\t(\s*[^ \t].*)$/)
			{	# nonempty In> continuation line, need to trim the preceding backslash
				$piece = $1;
				$in_text =~ s/\\$//;
				$in_text .= $piece;
			}
			else
			{	# none of the above, ignore this line, clear flags, print nothing
				$have_in = 0;
				$out_text = $in_text = "";
			}
		}
		elsif ($have_out == 1)
		{
			if (/^\tOut\>\s*(.*)$/)
			{	# continuation Out>, need to trim the preceding backslash
				$piece = $1;
				$out_text =~ s/\\$//;
				$out_text .= $piece;
			}
			elsif (/^\tIn\>\s*(.*)$/)
			{	# In> line started, print test, clear flags
				&print_test($in_text, $out_text);
				$in_text = $1;
				$out_text = "";
				$have_in = 1;
				$have_out = 0;
			}
			elsif (/^\t(\s*[^ \t].*)$/)
			{	# nonempty Out> continuation line, need to trim the preceding backslash
				$piece = $1;
				$out_text =~ s/\\$//;
				$out_text .= $piece;
			}
			else
			{	# none of the above, ignore this line, clear flags, print test
				&print_test($in_text, $out_text);
				$have_out = 0;
				$out_text = $in_text = "";
			}
		}
		else	# we are outside of any in/out blocks
		{
			if (/^\tIn\>\s*(.*)$/)
			{	# In> line started, set flags
				$in_text = $1;
				$out_text = "";
				$have_in = 1;
				$have_out = 0;
			}
			else
			{	# nothing interesting, ignore this line, clear flags, print test
				$out_text = $in_text = "";
			}
		}
	}
	else
	{	# if not inside *EG: check if it is starting
		if (/^\*(EG|E\.G\.)\s\s*test\s*$/ # *EG test or *E.G. test
			or /^\*(EG|E\.G\.)\s*$/
			or /^\*TEST/
		)
		{	# starting EG block
			$in_EG = 1;
			&start_eg();
		}		
	}
}

sub print_test
{
	my ($in_text, $out_text) = (@_);
	# do not print unless both are non-empty
	$in_text =~ s/;\s*$//;	# trim the final ';' from the In> string
	$out_text =~ s/;\s*$//;	# trim the final ';' from the Out> string
	print << "EOF1" unless ($in_text eq "" or $out_text eq "");
Verify($in_text, $out_text, "at line $line in file $filename");
EOF1

}

sub start_eg	# what to print into the test file in front of each EG block
{
	print << "EOF2";
/* Testing EG block at line $line in file $filename */
Builtin'Precision'Set(10);Clear(x);Clear(y);Clear(z);Clear(a);Clear(b); Clear(A);Clear(B);Clear(v);Clear(p);
EOF2
}

sub finish_eg
{
}