// Compile the given code and return the error count.
public static Compiler HelperCompile(string [] code, FortranOptions opts)
{
Compiler comp = new Compiler(opts);
comp.CompileString(code);
Assert.AreEqual(0, comp.Messages.ErrorCount);
return comp;
}
static void Main(string[] args)
{
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
opts.Messages = messages;
if (opts.Parse(args)) {
Compiler comp = new Compiler(opts);
comp.Messages = messages;
foreach (string srcfile in opts.SourceFiles) {
if (!File.Exists(srcfile)) {
messages.Error(MessageCode.SOURCEFILENOTFOUND, String.Format("File '{0}' not found", srcfile));
break;
}
comp.Compile(srcfile);
}
if (messages.ErrorCount == 0) {
comp.Save();
if (opts.Run && messages.ErrorCount == 0) {
comp.Execute();
}
}
}
foreach (Message msg in messages) {
if (msg.Level == MessageLevel.Error) {
Console.ForegroundColor = ConsoleColor.Red;
}
Console.WriteLine(msg);
Console.ResetColor();
}
if (messages.ErrorCount > 0) {
Console.WriteLine(String.Format("*** {0} errors found. Compilation stopped.", messages.ErrorCount));
}
}
public void ValidateBinaryParsing()
{
string [] code = new [] {
" B'1010101111'",
" b\"111\"",
" B'121'"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.INTEGER);
IntegerToken intToken = (IntegerToken)token;
Assert.AreEqual(intToken.Value, 687);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.INTEGER);
intToken = (IntegerToken)token;
Assert.AreEqual(intToken.Value, 7);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
ls.GetToken();
Assert.IsTrue(messages.ErrorCount > 0);
Assert.IsTrue(messages[0].Line == 3);
Assert.IsTrue(messages[0].Code == MessageCode.BADNUMBERFORMAT);
}
public void ExtIntrAbs()
{
string [] code = new [] {
" FUNCTION IABS",
" IABS = ABS(-94)",
" RETURN",
" END",
" FUNCTION RABS",
" RABS = ABS(-7.4)",
" RETURN",
" END",
" FUNCTION DABS",
" DOUBLE PRECISION DABS",
" DABS = ABS(-2.6D0)",
" RETURN",
" END"
};
FortranOptions opts = new FortranOptions();
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "IABS", 94);
Helper.HelperRunDouble(comp, "DABS", 2.6);
Helper.HelperRunFloat(comp, "RABS", 7.4f);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "IABS", 94);
Helper.HelperRunDouble(comp, "DABS", 2.6);
Helper.HelperRunFloat(comp, "RABS", 7.4f);
}
public void ValidateDefaultOptions()
{
FortranOptions opts = new FortranOptions();
Assert.IsFalse(opts.Backslash);
Assert.IsFalse(opts.GenerateDebug);
}
/// <summary>
/// Constructs a Fortran compiler object with the given options.
/// </summary>
/// <param name="opts">Compiler options</param>
public Compiler(FortranOptions opts)
{
_globalSymbols = new SymbolCollection("Global"); // Functions and Subroutines
_localSymbols = new SymbolCollection("Local"); // Everything else including labels
_ptree = new CollectionParseNode();
_messages = new MessageCollection(opts);
_entryPointName = "Main";
_opts = opts;
}
/// <summary>
/// Initialises an instance of the <c>Lexer</c> class.
/// </summary>
/// <param name="lines">An array of input strings</param>
/// <param name="opts">An instance of the <c>Options</c> class</param>
/// <param name="messages">An instance of the <c>MessageCollection</c> class</param>
public Lexer(string[] lines, FortranOptions opts, MessageCollection messages)
{
_lines = lines;
_index = -1;
_tindex = 0;
_opts = opts;
_messages = messages;
_tokens = new List<SimpleToken>();
}
public void ValidateOptionParsing()
{
FortranOptions opts = new FortranOptions();
string[] args = new [] {
"-backslash",
"-invalidoption",
"-debug" };
Assert.IsFalse(opts.Parse(args));
Assert.IsTrue(opts.Backslash);
Assert.IsTrue(opts.GenerateDebug);
Assert.IsTrue(opts.Messages.Count == 2);
Assert.IsTrue(opts.Messages[0].Code == MessageCode.BADOPTION);
Assert.IsTrue(opts.Messages[1].Code == MessageCode.MISSINGSOURCEFILE);
}
public void ValidateFilenameParsing()
{
FortranOptions opts = new FortranOptions();
string[] args = new [] {
"-backslash",
"testfile1.f",
"-debug",
"testfile2.f"
};
Assert.IsTrue(opts.Parse(args));
Assert.IsTrue(opts.SourceFiles.Count == 2);
Assert.AreEqual(opts.SourceFiles[0], "testfile1.f");
Assert.AreEqual(opts.SourceFiles[1], "testfile2.f");
Assert.IsTrue(opts.Backslash);
Assert.IsTrue(opts.GenerateDebug);
}
public void ValidateBackslashStringParsing()
{
string [] code = new [] {
" \"Ab\\tCDEf\\n\""
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.STRING);
StringToken stringToken = (StringToken)token;
Assert.AreEqual(stringToken.String, "Ab\tCDEf\n");
// Turn on the option to treat backslash character as
// a backslash and not a special character.
opts.Backslash = true;
ls = new Lexer(code, opts, messages);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.STRING);
stringToken = (StringToken)token;
Assert.AreEqual(stringToken.String, "Ab\\tCDEf\\n");
}
public void ValidateRealParsing()
{
string [] code = new [] {
" 123.0976AA",
" 123.0976E-2",
" .5"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.REAL);
RealToken realToken = (RealToken)token;
Assert.IsTrue(System.Math.Abs(realToken.Value - 123.0976f) < float.Epsilon, "Expected 123.0976 but saw " + realToken.Value);
Assert.IsTrue(ls.GetToken().ID == TokenID.IDENT);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.REAL);
realToken = (RealToken)token;
Assert.IsTrue(System.Math.Abs(realToken.Value - 123.0976E-2f) < float.Epsilon, "Expected 123.0976E-2 but saw " + realToken.Value);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.REAL);
realToken = (RealToken)token;
Assert.IsTrue(System.Math.Abs(realToken.Value - 0.5f) < float.Epsilon, "Expected 0.5 but saw " + realToken.Value);
}
public void ValidateOctalParsing()
{
string [] code = new [] {
" O'745'",
" O\"340\"",
" O'892'"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.INTEGER);
IntegerToken intToken = (IntegerToken)token;
Assert.AreEqual(intToken.Value, 485);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.INTEGER);
intToken = (IntegerToken)token;
Assert.AreEqual(intToken.Value, 224);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
ls.GetToken();
Assert.IsTrue(messages.ErrorCount > 0);
Assert.IsTrue(messages[0].Line == 3);
Assert.IsTrue(messages[0].Code == MessageCode.BADNUMBERFORMAT);
}
public void ValidateIntegerParsing()
{
string [] code = new [] {
" 1230976AA"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.INTEGER);
IntegerToken intToken = (IntegerToken)token;
Assert.AreEqual(intToken.Value, 1230976);
}
public void ValidateHexParsing()
{
string [] code = new [] {
" $CC4DE",
" Z'CC4DE'",
" Z\"CC4DE\"",
" $AGG"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.INTEGER);
IntegerToken intToken = (IntegerToken)token;
Assert.AreEqual(intToken.Value, 0xCC4DE);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.INTEGER);
intToken = (IntegerToken)token;
Assert.AreEqual(intToken.Value, 0xCC4DE);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.INTEGER);
intToken = (IntegerToken)token;
Assert.AreEqual(intToken.Value, 0xCC4DE);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.INTEGER);
intToken = (IntegerToken)token;
Assert.AreEqual(intToken.Value, 0xA);
Assert.IsTrue(ls.GetToken().ID == TokenID.IDENT);
}
public void ExtIntrFloat()
{
string [] code = new [] {
" FUNCTION RFLOATI",
" RETURN FLOAT(12)",
" END"
};
FortranOptions opts = new FortranOptions();
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunFloat(comp, "RFLOATI", 12f);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunFloat(comp, "RFLOATI", 12f);
}
public void ExtIntrDLog10()
{
string [] code = new [] {
" FUNCTION RDLOG10",
" DOUBLE PRECISION RDLOG10",
" RDLOG10 = DLOG10(3.72D0)",
" RETURN",
" END"
};
FortranOptions opts = new FortranOptions();
double expected = Math.Log10(3.72);
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunDouble(comp, "RDLOG10", expected);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunDouble(comp, "RDLOG10", expected);
}
public void ValidateTabDelimiter()
{
string [] code = new [] {
"100\tINTEGER A",
"\tREAL B"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
Assert.IsTrue(ls.GetKeyword().ID == TokenID.KINTEGER);
Assert.IsTrue(ls.HasLabel);
Assert.IsTrue(ls.Label == "100");
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.IDENT);
IdentifierToken identToken = (IdentifierToken)token;
Assert.AreEqual(identToken.Name, "A");
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
Assert.IsTrue(ls.GetKeyword().ID == TokenID.KREAL);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.IDENT);
identToken = (IdentifierToken)token;
Assert.AreEqual(identToken.Name, "B");
}
public void ExtIntrAcos()
{
string [] code = new [] {
" FUNCTION RACOS",
" RACOS = ACOS(0.4)",
" RETURN",
" END",
" FUNCTION DACOS",
" DOUBLE PRECISION DACOS, V",
" V = 0.4",
" DACOS = ACOS(V)",
" RETURN",
" END"
};
FortranOptions opts = new FortranOptions();
double expected = Math.Acos(0.4);
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunFloat(comp, "RACOS", (float)expected);
Helper.HelperRunDouble(comp, "DACOS", expected);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunFloat(comp, "RACOS", (float)expected);
Helper.HelperRunDouble(comp, "DACOS", expected);
}
public void ExtIntrDsqrt()
{
string [] code = new [] {
" FUNCTION DDSQRT",
" DOUBLE PRECISION DDSQRT",
" RETURN DSQRT(49D0)",
" END"
};
FortranOptions opts = new FortranOptions();
double expected = Math.Sqrt(49);
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunDouble(comp, "DDSQRT", expected);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunDouble(comp, "DDSQRT", expected);
}
public void ExtIntrInt()
{
string [] code = new [] {
" FUNCTION JINTI",
" RETURN INT(12)",
" END",
" FUNCTION JINTR",
" RETURN INT(12.5)",
" END",
" FUNCTION JINTD",
" RETURN INT(13.0D2)",
" END",
" FUNCTION JINTC",
" RETURN INT((13,5))",
" END"
};
FortranOptions opts = new FortranOptions();
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "JINTI", 12);
Helper.HelperRunInteger(comp, "JINTR", 12);
Helper.HelperRunInteger(comp, "JINTD", 1300);
Helper.HelperRunInteger(comp, "JINTC", 13);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "JINTI", 12);
Helper.HelperRunInteger(comp, "JINTR", 12);
Helper.HelperRunInteger(comp, "JINTD", 1300);
Helper.HelperRunInteger(comp, "JINTC", 13);
}
public void ExtIntrIfix()
{
string [] code = new [] {
" FUNCTION ITEST",
" RETURN IFIX(12.45E1)",
" END",
" FUNCTION ITEST2",
" RETURN INT(12.45E1)",
" END"
};
FortranOptions opts = new FortranOptions();
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "ITEST", 124);
Helper.HelperRunInteger(comp, "ITEST2", 124);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "ITEST", 124);
Helper.HelperRunInteger(comp, "ITEST2", 124);
}
public void ExtIntrIchar()
{
string [] code = new [] {
" FUNCTION ITEST1",
" RETURN ICHAR(\"foo\")",
" END",
" FUNCTION ITEST2",
" CHARACTER *3 STR1",
" STR1 = 'HELLO'",
" RETURN ICHAR(STR1)",
" END"
};
FortranOptions opts = new FortranOptions();
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "ITEST1", 102);
Helper.HelperRunInteger(comp, "ITEST2", 72);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "ITEST1", 102);
Helper.HelperRunInteger(comp, "ITEST2", 72);
}
public void ExtIntrIabs()
{
string [] code = new [] {
" FUNCTION ITEST1",
" RETURN IABS(-12)",
" END",
" FUNCTION ITEST2",
" RETURN IABS(73)",
" END"
};
FortranOptions opts = new FortranOptions();
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "ITEST1", 12);
Helper.HelperRunInteger(comp, "ITEST2", 73);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunInteger(comp, "ITEST1", 12);
Helper.HelperRunInteger(comp, "ITEST2", 73);
}
public void ValidateStringParsing()
{
string [] code = new [] {
" PRINT \"AbCDEf\""
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
Assert.IsTrue(ls.GetKeyword().ID == TokenID.KPRINT);
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.STRING);
StringToken stringToken = (StringToken)token;
Assert.AreEqual(stringToken.String, "AbCDEf");
}
public void ValidateDoublePrecisionParsing()
{
string [] code = new [] {
" 123.0976D4AA",
" 123.0976D-2"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.DOUBLE);
DoubleToken realToken = (DoubleToken)token;
Assert.IsTrue(Helper.DoubleCompare(realToken.Value, 123.0976E4), "Expected 123.0976E4 but saw " + realToken.Value);
Assert.IsTrue(ls.GetToken().ID == TokenID.IDENT);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.DOUBLE);
realToken = (DoubleToken)token;
Assert.IsTrue(Helper.DoubleCompare(realToken.Value, 123.0976E-2), "Expected 123.0976E-2 but saw " + realToken.Value);
}
public void ValidateF77ExtContinuationCharacter()
{
string [] code = new [] {
"100 INTEGER STA&",
" TION"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
Assert.IsTrue(ls.GetKeyword().ID == TokenID.KINTEGER);
SimpleToken token = ls.GetToken();
Assert.IsTrue(token.ID == TokenID.IDENT);
IdentifierToken identToken = (IdentifierToken)token;
Assert.AreEqual(identToken.Name, "STATION");
}
public void ExtIntrDprod()
{
string [] code = new [] {
" FUNCTION DDPROD",
" DOUBLE PRECISION DDPROD",
" DDPROD = DPROD(12.4,3.8)",
" RETURN",
" END"
};
FortranOptions opts = new FortranOptions();
double expected = 12.4 * 3.8;
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunDouble(comp, "DDPROD", expected);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunDouble(comp, "DDPROD", expected);
}
public void ValidateHasLabel()
{
string [] code = new [] {
"100 INTEGER A",
" STOP"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
Assert.IsTrue(ls.GetKeyword().ID == TokenID.KINTEGER);
Assert.IsTrue(ls.HasLabel);
Assert.IsTrue(ls.Label == "100");
Assert.IsTrue(ls.GetToken().ID == TokenID.IDENT);
Assert.IsTrue(messages.ErrorCount == 0);
}
public void ValidateDebug()
{
string [] code = new [] {
" INTEGER A",
"D REAL B",
" INTEGER C"
};
FortranOptions opts = new FortranOptions();
MessageCollection messages = new MessageCollection(opts);
Lexer ls = new Lexer(code, opts, messages);
Assert.IsTrue(ls.GetKeyword().ID == TokenID.KINTEGER);
Assert.IsTrue(ls.GetToken().ID == TokenID.IDENT);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
Assert.IsTrue(ls.GetKeyword().ID == TokenID.KINTEGER);
// Now it should pick up 'D' lines.
opts.GenerateDebug = true;
ls = new Lexer(code, opts, messages);
Assert.IsTrue(ls.GetKeyword().ID == TokenID.KINTEGER);
Assert.IsTrue(ls.GetToken().ID == TokenID.IDENT);
Assert.IsTrue(ls.GetToken().ID == TokenID.EOL);
Assert.IsTrue(ls.GetKeyword().ID == TokenID.KREAL);
}
public void ExtIntrDtanh()
{
string [] code = new [] {
" FUNCTION DDTANH",
" DOUBLE PRECISION DDTANH",
" RETURN DTANH(0.147D0)",
" END"
};
FortranOptions opts = new FortranOptions();
double expected = Math.Tanh(0.147);
Compiler comp = Helper.HelperCompile(code, opts);
Helper.HelperRunDouble(comp, "DDTANH", expected);
opts.Inline = false;
comp = Helper.HelperCompile(code, opts);
Helper.HelperRunDouble(comp, "DDTANH", expected);
}