@@ -970,6 +970,18 @@ static bool sem_check_const_decl(tree_t t, nametab_t *tab)
970970
971971 if (fwd == NULL )
972972 sem_propagate_constraints (t , value );
973+
974+ // A constant with a globaly static value should be treated as
975+ // globally static regardless of where it is declared
976+ if (sem_globally_static (value )) {
977+ tree_set_flag (t , TREE_F_GLOBALLY_STATIC );
978+
979+ // A reference to a constant with a locally static subype and
980+ // locally static value is locally static
981+ if (sem_locally_static (value )
982+ && sem_static_subtype (tree_type (t ), sem_locally_static ))
983+ tree_set_flag (t , TREE_F_LOCALLY_STATIC );
984+ }
973985 }
974986 else if (tree_kind (find_enclosing (tab , S_DESIGN_UNIT )) != T_PACKAGE )
975987 sem_error (t , "deferred constant declarations are only permitted "
@@ -1447,6 +1459,13 @@ static bool sem_check_generic_decl(tree_t t, nametab_t *tab)
14471459 type_pp (type ));
14481460 }
14491461
1462+ if (tree_flags (t ) & TREE_F_LOCALLY_STATIC ) {
1463+ // For a generic declaration in a pacakage or subprogram to be
1464+ // locally static it must also have a locally static subtype
1465+ if (!sem_static_subtype (type , sem_locally_static ))
1466+ tree_clear_flag (t , TREE_F_LOCALLY_STATIC );
1467+ }
1468+
14501469 return true;
14511470}
14521471
@@ -5530,20 +5549,17 @@ static bool sem_locally_static(tree_t t)
55305549
55315550 // A constant reference (other than a deferred constant) with a
55325551 // locally static value
5533- if (dkind == T_CONST_DECL ) {
5534- if (tree_has_value (decl ))
5535- return sem_locally_static (tree_value (decl ));
5536- else
5537- return false;
5538- }
5552+ if (dkind == T_CONST_DECL && (tree_flags (decl ) & TREE_F_LOCALLY_STATIC ))
5553+ return true;
55395554
55405555 // An alias of a locally static name
55415556 if (dkind == T_ALIAS )
55425557 return sem_locally_static (tree_value (decl ));
55435558
5544- // [2008] A generic reference with a locally static subtype
5545- if (dkind == T_GENERIC_DECL && (standard () >= STD_08 || relaxed_rules ()))
5546- return sem_static_subtype (tree_type (decl ), sem_locally_static );
5559+ // [2008] A formal generic constant of a generic-mapped subprogram
5560+ // or package with a locally static subtype
5561+ if (dkind == T_GENERIC_DECL && (tree_flags (decl ) & TREE_F_LOCALLY_STATIC ))
5562+ return true;
55475563 }
55485564
55495565 // A locally static range
@@ -5794,8 +5810,16 @@ static bool sem_globally_static(tree_t t)
57945810
57955811 if (kind == T_REF ) {
57965812 tree_t decl = tree_ref (t );
5797- const tree_kind_t decl_kind = tree_kind (decl );
5798- return decl_kind == T_GENERIC_DECL || decl_kind == T_CONST_DECL ;
5813+ switch (tree_kind (decl )) {
5814+ case T_GENERIC_DECL :
5815+ return true;
5816+ case T_CONST_DECL :
5817+ // Do not treat all constants as globally static, this is a
5818+ // defect in the LRM
5819+ return !!(tree_flags (decl ) & TREE_F_GLOBALLY_STATIC );
5820+ default :
5821+ return false;
5822+ }
57995823 }
58005824 else if (kind == T_EXTERNAL_NAME )
58015825 return tree_class (t ) == C_CONSTANT ;
@@ -7157,20 +7181,6 @@ static bool sem_check_cond_value(tree_t t, nametab_t *tab)
71577181 return true;
71587182}
71597183
7160- static bool sem_check_sequence (tree_t t , nametab_t * tab )
7161- {
7162- const int ndecls = tree_decls (t );
7163- for (int i = 0 ; i < ndecls ; i ++ ) {
7164- // Mark all constant declarations as they need to be treated
7165- // specially when calculating longest static prefix
7166- tree_t d = tree_decl (t , i );
7167- if (tree_kind (d ) == T_CONST_DECL )
7168- tree_set_flag (d , TREE_F_SEQ_BLOCK );
7169- }
7170-
7171- return true;
7172- }
7173-
71747184static bool sem_check_prot_decl (tree_t t , nametab_t * tab )
71757185{
71767186 const int ndecls = tree_decls (t );
@@ -7349,6 +7359,7 @@ bool sem_check(tree_t t, nametab_t *tab)
73497359 case T_BOX :
73507360 case T_PSL :
73517361 case T_LOOP :
7362+ case T_SEQUENCE :
73527363 return true;
73537364 case T_CONV_FUNC :
73547365 return sem_check_conv_func (t , tab );
@@ -7374,8 +7385,6 @@ bool sem_check(tree_t t, nametab_t *tab)
73747385 return sem_check_view_decl (t , tab );
73757386 case T_COND_VALUE :
73767387 return sem_check_cond_value (t , tab );
7377- case T_SEQUENCE :
7378- return sem_check_sequence (t , tab );
73797388 case T_PROT_DECL :
73807389 return sem_check_prot_decl (t , tab );
73817390 case T_INERTIAL :
0 commit comments