{"id":810952,"url":"http://patchwork.ozlabs.org/api/1.2/patches/810952/?format=json","web_url":"http://patchwork.ozlabs.org/project/gcc/patch/20170907100934.GA69580@adacore.com/","project":{"id":17,"url":"http://patchwork.ozlabs.org/api/1.2/projects/17/?format=json","name":"GNU Compiler Collection","link_name":"gcc","list_id":"gcc-patches.gcc.gnu.org","list_email":"gcc-patches@gcc.gnu.org","web_url":null,"scm_url":null,"webscm_url":null,"list_archive_url":"","list_archive_url_format":"","commit_url_format":""},"msgid":"<20170907100934.GA69580@adacore.com>","list_archive_url":null,"date":"2017-09-07T10:09:34","name":"[Ada] Proper handling of dimension information in a type conversion.","commit_ref":null,"pull_url":null,"state":"new","archived":false,"hash":"bdd788f03555a8c5f90bbdf64915342f8bfb9a8c","submitter":{"id":4418,"url":"http://patchwork.ozlabs.org/api/1.2/people/4418/?format=json","name":"Arnaud Charlet","email":"charlet@adacore.com"},"delegate":null,"mbox":"http://patchwork.ozlabs.org/project/gcc/patch/20170907100934.GA69580@adacore.com/mbox/","series":[{"id":1974,"url":"http://patchwork.ozlabs.org/api/1.2/series/1974/?format=json","web_url":"http://patchwork.ozlabs.org/project/gcc/list/?series=1974","date":"2017-09-07T10:09:34","name":"[Ada] Proper handling of dimension information in a type conversion.","version":1,"mbox":"http://patchwork.ozlabs.org/series/1974/mbox/"}],"comments":"http://patchwork.ozlabs.org/api/patches/810952/comments/","check":"pending","checks":"http://patchwork.ozlabs.org/api/patches/810952/checks/","tags":{},"related":[],"headers":{"Return-Path":"","X-Original-To":"incoming@patchwork.ozlabs.org","Delivered-To":["patchwork-incoming@bilbo.ozlabs.org","mailing list gcc-patches@gcc.gnu.org"],"Authentication-Results":["ozlabs.org;\n\tspf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org\n\t(client-ip=209.132.180.131; helo=sourceware.org;\n\tenvelope-from=gcc-patches-return-461677-incoming=patchwork.ozlabs.org@gcc.gnu.org;\n\treceiver=)","ozlabs.org; dkim=pass (1024-bit key;\n\tunprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org\n\theader.b=\"l1IkEe8a\"; dkim-atps=neutral","sourceware.org; auth=none"],"Received":["from sourceware.org (server1.sourceware.org [209.132.180.131])\n\t(using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256\n\tbits)) (No client certificate requested)\n\tby ozlabs.org (Postfix) with ESMTPS id 3xnx5h4ZhJz9s8J\n\tfor ;\n\tThu, 7 Sep 2017 20:10:00 +1000 (AEST)","(qmail 129534 invoked by alias); 7 Sep 2017 10:09:38 -0000","(qmail 129349 invoked by uid 89); 7 Sep 2017 10:09:37 -0000","from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by\n\tsourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP;\n\tThu, 07 Sep 2017 10:09:35 +0000","from localhost (localhost.localdomain [127.0.0.1])\tby\n\tfiltered-rock.gnat.com (Postfix) with ESMTP id 24F7E561B2;\n\tThu, 7 Sep 2017 06:09:34 -0400 (EDT)","from rock.gnat.com ([127.0.0.1])\tby localhost (rock.gnat.com\n\t[127.0.0.1]) (amavisd-new, port 10024)\twith LMTP id\n\toDQcL8WeSogw; Thu, 7 Sep 2017 06:09:34 -0400 (EDT)","from tron.gnat.com (tron.gnat.com\n\t[IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294])\tby rock.gnat.com\n\t(Postfix) with ESMTP id 132DE561AC;\n\tThu, 7 Sep 2017 06:09:34 -0400 (EDT)","by tron.gnat.com (Postfix, from userid 4192)\tid 107384FC;\n\tThu, 7 Sep 2017 06:09:34 -0400 (EDT)"],"DomainKey-Signature":"a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id\n\t:list-unsubscribe:list-archive:list-post:list-help:sender:date\n\t:from:to:cc:subject:message-id:mime-version:content-type; q=dns;\n\ts=default; b=fUjGkq1oOAwwWm27fnmp60ZZKoJc/ekaXWNfxp+JX0Oip/AfY4\n\tGXjzNWGocmlSFfTm6VnMBKMqBhiIfiVjjG0kdpTP0xCebsHwHjtqgs8I/y+4W72y\n\td4QU0gSz+FtODoGfF8XZFAEmhDkzYjRMPMMPVdHyanpsm4nUedZDM2++8=","DKIM-Signature":"v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id\n\t:list-unsubscribe:list-archive:list-post:list-help:sender:date\n\t:from:to:cc:subject:message-id:mime-version:content-type; s=\n\tdefault; bh=MiswakWA61Fs6v/Uu8VB6ltzBa0=; b=l1IkEe8a3A3iiwTn5+0+\n\tXd0eP4VtAkUQRLLJNyoAqPrS8y2V+0xEiW55K0FFLnIYwWDBg3xENWaOKVyQQyyG\n\t9oH7j8Wfk73jIKaYjJVHyJxFm0NdjSGBx5m5SSsMLjKe3yO0nAQEGe22czMYFdkM\n\tc31OWNodOaajf/6MIZ3HuUk=","Mailing-List":"contact gcc-patches-help@gcc.gnu.org; run by ezmlm","Precedence":"bulk","List-Id":"","List-Unsubscribe":"","List-Archive":"","List-Post":"","List-Help":"","Sender":"gcc-patches-owner@gcc.gnu.org","X-Virus-Found":"No","X-Spam-SWARE-Status":"No, score=-11.1 required=5.0 tests=BAYES_00, GIT_PATCH_2,\n\tGIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE,\n\tSPF_PASS autolearn=ham version=3.3.2 spammy=sem, Degree, 2806","X-HELO":"rock.gnat.com","Date":"Thu, 7 Sep 2017 06:09:34 -0400","From":"Arnaud Charlet ","To":"gcc-patches@gcc.gnu.org","Cc":"Ed Schonberg ","Subject":"[Ada] Proper handling of dimension information in a type conversion.","Message-ID":"<20170907100934.GA69580@adacore.com>","MIME-Version":"1.0","Content-Type":"multipart/mixed; boundary=\"qMm9M+Fa2AknHoGS\"","Content-Disposition":"inline","User-Agent":"Mutt/1.5.23 (2014-03-12)"},"content":"This patch implements the proper handling of dimension information on type\nconversions. Given a conversion T (Expr), where the expression has type TE,\nthe following cases arise:\n\na) If TE has dimension information, the dimensions of the conversion are those\nof TE.\n\nb) If TE has no dimension information, dimensions of conversion are those of T.\n\nc) If T and TE belong to different dimension systems, they must have identical\ndimensions, unless T is the root type of its system, in which case dimensions\nare those of TE, and the conversion can be seen as a \"view conversion\" that\npreserves the dimensions of its argument.\n\nd) If T is a non-dimensioned type, such a Standard.Float, the conversion has no\ndimension information.\n\nThe following must compile quietly:\n\n gcc -c main.adb\n gcc -c -gnatd.F main.adb\n\n---\nwith Units; use Units;\n\nprocedure main with SPARK_Mode is\n\n subtype Servo_Angle_Type is\n Units.Angle_Type range -40.0 * Degree .. 40.0 * Degree;\n\n function Sat_Servo_Angle is new Saturated_Cast (Servo_Angle_Type);\nbegin\n null;\nend main;\n---\nwith Ada.Numerics;\n\npackage units with SPARK_Mode is\n\n type Unit_Type is new Float with \n Dimension_System =>\n ((Unit_Name => Meter, Unit_Symbol => 'm', Dim_Symbol => 'L'),\n (Unit_Name => Kilogram, Unit_Symbol => \"kg\", Dim_Symbol => 'M'),\n (Unit_Name => Second, Unit_Symbol => 's', Dim_Symbol => 'T'),\n (Unit_Name => Ampere, Unit_Symbol => 'A', Dim_Symbol => 'I'),\n (Unit_Name => Kelvin, Unit_Symbol => 'K', Dim_Symbol => \"Theta\"),\n (Unit_Name => Radian, Unit_Symbol => \"Rad\", Dim_Symbol => \"A\")),\n Default_Value => 0.0; -- required for matrices\n\n subtype Angle_Type is Unit_Type with\n Dimension => (Symbol => \"Rad\", Radian => 1, others => 0);\n\n Degree : constant Angle_Type := Angle_Type (2.0 * Ada.Numerics.Pi / 360.0);\n\n generic\n type T is digits <>;\n function Saturated_Cast (val : Float) return T with Inline;\n -- convert a float into a more specific float type, and trim\n -- to the value range\nend units;\n---\npackage body units with SPARK_Mode is\n function Saturated_Cast (val : Float) return T is\n ret : T;\n begin\n if val >= Float (T'Last) then\n ret := T'Last;\n elsif val <= Float (T'First) then\n ret := T'First;\n else\n ret := T (val);\n end if;\n return ret;\n end Saturated_Cast;\nend units;\n\nTested on x86_64-pc-linux-gnu, committed on trunk\n\n2017-09-07 Ed Schonberg \n\n\t* sem_dim.adb (Analyze_Dimension_Type_Conversion): New procedure\n\tto handle properly various cases of type conversions where the\n\ttarget type and/or the expression carry dimension information.\n\t(Dimension_System_Root); If a subtype carries dimension\n\tinformation, obtain the source parent type that carries the\n\tDimension aspect.","diff":"Index: sem_dim.adb\n===================================================================\n--- sem_dim.adb\t(revision 251836)\n+++ sem_dim.adb\t(working copy)\n@@ -35,6 +35,7 @@\n with Opt; use Opt;\n with Rtsfind; use Rtsfind;\n with Sem; use Sem;\n+with Sem_Aux; use Sem_Aux;\n with Sem_Eval; use Sem_Eval;\n with Sem_Res; use Sem_Res;\n with Sem_Util; use Sem_Util;\n@@ -280,6 +281,14 @@\n -- both the identifier and the parent type of N are not dimensionless,\n -- return an error.\n \n+ procedure Analyze_Dimension_Type_Conversion (N : Node_Id);\n+ -- Type conversions handle conversions between literals and dimensioned\n+ -- types, from dimensioned types to their base type, and between different\n+ -- dimensioned systems. Dimensions of the conversion are obtained either\n+ -- from those of the expression, or from the target type, and dimensional\n+ -- consistency must be checked when converting between values belonging\n+ -- to different dimensioned systems.\n+\n procedure Analyze_Dimension_Unary_Op (N : Node_Id);\n -- Subroutine of Analyze_Dimension for unary operators. For Plus, Minus and\n -- Abs operators, propagate the dimensions from the operand to N.\n@@ -301,6 +310,11 @@\n -- dimension\" if Description_Needed. if N is dimensionless, return \"'[']\",\n -- or \"is dimensionless\" if Description_Needed.\n \n+ function Dimension_System_Root (T : Entity_Id) return Entity_Id;\n+ -- Given a type that has dimension information, return the type that is the\n+ -- root of its dimension system, e.g. Mks_Type. If T is not a dimensioned\n+ -- type, i.e. a standard numeric type, return Empty.\n+\n procedure Dim_Warning_For_Numeric_Literal (N : Node_Id; Typ : Entity_Id);\n -- Issue a warning on the given numeric literal N to indicate that the\n -- compiler made the assumption that the literal is not dimensionless\n@@ -1191,13 +1205,7 @@\n Analyze_Dimension_Subtype_Declaration (N);\n \n when N_Type_Conversion =>\n- if In_Instance\n- and then Exists (Dimensions_Of (Expression (N)))\n- then\n- Set_Dimensions (N, Dimensions_Of (Expression (N)));\n- else\n- Analyze_Dimension_Has_Etype (N);\n- end if;\n+ Analyze_Dimension_Type_Conversion (N);\n \n when N_Unary_Op =>\n Analyze_Dimension_Unary_Op (N);\n@@ -1384,26 +1392,6 @@\n return Dimensions_Of (Etype (N));\n end if;\n \n- -- A type conversion may have been inserted to rewrite other\n- -- expressions, e.g. function returns. Dimensions are those of\n- -- the target type, unless this is a conversion in an instance,\n- -- in which case the proper dimensions are those of the operand,\n-\n- elsif Nkind (N) = N_Type_Conversion then\n- if In_Instance\n- and then Is_Generic_Actual_Type (Etype (Expression (N)))\n- then\n- return Dimensions_Of (Etype (Expression (N)));\n-\n- elsif In_Instance\n- and then Exists (Dimensions_Of (Expression (N)))\n- then\n- return Dimensions_Of (Expression (N));\n-\n- else\n- return Dimensions_Of (Etype (N));\n- end if;\n-\n -- Otherwise return the default dimensions\n \n else\n@@ -2339,6 +2327,56 @@\n end if;\n end Analyze_Dimension_Subtype_Declaration;\n \n+ ---------------------------------------\n+ -- Analyze_Dimension_Type_Conversion --\n+ ---------------------------------------\n+\n+ procedure Analyze_Dimension_Type_Conversion (N : Node_Id) is\n+ Expr_Root : constant Entity_Id :=\n+ Dimension_System_Root (Etype (Expression (N)));\n+ Target_Root : constant Entity_Id :=\n+ Dimension_System_Root (Etype (N));\n+\n+ begin\n+ -- If the expression has dimensions and the target type has dimensions,\n+ -- the conversion has the dimensions of the expression. Consistency is\n+ -- checked below. Converting to a non-dimensioned type such as Float\n+ -- ignores the dimensions of the expression.\n+\n+ if Exists (Dimensions_Of (Expression (N)))\n+ and then Present (Target_Root)\n+ then\n+ Set_Dimensions (N, Dimensions_Of (Expression (N)));\n+\n+ -- Otherwise the dimensions are those of the target type.\n+\n+ else\n+ Analyze_Dimension_Has_Etype (N);\n+ end if;\n+\n+ -- A conversion between types in different dimension systems (e.g. MKS\n+ -- and British units) must respect the dimensions of expression and\n+ -- type, It is up to the user to provide proper conversion factors.\n+\n+ -- Upward conversions to root type of a dimensioned system are legal,\n+ -- and correspond to \"view conversions\", i.e. preserve the dimensions\n+ -- of the expression; otherwise conversion must be between types with\n+ -- then same dimensions. Conversions to a non-dimensioned type such as\n+ -- Float lose the dimensions of the expression.\n+\n+ if Present (Expr_Root)\n+ and then Present (Target_Root)\n+ and then Etype (N) /= Target_Root\n+ and then Dimensions_Of (Expression (N)) /= Dimensions_Of (Etype (N))\n+ then\n+ Error_Msg_N (\"dimensions mismatch in conversion\", N);\n+ Error_Msg_N\n+ (\"\\expression \" & Dimensions_Msg_Of (Expression (N), True), N);\n+ Error_Msg_N\n+ (\"\\target type \" & Dimensions_Msg_Of (Etype (N), True), N);\n+ end if;\n+ end Analyze_Dimension_Type_Conversion;\n+\n --------------------------------\n -- Analyze_Dimension_Unary_Op --\n --------------------------------\n@@ -2665,6 +2703,24 @@\n or else Dimensions_Of (T1) = Dimensions_Of (T2);\n end Dimensions_Match;\n \n+ ---------------------------\n+ -- Dimension_System_Root --\n+ ---------------------------\n+\n+ function Dimension_System_Root (T : Entity_Id) return Entity_Id is\n+ Root : Entity_Id;\n+\n+ begin\n+ Root := Base_Type (T);\n+\n+ if Has_Dimension_System (Root) then\n+ return First_Subtype (Root); -- for example Dim_Mks\n+\n+ else\n+ return Empty;\n+ end if;\n+ end Dimension_System_Root;\n+\n ----------------------------------------\n -- Eval_Op_Expon_For_Dimensioned_Type --\n ----------------------------------------\n","prefixes":["Ada"]}