diff mbox

[Ada] Crash on illegal expression in context with predicate

Message ID 20160622100030.GA26642@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet June 22, 2016, 10 a.m. UTC 
This patch fixes a compiler abort on a return statement for a function whose
type is a derived type with a dynamic predicate, when the return expression
has the parent type.

Compiling gpr2-attribute.adb must yield:

   gpr2-attribute.adb:8:14:
         expected type "Qualified_Name" defined at gpr2-attribute.ads:12
   gpr2-attribute.adb:8:14: found type "Standard.String"

---
package GPR2 is

   subtype Name_Type is String
     with Dynamic_Predicate => Name_Type'Length > 0;

end GPR2;
--
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package GPR2.Attribute is

   type Qualified_Name (<>) is private;

   function Create (Name : Name_Type) return Qualified_Name;

private

   type Qualified_Name is new Name_Type;

end GPR2.Attribute;
--

package body GPR2.Attribute is

   function Create (Name : Name_Type) return Qualified_Name is
   begin
      --  OK: return Qualified_Name (Name);
      --  with below code (missing conversion) GNAT crashes
      return Name;
   end Create;

end GPR2.Attribute;

Tested on x86_64-pc-linux-gnu, committed on trunk

2016-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Is_Predicate_Static): An inherited predicate
	can be static only if it applies to a scalar type.
diff mbox

Patch

Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 237680)
+++ sem_ch13.adb	(working copy)
@@ -8552,8 +8552,7 @@ 
                         Expression => Expr))));
 
             --  If declaration has not been analyzed yet, Insert declaration
-            --  before freeze node.
-            --  Insert body after freeze node.
+            --  before freeze node.  Insert body itself after freeze node.
 
             if not Analyzed (FDecl) then
                Insert_Before_And_Analyze (N, FDecl);
@@ -11644,9 +11643,11 @@ 
       --  to specify a static predicate for a subtype which is inheriting a
       --  dynamic predicate, so the static predicate validation here ignores
       --  the inherited predicate even if it is dynamic.
+      --  In all cases, a static predicate can only apply to a scalar type.
 
       elsif Nkind (Expr) = N_Function_Call
         and then Is_Predicate_Function (Entity (Name (Expr)))
+        and then Is_Scalar_Type (Etype (First_Entity (Entity (Name (Expr)))))
       then
          return True;