Allow object."field" syntax (see #7722)

src/optimization/inlineConstructors.ml

@@ -274,7 +274,7 @@ let inline_constructors ctx e =
 			end
 		| TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some _} as cf)} as c,_,pl),_ when is_extern_ctor c cf ->
 			error "Extern constructor could not be inlined" e.epos;
-		| TObjectDecl fl, _ when captured && fl <> [] && List.for_all (fun((s,_,_),_) -> Lexer.is_valid_identifier s) fl ->
+		| TObjectDecl fl, _ when captured && fl <> [] && List.for_all (fun((s,_,_),_) -> Lexer.is_valid_identifier s) fl -> (* TODO: check what we wanna do with is_valid_identifier here *)
 			let v = alloc_var VGenerated "inlobj" e.etype e.epos in
 			let ev = mk (TLocal v) v.v_type e.epos in
 			let el = List.map (fun ((s,_,_),e) ->

src/optimization/optimizer.ml

@@ -471,7 +471,7 @@ let inline_constructors ctx e =
 					begin try
 						let ev = mk (TLocal v) v.v_type e.epos in
 						let el = List.fold_left (fun acc ((s,_,_),e) ->
-							if not (Lexer.is_valid_identifier s) then raise Exit;
+							if not (Lexer.is_valid_identifier s) then raise Exit; (* TODO: check what we wanna do with is_valid_identifier here *)
 							let ef = mk (TField(ev,FDynamic s)) e.etype e.epos in
 							let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in
 							e :: acc

src/syntax/grammar.mly

@@ -79,22 +79,24 @@ let property_ident = parser
 	| [< '(Kwd Default,p) >] -> "default",p
 	| [< '(Kwd Null,p) >] -> "null",p
 
-let questionable_dollar_ident s =
-	let po = match s with parser
-		| [< '(Question,p) >] -> Some p
-		| [< >] -> None
-	in
-	let name,p = dollar_ident s in
+let question_mark = parser
+	| [< '(Question,p) >] -> p
+
+let field_decl_ident = parser
+	| [< '(Const (Ident i),p) >] -> i,p
+	| [< '(Const (String (i,_)),p) >] -> i,p
+	| [< '(Dollar i,p) >] -> ("$" ^ i),p
+
+let questionable_field_decl_ident s =
+	let po = popt question_mark s in
+	let name,p = field_decl_ident s in
 	match po with
 		| None ->
 			false,(name,p)
 		| Some p' ->
 			if p.pmin <> p'.pmax then syntax_error (Custom (Printf.sprintf "Invalid usage of ?, use ?%s instead" name)) s ~pos:(Some p') ();
 			true,(name,p)
 
-let question_mark = parser
-	| [< '(Question,p) >] -> p
-
 let semicolon s =
 	if fst (last_token s) = BrClose then
 		match s with parser
@@ -783,7 +785,7 @@ and parse_function_type_next tl p1 = parser
 and parse_type_anonymous s =
 	let p0 = popt question_mark s in
 	match s with parser
-	| [< name, p1 = dollar_ident; t = parse_type_hint; s >] ->
+	| [< name, p1 = field_decl_ident; t = parse_type_hint; s >] ->
 		let opt,p1 = match p0 with
 			| Some p -> true,punion p p1
 			| None -> false,p1
@@ -887,7 +889,7 @@ and parse_class_field tdecl s =
 				meta
 		in
 		let name,pos,k,al,meta = (match s with parser
-		| [< '(Kwd Var,p1); opt,name = questionable_dollar_ident; s >] ->
+		| [< '(Kwd Var,p1); opt,name = questionable_field_decl_ident; s >] ->
 			let meta = check_optional opt name in
 			begin match s with parser
 			| [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_) >] ->
@@ -900,7 +902,7 @@ and parse_class_field tdecl s =
 			end
 		| [< '(Kwd Final,p1) >] ->
 			begin match s with parser
-			| [< opt,name = questionable_dollar_ident; t = popt parse_type_hint; e,p2 = parse_var_field_assignment >] ->
+			| [< opt,name = questionable_field_decl_ident; t = popt parse_type_hint; e,p2 = parse_var_field_assignment >] ->
 				let meta = check_optional opt name in
 				name,punion p1 p2,FVar(t,e),(al @ [AFinal,p1]),meta
 			| [< al2 = plist parse_cf_rights; f = parse_function_field doc meta (al @ ((AFinal,p1) :: al2)) >] ->
@@ -1476,6 +1478,7 @@ and parse_field e1 p s =
 		| [< '(Kwd New,p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,"new") , punion (pos e1) p2) s
 		| [< '(Kwd k,p2) when !parsing_macro_cond && p.pmax = p2.pmin; s >] -> expr_next (EField (e1,s_keyword k) , punion (pos e1) p2) s
 		| [< '(Const (Ident f),p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,f) , punion (pos e1) p2) s
+		| [< '(Const (String (f,_)),p2) when p.pmax = p2.pmin; s >] -> expr_next (EField (e1,f) , punion (pos e1) p2) s
 		| [< '(Dollar v,p2); s >] -> expr_next (EField (e1,"$"^v) , punion (pos e1) p2) s
 		| [< >] ->
 			(* turn an integer followed by a dot into a float *)

src/typing/typer.ml

@@ -1623,11 +1623,13 @@ and type_object_decl ctx fl with_type p =
 	| _ ->
 		ODKPlain
 	) in
+	let check_field_name name quotes p =
+		if quotes = NoQuotes && starts_with name '$' then error "Field names starting with a dollar are not allowed" p;
+	in
 	let type_fields field_map =
 		let fields = ref PMap.empty in
 		let extra_fields = ref [] in
 		let fl = List.map (fun ((n,pn,qs),e) ->
-			let is_valid = Lexer.is_valid_identifier n in
 			if PMap.mem n !fields then error ("Duplicate field in object declaration : " ^ n) p;
 			let is_final = ref false in
 			let e = try
@@ -1644,16 +1646,13 @@ and type_object_decl ctx fl with_type p =
 				let e = if is_null t && not (is_null e.etype) then mk (TCast(e,None)) (ctx.t.tnull e.etype) e.epos else e in
 				(try type_eq EqStrict e.etype t; e with Unify_error _ -> mk (TCast (e,None)) t e.epos)
 			with Not_found ->
-				if is_valid then
-					extra_fields := n :: !extra_fields;
+				extra_fields := n :: !extra_fields;
 				type_expr ctx e WithType.value
 			in
-			if is_valid then begin
-				if starts_with n '$' then error "Field names starting with a dollar are not allowed" p;
-				let cf = mk_field n e.etype (punion pn e.epos) pn in
-				if !is_final then add_class_field_flag cf CfFinal;
-				fields := PMap.add n cf !fields;
-			end;
+			check_field_name n qs p;
+			let cf = mk_field n e.etype (punion pn e.epos) pn in
+			if !is_final then add_class_field_flag cf CfFinal;
+			fields := PMap.add n cf !fields;
 			((n,pn,qs),e)
 		) fl in
 		let t = mk_anon ~fields:!fields (ref Const) in
@@ -1670,16 +1669,12 @@ and type_object_decl ctx fl with_type p =
 	in
 	let type_plain_fields () =
 		let rec loop (l,acc) ((f,pf,qs),e) =
-			let is_valid = Lexer.is_valid_identifier f in
 			if PMap.mem f acc then error ("Duplicate field in object declaration : " ^ f) p;
 			let e = type_expr ctx e (WithType.named_structure_field f) in
 			(match follow e.etype with TAbstract({a_path=[],"Void"},_) -> error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
 			let cf = mk_field f e.etype (punion pf e.epos) pf in
 			if ctx.in_display && DisplayPosition.display_position#enclosed_in pf then DisplayEmitter.display_field ctx Unknown CFSMember cf pf;
-			(((f,pf,qs),e) :: l, if is_valid then begin
-				if starts_with f '$' then error "Field names starting with a dollar are not allowed" p;
-				PMap.add f cf acc
-			end else acc)
+			(((f,pf,qs),e) :: l, (check_field_name f qs p; PMap.add f cf acc))
 		in
 		let fields , types = List.fold_left loop ([],PMap.empty) fl in
 		let x = ref Const in
@@ -2481,8 +2476,8 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 	| EField ((EConst (String(s,_)),ps),"code") ->
 		if UTF8.length s <> 1 then error "String must be a single UTF8 char" ps;
 		mk (TConst (TInt (Int32.of_int (UCharExt.code (UTF8.get s 0))))) ctx.t.tint p
-	| EField(_,n) when starts_with n '$' ->
-		error "Field names starting with $ are not allowed" p
+(* 	| EField(_,n) when starts_with n '$' -> TODO: this should be only allowed for quoted fields
+		error "Field names starting with $ are not allowed" p *)
 	| EConst (Ident s) ->
 		if s = "super" && with_type <> WithType.NoValue && not ctx.in_display then error "Cannot use super as value" p;
 		let e = maybe_type_against_enum ctx (fun () -> type_ident ctx s p mode) with_type false p in

tests/unit/src/unit/issues/Issue3547.hx

@@ -3,6 +3,7 @@ package unit.issues;
 private typedef Option = {
 	?foo: Int,
 	?bar: Int,
+	"x-bar": Int,
 }
 
 class Issue3547 extends Test {

tests/unit/src/unit/issues/Issue7722.hx

@@ -0,0 +1,35 @@
+package unit.issues;
+
+private typedef Schema = {
+	final "$ref":String;
+	var ?"enum":Int;
+	var "default":{"$id":Int, "class":String};
+	var "aria-details":String;
+}
+
+class Issue7722 extends unit.Test {
+	function test() {
+		var a:Schema = {
+			"$ref": "hi",
+			"enum": 42,
+			"default": {"$id": 10, "class": "bye"},
+			"aria-details": "yep",
+		};
+		var b = {
+			"$ref": "hi",
+			"enum": 42,
+			"default": {"$id": 10, "class": "bye"},
+			"aria-details": "yep",
+		};
+		eq("hi", a."$ref");
+		eq(42, a."enum");
+		eq(10, a."default"."$id");
+		eq("bye", a."default"."class");
+		eq("yep", a."aria-details");
+		eq("hi", b."$ref");
+		eq(42, b."enum");
+		eq(10, b."default"."$id");
+		eq("bye", b."default"."class");
+		eq("yep", b."aria-details");
+	}
+}