[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Thu, 19 Jan 2017 11:51:22 +0000 (12:51 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 19 Jan 2017 11:51:22 +0000 (12:51 +0100)
2017-01-19  Ed Schonberg  <schonberg@adacore.com>

* sem_ch4.ads, sem_ch4.adb (Try_Object_Operation): Make subprogram
public, for use elsewhere.
* sem_ch6.adb (Analyze_Procedure_Call): In SPARK_Mode and within
an Inlined_body, recognize a call that uses object notation
and has not been rewritten as a regular call because regular
expansion has not taken place.

2017-01-19  Bob Duff  <duff@adacore.com>

* checks.adb (Apply_Type_Conversion_Checks): Disable small optimization
in case of generic formal discrete types, because it causes crashes in
the compiler when built with assertions on.

From-SVN: r244620

gcc/ada/ChangeLog
gcc/ada/checks.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_ch4.ads
gcc/ada/sem_ch6.adb

index 7f7fcd8b3e4152d322b868a9596742a2dd6b2c51..5eda55755dfbea9c65274cc0abe731a89270e191 100644 (file)
@@ -1,3 +1,18 @@
+2017-01-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch4.ads, sem_ch4.adb (Try_Object_Operation): Make subprogram
+       public, for use elsewhere.
+       * sem_ch6.adb (Analyze_Procedure_Call): In SPARK_Mode and within
+       an Inlined_body, recognize a call that uses object notation
+       and has not been rewritten as a regular call because regular
+       expansion has not taken place.
+
+2017-01-19  Bob Duff  <duff@adacore.com>
+
+       * checks.adb (Apply_Type_Conversion_Checks): Disable small optimization
+       in case of generic formal discrete types, because it causes crashes in
+       the compiler when built with assertions on.
+
 2017-01-19  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * lib-xref-spark_specific.adb, sem_util.adb, sem_util.ads,
index 80b4b4b782f857c9ffec147bee6e05486b2d99c3..1e2231b3615ff12edabb709ff21f3a94e0c61961 100644 (file)
@@ -3391,14 +3391,17 @@ package body Checks is
               and then not Float_To_Int
             then
                --  A small optimization: the attribute 'Pos applied to an
-               --  enumeration type has a known range, even though its type
-               --  is Universal_Integer. So in numeric conversions it is
-               --  usually within range of the target integer type. Use the
-               --  static bounds of the base types to check.
+               --  enumeration type has a known range, even though its type is
+               --  Universal_Integer. So in numeric conversions it is usually
+               --  within range of the target integer type. Use the static
+               --  bounds of the base types to check. Disable this optimization
+               --  in case of a generic formal discrete type, because we don't
+               --  necessarily know the upper bound yet.
 
                if Nkind (Expr) = N_Attribute_Reference
                  and then Attribute_Name (Expr) = Name_Pos
                  and then Is_Enumeration_Type (Etype (Prefix (Expr)))
+                 and then not Is_Generic_Type (Etype (Prefix (Expr)))
                  and then Is_Integer_Type (Target_Type)
                then
                   declare
index db41afb4797f6a9397f38aa4c8e374adc5e9ed44..56da406186704fb5de299981d6eca7fa71dacdb1 100644 (file)
@@ -323,18 +323,6 @@ package body Sem_Ch4 is
    --  subprogram, and the call F (X) interpreted as F.all (X). In this case
    --  the call may be overloaded with both interpretations.
 
-   function Try_Object_Operation
-     (N            : Node_Id;
-      CW_Test_Only : Boolean := False) return Boolean;
-   --  Ada 2005 (AI-252): Support the object.operation notation. If node N
-   --  is a call in this notation, it is transformed into a normal subprogram
-   --  call where the prefix is a parameter, and True is returned. If node
-   --  N is not of this form, it is unchanged, and False is returned. If
-   --  CW_Test_Only is true then N is an N_Selected_Component node which
-   --  is part of a call to an entry or procedure of a tagged concurrent
-   --  type and this routine is invoked to search for class-wide subprograms
-   --  conflicting with the target entity.
-
    procedure wpo (T : Entity_Id);
    pragma Warnings (Off, wpo);
    --  Used for debugging: obtain list of primitive operations even if
index 0a196439fb1fe051df4562e77aec463226c276be..a6105c1d5f137a57a2a2b1c757ded78f57bd7d4b 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -64,4 +64,16 @@ package Sem_Ch4  is
    --  The resolution of the construct requires some semantic information
    --  on the prefix and the indexes.
 
+   function Try_Object_Operation
+     (N            : Node_Id;
+      CW_Test_Only : Boolean := False) return Boolean;
+   --  Ada 2005 (AI-252): Support the object.operation notation. If node N
+   --  is a call in this notation, it is transformed into a normal subprogram
+   --  call where the prefix is a parameter, and True is returned. If node
+   --  N is not of this form, it is unchanged, and False is returned. If
+   --  CW_Test_Only is true then N is an N_Selected_Component node which
+   --  is part of a call to an entry or procedure of a tagged concurrent
+   --  type and this routine is invoked to search for class-wide subprograms
+   --  conflicting with the target entity.
+
 end Sem_Ch4;
index 21f076932dcd286cf581916bac4fc7d89254b1c2..6e4818d6e3eb21e866d4f12144577ff68fb12a2e 100644 (file)
@@ -1711,7 +1711,31 @@ package body Sem_Ch6 is
                                                        E_Function,
                                                        E_Procedure)
       then
-         Analyze_Call_And_Resolve;
+         --  When front-end inlining is enabled, as with SPARK_Mode, a call
+         --  in prefix notation may still be missing its controlling argument,
+         --  so perform the transformation now.
+
+         if SPARK_Mode = On and then In_Inlined_Body then
+            declare
+               Subp : constant Entity_Id := Entity (Selector_Name (P));
+               Typ  : constant Entity_Id := Etype (Prefix (P));
+
+            begin
+               if Is_Tagged_Type (Typ)
+                 and then Present (First_Formal (Subp))
+                 and then Etype (First_Formal (Subp)) = Typ
+                 and then Try_Object_Operation (P)
+               then
+                  return;
+
+               else
+                  Analyze_Call_And_Resolve;
+               end if;
+            end;
+
+         else
+            Analyze_Call_And_Resolve;
+         end if;
 
       elsif Nkind (P) = N_Selected_Component
         and then Ekind (Entity (Selector_Name (P))) = E_Entry_Family