+2015-05-28 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Is_Visible_Component): Component is visible
+ in a derived type if inherited through an ancestor that has a
+ partial view of the original type holding the component, if the
+ full view of that original type is in scope.
+ * sem_util.ads (Get_Body_From_Stub): Works for all kinds of stubs.
+
+2015-05-28 Bob Duff <duff@adacore.com>
+
+ * sem_util.adb (Requires_Transient_Scope): For definite untagged
+ subtypes, we should never have to use the secondary stack. This moves
+ toward that goal. But there are still cases that don't work.
+ Here, we move the check for Is_Definite first, but add a
+ special-purpose check for Has_Discrim_Dep_Array.
+
2015-05-28 Bob Duff <duff@adacore.com>
* sem_util.adb (Requires_Transient_Scope): Avoid returning
N : Node_Id := Empty) return Boolean
is
Original_Comp : Entity_Id := Empty;
- Original_Scope : Entity_Id;
+ Original_Type : Entity_Id;
Type_Scope : Entity_Id;
function Is_Local_Type (Typ : Entity_Id) return Boolean;
return False;
else
- Original_Scope := Scope (Original_Comp);
+ Original_Type := Scope (Original_Comp);
Type_Scope := Scope (Base_Type (Scope (C)));
end if;
-- This test only concerns tagged types
- if not Is_Tagged_Type (Original_Scope) then
+ if not Is_Tagged_Type (Original_Type) then
return True;
-- If it is _Parent or _Tag, there is no visibility issue
elsif Ekind (Original_Comp) = E_Discriminant
and then
- (not Has_Unknown_Discriminants (Original_Scope)
+ (not Has_Unknown_Discriminants (Original_Type)
or else (Present (N)
and then Nkind (N) = N_Selected_Component
and then Nkind (Prefix (N)) = N_Type_Conversion
-- visible. The latter suppression of visibility is needed for cases
-- that are tested in B730006.
- elsif Is_Private_Type (Original_Scope)
+ elsif Is_Private_Type (Original_Type)
or else
(not Is_Private_Descendant (Type_Scope)
and then not In_Open_Scopes (Type_Scope)
- and then Has_Private_Declaration (Original_Scope))
+ and then Has_Private_Declaration (Original_Type))
then
-- If the type derives from an entity in a formal package, there
-- are no additional visible components.
else
return
Is_Child_Unit (Cunit_Entity (Current_Sem_Unit))
- and then In_Open_Scopes (Scope (Original_Scope))
+ and then In_Open_Scopes (Scope (Original_Type))
and then Is_Local_Type (Type_Scope);
end if;
begin
loop
- if Ancestor = Original_Scope then
+ if Ancestor = Original_Type then
return True;
+
+ -- The ancestor may have a partial view of the original
+ -- type, but if the full view is in scope, as in a child
+ -- body, the component is visible.
+
+ elsif In_Private_Part (Scope (Original_Type))
+ and then Full_View (Ancestor) = Original_Type
+ then
+ return True;
+
elsif Ancestor = Etype (Ancestor) then
+
+ -- No further ancestors to examine.
+
return False;
end if;
-- could be nested inside some other record that is constrained by
-- nondiscriminants). That is, the recursive calls are too conservative.
+ function Has_Discrim_Dep_Array (Typ : Entity_Id) return Boolean;
+ -- True if we find certain discriminant-dependent array
+ -- subcomponents. This shouldn't be necessary, but without this check,
+ -- we crash in gimplify. ???
+
function Caller_Known_Size_Record (Typ : Entity_Id) return Boolean is
pragma Assert (Typ = Underlying_Type (Typ));
return True;
end Caller_Known_Size_Record;
- -- Local deeclarations
+ function Has_Discrim_Dep_Array (Typ : Entity_Id) return Boolean is
+ pragma Assert (Typ = Underlying_Type (Typ));
+
+ begin
+ if Is_Array_Type (Typ) then
+ return Size_Depends_On_Discriminant (Typ);
+ end if;
+
+ if Is_Record_Type (Typ)
+ or else
+ Is_Protected_Type (Typ)
+ then
+ declare
+ Comp : Entity_Id := First_Entity (Typ);
+
+ begin
+ while Present (Comp) loop
+
+ -- Only look at E_Component entities. No need to look at
+ -- E_Discriminant entities, and we must ignore internal
+ -- subtypes generated for constrained components.
+
+ if Ekind (Comp) = E_Component then
+ declare
+ Comp_Type : constant Entity_Id :=
+ Underlying_Type (Etype (Comp));
+
+ begin
+ if Has_Discrim_Dep_Array (Comp_Type) then
+ return True;
+ end if;
+ end;
+ end if;
+
+ Next_Entity (Comp);
+ end loop;
+ end;
+ end if;
+
+ return False;
+ end Has_Discrim_Dep_Array;
+
+ -- Local declarations
Typ : constant Entity_Id := Underlying_Type (Id);
elsif Is_Tagged_Type (Typ) or else Has_Controlled_Component (Typ) then
return not Is_Value_Type (Typ);
- -- Indefinite (discriminated) untagged record or protected type
-
- elsif Is_Record_Type (Typ) or else Is_Protected_Type (Typ) then
- return not Caller_Known_Size_Record (Typ);
- -- ???Should come after Is_Definite_Subtype below
-
-- Untagged definite subtypes are known size. This includes all
-- elementary [sub]types. Tasks are known size even if they have
-- discriminants.
elsif Is_Definite_Subtype (Typ) or else Is_Task_Type (Typ) then
- if Is_Array_Type (Typ) -- ???Shouldn't be necessary
- and then New_Requires_Transient_Scope
- (Underlying_Type (Component_Type (Typ)))
- then
- return True;
+ if Is_Record_Type (Typ) or else Is_Protected_Type (Typ) then
+ if not Has_Discriminants (Typ) then
+ if Has_Discrim_Dep_Array (Typ) then
+ return True; -- ???Shouldn't be necessary
+ end if;
+ end if;
end if;
return False;
+ -- Indefinite (discriminated) untagged record or protected type
+
+ elsif Is_Record_Type (Typ) or else Is_Protected_Type (Typ) then
+ return not Caller_Known_Size_Record (Typ);
+
-- Unconstrained array
else
-- returned. Otherwise the Etype of the node is returned.
function Get_Body_From_Stub (N : Node_Id) return Node_Id;
- -- Return the body node for a stub (subprogram or package)
+ -- Return the body node for a stub.
function Get_Cursor_Type
(Aspect : Node_Id;
projects / gcc.git / commitdiff