Prechádzať zdrojové kódy

Use qualident as CASE's label - according to report.

Vladislav Folts 9 rokov pred
rodič
commit
064c95e741

BIN
bin/compiled.zip


+ 1 - 1
src/grammar.js

@@ -124,7 +124,7 @@ var ifStatement = and("IF", context(and(expression, required("THEN", "THEN expec
                                         "END"), 
                                     contexts.If));
 
-var label = or(integer, string, ident);
+var label = or(integer, string, qualident);
 var labelRange = context(and(label, optional(and("..", label))), ContextCase.Range);
 var caseLabelList = context(and(labelRange, repeat(and(",", labelRange))), ContextCase.LabelList);
 var caseParser = optional(context(and(caseLabelList, ":", statementSequence), contexts.CaseLabel));

+ 13 - 4
src/ob/ContextCase.ob

@@ -33,7 +33,10 @@ TYPE
     END;
 
     Range* = RECORD(ContextExpression.ExpressionHandler)
+        PROCEDURE handleQIdent*(q: ContextHierarchy.QIdent);
+
         from, to: ConstValue.PInt;
+        typeGuardHandled: BOOLEAN;
     END;
 
     GuardedVariable = RECORD(Types.Variable)
@@ -237,18 +240,24 @@ BEGIN
     END;
 END;
 
-PROCEDURE Range.handleIdent(id: STRING);
+PROCEDURE Range.handleQIdent(q: ContextHierarchy.QIdent);
 BEGIN
-    info <- ContextHierarchy.getSymbol(SELF.root()^, id).info();
+    IF SELF.typeGuardHandled THEN
+        Errors.raise("cannot use diapason (..) with type guard");
+    END;
+
+    found <- ContextHierarchy.getQIdSymbolAndScope(SELF.root()^, q);
+    info <- found.symbol().info();
     typeTest <- caseContext(SELF).typeTest;
     IF typeTest # NIL THEN
         IF info IS TypeId.PType THEN
             labelContext(SELF).handleTypeGuard(typeTest, info);
+            SELF.typeGuardHandled := TRUE;
         ELSE
-            Errors.raise("'" + id + "' is not a type");
+            Errors.raise("'" + q.code + "' is not a type");
         END;
     ELSIF ~(info IS Types.PConst) THEN
-        Errors.raise("'" + id + "' is not a constant");
+        Errors.raise("'" + q.code + "' is not a constant");
     ELSE
         type <- info.type;
         IF type IS Types.PString THEN

+ 28 - 0
test/expected/case_type_import.js

@@ -0,0 +1,28 @@
+<rtl code>
+var m1 = function (){
+function Base(){
+}
+function Derived(){
+	Base.call(this);
+}
+RTL$.extend(Derived, Base);
+return {
+	Base: Base,
+	Derived: Derived
+}
+}();
+var m2 = function (m1){
+var b = new m1.Base();
+var d = new m1.Derived();
+
+function isDerived(b/*VAR Base*/){
+	var result = false;
+	var $case1 = b;
+	if ($case1 instanceof m1.Derived){
+		result = true;
+	}
+	return result;
+}
+RTL$.assert(!isDerived(b));
+RTL$.assert(isDerived(d));
+}(m1);

+ 31 - 0
test/input/case_type_import.ob

@@ -0,0 +1,31 @@
+MODULE m1;
+TYPE
+	Base* = RECORD
+	END;
+
+	Derived* = RECORD(Base)
+	END;
+
+END m1.
+
+MODULE m2;
+IMPORT m1;
+VAR
+	b: m1.Base;
+	d: m1.Derived;
+
+PROCEDURE isDerived(VAR b: m1.Base): BOOLEAN;
+VAR
+	result: BOOLEAN;
+BEGIN
+	CASE b OF
+		m1.Derived: 
+			result := TRUE;
+	END;
+	RETURN result
+END isDerived;
+
+BEGIN
+	ASSERT(~isDerived(b));
+	ASSERT(isDerived(d));
+END m2.

+ 31 - 0
test/input/run/case_type_import.ob

@@ -0,0 +1,31 @@
+MODULE m1;
+TYPE
+	Base* = RECORD
+	END;
+
+	Derived* = RECORD(Base)
+	END;
+
+END m1.
+
+MODULE m2;
+IMPORT m1;
+VAR
+	b: m1.Base;
+	d: m1.Derived;
+
+PROCEDURE isDerived(VAR b: m1.Base): BOOLEAN;
+VAR
+	result: BOOLEAN;
+BEGIN
+	CASE b OF
+		m1.Derived: 
+			result := TRUE;
+	END;
+	RETURN result
+END isDerived;
+
+BEGIN
+	ASSERT(~isDerived(b));
+	ASSERT(isDerived(d));
+END m2.

+ 10 - 1
test/test_unit.js

@@ -695,7 +695,10 @@ return {
          ["CASE pb OF 123 END", "type's name expected in label, got expression: 123"],
          ["CASE pb OF \"a\" END", "type's name expected in label, got expression: \"a\""],
          ["CASE pb OF c END", "'c' is not a type"],
-         ["CASE pb OF PT2: pb.i := 0 END", "invalid type test: 'T2' is not an extension of 'Base'"]
+         ["CASE pb OF PT2: pb.i := 0 END", "invalid type test: 'T2' is not an extension of 'Base'"],
+         ["CASE pb OF PDerived..PDerived2: END", "cannot use diapason (..) with type guard"],
+         ["CASE pb OF PDerived..1: END", "type's name expected in label, got expression: 1"],
+         ["CASE c OF 0..PDerived: END", "'PDerived' is not a constant"]
          )
     ),
 "CASE statement with type guard for VAR argument": testWithContext(
@@ -731,6 +734,12 @@ return {
     fail(["CASE pb^ OF Derived: pb.i := 0 END", "type 'Base' has no 'i' field"]
          )
     ),
+"CASE statement with type guard for imported type": testWithModule(
+    "MODULE test; TYPE Base* = RECORD END; Derived* = RECORD(Base) END; Derived2 = RECORD(Base) END; END test.",
+    pass("MODULE m; IMPORT test; PROCEDURE p(VAR b: test.Base); BEGIN CASE b OF test.Derived: END; END p; END m."),
+    fail(["MODULE m; IMPORT test; PROCEDURE p(VAR b: test.Base); BEGIN CASE b OF test.Derived2: END; END p; END m.",
+          "identifier 'Derived2' is not exported by module 'test'"]
+        )),
 "WHILE statement": testWithContext(
     context(grammar.statement,
             "VAR b1: BOOLEAN; i1: INTEGER;"),