Support semver semantics in #if version() (closes #8297)

src/syntax/parserEntry.ml

@@ -19,6 +19,7 @@
 open Globals
 open Ast
 open Parser
+open Semver
 open Grammar
 open DisplayPosition
 
@@ -28,25 +29,12 @@ type small_type =
 	| TBool of bool
 	| TFloat of float
 	| TString of string
-	| TVersion of int list
+	| TVersion of (version * version * version) * (version list option)
 
 let is_true = function
 	| TBool false | TNull | TFloat 0. | TString "" -> false
 	| _ -> true
 
-let make_version s =
-	List.map (fun s -> try int_of_string s with _ -> 0) (ExtString.String.nsplit s ".")
-
-let rec compare_version a b =
-	match a, b with
-	| [], [] -> 0
-	| 0 :: l1, [] -> compare_version l1 []
-	| [], 0 :: l2 -> compare_version [] l2
-	| a :: l1 , b :: l2 when a = b -> compare_version l1 l2
-	| a :: _, b :: _ -> compare a b
-	| (_ :: _, []) -> 1
-	| ([] , _ :: _) -> -1
-
 let cmp v1 v2 =
 	match v1, v2 with
 	| TNull, TNull -> 0
@@ -55,9 +43,9 @@ let cmp v1 v2 =
 	| TBool a, TBool b -> compare a b
 	| TString a, TFloat b -> compare (float_of_string a) b
 	| TFloat a, TString b -> compare a (float_of_string b)
-	| TVersion a, TVersion b -> compare_version a b
-	| TString a, TVersion b -> compare_version (make_version a) b
-	| TVersion a, TString b -> compare_version a (make_version b)
+	| TString a, TVersion (release,pre) -> compare_version (parse_version a) (release,pre)
+	| TVersion (release,pre), TString b -> compare_version (release,pre) (parse_version b)
+	| TVersion (release1,pre1), TVersion (release2,pre2) -> compare_version (release1,pre1) (release2,pre2)
 	| _ -> raise Exit (* always false *)
 
 let rec eval ctx (e,p) =
@@ -67,7 +55,9 @@ let rec eval ctx (e,p) =
 	| EConst (String s) -> TString s
 	| EConst (Int i) -> TFloat (float_of_string i)
 	| EConst (Float f) -> TFloat (float_of_string f)
-	| ECall ((EConst (Ident "version"),_),[(EConst (String s),_)]) -> TVersion (make_version s)
+	| ECall ((EConst (Ident "version"),_),[(EConst (String s), p)]) ->
+		(try match parse_version s with release,pre -> TVersion (release,pre)
+		with Invalid_argument msg -> error (Custom msg) p)
 	| EBinop (OpBoolAnd, e1, e2) -> TBool (is_true (eval ctx e1) && is_true (eval ctx e2))
 	| EBinop (OpBoolOr, e1, e2) -> TBool (is_true (eval ctx e1) || is_true(eval ctx e2))
 	| EUnop (Not, _, e) -> TBool (not (is_true (eval ctx e)))
@@ -76,7 +66,8 @@ let rec eval ctx (e,p) =
 		let v1 = eval ctx e1 in
 		let v2 = eval ctx e2 in
 		let compare op =
-			TBool (try op (cmp v1 v2) 0 with _ -> false)
+			try TBool (try op (cmp v1 v2) 0 with _ -> false)
+			with Invalid_argument msg -> error (Custom msg) p
 		in
 		(match op with
 		| OpEq -> compare (=)

src/syntax/semver.ml

@@ -0,0 +1,122 @@
+(*
+	The Haxe Compiler
+	Copyright (C) 2005-2019  Haxe Foundation
+
+	This program is free software; you can redistribute it and/or
+	modify it under the terms of the GNU General Public License
+	as published by the Free Software Foundation; either version 2
+	of the License, or (at your option) any later version.
+
+	This program is distributed in the hope that it will be useful,
+	but WITHOUT ANY WARRANTY; without even the implied warranty of
+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	GNU General Public License for more details.
+
+	You should have received a copy of the GNU General Public License
+	along with this program; if not, write to the Free Software
+	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(**
+	A single version within semver string (e.g major or minor or patch)
+*)
+type version =
+	| SVNone			(* Not specified by user. E.g. no patch in `version("4.0")` *)
+	| SVNum of int
+	| SVStr of string	(* `alpha`, `pre`, `rc` etc. *)
+
+let s_version = function
+	| SVNone -> "SVNone"
+	| SVNum n -> "SVNum " ^ (string_of_int n)
+	| SVStr s -> "SVStr " ^ s
+
+let to_string ((major,minor,patch),pre) =
+	let str v =
+		match v with
+			| SVNone -> "?"
+			| SVNum n -> string_of_int n
+			| SVStr s -> s
+	in
+	(String.concat "." (List.map str [major;minor;patch]))
+	^ match pre with
+		| None -> ""
+		| Some pre -> "-" ^ (String.concat "." (List.map str pre))
+
+
+(**
+	Parse SemVer string
+*)
+let parse_version s =
+	let error () = raise (Invalid_argument "Invalid version string. Should follow SemVer.") in
+	let parse dotted_str =
+		List.map
+			(fun s ->
+				try SVNum (int_of_string s)
+				with _ -> SVStr s
+			)
+			(String.split_on_char '.' dotted_str)
+	in
+	let parse_release dotted_str =
+		match parse dotted_str with
+			| [SVNum _ as major; SVNum _ as minor; SVNum _ as patch] -> (major, minor, patch)
+			| [SVNum _ as major; SVNum _ as minor] -> (major, minor, SVNone)
+			| [SVNum _ as major] -> (major, SVNone, SVNone)
+			| _ -> error()
+	in
+	let result =
+	match String.index_opt s '-' with
+		(* 1.2.3 *)
+		| None -> (parse_release s), None
+		(* 1.2.3- *)
+		| Some index when index + 1 = String.length s -> error()
+		(* 1.2.3-alpha.1+23 *)
+		| Some index ->
+			let release = parse_release (String.sub s 0 index)
+			and pre =
+				let pre_str = String.sub s (index + 1) (String.length s - (index + 1)) in
+				(* remove build meta *)
+				let pre_str =
+					try String.sub pre_str 0 (String.index pre_str '+')
+					with Not_found -> pre_str
+				in
+				parse pre_str
+			in
+			release, Some pre
+		in
+		print_endline (to_string result);
+		result
+
+(**
+	@see https://semver.org/#spec-item-11
+*)
+let compare_version a b =
+	let compare_v v1 v2 =
+		match v1,v2 with
+			| SVNone, _ -> 0
+			| _, SVNone -> 0
+			| SVNum n1, SVNum n2 -> compare n1 n2
+			| SVStr s1, SVStr s2 -> compare s1 s2
+			| SVStr _, SVNum _ -> 1
+			| SVNum _, SVStr _ -> -1
+	in
+	let rec compare_lists version_list1 version_list2 =
+		match version_list1, version_list2 with
+			| [], [] -> 0
+			| [], _ -> -1
+			| _, [] -> 1
+			| v1 :: rest1, v2 :: rest2 ->
+				let diff = compare_v v1 v2 in
+				if diff <> 0 then diff
+				else compare_lists rest1 rest2
+	in
+	match a, b with
+		| ((major1,minor1,patch1), pre1), ((major2,minor2,patch2), pre2) ->
+			let diff = compare_lists [major1;minor1;patch1] [major2;minor2;patch2] in
+			if diff <> 0 then
+				diff
+			else
+				match pre1, pre2 with
+				| None, None -> 0
+				| None, _ -> 1
+				| _, None -> -1
+				| Some pre1, Some pre2 -> compare_lists pre1 pre2

tests/misc/projects/_semver/InvalidVersion.hx

@@ -0,0 +1,5 @@
+class InvalidVersion {
+	static function main() {
+		#if (version("wat")) #end
+	}
+}

tests/misc/projects/_semver/Main.hx

@@ -0,0 +1,53 @@
+class Main {
+	public static function main():Void {
+		// 1.0.0-alpha < 1.0.0-alpha.1 < 1.0.0-alpha.beta < 1.0.0-beta < 1.0.0-beta.2 < 1.0.0-beta.11 < 1.0.0-rc.1 < 1.0.0
+
+		#if (version("1.0.0-alpha") < version("1.0.0-alpha.1"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-alpha.1") < version("1.0.0-alpha.beta"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-alpha.beta") < version("1.0.0-beta"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-beta") < version("1.0.0-beta.2"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-beta.2") < version("1.0.0-beta.11"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-beta.11") < version("1.0.0-rc.1"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-rc.1") < version("1.0.0"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-rc.1") < version("1.0.1"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-rc.1") < version("1.1.0"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-rc.1") < version("2.0.0"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0-rc.1") == version("1.0.0-rc.1"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.0") == version("1.0"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.1") >= version("1"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.0.1") > version("1"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("1.1.0") > version("1"))
+		#else #error "Failed semver comparison" #end
+
+		#if (version("2.0.0") > version("1.0"))
+		#else #error "Failed semver comparison" #end
+	}
+}

tests/misc/projects/_semver/compile-fail.hxml

@@ -0,0 +1 @@
+-main InvalidVersion

tests/misc/projects/_semver/compile-fail.hxml.stderr

@@ -0,0 +1 @@
+InvalidVersion.hx:3: characters 16-21 : Invalid version string. Should follow SemVer.

tests/misc/projects/_semver/compile.hxml

@@ -0,0 +1 @@
+-main Main