Commit 277c9abe by Arnaud Charlet

sem_ch3.adb (Analyze_Full_Type_Declaration): move test that a type has a…

sem_ch3.adb (Analyze_Full_Type_Declaration): move test that a type has a discriminant specification so that it does not...

        * sem_ch3.adb (Analyze_Full_Type_Declaration): move test that a type
        has a discriminant specification so that it does not include the case
        of derived types
        (Derived_Type_Declaration): move here the test that a derived type has a
        discriminant specification

From-SVN: r177104
parent a5fe697b
...@@ -2268,7 +2268,7 @@ package body Sem_Ch3 is ...@@ -2268,7 +2268,7 @@ package body Sem_Ch3 is
Check_Formal_Restriction Check_Formal_Restriction
("discriminant type is not allowed", ("discriminant type is not allowed",
Defining_Identifier Defining_Identifier
(First (Discriminant_Specifications (N)))); (First (Discriminant_Specifications (N))));
end if; end if;
when others => when others =>
...@@ -2276,7 +2276,7 @@ package body Sem_Ch3 is ...@@ -2276,7 +2276,7 @@ package body Sem_Ch3 is
Error_Msg_N Error_Msg_N
("elementary or array type cannot have discriminants", ("elementary or array type cannot have discriminants",
Defining_Identifier Defining_Identifier
(First (Discriminant_Specifications (N)))); (First (Discriminant_Specifications (N))));
end if; end if;
end case; end case;
...@@ -3026,20 +3026,19 @@ package body Sem_Ch3 is ...@@ -3026,20 +3026,19 @@ package body Sem_Ch3 is
-- mark and shall not be unconstrained. (The only exception to this -- mark and shall not be unconstrained. (The only exception to this
-- is the admission of declarations of constants of type String.) -- is the admission of declarations of constants of type String.)
if not Nkind_In (Object_Definition (N), if not Nkind_In (Object_Definition (N), N_Identifier,
N_Identifier, N_Expanded_Name)
N_Expanded_Name)
then then
Check_Formal_Restriction Check_Formal_Restriction
("subtype mark expected", Object_Definition (N)); ("subtype mark expected", Object_Definition (N));
elsif Is_Array_Type (T) elsif Is_Array_Type (T)
and then not Is_Constrained (T) and then not Is_Constrained (T)
and then T /= Standard_String and then T /= Standard_String
then then
Check_Formal_Restriction ("subtype mark of constrained type expected", Check_Formal_Restriction
Object_Definition (N)); ("subtype mark of constrained type expected",
else Object_Definition (N));
null;
end if; end if;
-- There are no aliased objects in SPARK or ALFA -- There are no aliased objects in SPARK or ALFA
...@@ -3062,8 +3061,8 @@ package body Sem_Ch3 is ...@@ -3062,8 +3061,8 @@ package body Sem_Ch3 is
(Is_CPP_Class (Root_Type (Etype (Act_T))) (Is_CPP_Class (Root_Type (Etype (Act_T)))
or else or else
(Present (Full_View (Root_Type (Etype (Act_T)))) (Present (Full_View (Root_Type (Etype (Act_T))))
and then and then
Is_CPP_Class (Full_View (Root_Type (Etype (Act_T)))))) Is_CPP_Class (Full_View (Root_Type (Etype (Act_T))))))
then then
Error_Msg_N Error_Msg_N
("predefined assignment not available for 'C'P'P tagged types", ("predefined assignment not available for 'C'P'P tagged types",
...@@ -3991,8 +3990,7 @@ package body Sem_Ch3 is ...@@ -3991,8 +3990,7 @@ package body Sem_Ch3 is
Set_Has_Delayed_Freeze (Id); Set_Has_Delayed_Freeze (Id);
end if; end if;
-- Subtype of Boolean is not allowed to have a constraint in SPARK or -- Subtype of Boolean cannot have a constraint in SPARK or ALFA
-- ALFA.
if Is_Boolean_Type (T) if Is_Boolean_Type (T)
and then Nkind (Subtype_Indication (N)) = N_Subtype_Indication and then Nkind (Subtype_Indication (N)) = N_Subtype_Indication
...@@ -14069,7 +14067,7 @@ package body Sem_Ch3 is ...@@ -14069,7 +14067,7 @@ package body Sem_Ch3 is
end if; end if;
-- Only composite types other than array types are allowed to have -- Only composite types other than array types are allowed to have
-- discriminants. In SPARK in ALFA, no types are allowed to have -- discriminants. In SPARK and in ALFA, no types are allowed to have
-- discriminants. -- discriminants.
if Present (Discriminant_Specifications (N)) then if Present (Discriminant_Specifications (N)) then
...@@ -14111,10 +14109,10 @@ package body Sem_Ch3 is ...@@ -14111,10 +14109,10 @@ package body Sem_Ch3 is
or else Has_Private_Component (Parent_Type) or else Has_Private_Component (Parent_Type)
then then
-- The ancestor type of a formal type can be incomplete, in which -- The ancestor type of a formal type can be incomplete, in which
-- case only the operations of the partial view are available in -- case only the operations of the partial view are available in the
-- the generic. Subsequent checks may be required when the full -- generic. Subsequent checks may be required when the full view is
-- view is analyzed, to verify that derivation from a tagged type -- analyzed to verify that a derivation from a tagged type has an
-- has an extension. -- extension.
if Nkind (Original_Node (N)) = N_Formal_Type_Declaration then if Nkind (Original_Node (N)) = N_Formal_Type_Declaration then
null; null;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment