Commit c206e8fd by Arnaud Charlet

sem_ch3.adb, [...]: Minor reformatting

        * sem_ch3.adb, sem_ch6.adb: Minor reformatting

        * adaint.c (__gnat_is_readable_file): Check for file existence
        when not using ACL (always the case on remote drives).

From-SVN: r146406
parent 5987e59c
...@@ -1956,7 +1956,7 @@ __gnat_is_readable_file (char *name) ...@@ -1956,7 +1956,7 @@ __gnat_is_readable_file (char *name)
return __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping); return __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
} }
else else
return 1; return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else #else
int ret; int ret;
......
...@@ -5527,14 +5527,14 @@ package body Sem_Ch3 is ...@@ -5527,14 +5527,14 @@ package body Sem_Ch3 is
-- derived from the full view of the parent, and hopefully has -- derived from the full view of the parent, and hopefully has
-- known discriminants. -- known discriminants.
-- If the full view of the parent type has its underlying record view -- If the full view of the parent type has an underlying record view,
-- available then use it to generate the underlying record view of -- use it to generate the underlying record view of this derived type
-- this Derived_Type (required to handle chains of derivations with -- (required for chains of derivations with unknown discriminants).
-- unknown discriminants).
-- Minor optimization: We avoid the generation of useless underlying -- Minor optimization: we avoid the generation of useless underlying
-- record view entities if the private type declaration has unknown -- record view entities if the private type declaration has unknown
-- discriminants but its corresponding full view has no discriminants -- discriminants but its corresponding full view has no
-- discriminants.
if Has_Unknown_Discriminants (Parent_Type) if Has_Unknown_Discriminants (Parent_Type)
and then Present (Full_P) and then Present (Full_P)
...@@ -5575,8 +5575,8 @@ package body Sem_Ch3 is ...@@ -5575,8 +5575,8 @@ package body Sem_Ch3 is
Set_Has_Private_Declaration (Full_Der); Set_Has_Private_Declaration (Full_Der);
Set_Has_Private_Declaration (Derived_Type); Set_Has_Private_Declaration (Derived_Type);
-- If the parent type has its underlying record view then we -- If the parent type has an underlying record view, use it
-- force here its use to derive the new underlying record view. -- here to build the new underlying record view.
if Present (Underlying_Record_View (Full_P)) then if Present (Underlying_Record_View (Full_P)) then
pragma Assert pragma Assert
...@@ -5590,12 +5590,11 @@ package body Sem_Ch3 is ...@@ -5590,12 +5590,11 @@ package body Sem_Ch3 is
Install_Visible_Declarations (Par_Scope); Install_Visible_Declarations (Par_Scope);
Insert_After (N, Decl); Insert_After (N, Decl);
-- Mark the entity as underlying record view before its -- Mark entity as an underlying record view before analysis,
-- analysis. Done to avoid the generation of its list of -- to avoid generating the list of its primitive operations
-- primitives (which is not really required for this entity) -- (which is not really required for this entity) and thus
-- and thus avoid supurious errors associated with missing -- prevent spurious errors associated with missing overriding
-- overriding of its abstract primitives (because they are -- of abstract primitives (overridden only for Derived_Type).
-- overriden in the list of primitives of Derived_Type).
Set_Ekind (Full_Der, E_Record_Type); Set_Ekind (Full_Der, E_Record_Type);
Set_Is_Underlying_Record_View (Full_Der); Set_Is_Underlying_Record_View (Full_Der);
...@@ -5607,20 +5606,19 @@ package body Sem_Ch3 is ...@@ -5607,20 +5606,19 @@ package body Sem_Ch3 is
Uninstall_Declarations (Par_Scope); Uninstall_Declarations (Par_Scope);
-- Freeze the underlying record view, to prevent generation -- Freeze the underlying record view, to prevent generation of
-- of useless dispatching information, which is simply shared -- useless dispatching information, which is simply shared with
-- with the real derived type. -- the real derived type.
Set_Is_Frozen (Full_Der); Set_Is_Frozen (Full_Der);
-- Keep fully linked the real entity and its underlying record -- Set up links between real entity and underlying record view
-- view entity
Set_Underlying_Record_View (Derived_Type, Base_Type (Full_Der)); Set_Underlying_Record_View (Derived_Type, Base_Type (Full_Der));
Set_Underlying_Record_View (Base_Type (Full_Der), Derived_Type); Set_Underlying_Record_View (Base_Type (Full_Der), Derived_Type);
end; end;
-- if discriminants are known, build derived record -- If discriminants are known, build derived record
else else
Build_Derived_Record_Type Build_Derived_Record_Type
...@@ -5645,12 +5643,12 @@ package body Sem_Ch3 is ...@@ -5645,12 +5643,12 @@ package body Sem_Ch3 is
Insert_After (N, Full_Decl); Insert_After (N, Full_Decl);
else else
-- If this is a completion, the full view being built is -- If this is a completion, the full view being built is itself
-- itself private. We build a subtype of the parent with -- private. We build a subtype of the parent with the same
-- the same constraints as this full view, to convey to the -- constraints as this full view, to convey to the back end the
-- back end the constrained components and the size of this -- constrained components and the size of this subtype. If the
-- subtype. If the parent is constrained, its full view can -- parent is constrained, its full view can serve as the
-- serve as the underlying full view of the derived type. -- underlying full view of the derived type.
if No (Discriminant_Specifications (N)) then if No (Discriminant_Specifications (N)) then
if Nkind (Subtype_Indication (Type_Definition (N))) = if Nkind (Subtype_Indication (Type_Definition (N))) =
...@@ -5666,7 +5664,7 @@ package body Sem_Ch3 is ...@@ -5666,7 +5664,7 @@ package body Sem_Ch3 is
else else
-- If there are new discriminants, the parent subtype is -- If there are new discriminants, the parent subtype is
-- constrained by them, but it is not clear how to build -- constrained by them, but it is not clear how to build
-- the underlying_full_view in this case ??? -- the Underlying_Full_View in this case???
null; null;
end if; end if;
...@@ -5678,9 +5676,7 @@ package body Sem_Ch3 is ...@@ -5678,9 +5676,7 @@ package body Sem_Ch3 is
Build_Derived_Record_Type Build_Derived_Record_Type
(N, Parent_Type, Derived_Type, Derive_Subps); (N, Parent_Type, Derived_Type, Derive_Subps);
if Present (Full_View (Parent_Type)) if Present (Full_View (Parent_Type)) and then not Is_Completion then
and then not Is_Completion
then
if not In_Open_Scopes (Par_Scope) if not In_Open_Scopes (Par_Scope)
or else not In_Same_Source_Unit (N, Parent_Type) or else not In_Same_Source_Unit (N, Parent_Type)
then then
...@@ -5710,8 +5706,8 @@ package body Sem_Ch3 is ...@@ -5710,8 +5706,8 @@ package body Sem_Ch3 is
end if; end if;
else else
-- If full view of parent is tagged, the completion -- If full view of parent is tagged, the completion inherits
-- inherits the proper primitive operations. -- the proper primitive operations.
Set_Defining_Identifier (Full_Decl, Full_Der); Set_Defining_Identifier (Full_Decl, Full_Der);
Build_Derived_Record_Type Build_Derived_Record_Type
...@@ -5732,13 +5728,12 @@ package body Sem_Ch3 is ...@@ -5732,13 +5728,12 @@ package body Sem_Ch3 is
Set_Full_View (Der_Base, Base_Type (Full_Der)); Set_Full_View (Der_Base, Base_Type (Full_Der));
-- Copy the discriminant list from full view to the partial views -- Copy the discriminant list from full view to the partial views
-- (base type and its subtype). Gigi requires that the partial -- (base type and its subtype). Gigi requires that the partial and
-- and full views have the same discriminants. -- full views have the same discriminants.
-- Note that since the partial view is pointing to discriminants -- Note that since the partial view is pointing to discriminants
-- in the full view, their scope will be that of the full view. -- in the full view, their scope will be that of the full view.
-- This might cause some front end problems and need -- This might cause some front end problems and need adjustment???
-- adjustment???
Discr := First_Discriminant (Base_Type (Full_Der)); Discr := First_Discriminant (Base_Type (Full_Der));
Set_First_Entity (Der_Base, Discr); Set_First_Entity (Der_Base, Discr);
...@@ -5756,10 +5751,10 @@ package body Sem_Ch3 is ...@@ -5756,10 +5751,10 @@ package body Sem_Ch3 is
Set_Stored_Constraint (Full_Der, Stored_Constraint (Derived_Type)); Set_Stored_Constraint (Full_Der, Stored_Constraint (Derived_Type));
else else
-- If this is a completion, the derived type stays private -- If this is a completion, the derived type stays private and
-- and there is no need to create a further full view, except -- there is no need to create a further full view, except in the
-- in the unusual case when the derivation is nested within a -- unusual case when the derivation is nested within a child unit,
-- child unit, see below. -- see below.
null; null;
end if; end if;
...@@ -5777,14 +5772,14 @@ package body Sem_Ch3 is ...@@ -5777,14 +5772,14 @@ package body Sem_Ch3 is
return; return;
end if; end if;
-- If full view of parent is a record type, Build full view as -- If full view of parent is a record type, build full view as a
-- a derivation from the parent's full view. Partial view remains -- derivation from the parent's full view. Partial view remains
-- private. For code generation and linking, the full view must -- private. For code generation and linking, the full view must have
-- have the same public status as the partial one. This full view -- the same public status as the partial one. This full view is only
-- is only needed if the parent type is in an enclosing scope, so -- needed if the parent type is in an enclosing scope, so that the
-- that the full view may actually become visible, e.g. in a child -- full view may actually become visible, e.g. in a child unit. This
-- unit. This is both more efficient, and avoids order of freezing -- is both more efficient, and avoids order of freezing problems with
-- problems with the added entities. -- the added entities.
if not Is_Private_Type (Full_View (Parent_Type)) if not Is_Private_Type (Full_View (Parent_Type))
and then (In_Open_Scopes (Scope (Parent_Type))) and then (In_Open_Scopes (Scope (Parent_Type)))
...@@ -5809,8 +5804,8 @@ package body Sem_Ch3 is ...@@ -5809,8 +5804,8 @@ package body Sem_Ch3 is
Derive_Subps => False); Derive_Subps => False);
end if; end if;
-- In any case, the primitive operations are inherited from -- In any case, the primitive operations are inherited from the
-- the parent type, not from the internal full view. -- parent type, not from the internal full view.
Set_Etype (Base_Type (Derived_Type), Base_Type (Parent_Type)); Set_Etype (Base_Type (Derived_Type), Base_Type (Parent_Type));
...@@ -5832,8 +5827,7 @@ package body Sem_Ch3 is ...@@ -5832,8 +5827,7 @@ package body Sem_Ch3 is
and then Present (Full_View (Parent_Type)) and then Present (Full_View (Parent_Type))
and then not Is_Tagged_Type (Full_View (Parent_Type)) and then not Is_Tagged_Type (Full_View (Parent_Type))
then then
Error_Msg_N Error_Msg_N ("cannot add discriminants to untagged type", N);
("cannot add discriminants to untagged type", N);
end if; end if;
Set_Stored_Constraint (Derived_Type, No_Elist); Set_Stored_Constraint (Derived_Type, No_Elist);
...@@ -5850,13 +5844,13 @@ package body Sem_Ch3 is ...@@ -5850,13 +5844,13 @@ package body Sem_Ch3 is
(Base_Type (Derived_Type), Finalize_Storage_Only (Parent_Type)); (Base_Type (Derived_Type), Finalize_Storage_Only (Parent_Type));
end if; end if;
-- Construct the implicit full view by deriving from full view of -- Construct the implicit full view by deriving from full view of the
-- the parent type. In order to get proper visibility, we install -- parent type. In order to get proper visibility, we install the
-- the parent scope and its declarations. -- parent scope and its declarations.
-- ??? if the parent is untagged private and its completion is -- ??? If the parent is untagged private and its completion is
-- tagged, this mechanism will not work because we cannot derive -- tagged, this mechanism will not work because we cannot derive from
-- from the tagged full view unless we have an extension -- the tagged full view unless we have an extension.
if Present (Full_View (Parent_Type)) if Present (Full_View (Parent_Type))
and then not Is_Tagged_Type (Full_View (Parent_Type)) and then not Is_Tagged_Type (Full_View (Parent_Type))
...@@ -5929,11 +5923,11 @@ package body Sem_Ch3 is ...@@ -5929,11 +5923,11 @@ package body Sem_Ch3 is
and then Scope (Parent_Type) /= Current_Scope and then Scope (Parent_Type) /= Current_Scope
then then
-- This is the unusual case where a type completed by a private -- This is the unusual case where a type completed by a private
-- derivation occurs within a package nested in a child unit, -- derivation occurs within a package nested in a child unit, and
-- and the parent is declared in an ancestor. In this case, the -- the parent is declared in an ancestor. In this case, the full
-- full view of the parent type will become visible in the body -- view of the parent type will become visible in the body of the
-- of the enclosing child, and only then will the current type -- enclosing child, and only then will the current type be
-- be possibly non-private. We build a underlying full view that -- possibly non-private. We build a underlying full view that
-- will be installed when the enclosing child body is compiled. -- will be installed when the enclosing child body is compiled.
Full_Der := Full_Der :=
...@@ -7121,8 +7115,8 @@ package body Sem_Ch3 is ...@@ -7121,8 +7115,8 @@ package body Sem_Ch3 is
Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Base)); Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Base));
end if; end if;
-- Minor optimization: There is no need to generate the class wide -- Minor optimization: there is no need to generate the class-wide
-- entity associated with an underlying record view -- entity associated with an underlying record view.
if not Is_Underlying_Record_View (Derived_Type) then if not Is_Underlying_Record_View (Derived_Type) then
Make_Class_Wide_Type (Derived_Type); Make_Class_Wide_Type (Derived_Type);
...@@ -7322,8 +7316,8 @@ package body Sem_Ch3 is ...@@ -7322,8 +7316,8 @@ package body Sem_Ch3 is
end if; end if;
end if; end if;
-- Update the class_wide type, which shares the now-completed entity -- Update the class-wide type, which shares the now-completed entity
-- list with its specific type. In case of underlying record views -- list with its specific type. In case of underlying record views,
-- we do not generate the corresponding class wide entity. -- we do not generate the corresponding class wide entity.
if Is_Tagged if Is_Tagged
...@@ -13189,7 +13183,7 @@ package body Sem_Ch3 is ...@@ -13189,7 +13183,7 @@ package body Sem_Ch3 is
Error_Msg_N ("null exclusion can only apply to an access type", N); Error_Msg_N ("null exclusion can only apply to an access type", N);
end if; end if;
-- Avoid deriving parent primitives in underlying record views -- Avoid deriving parent primitives of underlying record views
Build_Derived_Type (N, Parent_Type, T, Is_Completion, Build_Derived_Type (N, Parent_Type, T, Is_Completion,
Derive_Subps => not Is_Underlying_Record_View (T)); Derive_Subps => not Is_Underlying_Record_View (T));
......
...@@ -583,8 +583,8 @@ package body Sem_Ch6 is ...@@ -583,8 +583,8 @@ package body Sem_Ch6 is
Error_Msg_N ("must use anonymous access type", Subtype_Ind); Error_Msg_N ("must use anonymous access type", Subtype_Ind);
end if; end if;
-- Subtype_indication case; check that the types are the same, and -- Subtype indication case: check that the types are the same, and
-- statically match if appropriate. Handle also record types with -- statically match if appropriate. Also handle record types with
-- unknown discriminants for which we have built the underlying -- unknown discriminants for which we have built the underlying
-- record view. -- record view.
......
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